mirror of https://github.com/GNOME/gimp.git
see plug-ins/perl/Changes
This commit is contained in:
Marc Lehmann
parent
ee7af4285d
commit
9df8a5b13c
plug-ins/perl
|
|
@ -1,5 +1,9 @@
|
|||
Revision history for Gimp-Perl extension.
|
||||
|
||||
|
||||
- fix around PDL-2.002 exporting its own ppport.h.
|
||||
- new script examples/frame_reshuffle.
|
||||
|
||||
1.095 Tue Jun 29 01:22:01 CEST 1999
|
||||
- finally cut support for gimp-1.0.2 and gtk-1.0,
|
||||
fix the underscore confusion in Gimp/Net.pm.
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@
|
|||
#include "perl.h"
|
||||
#include "XSUB.h"
|
||||
#define NEED_newCONSTSUB
|
||||
#include "ppport.h"
|
||||
#include "gppport.h"
|
||||
|
||||
/* FIXME */
|
||||
/* dirty is used in gimp.h. */
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@
|
|||
#include "EXTERN.h"
|
||||
#include "perl.h"
|
||||
#include "XSUB.h"
|
||||
#include "ppport.h"
|
||||
#include "gppport.h"
|
||||
|
||||
/* dirty is used in gimp.h AND in perl < 5.005 or with PERL_POLLUTE. */
|
||||
#ifdef dirty
|
||||
|
|
@ -184,7 +184,7 @@ static int gdrawable_free (SV *obj, MAGIC *mg)
|
|||
return 0;
|
||||
}
|
||||
|
||||
MGVTBL vtbl_gdrawable = {0, 0, 0, 0, gdrawable_free};
|
||||
static MGVTBL vtbl_gdrawable = {0, 0, 0, 0, gdrawable_free};
|
||||
|
||||
static SV *new_gdrawable (gint32 id)
|
||||
{
|
||||
|
|
@ -265,7 +265,7 @@ static int gpixelrgn_free (SV *obj, MAGIC *mg)
|
|||
return 0;
|
||||
}
|
||||
|
||||
MGVTBL vtbl_gpixelrgn = {0, 0, 0, 0, gpixelrgn_free};
|
||||
static MGVTBL vtbl_gpixelrgn = {0, 0, 0, 0, gpixelrgn_free};
|
||||
|
||||
static SV *new_gpixelrgn (SV *gdrawable, int x, int y, int width, int height, int dirty, int shadow)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -40,6 +40,7 @@ sub new {
|
|||
sub _cache {
|
||||
my $self = shift;
|
||||
my $fmt = shift;
|
||||
local $^W = 0;
|
||||
if (!$self->{doc}{$fmt} && $converter{$fmt}) {
|
||||
my $doc = $converter{$fmt}->($self->{path});
|
||||
undef $doc if $?>>8;
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ t/load.t
|
|||
t/loadlib.t
|
||||
t/run.t
|
||||
extradefs.h
|
||||
ppport.h
|
||||
gppport.h
|
||||
Perl-Server
|
||||
etc/configure
|
||||
etc/configure.in
|
||||
|
|
@ -102,3 +102,5 @@ examples/colourtoalpha
|
|||
examples/pixelmap
|
||||
embedxpm
|
||||
logo.xpm
|
||||
examples/frame_reshuffle
|
||||
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ $|=1;
|
|||
sethspin.pl animate_cells image_tile yinyang stamps font_table
|
||||
perlotine randomblends innerbevel fit-text guidegrid roundrectsel
|
||||
repdup centerguide stampify goldenmean triangle billboard mirrorsplit
|
||||
oneliners randomart1 pixelmap glowing_steel
|
||||
oneliners randomart1 pixelmap glowing_steel frame_reshuffle
|
||||
);
|
||||
@shebang = (map("examples/$_",@examples),
|
||||
qw(Perl-Server examples/example-net.pl examples/homepage-logo.pl
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@
|
|||
#include "perl.h"
|
||||
#include "XSUB.h"
|
||||
#define NEED_newCONSTSUB
|
||||
#include "ppport.h"
|
||||
#include "gppport.h"
|
||||
|
||||
#include <libgimp/gimpmodule.h>
|
||||
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
#include "perl.h"
|
||||
#include "XSUB.h"
|
||||
#define NEED_newCONSTSUB
|
||||
#include "ppport.h"
|
||||
#include "gppport.h"
|
||||
|
||||
#if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE)
|
||||
# undef printf
|
||||
|
|
|
|||
|
|
@ -310,6 +310,27 @@ sub query {
|
|||
[&Gimp::PARAM_INT32, "flags", "internal flags (must be 0)"],
|
||||
[&Gimp::PARAM_INT32, "extra", "multi-purpose ;)"],
|
||||
],[]);
|
||||
|
||||
Gimp->install_procedure("gimp_procedural_db_constant_register", "Register a plug-in specific integer constant",
|
||||
"Plug-ins should register their custom constants using this function, so".
|
||||
"other plug-ins (notably script-languages) can access these using symbolic names",
|
||||
"Marc Lehmann <pcg\@goof.com>", "Marc Lehmann", "1999-07-07",
|
||||
"<None>", "*",&Gimp::PROC_EXTENSION,
|
||||
[
|
||||
[&Gimp::PARAM_STRING, "procedure", "The name of the function that uses this constant"],
|
||||
[&Gimp::PARAM_STRING, "arg_num", "The name of the argument that this constant is used for"],
|
||||
[&Gimp::PARAM_STRING, "constant_name", "The name of the constant, should be all-uppercase"],
|
||||
[&Gimp::PARAM_INT32, "constant_value", "The (integer) value for this constant"],
|
||||
],[]);
|
||||
Gimp->install_procedure("gimp_procedural_db_set_default", "Set the default value for a plug-in argument",
|
||||
"Plug-ins should register default values for their arguments",
|
||||
"Marc Lehmann <pcg\@goof.com>", "Marc Lehmann", "1999-07-07",
|
||||
"<None>", "*",&Gimp::PROC_EXTENSION,
|
||||
[
|
||||
[&Gimp::PARAM_STRING, "procedure", "The name of the function that uses this constant"],
|
||||
[&Gimp::PARAM_STRING, "arg_num", "The name of the argument that this constant is used for"],
|
||||
[&Gimp::PARAM_INT32, "default_value", "The default value for this constant"],
|
||||
],[]);
|
||||
}
|
||||
|
||||
sub quit {
|
||||
|
|
|
|||
|
|
@ -0,0 +1,80 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use Gimp 1.095;
|
||||
use Gimp::Fu;
|
||||
|
||||
register "layer_reorder",
|
||||
"Reshuffle the order of layers in an image according to a function",
|
||||
"=pod",
|
||||
"Marc Lehmann <pcg\@goof.com>",
|
||||
"Marc Lehmann <pcg\@goof.com>",
|
||||
"19990707",
|
||||
"<Image>/Layers/Stack/Reorder Layers",
|
||||
"*",
|
||||
[
|
||||
[PF_RADIO, "function", "which remapping function to use: CUSTOM (0), REVERSE (1), SHIFT (2)", 1,
|
||||
[Custom => 0, Reverse => 1, Shift => 2] ],
|
||||
[PF_STRING, "custom", "the (optional) custom function to use, e.g. 'n-i' reverses the order"],
|
||||
],
|
||||
[],
|
||||
['gimp-1.1'],
|
||||
sub {
|
||||
my($img,$drawable,$function,$custom) = @_;
|
||||
|
||||
$custom = "-i" if $function == 1;
|
||||
$custom = "(i+$custom)%n" if $function == 2;
|
||||
|
||||
my @layers = $img->get_layers;
|
||||
|
||||
$layers[-1]->add_alpha;
|
||||
|
||||
# replace vars
|
||||
$custom =~ s/\bn\b/scalar@layers/ge;
|
||||
$custom =~ s/\bi\b/\$i/g;
|
||||
|
||||
$function = eval "sub { my \$i = shift;\n#line 0\n$custom\n}";
|
||||
die "syntax error in expression '$custom': $@\n" if $@;
|
||||
|
||||
# calculcate new order
|
||||
my $index = 0;
|
||||
@layers = map $_->[0],
|
||||
sort { $b->[1] <=> $a->[1] }
|
||||
map [$_, $function->($index++)],
|
||||
@layers;
|
||||
|
||||
# now re-order the layers
|
||||
$img->undo_push_group_start;
|
||||
for(@layers) {
|
||||
$img->raise_layer_to_top($_) unless $$_ == ${($img->get_layers)[0]};
|
||||
}
|
||||
Gimp->displays_flush;
|
||||
$img->undo_push_group_end;
|
||||
};
|
||||
|
||||
exit main;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This function re-orders the layer stack using either a builtin function
|
||||
(only reversal is available at the moment, contact me if you find another
|
||||
useful function) or a custom one.
|
||||
|
||||
REVERSE (1) will reverse the order of layers (it is equivalent to the custom
|
||||
function C<-i>).
|
||||
|
||||
SHIFT (2) will shift the sequence by the amount (positive or negative)
|
||||
indicated in the custom field. It is equivalent to the custom function
|
||||
C<( i + custom ) % n>.
|
||||
|
||||
If you specify CUSTOM (0) as function than you can use the "custom"
|
||||
argument to specify any function you like. Any C<i> is replaced by the
|
||||
index of the layer (C<0>..C<n-1>), any C<n> is replaced by the total
|
||||
number of layers. The function returns the new position of the layer,
|
||||
which is measured relative to all other positions, i.e. your function can
|
||||
return values 0.1, 0.7 and 0.3 for layers 0, 1 and 2 respectively, and the
|
||||
new order will be 0, 2 and 1.
|
||||
|
||||
Examples:
|
||||
|
||||
-i # reverse the order of layers
|
||||
(i+5)%n # shift the order of frames by 5
|
||||
|
|
@ -14,7 +14,7 @@ sub get_vguides { # get back an ordered set of vertical guides
|
|||
my ($img)=@_;
|
||||
$i=0;
|
||||
my @vguides;
|
||||
while ($i=$img->findnext_guide($i)) {
|
||||
while ($i=$img->find_next_guide($i)) {
|
||||
if (!$img->get_guide_orientation($i)){
|
||||
$keyval = sprintf("%4d", $img->get_guide_position($i));
|
||||
$vkeys{$keyval} = $i;
|
||||
|
|
@ -31,7 +31,7 @@ sub get_hguides { # get back an ordered set of horizontal guides
|
|||
my ($img)=@_;
|
||||
$i=0;
|
||||
my @hguides;
|
||||
while ($i=$img->findnext_guide($i)) {
|
||||
while ($i=$img->find_next_guide($i)) {
|
||||
if ($img->get_guide_orientation($i)){
|
||||
$keyval = sprintf("%4d", $img->get_guide_position($i));
|
||||
$hkeys{$keyval} = $i;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,291 @@
|
|||
|
||||
#ifndef _G_P_P_PORTABILITY_H_
|
||||
#define _G_P_P_PORTABILITY_H_
|
||||
|
||||
/* Perl/Pollution/Portability Version 1.0007-gimp-2 */
|
||||
|
||||
/* Copyright (C) 1999, Kenneth Albanowski. This code may be used and
|
||||
distributed under the same license as any version of Perl. */
|
||||
|
||||
/* For the latest version of this code, please retreive the Devel::PPPort
|
||||
module from CPAN, contact the author at <kjahds@kjahds.com>, or check
|
||||
with the Perl maintainers. */
|
||||
|
||||
/* If you needed to customize this file for your project, please mention
|
||||
your changes, and visible alter the version number. */
|
||||
|
||||
|
||||
/*
|
||||
In order for a Perl extension module to be as portable as possible
|
||||
across differing versions of Perl itself, certain steps need to be taken.
|
||||
Including this header is the first major one, then using dTHR is all the
|
||||
appropriate places and using a PL_ prefix to refer to global Perl
|
||||
variables is the second.
|
||||
*/
|
||||
|
||||
|
||||
/* If you use one of a few functions that were not present in earlier
|
||||
versions of Perl, please add a define before the inclusion of ppport.h
|
||||
for a static include, or use the GLOBAL request in a single module to
|
||||
produce a global definition that can be referenced from the other
|
||||
modules.
|
||||
|
||||
Function: Static define: Extern define:
|
||||
newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
|
||||
|
||||
*/
|
||||
|
||||
|
||||
/* To verify whether ppport.h is needed for your module, and whether any
|
||||
special defines should be used, ppport.h can be run through Perl to check
|
||||
your source code. Simply say:
|
||||
|
||||
perl -x ppport.h *.c *.h *.xs foo/any.c [etc]
|
||||
|
||||
The result will be a list of patches suggesting changes that should at
|
||||
least be acceptable, if not necessarily the most efficient solution, or a
|
||||
fix for all possible problems. It won't catch where dTHR is needed, and
|
||||
doesn't attempt to account for global macro or function definitions,
|
||||
nested includes, typemaps, etc.
|
||||
|
||||
In order to test for the need of dTHR, please try your module under a
|
||||
recent version of Perl that has threading compiled-in.
|
||||
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
#!/usr/bin/perl
|
||||
@ARGV = ("*.xs") if !@ARGV;
|
||||
%badmacros = %funcs = %macros = (); $replace = 0;
|
||||
foreach (<DATA>) {
|
||||
$funcs{$1} = 1 if /Provide:\s+(\S+)/;
|
||||
$macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
|
||||
$replace = $1 if /Replace:\s+(\d+)/;
|
||||
$badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/;
|
||||
$badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
|
||||
}
|
||||
foreach $filename (map(glob($_),@ARGV)) {
|
||||
unless (open(IN, "<$filename")) {
|
||||
warn "Unable to read from $file: $!\n";
|
||||
next;
|
||||
}
|
||||
print "Scanning $filename...\n";
|
||||
$c = ""; while (<IN>) { $c .= $_; } close(IN);
|
||||
$need_include = 0; %add_func = (); $changes = 0;
|
||||
$has_include = ($c =~ /#.*include.*ppport/m);
|
||||
|
||||
foreach $func (keys %funcs) {
|
||||
if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) {
|
||||
if ($c !~ /\b$func\b/m) {
|
||||
print "If $func isn't needed, you don't need to request it.\n" if
|
||||
$changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m);
|
||||
} else {
|
||||
print "Uses $func\n";
|
||||
$need_include = 1;
|
||||
}
|
||||
} else {
|
||||
if ($c =~ /\b$func\b/m) {
|
||||
$add_func{$func} =1 ;
|
||||
print "Uses $func\n";
|
||||
$need_include = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (not $need_include) {
|
||||
foreach $macro (keys %macros) {
|
||||
if ($c =~ /\b$macro\b/m) {
|
||||
print "Uses $macro\n";
|
||||
$need_include = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
foreach $badmacro (keys %badmacros) {
|
||||
if ($c =~ /\b$badmacro\b/m) {
|
||||
$changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm);
|
||||
print "Uses $badmacros{$badmacro} (instead of $badmacro)\n";
|
||||
$need_include = 1;
|
||||
}
|
||||
}
|
||||
|
||||
if (scalar(keys %add_func) or $need_include != $has_include) {
|
||||
if (!$has_include) {
|
||||
$inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
|
||||
"#include \"ppport.h\"\n";
|
||||
$c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m;
|
||||
} elsif (keys %add_func) {
|
||||
$inc = join('',map("#define NEED_$_\n", sort keys %add_func));
|
||||
$c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m;
|
||||
}
|
||||
if (!$need_include) {
|
||||
print "Doesn't seem to need ppport.h.\n";
|
||||
$c =~ s/^.*#.*include.*ppport.*\n//m;
|
||||
}
|
||||
$changes++;
|
||||
}
|
||||
|
||||
if ($changes) {
|
||||
open(OUT,">/tmp/ppport.h.$$");
|
||||
print OUT $c;
|
||||
close(OUT);
|
||||
open(DIFF, "diff -u $filename /tmp/ppport.h.$$|");
|
||||
while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; }
|
||||
close(DIFF);
|
||||
unlink("/tmp/ppport.h.$$");
|
||||
} else {
|
||||
print "Looks OK\n";
|
||||
}
|
||||
}
|
||||
__DATA__
|
||||
*/
|
||||
|
||||
#ifndef PERL_REVISION
|
||||
# ifndef __PATCHLEVEL_H_INCLUDED__
|
||||
# include "patchlevel.h"
|
||||
# endif
|
||||
# ifndef PERL_REVISION
|
||||
# define PERL_REVISION (5)
|
||||
/* Replace: 1 */
|
||||
# define PERL_VERSION PATCHLEVEL
|
||||
# define PERL_SUBVERSION SUBVERSION
|
||||
/* Replace PERL_PATCHLEVEL with PERL_VERSION */
|
||||
/* Replace: 0 */
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
|
||||
|
||||
#ifndef ERRSV
|
||||
# define ERRSV perl_get_sv("@",FALSE)
|
||||
#endif
|
||||
|
||||
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
|
||||
/* Replace: 1 */
|
||||
# define PL_sv_undef sv_undef
|
||||
# define PL_sv_yes sv_yes
|
||||
# define PL_sv_no sv_no
|
||||
# define PL_na na
|
||||
# define PL_stdingv stdingv
|
||||
# define PL_hints hints
|
||||
# define PL_curcop curcop
|
||||
# define PL_curstash curstash
|
||||
# define PL_copline copline
|
||||
# define PL_Sv Sv
|
||||
# define PL_perl_destruct_level perl_destruct_level
|
||||
/* Replace: 0 */
|
||||
#endif
|
||||
|
||||
#ifndef dTHR
|
||||
# ifdef WIN32
|
||||
# define dTHR extern int Perl___notused
|
||||
# else
|
||||
# define dTHR extern int errno
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#ifndef boolSV
|
||||
# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
|
||||
#endif
|
||||
|
||||
#ifndef gv_stashpvn
|
||||
# define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
|
||||
#endif
|
||||
|
||||
#ifndef newSVpvn
|
||||
# define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
|
||||
#endif
|
||||
|
||||
#ifndef newRV_inc
|
||||
/* Replace: 1 */
|
||||
# define newRV_inc(sv) newRV(sv)
|
||||
/* Replace: 0 */
|
||||
#endif
|
||||
|
||||
#ifndef newRV_noinc
|
||||
# ifdef __GNUC__
|
||||
# define newRV_noinc(sv) \
|
||||
({ \
|
||||
SV *nsv = (SV*)newRV(sv); \
|
||||
SvREFCNT_dec(sv); \
|
||||
nsv; \
|
||||
})
|
||||
# else
|
||||
# if defined(CRIPPLED_CC) || defined(USE_THREADS)
|
||||
static SV * newRV_noinc (SV * sv)
|
||||
{
|
||||
SV *nsv = (SV*)newRV(sv);
|
||||
SvREFCNT_dec(sv);
|
||||
return nsv;
|
||||
}
|
||||
# else
|
||||
# define newRV_noinc(sv) \
|
||||
((PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
|
||||
# endif
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/* Provide: newCONSTSUB */
|
||||
|
||||
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
|
||||
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
|
||||
|
||||
#if defined(NEED_newCONSTSUB)
|
||||
static
|
||||
#else
|
||||
extern void newCONSTSUB _((HV * stash, char * name, SV *sv));
|
||||
#endif
|
||||
|
||||
#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
|
||||
void
|
||||
newCONSTSUB(stash,name,sv)
|
||||
HV *stash;
|
||||
char *name;
|
||||
SV *sv;
|
||||
{
|
||||
U32 oldhints = PL_hints;
|
||||
HV *old_cop_stash = PL_curcop->cop_stash;
|
||||
HV *old_curstash = PL_curstash;
|
||||
line_t oldline = PL_curcop->cop_line;
|
||||
PL_curcop->cop_line = PL_copline;
|
||||
|
||||
PL_hints &= ~HINT_BLOCK_SCOPE;
|
||||
if (stash)
|
||||
PL_curstash = PL_curcop->cop_stash = stash;
|
||||
|
||||
newSUB(
|
||||
|
||||
#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
|
||||
/* before 5.003_22 */
|
||||
start_subparse(),
|
||||
#else
|
||||
# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
|
||||
/* 5.003_22 */
|
||||
start_subparse(0),
|
||||
# else
|
||||
/* 5.003_23 onwards */
|
||||
start_subparse(FALSE, 0),
|
||||
# endif
|
||||
#endif
|
||||
|
||||
newSVOP(OP_CONST, 0, newSVpv(name,0)),
|
||||
newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
|
||||
newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
|
||||
);
|
||||
|
||||
PL_hints = oldhints;
|
||||
PL_curcop->cop_stash = old_cop_stash;
|
||||
PL_curstash = old_curstash;
|
||||
PL_curcop->cop_line = oldline;
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif /* newCONSTSUB */
|
||||
|
||||
/*GIMP*/
|
||||
#ifndef SvPV_nolen
|
||||
# define SvPV_nolen(b) SvPV((b),PL_na)
|
||||
#endif
|
||||
|
||||
#endif /* _G_P_P_PORTABILITY_H_ */
|
||||
Loading…
Reference in New Issue