see plug-ins/perl/Changes

plug-ins/perl/Changes

 Revision history for Gimp-Perl extension.
 
-	- added examples/yinyang, examples/image_tile.
+	- added examples/yinyang, examples/image_tile, examples/stamps.
         - bangpath is no longer updated inplace. As a result, only plug-ins
           that are going to get installed are being fixed, the examples are
           not.
@@ -8,6 +8,10 @@ Revision history for Gimp-Perl extension.
 	  error handling.
 	- reworked callback handling, should be more flexible in the future.
         - changed implementation of PF_CUSTOM (still untested).
+        - fixed some rather scientific memory leaks, fixed more bugs.
+        - the case when "not enough arguments" were supplied for a function
+          was not reliably detected.
+        - gimp_progress_init now accepts either one or two arguments.
 
 1.061 Fri Mar 12 21:27:26 CET 1999
 	- closed big, BIG security hole on password authenticitation

plug-ins/perl/Gimp.pm

@@ -5,7 +5,7 @@ use Carp;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD %EXPORT_TAGS @EXPORT_FAIL
             @_consts @_procs $interface_pkg $interface_type @_param @_al_consts
             @PREFIXES $_PROT_VERSION
-            @gimp_gui_functions $function $ignore_die
+            @gimp_gui_functions $function
             $help $verbose $host);
 
 require DynaLoader;
@@ -269,6 +269,8 @@ EOF
 
 my @log;
 my $caller;
