see plug-ins/perl/Changes

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.

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];
          };

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; i<n; i++)
+     {
+       AV *a = newAV ();
+       av_extend (a, 3-1);
+       av_store (a, 0, newSViv (p->type));
+       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,
+		    &params, &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

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;
    }
    ();
 }

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

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;
    {

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;
 }