see plug-ins/perl/Changes

plug-ins/perl/Changes

 Revision history for Gimp-Perl extension.
 
+	- added guidegrid, git-text, roundrectsel.
+
+1.072 Sat Mar 27 21:04:39 CET 1999
 	- scripts will now be correctly installed when IN_GIMP.
+        - test-dir was not removed by make distclean etc.
+        - messages now only show up in the Perl Control Center.
+          this is not correct, however ;)
 
 1.071 Tue Mar 23 13:47:10 CET 1999
 	- changed the definition of PF_RADIO, simplifying it (it ain't no C).

plug-ins/perl/Gimp.pm

@@ -8,11 +8,12 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD %EXPORT_TAGS @EXPORT_FAIL
             @gimp_gui_functions $function $basename
             $in_quit $in_run $in_net $in_init $in_query $no_SIG
             $help $verbose $host);
+use subs qw(init end lock unlock canonicalize_color);
 
 require DynaLoader;
 
 @ISA=qw(DynaLoader);
-$VERSION = 1.071;
+$VERSION = 1.072;
 
 @_param = qw(
 	PARAM_BOUNDARY	PARAM_CHANNEL	PARAM_COLOR	PARAM_DISPLAY	PARAM_DRAWABLE
@@ -161,7 +162,7 @@ sub import($;@) {
    for(@_) {
       if ($_ eq ":auto") {
          push(@export,@_consts,@_procs);
-         *{"${up}::AUTOLOAD"} = sub {
+         *{"$up\::AUTOLOAD"} = sub {
             croak "cannot autoload '$AUTOLOAD' at this time" unless initialized();
             my ($class,$name) = $AUTOLOAD =~ /^(.*)::(.*?)$/;
             *{$AUTOLOAD} = sub { Gimp->$name(@_) };
@@ -183,7 +184,7 @@ sub import($;@) {
    }
    
    for(@export) {
-      *{"${up}::$_"} = \&$_;
+      *{"$up\::$_"} = \&$_;
    }
 }
 
@@ -308,11 +309,16 @@ sub die_msg {
    logger(message => substr($_[0],0,-1), fatal => 1, function => 'ERROR');
 }
 
+# this needs to be improved
+sub quiet_die {
+   die "BE QUIET ABOUT THIS DIE\n";
+}
+
 unless ($no_SIG) {
    $SIG{__DIE__} = sub {
       unless ($^S || !defined $^S || $in_quit) {
          die_msg $_[0];
-         initialized() ? die "BE QUIET ABOUT THIS DIE\n" : xs_exit(main());
+         initialized() ? &quiet_die : exit quiet_main();
       } else {
         die $_[0];
       }
@@ -332,7 +338,7 @@ sub call_callback {
    my $cb = shift;
    return () if $caller eq "Gimp";
    if (UNIVERSAL::can($caller,$cb)) {
-      &{"${caller}::$cb"};
+      &{"$caller\::$cb"};
    } else {
       die_msg "required callback '$cb' not found\n" if $req;
    }
@@ -363,7 +369,7 @@ sub main {
    $caller=caller;
    #d# #D# # BIG BUG LURKING SOMEWHERE
    # just calling exit() will be too much for bigexitbug.pl
-   xs_exit(&{"${interface_pkg}::gimp_main"});
+   xs_exit(&{"$interface_pkg\::gimp_main"});
 }
 
 # same as main, but callbacks are ignored
@@ -386,18 +392,20 @@ $interface_pkg->import;
 
 # create some common aliases
 for(qw(_gimp_procedure_available gimp_call_procedure set_trace initialized)) {
-   *$_ = \&{"${interface_pkg}::$_"};
+   *$_ = \&{"$interface_pkg\::$_"};
 }
 
-*init  = \&{"${interface_pkg}::gimp_init"};
-*end   = \&{"${interface_pkg}::gimp_end" };
-*lock  = \&{"${interface_pkg}::lock" };
-*unlock= \&{"${interface_pkg}::unlock" };
+*init  = \&{"$interface_pkg\::gimp_init"};
+*end   = \&{"$interface_pkg\::gimp_end" };
+*lock  = \&{"$interface_pkg\::lock" };
+*unlock= \&{"$interface_pkg\::unlock" };
 
 ($basename = $0) =~ s/^.*[\\\/]//;
 
+# extra check for Gimp::Feature::import
+$in_query=0 unless defined $in_query;	# perl -w is SOOO braindamaged
 $verbose=
-$in_quit=$in_run=$in_net=$in_init=$in_query=0; # perl -w is braindamaged
+$in_quit=$in_run=$in_net=$in_init;	# perl -w is braindamaged
 
 my %ignore_function = ();
 
@@ -422,7 +430,7 @@ sub _croak($) {
 
 sub AUTOLOAD {
    my ($class,$name) = $AUTOLOAD =~ /^(.*)::(.*?)$/;
-   for(@{"${class}::PREFIXES"}) {
+   for(@{"$class\::PREFIXES"}) {
       my $sub = $_.$name;
       if (exists $ignore_function{$sub}) {
         *{$AUTOLOAD} = sub { () };
@@ -438,7 +446,7 @@ sub AUTOLOAD {
          };
          goto &$AUTOLOAD;
       } elsif (UNIVERSAL::can($interface_pkg,$sub)) {
-         my $ref = \&{"${interface_pkg}::$sub"};
+         my $ref = \&{"$interface_pkg\::$sub"};
          *{$AUTOLOAD} = sub {
             shift unless ref $_[0];
 #               goto &$ref;	# does not always work, PERLBUG! #FIXME
@@ -469,10 +477,10 @@ sub AUTOLOAD {
 sub _pseudoclass {
   my ($class, @prefixes)= @_;
   unshift(@prefixes,"");
-  *{"Gimp::${class}::AUTOLOAD"} = \&AUTOLOAD;
-  push(@{"${class}::ISA"}		, "Gimp::${class}");
-  push(@{"Gimp::${class}::PREFIXES"}	, @prefixes); @prefixes=@{"Gimp::${class}::PREFIXES"};
-  push(@{"${class}::PREFIXES"}		, @prefixes); @prefixes=@{"${class}::PREFIXES"};
+  *{"Gimp::$class\::AUTOLOAD"} = \&AUTOLOAD;
+  push(@{"$class\::ISA"}		, "Gimp::$class");
+  push(@{"Gimp::$class\::PREFIXES"}	, @prefixes); @prefixes=@{"Gimp::$class\::PREFIXES"};
+  push(@{"$class\::PREFIXES"}		, @prefixes); @prefixes=@{"$class\::PREFIXES"};
 }
 
 _pseudoclass qw(Layer		gimp_layer_ gimp_drawable_ gimp_floating_sel_ gimp_image_ gimp_ plug_in_);

plug-ins/perl/Gimp/Feature.pm

@@ -40,6 +40,7 @@ sub import {
    my $pkg = shift;
    my $feature;
 
+   local $Gimp::in_query=1;
    while(@_) {
       $_=shift;
       s/^://;
@@ -91,21 +92,26 @@ sub present {
       0;
    } else {
       require Gimp;
-      Gimp::logger(message => "unimplemented requirement '$_' (failed)", fatal => 1);
+      Gimp::logger(message => "unimplemented requirement '$_' (failed)");
       0;
    }
 }
 
-sub missing {
+sub _missing {
    my ($msg,$function)=@_;
    require Gimp;
    Gimp::logger(message => "$_[0] is required but not found", function => $function);
-   Gimp::initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit Gimp::quiet_main();
+   Gimp::initialized() ? &Gimp::quiet_die() : exit Gimp::quiet_main();
+}
+
+sub missing {
+   local $Gimp::in_query=1;
+   &_missing;
 }
 
 sub need {
    my ($feature,$function)=@_;
-   missing($description{$feature},$function) unless present $feature;
+   _missing($description{$feature},$function) unless present $feature;
 }
 
 1;

plug-ins/perl/Gimp/Net.pm

@@ -73,9 +73,9 @@ sub _gimp_procedure_available {
 # this is hardcoded into gimp_call_procedure!
 sub response {
    my($len,$req);
-   read($server_fh,$len,4) == 4 or die "protocol error";
+   read($server_fh,$len,4) == 4 or die "protocol error (1)";
    $len=unpack("N",$len);
-   read($server_fh,$req,$len) == $len or die "protocol error";
+   read($server_fh,$req,$len) == $len or die "protocol error (2)";
    net2args($req);
 }
 

plug-ins/perl/MANIFEST

@@ -75,4 +75,7 @@ examples/font_table
 examples/perlotine
 examples/randomblends
 examples/innerbevel
+examples/fit-text
+examples/guidegrid
+examples/roundrectsel
 

plug-ins/perl/Makefile.PL

@@ -10,7 +10,7 @@ $|=1;
       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 stamps font_table
-      perlotine randomblends innerbevel
+      perlotine randomblends innerbevel fit-text guidegrid roundrectsel
    );
 @shebang = (map("examples/$_",@examples),
    qw(Perl-Server examples/example-net.pl examples/homepage-logo.pl
@@ -288,6 +288,7 @@ clean mostlyclean objclean:
 
 distclean maintainer-clean: clean
 	rm -f Makefile config.cache config.pl config.log config.h config.status stamp-h Makefile.old
+        rm -rf test-dir inst-temp
 EOF
    close MAKEFILE;
    exit;

plug-ins/perl/examples/fit-text

+#!/usr/bin/perl
+# <sjburges@gimp.org>
+# This is adrian and xachs idea - take a rectangluar selection, and select
+# font type and string.  Then fill it with whatever size is needed.
+
+use Gimp;
+use Gimp::Fu;
+use Gimp::Util;
+
+# Gimp::set_trace(TRACE_ALL);
+
+$defaultfont = "-*-blippo-heavy-r-normal-*-*-360-*-*-p-*-iso8859-1";
+undef $defaultfont;
+
+sub growfont {
+	($fontname, $plussize) = @_;
+	@fontdesc = split /-/, $fontname;
+	$fontdesc[8] += $plussize;
+	$outname = join "-", @fontdesc;
+	return $outname;		
+	} 
+
+register "fit_text", 
+         "Fit Text - fit text to a selection", 
+         "Have a rectangular selection, and select the font type and spacing.  It will fill the selection with text as closely as possible.  If no selection is made prior to running, it will fill the entire image.",
+         "Seth Burgess", 
+         "Seth Burgess <sjburges\@gimp.org>", 
+         "1999-03-21",
+         "<Image>/Filters/Render/Fit Text", 
+         "*", 
+         [ 
+           [PF_FONT, "font", "What font type to use - size will be ignored", $defaultfont], 
+           [PF_STRING, "string", "Text String to fill with", "Fit Text"], 
+            ],
+         [],
+         ['gimp-1.1'],
+         sub {
+    my($img,$layer,$xlfd,$string) =@_;
+    ($sel,$x1,$y1,$x2,$y2) = $img->gimp_selection_bounds;
+    $width = $x2-$x1;
+	$height = $y2-$y1;
+	
+	@extents=gimp_text_get_extents_fontname($string,xlfd_size($xlfd),$xlfd);
+	$growsize = ($extents[0]<$width && $extents[1]<$height) ? 80 : -80;
+	if ($growsize > 0 ) {
+		 while ($extents[0]<$width && $extents[1]<$height) {
+				$xlfd = growfont($xlfd,$growsize); 	
+				@extents=gimp_text_get_extents_fontname($string,xlfd_size($xlfd),$xlfd);
+				}
+		$xlfd = growfont($xlfd, -$growsize);
+		}
+	else { 
+		 while ($extents[0]>$width || $extents[1]>$height) {
+				$xlfd = growfont($xlfd,$growsize); 	
+				@extents=gimp_text_get_extents_fontname($string,xlfd_size($xlfd),$xlfd);
+				}
+		}
+	
+	while ($extents[0]<$width && $extents[1]<$height) {
+		$xlfd = growfont($xlfd,10); # precision for the last bit	
+		@extents=gimp_text_get_extents_fontname($string,xlfd_size($xlfd),$xlfd);
+		}
+	
+	 while ($extents[0]>$width || $extents[1]>$height) {
+			$xlfd = growfont($xlfd,-4); 	
+			@extents=gimp_text_get_extents_fontname($string,xlfd_size($xlfd),$xlfd);
+			}
+ 	# print $xlfd, "\n";
+	
+	$tmplay = $layer->text_fontname($x1,$y1,$string,0,1,xlfd_size($xlfd), $xlfd);
+	$width2=$tmplay->width;
+	$height2=$tmplay->height;
+
+# X returns crap, so fine tune it here.
+#	print "$width2, $height2:$width, $height\n";
+	while ($width2<$width && $height2<$height) {
+		$tmplay->remove;
+		$xlfd = growfont($xlfd,4); 	
+		$tmplay=$layer->text_fontname($x1,$y1,$string,0,1,xlfd_size($xlfd), $xlfd);
+		$width2=$tmplay->width;
+		$height2=$tmplay->height;
+		}
+
+	$tmplay->remove;
+	$xlfd = growfont($xlfd,-2); 	
+	$tmplay=$layer->text_fontname($x1,$y1,$string,0,1,xlfd_size($xlfd), $xlfd);
+    return();
+};
+exit main;

plug-ins/perl/examples/guidegrid

+#!/usr/bin/perl
+# <sjburges@gimp.org>
+# This is adrian's idea - take random blends and difference them.  You're
+# bound to come up w/ something cool eventually.
+
+use Gimp;
+use Gimp::Fu;
+use Gimp::Util;
+
+# Gimp::set_trace(TRACE_ALL);
+
+register "guide_grid", 
+         "GuideGrid - creates a grid of guides\n",
+         "You specify the X spacing, the Y spacing, and initial offsets.  It creates a grid of guides\n",
+         "Seth Burgess", 
+         "Seth Burgess <sjburges\@gimp.org>", 
+         "1999-03-20",
+         "<Image>/GuideGrid", 
+         "*", 
+         [ 
+           [PF_SPINNER, "x_spacing", "How far to space grid horizontally", 24, [1,1000,1]], 
+           [PF_SPINNER, "y_spacing", "How far to space grid vertically", 24, [1,1000,1]], 
+           [PF_SPINNER, "x_offset", "How much to initially offset it horizontally", 0, [0,1000,1]], 
+           [PF_SPINNER, "y_offset", "How much to initially offset it vertically", 0, [0,1000,1]], 
+            ],
+         [],
+         ['gimp-1.1'],
+         sub {
+    my($img,$layer,$xspace, $yspace, $xoffset, $yoffset) =@_;
+
+	for ($i=$xoffset; $i<$img->width; $i+=$xspace) {
+		if ($i) {
+			$img->add_vguide($i);
+			}
+		}
+
+	for ($i=$yoffset; $i<$img->height; $i+=$yspace) {
+		if ($i) {
+			$img->add_hguide($i);
+			}
+		}
+
+    return();
+};
+exit main;

plug-ins/perl/examples/innerbevel

@@ -39,6 +39,9 @@ register $regname, $shortdesc, $longdesc, $authorname, $author, $date, $path, $i
    [PF_SLIDER, "shinyness", "How shiny the final image will be",30, [0,90,5]],
    [PF_SLIDER, "depth_shape", "Determines the final shape", 34 , [0,64,32]], 
    [PF_RADIO, "map", "The type of Map to use", 2, [Linear => 0, Spherical => 1, Sinusoidal => 2] ], 
+  ],[],
+  [
+   'gimp-1.1',
   ], sub {
 
 my ($font, $text, $color1, $color2, $azimuth, $elevation, $depth, $maptype) = @_;

plug-ins/perl/examples/randomblends

@@ -24,7 +24,10 @@ register "random_blends",
          "RGB*, GRAY*", 
          [ 
            [PF_SPINNER, "number", "How many gradients to apply", 7, [1,255,1]], 
-            ], sub {
+            ],
+         [],
+         ['gimp-1.1'],
+         sub {
     my($img,$layer,$numgradients) =@_;
     eval { $img->undo_push_group_start };  # undo is broked for this one.
 # add this to the get_state (after its working?)

plug-ins/perl/examples/roundrectsel

+#!/usr/bin/perl
+# <sjburges@gimp.org>
+# This is adrian's idea - take random blends and difference them.  You're
+# bound to come up w/ something cool eventually.
+
+use Gimp;
+use Gimp::Fu;
+use Gimp::Util;
+
+# Gimp::set_trace(TRACE_ALL);
+
+register "round_rect_sel", 
+         "Rounds a rectangular selection.",
+         "Rounds a rectangular selection. If no selection exists, it selects all first, then rounds that selection.  If there exists a selection, but its non-rectangluar, it will be replaced by a rectangluar one.",
+         "Seth Burgess", 
+         "Seth Burgess <sjburges\@gimp.org>", 
+         "1999-03-25",
+         "<Image>/Select/Generate/Rounded Rectangluar Selection", 
+         "*", 
+         [ 
+           [PF_SPINNER, "x_rounding", "How much to round in the horizontal, in pixels", 16, [1,1000,1]], 
+           [PF_SPINNER, "y_rounding", "How far to round the in vertical, in pixels", 16, [1,1000,1]], 
+            ], sub {
+    my($img,$layer,$x_round, $y_round) =@_;
+	eval { $img->undo_push_group_start };
+	@bounds = $img->selection_bounds;
+	# recreate the selection
+	$img->rect_select($bounds[1], $bounds[2], $bounds[3]-$bounds[1], $bounds[4]-$bounds[2], 0, 0, 0.5);
+
+	# cut out the corners
+	$img->rect_select($bounds[1], $bounds[2], $x_round/2, $y_round/2, 1, 0, 0.5); 
+	$img->rect_select($bounds[3]-$x_round/2, $bounds[2], $x_round/2, $y_round/2, 1, 0, 0.5); 
+	$img->rect_select($bounds[3]-$x_round/2, $bounds[4]-$y_round/2, $x_round/2, $y_round/2, 1, 0, 0.5); 
+	$img->rect_select($bounds[1], $bounds[4]-$y_round/2, $x_round/2, $y_round/2, 1, 0, 0.5); 
+
+	# add them back as elipses
+	
+	$img->ellipse_select($bounds[1], $bounds[2], $x_round, $y_round, 0, 1, 0, 0.5); 
+	$img->ellipse_select($bounds[3]-$x_round, $bounds[2], $x_round, $y_round, 0, 1, 0, 0.5); 
+	$img->ellipse_select($bounds[3]-$x_round, $bounds[4]-$y_round, $x_round, $y_round, 0, 1, 0, 0.5); 
+	$img->ellipse_select($bounds[1], $bounds[4]-$y_round, $x_round, $y_round, 0, 1, 0, 0.5); 
+
+
+	eval { $img->undo_push_group_end };
+    return();
+};
+exit main;

plug-ins/perl/examples/terral_text

@@ -49,6 +49,7 @@ register
 	  [ PF_SLIDER, "blur_amount", "Blur Amount", 10, [0,26,1]],
 	], 
         [],
+        ['gimp-1.1'],
 sub {
 	($img, $pattern, $solidnoise, $font, $text, $blur) = @_;
 	$oldbg = gimp_palette_get_background();

plug-ins/perl/scm2perl

@@ -40,7 +40,7 @@ Perl knows the length of arrays, Script-Fu doesn't. Functions returning
 single arrays return them as a normal perl array, Functions returning
 more then one array return it as an array-ref. Script-Fu (and the
 converted script) expect to get a length argument and then the
-arguments. Each occurence (common ones are C<gimp_list_images> or
+arguments. Each occurrence (common ones are C<gimp_list_images> or
 C<gimp_image_get_layers>) must be fixed by hand.
 
 =head1 AUTHOR

plug-ins/perl/t/run.t

@@ -21,7 +21,7 @@ sub skip($$;$) {
 }
 
 END {
-#  system("rm","-rf",$dir);#d##FIXME#
+  system("rm","-rf",$dir);#d##FIXME#
 }
 
 use Cwd;