+my $ignore_die;
+my $in_quit;
 
 sub format_msg {
    $_=shift;
@@ -297,12 +299,12 @@ sub logger {
    $args{function} = ""                   unless defined $args{function};
    $args{fatal}    = 1                    unless defined $args{fatal};
    push(@log,[$file,@args{'function','message','fatal'}]);
-   print STDERR format_msg($log[-1]),"\n" if $verbose || $interface_type eq 'net';
+   print STDERR format_msg($log[-1]),"\n";
    _initialized_callback if initialized();
 }
 
 sub die_msg {
-   logger(message => substr($_[0],0,-1), fatal => 1, function => 'DIE');
+   logger(message => substr($_[0],0,-1), fatal => 1, function => 'ERROR');
 }
 
 sub call_callback {
@@ -328,14 +330,17 @@ sub callback {
    } elsif ($type eq "-query") {
       call_callback 1,"query";
    } elsif ($type eq "-quit") {
-      local $ignore_die = 0;
+      $ignore_die = 1;
       call_callback 0,"quit";
+      undef $ignore_die;
    }
 }
 
 sub main {
    $caller=caller;
-   &{"${interface_pkg}::gimp_main"};
+   #d# #D# # BIG BUG LURKING SOMEWHERE
+   # just calling exit() will be too much for bigexitbug.pl
+   xs_exit(&{"${interface_pkg}::gimp_main"});
 }
 
 # same as main, but callbacks are ignored
@@ -346,7 +351,7 @@ sub quiet_main {
 $SIG{__DIE__} = sub {
    if (!$^S && $ignore_die) {
       die_msg $_[0];
-      initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit main();
+      initialized() ? die "BE QUIET ABOUT THIS DIE\n" : xs_exit(main());
    } else {
      die $_[0];
    }
@@ -356,7 +361,7 @@ $SIG{__WARN__} = sub {
    if ($ignore_die) {
      warn $_[0];
    } else {
-     logger(message => substr($_[0],0,-1), fatal => 0, function => 'WARN');
+     logger(message => substr($_[0],0,-1), fatal => 0, function => 'WARNING');
    }
 };
 
@@ -401,7 +406,7 @@ sub ignore_functions(@) {
 
 sub _croak($) {
   $_[0] =~ s/ at .*? line \d+.*$//s;
-  Carp::croak $_[0];
+  croak($_[0]);
 }
 
 sub AUTOLOAD {
@@ -643,7 +648,14 @@ In a Gimp::Fu-script, you should call C<Gimp::Fu::main> instead:
  exit main;		# Gimp::Fu::main is exported by default as well.
 
 This is similar to Gtk, Tk or similar modules, where you have to call the
-main eventloop.
+main eventloop. Attention: although you call C<exit> with the result of
+C<main>, the main function might not actually return. This depends on both
+the version of Gimp and the version of the Gimp-Perl module that is in
+use.  Do not depend on C<main> to return at all, but still call C<exit>
+immediately.
+
+If you need to do cleanups before exiting you should use the C<quit>
+callback (which is not yet available if you use Gimp::Fu).
 
 =head1 CALLBACKS
 

plug-ins/perl/Gimp.xs

@@ -81,21 +81,28 @@ void
 _exit()
 	CODE:
 #ifdef HAVE__EXIT
-        _exit(0);
+	_exit(0);
 #elif defined(SIGKILL)
-        raise(SIGKILL);
+	raise(SIGKILL);
 #else
-        raise(9);
+	raise(9);
 #endif
-        abort();
+	abort();
+
+void
+xs_exit(status)
+	int	status
+	CODE:
+	exit (status);
 
 # this one is for prefix mismatch check.
+# should be replaced by a generic config mechanism
 char *
 _gimp_prefix()
 	CODE:
-        RETVAL = GIMP_PREFIX;
+	RETVAL = GIMP_PREFIX;
 	OUTPUT:
-        RETVAL
+	RETVAL
 
 BOOT:
 {

plug-ins/perl/Gimp/Feature.pm

@@ -41,7 +41,8 @@ sub import {
 
    while(@_) {
       $_=shift;
-      s/^:// and need($_);
+      s/^://;
+      need($_);
    }
 }
 
@@ -115,7 +116,7 @@ Gimp::Features - check for specific features to be present before registering th
 
 or
 
-  use Gimp::Features qw(:feature1 :feature2 ...);
+  use Gimp::Features qw(feature1 feature2 ...);
 
 =head1 DESCRIPTION
 

plug-ins/perl/Gimp/Fu.pm

@@ -64,6 +64,9 @@ In general, a Gimp::Fu script looks like this:
 C<examples/example-fu.pl>, which is small Gimp::Fu-script you can take as
 starting point for your experiments)
 
+Attention: at the moment it's neccessary to always import the C<Gimp::Fu>
+module after the C<Gimp> module.
+
 =cut
 
 sub PF_INT8	() { PARAM_INT8		};

plug-ins/perl/Gimp/Lib.pm

@@ -35,6 +35,14 @@ sub import {}
 
 bootstrap Gimp::Lib $VERSION;
 
+# various functions for 1.0 compatibility
+
+sub gimp_progress_init {
+   push @_,-1 if @_<2;
+   eval { gimp_call_procedure "gimp_progress_init",@_ };
+   gimp_call_procedure "gimp_progress_init",shift if $@;
+}
+
 # functions to "autobless" where the autobless mechanism
 # does not work.
 
@@ -72,11 +80,12 @@ sub gimp_tile_bpp		{ $_[0]->{_bpp}		}
 sub gimp_tile_shadow		{ $_[0]->{_shadow}	}
 sub gimp_tile_gdrawable		{ $_[0]->{_gdrawable}	}
 
+# be careful not to require AUTOLOAD here
 sub Gimp::PixelRgn::DESTROY {
    my $self = shift;
    return unless $self =~ /=HASH/;
-   $self->{_drawable}->{_id}->update($self->{_x},$self->{_y},$self->{_w},$self->{_h})
-      if $self->dirty;
+   gimp_call_procedure "gimp_drawable_update",$self->{_drawable}->{_id},$self->{_x},$self->{_y},$self->{_w},$self->{_h}
+      if gimp_pixel_rgn_dirty($self);
 };
 
 # this is here to be atomic over the perl-server

plug-ins/perl/Gimp/Net.pm

@@ -236,7 +236,8 @@ sub gimp_init {
 sub gimp_end {
    $initialized = 0;
 
-   close $server_fh;
+   close $server_fh if $server_fh;
+   undef $server_fh;
    kill 'KILL',$gimp_pid if $gimp_pid;
    undef $gimp_pid;
 }

plug-ins/perl/Gimp/PDL.pm

@@ -18,7 +18,7 @@ sub Gimp::Tile::get_data($) {
    my($tile)=@_;
    my($pdl)=new_from_specification PDL (byte,width(),height(),
                                         $tile->bpp > 1 ? $tile->bpp : ());
-   ${$pdl->get_dataref} = &Gimp::Tile::_get_data;
+   ${$pdl->get_dataref} = Gimp::Tile::_get_data(@_);
    $pdl->upd_data;
    return $pdl;
 };
@@ -26,7 +26,7 @@ sub Gimp::Tile::get_data($) {
 sub Gimp::PixelRgn::get_pixel {
    my($rgn)=@_;
    my($pdl)=new_from_specification PDL (byte,$_[0]->bpp);
-   ${$pdl->get_dataref} = &Gimp::PixelRgn::_get_pixel;
+   ${$pdl->get_dataref} = Gimp::PixelRgn::_get_pixel(@_);
    $pdl->upd_data;
    return $pdl;
 };
@@ -34,7 +34,7 @@ sub Gimp::PixelRgn::get_pixel {
 sub Gimp::PixelRgn::get_col {
    my($rgn)=@_;
    my($pdl)=new_from_specification PDL (byte,$_[0]->bpp,$_[3]);
-   ${$pdl->get_dataref} = &Gimp::PixelRgn::__get_col;
+   ${$pdl->get_dataref} = Gimp::PixelRgn::__get_col(@_);
    $pdl->upd_data;
    return $pdl;
 };
@@ -42,14 +42,14 @@ sub Gimp::PixelRgn::get_col {
 sub Gimp::PixelRgn::get_row {
    my($rgn)=@_;
    my($pdl)=new_from_specification PDL (byte,$_[0]->bpp,$_[3]);
-   ${$pdl->get_dataref} = &Gimp::PixelRgn::_get_row;
+   ${$pdl->get_dataref} = Gimp::PixelRgn::_get_row(@_);
    $pdl->upd_data;
    return $pdl;
 };
 
 sub Gimp::PixelRgn::get_rect {
    my($pdl)=new_from_specification PDL (byte,$_[0]->bpp,$_[3],$_[4]);
-   ${$pdl->get_dataref} = &Gimp::PixelRgn::_get_rect;
+   ${$pdl->get_dataref} = Gimp::PixelRgn::_get_rect(@_);
    $pdl->upd_data;
    return $pdl;
 };

plug-ins/perl/Gimp/Util.pm

@@ -271,7 +271,6 @@ sub gimp_image_layertype {
 
 sub gimp_image_add_new_layer {
    my ($image,$index,$filltype,$alpha)=@_;
-   print "ALPHA $alpha\n";
    my $layer = new Layer ($image, $image->width, $image->height, $image->layertype (defined $alpha ? $alpha : 1), join(":",(caller)[1,2]), 100, NORMAL_MODE);
    $layer->fill (defined $filltype ? $filltype : BG_IMAGE_FILL);
    $image->add_layer ($layer, $index*1);

plug-ins/perl/MANIFEST

@@ -68,3 +68,5 @@ examples/sethspin.pl
 examples/animate_cells
 examples/yinyang
 examples/image_tile
+examples/stamps
+

plug-ins/perl/Makefile.PL

@@ -9,7 +9,7 @@ $|=1;
    qw(windy.pl prep4gif.pl webify.pl PDB alpha2color.pl tex-to-float ditherize.pl
       border.pl view3d.pl feedback.pl xachlego.pl xachshadow.pl parasite-editor
       scratches.pl blowinout.pl terral_text xachvision.pl gimpmagick perlcc
-      sethspin.pl animate_cells image_tile yinyang
+      sethspin.pl animate_cells image_tile yinyang stamps
    );
 @shebang = (map("examples/$_",@examples),
    qw(Perl-Server examples/example-net.pl examples/homepage-logo.pl

plug-ins/perl/TODO

@@ -22,7 +22,7 @@ important issues
   * Gimp::Fu import after Gimp? use Gimp::main for Gimp::Fu??
   * generic config query mechanism
   * Gimp->server_eval()
-  * supply a gimp-1.1 compatible gimp_progress_init
+[DONE]  * supply a gimp-1.1 compatible gimp_progress_init
   * install scripts in share/
 [DONE]  * fix auto-edit shebang for check-ins
 [DONE]  * gimp-tiles are not accessible in any way..

plug-ins/perl/examples/PDB

@@ -2,7 +2,7 @@
 
 #BEGIN {$^W=1};
 
-use Gimp::Feature qw(:perl-5.005 :gtk);
+use Gimp::Feature qw(perl-5.005 gtk);
 use Gimp (':consts');
 use Gimp::Fu;
 use Gtk;

plug-ins/perl/examples/blowinout.pl

@@ -3,7 +3,7 @@
 # Blow In/Out
 # John Pitney
 
-use Gimp;
+use Gimp 1.06;
 use Gimp::Fu;
 
 # print "hello there\n";
@@ -102,6 +102,8 @@ register
 	 [PF_RADIO, "direction", "Blow direction", 0, [["In", 1],["Out", 0]]],
          [PF_RADIO, "series", "Kind of series", 1, [["Arithmetic",1],["Geometric",0]]]
 	],
+        [],
+        ['gtk-1.2'],
 	\&blowinout;
 
 exit main;

plug-ins/perl/examples/border.pl

@@ -2,7 +2,7 @@
 
 #BEGIN {$^W=1};
 
-use Gimp::Feature qw(:pdl);
+use Gimp::Feature qw(pdl);
 use Gimp;
 use Gimp::Fu;
 use Gimp::PDL;

plug-ins/perl/examples/gimpmagick

 #!/usr/bin/perl
 
-use Gimp::Feature qw(:gtk :perl-5.005);
+use Gimp::Feature qw(gtk perl-5.005);
 use Gimp 1.06;
 use Gimp::Fu;
 use Gtk;

plug-ins/perl/examples/parasite-editor

@@ -2,7 +2,7 @@
 
 #BEGIN {$^W=1};
 
-use Gimp::Feature qw(:perl-5.005 :gtk);
+use Gimp::Feature qw(perl-5.005 gtk);
 use Gimp ();
 use Gimp::Fu;
 use Gtk;

plug-ins/perl/examples/perlcc

@@ -56,7 +56,7 @@ sub generate_log {
 
 sub gtkview_log {
    if ($_[0]) {
-      destroy $_[0];
+      $_[0]->destroy;
       undef $_[0];
    } else {
       my($title,$log)=@_[1,2];

plug-ins/perl/examples/sethspin.pl

-#!/usr/bin/perl
+#!/usr/bin/perl -w
 
-# This one's all mine.  Well, its GPL but I"m the author and creator.  
-# I think you need gimp 1.1 or better for this - if  you don't, please let 
+# This one's all mine.  Well, its GPL/Artisitic but I"m the author and creator. # I think you need gimp 1.1 or better for this - if  you don't, please let 
 # me know
 
 # As a fair warning, some of this code is a bit ugly.  But thats perl for ya :)
-
+#
+# Revision History:
+# 1.0 - Initial (too early) release
+# 1.1 - Second (still ugly) release: Made the perspective setting actually do
+#       something
+# 1.2 - Used some of the convienence functions, and made things a little eaiser
+#       from the user's standpoint too.  Also moved it from the 
+#       Filters->Animations-> menu to Xtns->Animations.  I think its 
+#       clearer whats going on this way.  It also works w/ any 2 layers now.
+        
 # Seth Burgess
 # <sjburges@gimp.org>
 
-use Gimp;
+use Gimp 1.06;
 use Gimp::Fu;
+use Gimp::Util;
 
 # Gimp::set_trace(TRACE_ALL);
 
-sub hideallbut {
-	($img, @butlist) = @_;
-	@layers = $img->get_layers();
-	foreach $layer (@layers) {
-		if ($layer->get_visible()) {
-			$layer->set_visible(0);
-			}
-		}
-	foreach $but (@butlist) {
-		if (! $layers[$but]->get_visible()) {
-			$layers[$but]->set_visible(1);
-			}
-		}
-	};	
-
 sub saw {  # a sawtooth function on PI
 	($val) = @_;
 	if ($val < 3.14159/2.0) {
@@ -42,40 +36,34 @@ sub saw {  # a sawtooth function on PI
 		}
 	else {
 		return (-1+$val/3.14159); 
-		};
-	}; 
-
-sub spin_layer {
-	my ($img, $spin, $dest, $numframes) = @_;
+		}
+	} 
 
-# Now lets spin it!
+sub spin_layer { # the function for actually spinning the layer
+	my ($img, $spin, $dest, $numframes, $prp) = @_;
+    # Now lets spin it!
 	$stepsize = 3.14159/$numframes; # in radians 
 	for ($i=0; $i<=3.14159; $i+=$stepsize) {
 		# create a new layer for spinning
-		if ($i < 3.14159/2.0) {
-			$framelay = $spin->layer_copy(1);
-			}
-		else {
-			$framelay = $dest->layer_copy(1);
-			}
+		$framelay = ($i < 3.14159/2.0) ?  $spin->copy(1) : $dest->copy(1);
 		$img->add_layer($framelay, 0);
 		# spin it a step
 		$img->selection_all();
 		@x = $img->selection_bounds();
 		# x[1],x[2]                  x[3],x[2]
         # x[1],x[4]                  x[3],x[4]
-		$psp = 0.2;  # The perspective amount
 		$floater = $framelay->perspective(1,
-	$x[1]+saw($i)*$psp*$framelay->width,$x[2]+$spin->height *sin($i)/2,  
-	$x[3]-saw($i)*$psp*$framelay->width,$x[2]+$spin->height *sin($i)/2,
-	$x[1]-saw($i)*$psp*$framelay->width,$x[4]-$spin->height *sin($i)/2,  
-	$x[3]+saw($i)*$psp*$framelay->width,$x[4]-$spin->height *sin($i)/2);  
-		$floater->floating_sel_to_layer();
+	$x[1]+saw($i)*$prp*$framelay->width,$x[2]+$spin->height *sin($i)/2,  
+	$x[3]-saw($i)*$prp*$framelay->width,$x[2]+$spin->height *sin($i)/2,
+	$x[1]-saw($i)*$prp*$framelay->width,$x[4]-$spin->height *sin($i)/2,  
+	$x[3]+saw($i)*$prp*$framelay->width,$x[4]-$spin->height *sin($i)/2);  
+		$floater->floating_sel_to_layer;
 		# fill entire layer with background  
 		$framelay->fill(1); # BG-IMAGE-FILL
 	}
 	for ($i=0; $i<$numframes; $i++) {
-		hideallbut($img, $i, $i+1);
+		@all_layers = $img->get_layers();
+		$img->set_visible($all_layers[$i],$all_layers[$i+1]);
 		$img->merge_visible_layers(0);
 		}
 	@all_layers = $img->get_layers();
@@ -85,64 +73,90 @@ sub spin_layer {
 	# clean up my temporary layers	
 	$img->remove_layer($all_layers[$numframes]);
 	$img->remove_layer($all_layers[$numframes+1]);
-
-};
+}
 
 register "seth_spin",
          "Seth Spin",
          "Take one image.  Spin it about the horizontal axis, and end up with another image.  I made it for easy web buttons.",
          "Seth Burgess",
          "Seth Burgess <sjburges\@gimp.org>",
-         "1.0",
-         "<Image>/Filters/Animation/Seth Spin",
-         "RGB*, GRAY*",
+         "1.0.1",
+         "<Toolbox>/Xtns/Animation/Seth Spin",
+         "*",
          [
+          [PF_DRAWABLE, "Source", "What drawable to spin from?"],
           [PF_DRAWABLE, "Destination","What drawable to spin to?"],
-		  [PF_INT8, "Frames", "How many frames to use?", 8],
-		  [PF_COLOR, "Background", "What color to use for background if not transparent", [0,0,0]],
-		  [PF_SLIDER, "Perspective", "How much perspective effect to get", 40, [0,255,5]],
-		  [PF_TOGGLE, "Spin Back", "Should it also spin back?  Will double the number of frames", 1],
-
+	  [PF_INT8, "Frames", "How many frames to use?", 16],
+	  [PF_COLOR, "Background", "What color to use for background if not transparent", [0,0,0]],
+	  [PF_SLIDER, "Perspective", "How much perspective effect to get", 40, [0,255,5]],
+	  [PF_TOGGLE, "Spin Back", "Also spin back?" , 1],
+          [PF_TOGGLE, "Convert Indexed", "Convert to indexed?", 1],
          ],
+         [],
+         ['gimp-1.1'],
          sub {
-   my($img,$src,$dest,$frames,$color,$psp,$spinback) =@_;
-  eval { $img->undo_push_group_start };
+   my($src,$dest,$frames,$color,$psp,$spinback,$indexed) =@_;
+	$maxwide = ($src->width > $dest->width) ? $src->width : $dest->width;
+	$maxhigh = ($src->height > $dest->height) ? $src->height: $dest->height;
+	$img = gimp_image_new($maxwide, $maxhigh, RGB);
+
+	$tmpimglayer = $img->add_new_layer(0,3,1); 
 
 	$oldbackground = gimp_palette_get_background();
 	gimp_palette_set_background($color);
-# Create the new layer that the spin will occur on...
 	$src->edit_copy();
-	$spinlayer = $src->edit_paste(1);
+	$spinlayer = $tmpimglayer->edit_paste(1);
 	$spinlayer->floating_sel_to_layer();
 
 	$dest->edit_copy();
-	$destlayer = $dest->edit_paste(1);
+	$destlayer = $tmpimglayer->edit_paste(1);
 	$destlayer->floating_sel_to_layer();
-	
-	spin_layer($img, $spinlayer, $destlayer, $frames);
+
+	$tmpimglayer->remove_layer;
+
+	$spinlayer->resize($maxwide, $maxhigh, $spinlayer->offsets);
+	$destlayer->resize($maxwide, $maxhigh, $destlayer->offsets);
+	# work around for PF_SLIDER when < 1
+	$psp = $psp/255.0;
+
+	# need an even number of frames for spinback
+	if ($frames%2 && $spinback) {
+		$frames++;
+		gimp_message("An even number of frames is needed for spin back.\nAdjusted frames up to $frames");
+		}
+
+	spin_layer($img, $spinlayer, $destlayer, $spinback ? $frames/2 : $frames-1, $psp);
+	# it makes ugly sounds on the next line, but no harm is done.
+	$img->set_visible($img->add_new_layer(1),($img->get_layers)[0]); 
+	$img->merge_visible_layers(0);
 	
 	if ($spinback) { 
 		@layerlist = $img->get_layers();
-		$img->add_layer($layerlist[$frames]->copy(0),0);
-		$img->remove_layer($layerlist[$frames]);
+		$img->add_layer($layerlist[$frames/2]->copy(0),0);
 		@layerlist = $img->get_layers();
-		spin_layer($img, $layerlist[1], $layerlist[0], $frames);
-		$realframes = 2*$frames;
+		spin_layer($img, $layerlist[1], $layerlist[0], $frames/2, $psp);
+		$img->remove_layer(($img->get_layers)[0]);
 		}	
-	else {
-		$realframes = $frames;
-		}
-
+	
 	# unhide and name layers
-	@all_layers = $img->get_layers();
-	for ($i=0; $i<$realframes ; $i++) {
-		$all_layers[$i]->set_visible(1);
-		$all_layers[$i]->set_name("Spin Layer $i");
+	@all_layers = $img->get_layers;
+	$img->set_visible(@all_layers);
+	for ($i=1; $i<=$frames ; $i++) {
+		$all_layers[$i-1]->set_name("Spin Layer $i (50ms)");
 		}
-	gimp_palette_set_background($oldbackground);
+	$all_layers[$frames-1]->set_name("Spin Layer SRC (250ms)");  
+	
+	if ($spinback) {
+		$all_layers[$frames/2-1]->set_name("Spin Layer DEST (250ms)"); 
+		}
+	else { $all_layers[0]->set_name("Spin Layer DEST (250ms)")}
 	
-  eval { $img->undo_push_group_end };
-	gimp_displays_flush();
+	$img->display_new;
+
+	# indexed conversion wants a display for some reason
+	if ($indexed) { $img->convert_indexed(1,255); } 
+
+	gimp_palette_set_background($oldbackground);
 	return();
 };