From f72dbf5800c881f741a4d5453f91effca9e58774 Mon Sep 17 00:00:00 2001 From: Marc Lehmann Date: Fri, 11 Jun 1999 19:35:23 +0000 Subject: [PATCH] see plug-ins/perl/Changes --- plug-ins/perl/Changes | 1 + plug-ins/perl/Gimp.pm | 12 ++++--- plug-ins/perl/Gimp/Lib.xs | 56 +++++++++++++++++++++++++++++ plug-ins/perl/Gimp/Util.pm | 3 +- plug-ins/perl/TODO | 6 ++-- plug-ins/perl/examples/pixelmap | 2 +- plug-ins/perl/examples/scratches.pl | 2 +- 7 files changed, 72 insertions(+), 10 deletions(-) diff --git a/plug-ins/perl/Changes b/plug-ins/perl/Changes index 0d58d5706a..e053b004b1 100644 --- a/plug-ins/perl/Changes +++ b/plug-ins/perl/Changes @@ -1,5 +1,6 @@ Revision history for Gimp-Perl extension. + - possible workaround for Gimp::Util::gimp_layer_get_position. - WRAP, SMEAR and BLACK were not being exported. - fixed small bug in pixelmap. - implemented gimp_query_procedure in XS. diff --git a/plug-ins/perl/Gimp.pm b/plug-ins/perl/Gimp.pm index bbd3441e62..c137a01889 100644 --- a/plug-ins/perl/Gimp.pm +++ b/plug-ins/perl/Gimp.pm @@ -51,6 +51,7 @@ $VERSION = 1.092; 'PARASITE_UNDOABLE', 'PARASITE_PARENT_UNDOABLE', 'PARASITE_GRANDPARENT_UNDOABLE', 'TRACE_NONE', 'TRACE_CALL', 'TRACE_TYPE', 'TRACE_NAME', 'TRACE_DESC', 'TRACE_ALL', 'COMPRESSION_NONE', 'COMPRESSION_LZW', 'COMPRESSION_PACKBITS', + 'WRAP', 'SMEAR', 'BLACK', ); @_procs = ('main','xlfd_size'); @@ -115,7 +116,7 @@ sub import($;@) { if ($_ eq ":auto") { push(@export,@_consts,@_procs); *{"$up\::AUTOLOAD"} = sub { - croak "cannot autoload '$AUTOLOAD' at this time" unless initialized(); + croak "Cannot call '$AUTOLOAD' at this time" unless initialized(); my ($class,$name) = $AUTOLOAD =~ /^(.*)::(.*?)$/; *{$AUTOLOAD} = sub { Gimp->$name(@_) }; goto &$AUTOLOAD; @@ -431,7 +432,7 @@ sub AUTOLOAD { my $ref = \&{"Gimp::Util::$sub"}; *{$AUTOLOAD} = sub { shift unless ref $_[0]; -# goto &$ref # does not always work, PERLBUG! #FIXME + #goto &$ref; # does not always work, PERLBUG! #FIXME my @r = eval { &$ref }; _croak $@ if $@; wantarray ? @r : $r[0]; @@ -441,7 +442,7 @@ sub AUTOLOAD { my $ref = \&{"$interface_pkg\::$sub"}; *{$AUTOLOAD} = sub { shift unless ref $_[0]; -# goto &$ref; # does not always work, PERLBUG! #FIXME + #goto &$ref; # does not always work, PERLBUG! #FIXME my @r = eval { &$ref }; _croak $@ if $@; wantarray ? @r : $r[0]; @@ -450,8 +451,9 @@ sub AUTOLOAD { } elsif (_gimp_procedure_available ($sub)) { *{$AUTOLOAD} = sub { shift unless ref $_[0]; -# goto gimp_call_procedure # does not always work, PERLBUG! #FIXME - my @r=eval { gimp_call_procedure ($sub,@_) }; + unshift @_,$sub; + #goto &gimp_call_procedure; # does not always work, PERLBUG! #FIXME + my @r=eval { gimp_call_procedure (@_) }; _croak $@ if $@; wantarray ? @r : $r[0]; }; diff --git a/plug-ins/perl/Gimp/Lib.xs b/plug-ins/perl/Gimp/Lib.xs index 58d271c3a8..5c48157f89 100644 --- a/plug-ins/perl/Gimp/Lib.xs +++ b/plug-ins/perl/Gimp/Lib.xs @@ -599,6 +599,28 @@ convert_array2paramdef (AV *av, GParamDef **res) return count; } +SV * +newSV_paramdefs (GParamDef *p, int n) +{ + int i; + AV *av = newAV (); + + av_extend (av, n-1); + for (i=0; itype)); + av_store (a, 1, newSVpv (p->name,0)); + av_store (a, 2, newSVpv (p->description,0)); + p++; + + av_store (av, i, newRV_noinc ((SV*)a)); + } + + return newRV_noinc ((SV*)av); +} + static HV * param_stash (GParamType type) { @@ -1409,6 +1431,40 @@ _gimp_procedure_available(proc_name) OUTPUT: RETVAL +# checks wether a gimp procedure exists +void +gimp_query_procedure(proc_name) + char * proc_name + PPCODE: + { + char *proc_blurb; + char *proc_help; + char *proc_author; + char *proc_copyright; + char *proc_date; + int proc_type; + int nparams; + int nreturn_vals; + int n; + GParamDef *params; + GParamDef *return_vals; + + if (gimp_query_procedure (proc_name, &proc_blurb, &proc_help, &proc_author, + &proc_copyright, &proc_date, &proc_type, &nparams, &nreturn_vals, + ¶ms, &return_vals) == TRUE) + { + EXTEND (sp,8); + PUSHs (newSVpv (proc_blurb,0)); g_free (proc_blurb); + PUSHs (newSVpv (proc_help,0)); g_free (proc_help); + PUSHs (newSVpv (proc_author,0)); g_free (proc_author); + PUSHs (newSVpv (proc_copyright,0)); g_free (proc_copyright); + PUSHs (newSVpv (proc_date,0)); g_free (proc_date); + PUSHs (newSViv (proc_type)); + PUSHs (newSV_paramdefs (params, nparams)); destroy_paramdefs (params, nparams); + PUSHs (newSV_paramdefs (return_vals, nreturn_vals));destroy_paramdefs (return_vals, nreturn_vals); + } + } + void gimp_call_procedure (proc_name, ...) char * proc_name diff --git a/plug-ins/perl/Gimp/Util.pm b/plug-ins/perl/Gimp/Util.pm index 6973802d08..01828f628e 100644 --- a/plug-ins/perl/Gimp/Util.pm +++ b/plug-ins/perl/Gimp/Util.pm @@ -326,7 +326,8 @@ sub gimp_layer_get_position { my $layer = shift; my @layers = $layer->image->get_layers; for (0..$#layers) { - return $_ if ${$layers[$_]} == $$layer; + # the my is necessary for broken perl (return $_ => undef) + return (my $index=$_) if ${$layers[$_]} == $$layer; } (); } diff --git a/plug-ins/perl/TODO b/plug-ins/perl/TODO index 30d7cc8c3b..b12b3b19ea 100644 --- a/plug-ins/perl/TODO +++ b/plug-ins/perl/TODO @@ -10,6 +10,7 @@ make test TEST_VERBOSE=1 bugs + * Document spawn_options in Gimp::Net. * Selection => To Brush. [DONE] * --enable-perl=/tmp/leckmich * Kommandozeilenmodus(!). @@ -34,11 +35,13 @@ bugs important issues * gimp_progress_done + * gimp_progress_close + * maybe implement --enable-perl=runtime-only? + * --ui and --noui for Gimp::Fu * pdb_proc_renameto [DONE] * gimp_progress_init (1 & 2 args) * gimp_default_display (...) for libgimp * Gimp::Module for modules (!) - * gimp_progress_close * PerlCC configurable options for Perl-Server startup, Gipm_host etc. * implement CALLBACKS via the Perl-Server * PF_COORDS (just as Light Effects/FlareFX) @@ -50,7 +53,6 @@ important issues * register dummy function to calm gimp down (really??) * gimp->object_id, drawable_object_id remove! * vamp up homepage - * --ui and --noui for Gimp::Fu * Gimp::ping * allow plug-ins to register with only a drawable argument(!) * gradient button diff --git a/plug-ins/perl/examples/pixelmap b/plug-ins/perl/examples/pixelmap index ddaaf14778..16785df8f0 100755 --- a/plug-ins/perl/examples/pixelmap +++ b/plug-ins/perl/examples/pixelmap @@ -29,7 +29,7 @@ register "pixelmap", $expr =~ /\$y/ and $init.='$y = sequence(byte,$src->h); $y+=$src->y;'; $expr =~ /\$bpp/ and $init.='$bpp = $src->bpp;'; - $expr = "sub{$init\n#line 1\n$expr;\n$p}"; + $expr = "sub{$init\n#line 1\n$expr;\n\$p}"; my @bounds = $drawable->mask; { diff --git a/plug-ins/perl/examples/scratches.pl b/plug-ins/perl/examples/scratches.pl index 4281719f6c..0903ce4e1b 100755 --- a/plug-ins/perl/examples/scratches.pl +++ b/plug-ins/perl/examples/scratches.pl @@ -13,7 +13,7 @@ sub new_scratchlayer { $layer->fill (WHITE_IMAGE_FILL); $layer->noisify (0, 1, 1, 1, 0); $layer->mblur (0, $length, $angle); - $layer->levels (VALUE, 120, 255, $gamma, 0, 255); + $layer->levels (VALUE_LUT, 120, 255, $gamma, 0, 255); $layer; }