see plug-ins/perl/Changes

plug-ins/perl/Changes

@@ -1,5 +1,6 @@
 Revision history for Gimp-Perl extension.
 
+1.071 Tue Mar 23 13:47:10 CET 1999
 	- changed the definition of PF_RADIO, simplifying it (it ain't no C).
         - Gimp::Fu scripts try to run with default arguments if Gtk is not
           available.
@@ -10,6 +11,15 @@ Revision history for Gimp-Perl extension.
           bangpath.
         - added font_map. re-added xachshadow.pl, which was mysteriously
           missing.
+        - fixed Gimp::Util::set_state.
+        - improved get/set_state functions.
+        - added perlotine, randomblends and innerbevel plugins.
+        - improved t/run.t and server spawn robustness.
+        - Makefile.PL wrongly required the Gimp.pm in the current directory.
+        - made the 5.004 + gimp-1.0 combination work by working around another
+          bug in 5.004.
+        - fixed reporting of errors at startup time.
+        - enforcing argument name style. Eat it or die!
 
 1.07  Mon Mar 15 01:27:05 CET 1999
 	- added examples/yinyang, examples/image_tile, examples/stamps.

plug-ins/perl/Gimp.pm

@@ -162,6 +162,7 @@ sub import($;@) {
       if ($_ eq ":auto") {
          push(@export,@_consts,@_procs);
          *{"${up}::AUTOLOAD"} = sub {
+            croak "cannot autoload '$AUTOLOAD' at this time" unless initialized();
             my ($class,$name) = $AUTOLOAD =~ /^(.*)::(.*?)$/;
             *{$AUTOLOAD} = sub { Gimp->$name(@_) };
             goto &$AUTOLOAD;
@@ -329,6 +330,7 @@ unless ($no_SIG) {
 sub call_callback {
    my $req = shift;
    my $cb = shift;
+   return () if $caller eq "Gimp";
    if (UNIVERSAL::can($caller,$cb)) {
       &{"${caller}::$cb"};
    } else {
@@ -338,7 +340,6 @@ sub call_callback {
 
 sub callback {
    my $type = shift;
-   return () if $caller eq "Gimp";
    if ($type eq "-run") {
       local $function = shift;
       local $in_run = 1;
@@ -455,8 +456,6 @@ sub AUTOLOAD {
             wantarray ? @r : $r[0];
          };
          goto &$AUTOLOAD;
-      } elsif (defined(*{"${interface_pkg}::$sub"}{CODE})) {
-         die "safety net $interface_pkg :: $sub (REPORT THIS!!)";#d#
       }
    }
    # for performance reasons: supply a DESTROY method
@@ -790,10 +789,9 @@ interface (L<Gimp::Net>), and not as a native plug-in. Here's an example:
  
  Gimp::init;
  <do something with the gimp>
- Gimp::end;
 
 The optional argument to init has the same format as the GIMP_HOST variable
-described in L<Gimp::Net>.
+described in L<Gimp::Net>. Calling C<Gimp::end> is optional.
 
 =item Gimp::lock(), Gimp::unlock()
 

plug-ins/perl/Gimp.xs

@@ -62,6 +62,13 @@ _gimp_prefix()
 	OUTPUT:
 	RETVAL
 
+char *
+_gimp_path()
+	CODE:
+	RETVAL = GIMP_PATH;
+	OUTPUT:
+	RETVAL
+
 BOOT:
 {
    HV *stash = gv_stashpvn("Gimp", 4, TRUE);

plug-ins/perl/Gimp/Data.pm

@@ -1,8 +1,7 @@
 package Gimp::Data;
 
-use strict;
 use Carp;
-use Gimp qw();
+use Gimp ();
 
 sub TIEHASH {
    my $pkg = shift;

plug-ins/perl/Gimp/Feature.pm

@@ -47,21 +47,6 @@ sub import {
    }
 }
 
-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();
-}
-
-sub need {
-   my ($feature,$function)=@_;
-   unless (present($feature)) {
-      missing($description{$feature},$function);
-      Gimp::initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit Gimp::quiet_main();
-   }
-}
-
 sub describe {
    $description{$_[0]};
 }
@@ -111,6 +96,17 @@ sub present {
    }
 }
 
+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();
+}
+
+sub need {
+   my ($feature,$function)=@_;
+   missing($description{$feature},$function) unless present $feature;
+}
 
 1;
 __END__

plug-ins/perl/Gimp/Fu.pm

@@ -1,7 +1,7 @@
 package Gimp::Fu;
 
 use Carp;
-use Gimp qw();
+use Gimp ();
 use Gimp::Data;
 
 require Exporter;
@@ -158,6 +158,7 @@ sub help_window(\$$$) {
 
       $b = new Gtk::Text;
       $b->set_editable (0);
+      $b->set_word_wrap (1);
 
       $font = load Gtk::Gdk::Font "9x15bold";
       $font = fontset_load Gtk::Gdk::Font "-*-courier-medium-r-normal--*-120-*-*-*-*-*" unless $font;
@@ -281,7 +282,7 @@ sub interact($$$$@) {
               my $setval = sub {
                  $val=$_[0];
                  unless (defined $val && $fs->set_font_name ($val)) {
-                    warn "illegal default font description: $val" if defined $val;
+                    warn "illegal default font description for $function: $val\n" if defined $val;
                     $val=$def;
                     $fs->set_font_name ($val);
                  }
@@ -899,19 +900,20 @@ sub register($$$$$$$$$;@) {
    @_==0 or die "register called with too many or wrong arguments\n";
    
    for my $p (@$params,@$results) {
-      int($p->[0]) eq $p->[0] or croak "Argument/return value '$p->[1]' has illegal type '$p->[0]'";
+      int($p->[0]) eq $p->[0] or croak "$function: argument/return value '$p->[1]' has illegal type '$p->[0]'";
+      $p->[1]=~/^[0-9a-z_]+$/ or carp "$function: argument name '$p->[1]' contains illegal characters, only 0-9, a-z and _ allowed";
    }
    
    $function="perl_fu_".$function unless $function=~/^(?:perl_fu|extension|plug_in)/ || $function=~s/^\+//;
    
+   Gimp::logger message => "function name contains dashes instead of underscores",
+                function => $function, fatal => 0
+      if $function =~ y/-//;
+
    *$function = sub {
       $run_mode=shift;	# global!
       my(@pre,@defaults,@lastvals,$input_image);
 
-      Gimp::logger message => "function name contains dashes instead of underscores",
-                   function => $function, fatal => 0
-         if $function =~ y/-//;
-
       if ($menupath=~/^<Image>\//) {
          @_ >= 2 or die "<Image> plug-in called without both image and drawable arguments!\n";
          @pre = (shift,shift);

plug-ins/perl/Gimp/Lib.xs

@@ -611,7 +611,7 @@ push_gimp_sv (GParam *arg, int array_as_ref)
       case PARAM_STATUS:	sv = newSViv(arg->data.d_status	); break;
       case PARAM_STRING:
 	sv = arg->data.d_string ? neuSVpv(arg->data.d_string)
-	                        : &PL_sv_undef;
+	                        : newSVsv (&PL_sv_undef);
 	break;
 	
       case PARAM_COLOR:
@@ -810,6 +810,32 @@ destroy_paramdefs (GParamDef *arg, int count)
 }
 #endif
 
+#ifdef GIMP_HAVE_PROCEDURAL_DB_GET_DATA_SIZE
+#define get_data_size gimp_get_data_size
+#else
+guint32
+get_data_size (gchar *id)
+{
+  GParam *return_vals;
+  int nreturn_vals;
+  int length;
+
+  return_vals = gimp_run_procedure ("gimp_procedural_db_get_data",
+                                    &nreturn_vals,
+                                    PARAM_STRING, id,
+                                    PARAM_END);
+
+  if (return_vals[0].data.d_status == STATUS_SUCCESS)
+    length = return_vals[1].data.d_int32;
+  else
+    length = 0;
+
+  gimp_destroy_params (return_vals, nreturn_vals);
+
+  return length;
+}
+#endif
+
 static void simple_perl_call (char *function, char *arg1)
 {
    char *argv[2];
@@ -1363,20 +1389,7 @@ gimp_set_data(id, data)
 		
 		dta = SvPV (data, dlen);
 
-		/* do not remove this comment */
-#ifdef GIMP_HAVE_PROCEDURAL_DB_GET_DATA_SIZE
 		gimp_set_data (SvPV (id, dc), dta, dlen);
-#else
-		{
-		  char str[MAX_STRING]; /* hack */
-		  SvUPGRADE (id, SVt_PV);
-		  len = SvCUR (id);
-		  Copy (SvPV (id, dc), str, len, char);
-		  str[len+1] = 0;
-		  str[len] = 'S'; gimp_set_data (str, &dlen, sizeof (STRLEN));
-		  str[len] = 'C'; gimp_set_data (str, dta, dlen);
-		}
-#endif
 	}
 
 void
@@ -1389,35 +1402,12 @@ gimp_get_data(id)
 		STRLEN len;
 		STRLEN dc;
 		
-		/* do not remove this comment */
+		dlen = get_data_size (SvPV (id, dc));
-#ifdef GIMP_HAVE_PROCEDURAL_DB_GET_DATA_SIZE
-		dlen = gimp_get_data_size (SvPV (id, dc));
 		/* I count on dlen being zero if "id" doesn't exist.  */
 		data = newSVpv ("", 0);
 		gimp_get_data (SvPV (id, dc), SvGROW (data, dlen+1));
 		SvCUR_set (data, dlen);
 		*((char *)SvPV (data, dc) + dlen) = 0;
-#else
-		{
-		  char str[MAX_STRING]; /* hack */
-		  SvUPGRADE (id, SVt_PV);
-		  len = SvCUR (id);
-		  Copy (SvPV (id, dc), str, len, char);
-		  
-		  str[len+1] = 0;
-		  dlen = (STRLEN) -1;
-		  str[len] = 'S'; gimp_get_data (str, &dlen);
-		  
-		  data = newSVpv ("", 0);
-		  if (dlen != (STRLEN)-1)
-		    {
-		      str[len] = 'C'; gimp_get_data (str, SvGROW (data, dlen+1));
-		      SvCUR_set (data, dlen);
-		      *((char *)SvPV (data, dc) + dlen) = 0;
-		    }
-
-		}
-#endif
 	        XPUSHs (sv_2mortal (data));
 	}
 

plug-ins/perl/Gimp/Net.pm

@@ -140,26 +140,31 @@ sub set_trace {
 sub start_server {
    print "trying to start gimp\n" if $Gimp::verbose;
    $server_fh=local *FH;
-   socketpair $server_fh,GIMP_FH,PF_UNIX,SOCK_STREAM,AF_UNIX
+   my $gimp_fh=local *FH;
+   socketpair $server_fh,$gimp_fh,PF_UNIX,SOCK_STREAM,AF_UNIX
       or croak "unable to create socketpair for gimp communications: $!";
    $gimp_pid = fork;
    if ($gimp_pid > 0) {
       Gimp::ignore_functions(@Gimp::gimp_gui_functions);
+      close $gimp_fh;
       return $server_fh;
    } elsif ($gimp_pid == 0) {
       close $server_fh;
       delete $ENV{GIMP_HOST};
       unless ($Gimp::verbose) {
+         open STDIN,"</dev/null";
          open STDOUT,">/dev/null";
          open STDERR,">&1";
-         close STDIN;
       }
       my $args = &Gimp::RUN_NONINTERACTIVE." ".
                  (&Gimp::_PS_FLAG_BATCH | &Gimp::_PS_FLAG_QUIET)." ".
-                 fileno(GIMP_FH);
+                 fileno($gimp_fh);
       { # block to suppress warning with broken perls (e.g. 5.004)
-         exec "gimp","-n","-b","(extension-perl-server $args)",
+         exec &Gimp::_gimp_path,
-                               "(extension_perl_server $args)"
+              "-n","-b","(extension-perl-server $args)",
+              "(extension_perl_server $args)",
+              "(gimp_quit 0)",
+              "(gimp-quit 0)";
       }
       exit(255);
    } else {

plug-ins/perl/Gimp/UI.pm

@@ -1,7 +1,7 @@
 package Gimp::UI;
 
 use Carp;
-use Gimp qw();
+use Gimp ();
 use Gtk;
 
 $gtk_10 = Gtk->major_version==1 && Gtk->minor_version==0;

plug-ins/perl/Gimp/Util.pm

@@ -23,12 +23,15 @@ you end up with them and the user cannot see them or delete them. So we
 always attach our created layers to an image here, too avoid memory leaks
 and debugging times.
 
-These functions try to preserve the current settings like colors.
+These functions try to preserve the current settings like colors, but not
+all do.
 
 Also: these functions are handled in exactly the same way as
 PDB-Functions, i.e. the (hypothetical) function C<gimp_image_xyzzy> can be
 called as $image->xyzzy, if the module is available.
 
+The need to explicitly C<use Gimp::Util> will go away in the future.
+
 =head1 FUNCTIONS
 
 =over 4
@@ -55,20 +58,31 @@ use Gimp;
 
 =item C<get_state ()>, C<set_state state>
 
-C<get_state> returns a scalar representing most of gimps global state (at the
+C<get_state> returns a scalar representing most of gimps global state
-moment foreground colour and background colour). The state can later be
+(at the moment foreground colour, background colour, active gradient,
-restored by a call to C<set_state>. This is ideal for library functions such
+pattern and brush). The state can later be restored by a call to
-as the ones used here, at least when it includes more state in the future.
+C<set_state>. This is ideal for library functions such as the ones used
+here, at least when it includes more state in the future.
 
 =cut
 
 sub get_state() {
-   [Palette->get_foreground,Palette->get_background];
+   [
+    Palette->get_foreground,
+    Palette->get_background,
+    Gradients->get_active,
+    scalar Patterns->get_pattern,
+    scalar Brushes->get_brush,
+   ]
 }
 
 sub set_state($) {
-   Palette->set_foreground($_->[0]);
+   my $s = shift;
-   Palette->set_background($_->[1]);
+   Palette->set_foreground($s->[0]);
+   Palette->set_background($s->[1]);
+   Gradients->set_active($s->[2]);
+   Patterns->set_pattern($s->[3]);
+   Brushes->set_brush($s->[4]);
 }
 
 ##############################################################################

plug-ins/perl/MANIFEST

@@ -72,3 +72,7 @@ examples/yinyang
 examples/image_tile
 examples/stamps
 examples/font_table
+examples/perlotine
+examples/randomblends
+examples/innerbevel
+

plug-ins/perl/Makefile.PL

@@ -10,6 +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
    );
 @shebang = (map("examples/$_",@examples),
    qw(Perl-Server examples/example-net.pl examples/homepage-logo.pl
@@ -24,7 +25,7 @@ if ($ARGV[0] ne "--writemakefile") {
    do './config.pl';
    if(defined $EXTENSIVE_TESTS) {
       print "\nFetched some defaults from an earlier Makefile.PL run.\n";
-      print "Run \"make clean\" if you don't want this\n";
+      print "Run \"make realclean\" if you don't want this\n";
    } else {
       print "
 This module usually does only a very short installation check.
@@ -35,7 +36,7 @@ gimp-1.1 ;)
 If you decide to run these tests (please!), I'd be glad to hear
 success stories (and of course any bug-reports ;)
 
-Do you want me to make these tests [y]? ";
+Do you want me to run these tests [y]? ";
       
       print "y\n";
       $EXTENSIVE_TESTS = 1;
@@ -59,6 +60,45 @@ Do you want me to make these tests [y]? ";
 require ExtUtils::MakeMaker;
 import ExtUtils::MakeMaker;
 
+@INC = grep /^\//,@INC;
+eval { $Gimp::no_SIG=1; require Gimp };
+unless($@) {
+   $old_prefix = eval { Gimp::_gimp_prefix() };
+   if ($@) {
+      print <<EOF;
+
+WARNING: I've detected an old version of Gimp-Perl installed
+	 already. Since I cannot detect the prefix used to install
+	 it I will just overwrite it.  If you happen to use two
+	 different and incompatible versions of the Gimp with differing
+	 prefixes you should call configure with the --disable-perl
+	 switch to disable the perl extension, or consider installing
+	 the perl module elsewhere, using the environment variables
+	 PERL5LIB=/my/module/dir and PERL_MM_OPTS="PREFIX=\$PERL5LIB" to
+	 overwrite the installation directory (PERL_MM_OPTS) and run the
+	 Gimp (PERL5LIB). See "perldoc ExtUtils::MakeMaker" for a full
+	 discussion of your options.
+
+EOF
+   } else {
+      if ($GIMP_PREFIX ne $old_prefix) {
+	 print <<EOF;
+
+WARNING: I've detected another installation of the Gimp-Perl extension.
+	    
+	 This version uses the prefix '$GIMP_PREFIX'.
+	 The already installed version uses the prefix '$old_prefix'.
+
+	 They don't match, which indicates that installing Gimp-Perl might
+	 overwrite an old but still used installation. Gimp-Perl will
+	 therefore be disabled, and not be installed.
+
+EOF
+	 not_halt("prefix mismatch");
+      }
+   }
+}
+
 eval "use Gtk;"; $GTK = $@ eq "";
 eval "use PDL;"; $PDL = $@ eq "";
 eval "use Parse::RecDescent;"; $PRD = $@ eq "";
@@ -129,44 +169,6 @@ WARNING: version 0.3 of Gtk is _required_ for this module to
 EOF
 }
 
-eval { $Gimp::no_SIG=1; require Gimp };
-unless($@) {
-   $old_prefix = eval { Gimp::_gimp_prefix() };
-   if ($@) {
-      print <<EOF;
-
-WARNING: I've detected an old version of Gimp-Perl installed
-	 already. Since I cannot detect the prefix used to install
-	 it I will just overwrite it.  If you happen to use two
-	 different and incompatible versions of the Gimp with differing
-	 prefixes you should call configure with the --disable-perl
-	 switch to disable the perl extension, or consider installing
-	 the perl module elsewhere, using the environment variables
-	 PERL5LIB=/my/module/dir and PERL_MM_OPTS="PREFIX=\$PERL5LIB" to
-	 overwrite the installation directory (PERL_MM_OPTS) and run the
-	 Gimp (PERL5LIB). See "perldoc ExtUtils::MakeMaker" for a full
-	 discussion of your options.
-
-EOF
-   } else {
-      if ($GIMP_PREFIX ne $old_prefix) {
-	 print <<EOF;
-
-WARNING: I've detected another installaion of the Gimp-Perl extension.
-	    
-	 This version uses the prefix '$GIMP_PREFIX'.
-	 The already installed version uses the prefix '$old_prefix'.
-
-	 They don't match, which indicates that installing Gimp-Perl might
-	 overwrite an old but still used installation. Gimp-Perl will
-	 therefore be disabled, and not be installed.
-
-EOF
-	 not_halt("prefix mismatch");
-      }
-   }
-}
-
 # wo do no longer do these dirty things
 #for(@shebang) {
 #   system ($Config{perlpath},"-pi","-e","\$. == 1 and \$_ = '#!$Config{perlpath}\n'",$_);

plug-ins/perl/Perl-Server

@@ -16,9 +16,9 @@ use strict;
 use vars qw($use_unix $use_tcp $trace_res $server_quit $max_pkt $unix $tcp $ps_flags
             %object_dynamic $object_uid %objects $auth @authorized $exclusive
             $rm $saved_rm);
-# the '' might be required (i.e. no ())
+# the '' might be required (i.e. no ()). why??
-use Gimp '';
+use Gimp ();
-use Gimp::Net qw(:server);
+use Gimp::Net ();
 
 Gimp::set_trace(\$trace_res);
 Gimp::ignore_functions(qw(gimp_progress_init gimp_progress_update));
@@ -305,15 +305,15 @@ sub extension_perl_server {
 }
 
 sub query {
-  Gimp->install_procedure("extension_perl_server", "Start the Gimp-Perl Server",
+   Gimp->install_procedure("extension_perl_server", "Start the Gimp-Perl Server",
-                          "This is the server for plug-ins written using the Gimp::Net module",
+                           "This is the server for plug-ins written using the Gimp::Net module",
-                          "Marc Lehmann <pcg\@goof.com>", "Marc Lehmann", "1998-07-22",
+                           "Marc Lehmann <pcg\@goof.com>", "Marc Lehmann", "1998-07-22",
-                          "<Toolbox>/Xtns/Perl Server", "*",&Gimp::PROC_EXTENSION,
+                           "<Toolbox>/Xtns/Perl Server", "*",&Gimp::PROC_EXTENSION,
-                          [
+                           [
-                           [&Gimp::PARAM_INT32, "run_mode", "Interactive, [non-interactive]"],
+                            [&Gimp::PARAM_INT32, "run_mode", "Interactive, [non-interactive]"],
-                           [&Gimp::PARAM_INT32, "flags", "internal flags (must be 0)"],
+                            [&Gimp::PARAM_INT32, "flags", "internal flags (must be 0)"],
-                           [&Gimp::PARAM_INT32, "extra", "multi-purpose ;)"],
+                            [&Gimp::PARAM_INT32, "extra", "multi-purpose ;)"],
-                          ],[]);
+                           ],[]);
 }
 
 sub quit {

plug-ins/perl/etc/config.pl.in

@@ -7,11 +7,17 @@ $LDFLAGS	= q[@LDFLAGS@];
 $prefix		= q[@prefix@];
 $exec_prefix	= q[@exec_prefix@];
 $libdir		= q[@libdir@];
+$bindir		= q[@bindir@];
+
+$exec_prefix=~s/\${?prefix}?/$prefix/g;
+$libdir=~s/\${?exec_prefix}?/$exec_prefix/g;
+$bindir=~s/\${?exec_prefix}?/$exec_prefix/g;
 
 $IN_GIMP	= q[@IN_GIMP@];
 
 $PERL		= q[@PERL@];
-$GIMP		= q[@GIMP@];
+$GIMP		= $IN_GIMP ? q[@GIMP@] : "$bindir/gimp";
+
 $GIMPTOOL	= q[@GIMPTOOL@];
 $GIMP_INC	= q[@GIMP_CFLAGS@];
 $GIMP_INC_NOUI	= q[@GIMP_CFLAGS_NOUI@];
@@ -34,4 +40,4 @@ if ($IN_GIMP) {
    chomp $GIMP_PREFIX;
 }
 
-$DEFS = ' -DGIMP_PREFIX=\"'.$GIMP_PREFIX.'\"';
+$DEFS = ' -DGIMP_PREFIX=\"'.$GIMP_PREFIX.'\" -DGIMP_PATH=\"'.$GIMP.'\"';

plug-ins/perl/etc/configure

@@ -574,25 +574,31 @@ do
 set dummy $ac_prog; ac_word=$2
 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
 echo "configure:577: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_GIMP'+set}'`\" = set"; then
+if eval "test \"`echo '$''{'ac_cv_path_GIMP'+set}'`\" = set"; then
   echo $ac_n "(cached) $ac_c" 1>&6
 else
-  if test -n "$GIMP"; then
+  case "$GIMP" in
-  ac_cv_prog_GIMP="$GIMP" # Let the user override the test.
+  /*)
-else
+  ac_cv_path_GIMP="$GIMP" # Let the user override the test with a path.
+  ;;
+  ?:/*)			 
+  ac_cv_path_GIMP="$GIMP" # Let the user override the test with a dos path.
+  ;;
+  *)
   IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
   ac_dummy="$PATH"
-  for ac_dir in $ac_dummy; do
+  for ac_dir in $ac_dummy; do 
     test -z "$ac_dir" && ac_dir=.
     if test -f $ac_dir/$ac_word; then
-      ac_cv_prog_GIMP="$ac_prog"
+      ac_cv_path_GIMP="$ac_dir/$ac_word"
       break
     fi
   done
   IFS="$ac_save_ifs"
+  ;;
+esac
 fi
-fi
+GIMP="$ac_cv_path_GIMP"
-GIMP="$ac_cv_prog_GIMP"
 if test -n "$GIMP"; then
   echo "$ac_t""$GIMP" 1>&6
 else
@@ -601,7 +607,6 @@ fi
 
 test -n "$GIMP" && break
 done
-test -n "$GIMP" || GIMP="gimp"
 
 
 # Check whether --with-gimp-prefix or --without-gimp-prefix was given.
@@ -645,7 +650,7 @@ fi
   # Extract the first word of "gimptool", so it can be a program name with args.
 set dummy gimptool; ac_word=$2
 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:649: checking for $ac_word" >&5
+echo "configure:654: checking for $ac_word" >&5
 if eval "test \"`echo '$''{'ac_cv_path_GIMPTOOL'+set}'`\" = set"; then
   echo $ac_n "(cached) $ac_c" 1>&6
 else
@@ -680,7 +685,7 @@ fi
 
   min_gimp_version=1.0.2
   echo $ac_n "checking for GIMP - version >= $min_gimp_version""... $ac_c" 1>&6
-echo "configure:684: checking for GIMP - version >= $min_gimp_version" >&5
+echo "configure:689: checking for GIMP - version >= $min_gimp_version" >&5
   no_gimp=""
   if test "$GIMPTOOL" = "no" ; then
     no_gimp=yes
@@ -713,7 +718,7 @@ echo "configure:684: checking for GIMP - version >= $min_gimp_version" >&5
   echo $ac_n "cross compiling; assumed OK... $ac_c"
 else
   cat > conftest.$ac_ext <<EOF
-#line 717 "configure"
+#line 722 "configure"
 #include "confdefs.h"
 
 #include <stdio.h>
@@ -762,7 +767,7 @@ int main ()
 
 
 EOF
-if { (eval echo configure:766: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:771: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
 then
   :
 else
@@ -796,7 +801,7 @@ fi
           CFLAGS="$CFLAGS $GIMP_CFLAGS"
           LIBS="$LIBS $GIMP_LIBS"
           cat > conftest.$ac_ext <<EOF
-#line 800 "configure"
+#line 805 "configure"
 #include "confdefs.h"
 
 #include <stdio.h>
@@ -806,7 +811,7 @@ int main() {
  return 0; 
 ; return 0; }
 EOF
-if { (eval echo configure:810: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:815: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
   rm -rf conftest*
    echo "*** The test program compiled, but did not run. This usually means"
           echo "*** that the run-time linker is not finding GIMP or finding the wrong"
@@ -847,7 +852,7 @@ rm -f conftest*
 ac_gimp_save_CPPFLAGS="$CPPFLAGS"
 CPPFLAGS="$CPPFLAGS $GIMP_CFLAGS"
 echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
-echo "configure:851: checking how to run the C preprocessor" >&5
+echo "configure:856: checking how to run the C preprocessor" >&5
 # On Suns, sometimes $CPP names a directory.
 if test -n "$CPP" && test -d "$CPP"; then
   CPP=
@@ -862,13 +867,13 @@ else
   # On the NeXT, cc -E runs the code through the compiler's parser,
   # not just through cpp.
   cat > conftest.$ac_ext <<EOF
-#line 866 "configure"
+#line 871 "configure"
 #include "confdefs.h"
 #include <assert.h>
 Syntax Error
 EOF
 ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:872: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:877: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
 ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
 if test -z "$ac_err"; then
   :
@@ -879,13 +884,13 @@ else
   rm -rf conftest*
   CPP="${CC-cc} -E -traditional-cpp"
   cat > conftest.$ac_ext <<EOF
-#line 883 "configure"
+#line 888 "configure"
 #include "confdefs.h"
 #include <assert.h>
 Syntax Error
 EOF
 ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:889: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:894: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
 ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
 if test -z "$ac_err"; then
   :
@@ -896,13 +901,13 @@ else
   rm -rf conftest*
   CPP="${CC-cc} -nologo -E"
   cat > conftest.$ac_ext <<EOF
-#line 900 "configure"
+#line 905 "configure"
 #include "confdefs.h"
 #include <assert.h>
 Syntax Error
 EOF
 ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:906: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:911: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
 ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
 if test -z "$ac_err"; then
   :
@@ -927,7 +932,7 @@ fi
 echo "$ac_t""$CPP" 1>&6
 
 cat > conftest.$ac_ext <<EOF
-#line 931 "configure"
+#line 936 "configure"
 #include "confdefs.h"
 #include <libgimp/gimp.h>
 EOF
@@ -947,17 +952,17 @@ for ac_hdr in unistd.h
 do
 ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
 echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:951: checking for $ac_hdr" >&5
+echo "configure:956: checking for $ac_hdr" >&5
 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
   echo $ac_n "(cached) $ac_c" 1>&6
 else
   cat > conftest.$ac_ext <<EOF
-#line 956 "configure"
+#line 961 "configure"
 #include "confdefs.h"
 #include <$ac_hdr>
 EOF
 ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:961: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:966: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
 ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
 if test -z "$ac_err"; then
   rm -rf conftest*
@@ -983,73 +988,18 @@ else
 fi
 done
 
-for ac_func in _exit
-do
-echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:990: checking for $ac_func" >&5
-if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
-  echo $ac_n "(cached) $ac_c" 1>&6
-else
-  cat > conftest.$ac_ext <<EOF
-#line 995 "configure"
-#include "confdefs.h"
-/* System header to define __stub macros and hopefully few prototypes,
-    which can conflict with char $ac_func(); below.  */
-#include <assert.h>
-/* Override any gcc2 internal prototype to avoid an error.  */
-/* We use char because int might match the return type of a gcc2
-    builtin and then its argument prototype would still apply.  */
-char $ac_func();
-
-int main() {
-
-/* The GNU C library defines this for functions which it implements
-    to always fail with ENOSYS.  Some functions are actually named
-    something starting with __ and the normal name is an alias.  */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-$ac_func();
-#endif
-
-; return 0; }
-EOF
-if { (eval echo configure:1018: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
-  rm -rf conftest*
-  eval "ac_cv_func_$ac_func=yes"
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  eval "ac_cv_func_$ac_func=no"
-fi
-rm -f conftest*
-fi
-
-if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
-  echo "$ac_t""yes" 1>&6
-    ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
-  cat >> confdefs.h <<EOF
-#define $ac_tr_func 1
-EOF
- 
-else
-  echo "$ac_t""no" 1>&6
-fi
-done
-
 
 CONFIG_H="config.h"
 
 for ac_func in vsnprintf
 do
 echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:1048: checking for $ac_func" >&5
+echo "configure:998: checking for $ac_func" >&5
 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
   echo $ac_n "(cached) $ac_c" 1>&6
 else
   cat > conftest.$ac_ext <<EOF
-#line 1053 "configure"
+#line 1003 "configure"
 #include "confdefs.h"
 /* System header to define __stub macros and hopefully few prototypes,
     which can conflict with char $ac_func(); below.  */
@@ -1072,7 +1022,7 @@ $ac_func();
 
 ; return 0; }
 EOF
-if { (eval echo configure:1076: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1026: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
   rm -rf conftest*
   eval "ac_cv_func_$ac_func=yes"
 else
@@ -1128,12 +1078,12 @@ fi
 for ac_func in _exit
 do
 echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:1132: checking for $ac_func" >&5
+echo "configure:1082: checking for $ac_func" >&5
 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
   echo $ac_n "(cached) $ac_c" 1>&6
 else
   cat > conftest.$ac_ext <<EOF
-#line 1137 "configure"
+#line 1087 "configure"
 #include "confdefs.h"
 /* System header to define __stub macros and hopefully few prototypes,
     which can conflict with char $ac_func(); below.  */
@@ -1156,7 +1106,7 @@ $ac_func();
 
 ; return 0; }
 EOF
-if { (eval echo configure:1160: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1110: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
   rm -rf conftest*
   eval "ac_cv_func_$ac_func=yes"
 else
@@ -1543,3 +1493,4 @@ test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
 
 echo "now invoking perl to complete the configuration..."
 exec $PERL $MAKEFILE_PL --writemakefile PREFIX="$prefix"
+

plug-ins/perl/etc/configure.in

@@ -16,7 +16,7 @@ AC_ARG_WITH(includes,[  --with-includes=DIR     Additionally search for includes
 AC_ARG_WITH(libs,    [  --with-libs=DIR         Additionally search for libraries in dir in DIR (optional)],
    LIBS="$LIBS -L$with_libs")
 
-AC_CHECK_PROGS(GIMP,gimp,gimp)
+AC_PATH_PROGS(GIMP,gimp)
 
 AM_PATH_GIMP(1.0.2,, AC_MSG_ERROR(
 ** unable to find gimp, make sure it's in your path (version 1.0.2+ required!)
@@ -29,7 +29,6 @@ AC_EGREP_CPP(DIVIDE_MODE,[#include <libgimp/gimp.h>],AC_DEFINE(HAVE_DIVIDE_MODE)
 CPPFLAGS="$ac_gimp_save_CPPFLAGS"
 
 AC_CHECK_HEADERS(unistd.h)
-AC_CHECK_FUNCS(_exit)
 
 CONFIG_H="config.h"
 

plug-ins/perl/examples/alpha2color.pl

@@ -106,7 +106,7 @@ register
 	"<Image>/Image/Colors/Alpha2Color",
 	"RGBA",
 	[
-	 [PF_COLOR, "Color", "Color for current alpha", [127,127,127]]
+	 [PF_COLOR, "color", "Color for current alpha", [127,127,127]]
 	],
 	\&alpha2col;
 

plug-ins/perl/examples/animate_cells

@@ -85,7 +85,7 @@ register
   "<Image>/Filters/Animation/Animate Cells",
   "*",
   [
-   [PF_TOGGLE, "Work on a copy?", "", 1]
+   [PF_TOGGLE, "work_on_copy", "", 1]
   ],
   \&perl_fu_animate_cells;
 

plug-ins/perl/examples/font_table

@@ -179,17 +179,17 @@ register
   "<Toolbox>/Xtns/Render/Font Table",
   "*",
   [
-   [PF_STRING, "Foundery (perl regex or \"*\")", "Foundery", "*"],
+   [PF_STRING, "foundery", "Foundery (perl regex or \"*\")", "*"],
-   [PF_STRING, "Family (perl regex or \"*\")", "Family", "*"],
+   [PF_STRING, "family", "Family (perl regex or \"*\")", "*"],
-   [PF_STRING, "Weight (perl regex or \"*\")", "Weight", "*"],
+   [PF_STRING, "weight", "Weight (perl regex or \"*\")", "*"],
-   [PF_STRING, "Slant (perl regex or \"*\")", "Slant", "*"],
+   [PF_STRING, "slant", "Slant (perl regex or \"*\")", "*"],
-   [PF_INT32, "Point Size", "Size", 18],
+   [PF_INT32, "point_size", "Point Size", 18],
-   [PF_COLOR, "Text Color", "FG", 'black'],
+   [PF_COLOR, "text_color", "Text Color", 'black'],
-   [PF_COLOR, "Background Color", "BG", 'white'],
+   [PF_COLOR, "bg_color", "Background Color", 'white'],
-   [PF_FONT, "Label Font", "Font", '-*-courier-medium-r-normal--18-*-*-*-*-*-*-*'],
+   [PF_FONT, "label_font", "Label Font", '-*-courier-medium-r-normal--18-*-*-*-*-*-*-*'],
-   [PF_STRING, "Test String", "String", 'FOUR (4) SCORE and seven (7) years @%$*&'],
+   [PF_STRING, "test_string", "Test String", 'FOUR (4) SCORE and seven (7) years @%$*&'],
-   [PF_INT32, "Text Padding", "Padding", 10],
+   [PF_INT32, "padding", "Text Padding", 10],
-   [PF_INT32, "Maximum page height", "Height", 1000]
+   [PF_INT32, "height", "Maximum page height", 1000]
   ],
   \&font_table;
 

plug-ins/perl/examples/image_tile

@@ -442,13 +442,13 @@ register
    # Image and drawable are given for free...
    # [PF_IMAGE, "Input image", undef],
    # [PF_DRAWABLE, "Input drawable", undef],
-   [PF_INT32, "Number of tiles (X)", "X tiles", 10],
+   [PF_INT32, "tiles_x", "Number of tiles (X)", 10],
-   [PF_INT32, "Number of tiles (Y)", "Y tiles", 10],
+   [PF_INT32, "tiles_y", "Number of tiles (Y)", 10],
-   [PF_INT32, "Number of sample cells per tile (X)", "X cells", 4],
+   [PF_INT32, "samples_x", "Number of sample cells per tile (X)", 4],
-   [PF_INT32, "Number of sample cells per tile (Y)", "Y cells", 4],
+   [PF_INT32, "samples_y", "Number of sample cells per tile (Y)", 4],
-   [PF_INT32, "Duplicates (0[lots] - 100[none])", "Duplicates", 5],
+   [PF_INT32, "duplicates", "Duplicates (0[lots] - 100[none])", 5],
-   [PF_STRING, "Sub-image directories (space speparated)", "Directories"],
+   [PF_STRING, "image_dirs", "Sub-image directories (space speparated)"],
-   [PF_TOGGLE, "Delete cached image samples?", "", 0]
+   [PF_TOGGLE, "delete_cached", "Delete cached image samples?", 0]
   ],
   \&perl_fu_image_tile;
 

plug-ins/perl/examples/innerbevel

@@ -0,0 +1,95 @@
+#!/usr/bin/perl 
+# Effect taken from http://tigert.gimp.org/gimp/tutorials/beveled_text/
+# perl-ified by Seth Burgess <sjburges@gimp.org>
+
+# Programatically, this script is about as dull as they come.  The only 
+# exceptions are those of the neat util functions (that aren't all quite
+# working btw).  You can follow step by step with the website at 
+# http://tigert.gimp.org/gimp/tutorials/beveled_text/
+
+use Gimp;
+use Gimp::Fu;
+use Gimp::Util;
+
+$defaultcolor1 = [124,10,18];
+$defaultcolor2 = [200,19,27];
+
+$path = "<Toolbox>/Xtns/Render/Logos/Inner Bevel";
+$shortdesc = "Perform an inner bevel on text";
+$longdesc = "This uses tigert's inner bevel method on text, which can be found with his other excellent tutorials at http://tigert.gimp.org/";
+$date = "1999-03-23";
+$imgtypes = "*";
+$author = "Seth Burgess <sjburges\@gimp.org>";
+
+$path =~ m,/([^/]+)$,; 
+$regname = $1;
+$regname =~ s/ /_/g;
+$regname =~ tr/A-Z/a-z/;
+
+$author =~ m/^(.*) </;
+$authorname = $1;
+
+register $regname, $shortdesc, $longdesc, $authorname, $author, $date, $path, $imgtypes,
+  [ 
+   [PF_FONT, "font", "Font Name"],
+   [PF_STRING, "text", "Enter your text to be beveled", "INNERBEVEL"],
+   [PF_COLOR, "top_color", "Blend to this color", $defaultcolor2],
+   [PF_COLOR, "bot_color", "Blend from this color", $defaultcolor1],
+   [PF_SLIDER, "azimuth", "Direction of the shine", 132, [0,255,5]],
+   [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] ], 
+  ], sub {
+
+my ($font, $text, $color1, $color2, $azimuth, $elevation, $depth, $maptype) = @_;
+# -- step 1 -- 
+$oldst = get_state();
+
+gimp_palette_set_background($color1);
+gimp_palette_set_foreground($color2);
+
+@dims = gimp_text_wh($text, $font);
+
+$img = gimp_image_new($dims[0]+10, $dims[1]+10, RGB);
+
+# none of the macro's did quite what I was looking for here.  
+# i.e. create a text layer on transparent only...
+
+# -- step 2 --
+$layertmp = $img->add_new_layer(0,TRANS_IMAGE_FILL);
+$txtlayer = $img->text_fontname(-1, 10, 10, $text, 0, 1, xlfd_size($font), $font);
+$dsp = gimp_display_new($img);  # display the image early
+$layer = $img->merge_visible_layers(EXPAND_AS_NECESSARY);
+@pt1 = ($layer->width * 0.5 -1, 0);
+@pt2 = ($layer->width * 0.5 +1, $layer->height);
+# -- step 3 --
+$layer->set_preserve_trans(1);
+$layer->blend(FG_BG_RGB, 0, LINEAR, 100, 0, REPEAT_NONE, 0, 3, 0.20, @pt1, @pt2); # NORMAL isn't recognized
+# -- step 4 -- 
+$layer2 = $layer->copy(0);     # Can you override these to have a default? (would be nice)
+$img->add_layer($layer2, 0);
+# -- step 5 -- 
+$layer2->set_preserve_trans(1);
+$img->selection_all;
+gimp_palette_set_background([255,255,255]);
+$layer2->edit_fill;
+# -- step 6 -- 
+$layer2->set_preserve_trans(0);
+$layer2->gauss_rle(6,1,1);     # Defaults would be cool here too :)
+# -- step 7 --
+$layer->plug_in_bump_map($layer2, $azimuth, $elevation, $depth, 0,0,0,0,1,0,$maptype);
+# -- step 8 --
+$layer2->invert;
+$img->lower_layer($layer2);
+# -- step 9 --
+$layer2->translate(2, 3);
+
+# extra stuff
+$img->add_new_layer(2);
+$img->gimp_selection_none();
+
+set_state($oldst); # Doesn't seem to work - says it can't grok color 
+return();
+};
+
+exit main;  # <-- This lil' bugger caused me much grief.  I suppose its very much required?

plug-ins/perl/examples/perlotine

@@ -0,0 +1,166 @@
+#!/usr/bin/perl
+# <sjburges@gimp.org>
+# This is tigert's request.  I suppose it'll be useful to those that do
+# this sort of thing.  Personally I'll probably only run it to test and 
+# put up a demo image.
+
+use Gimp;
+use Gimp::Fu;
+use Gimp::Util;
+
+# Gimp::set_trace(TRACE_ALL);
+
+sub get_vguides {  # get back an ordered set of vertical guides
+    my ($img)=@_;
+    $i=0;
+    my @vguides;
+    while ($i=$img->findnext_guide($i)) {
+        if (!$img->get_guide_orientation($i)){
+			$keyval = sprintf("%4d", $img->get_guide_position($i));
+            $vkeys{$keyval} = $i;
+            }
+        }
+    foreach $key(sort (keys %vkeys)) {
+		# print "Unshifting ",  $key, "\n";
+        push @vguides, $vkeys{$key};
+        } 
+    return @vguides;
+    }
+
+sub get_hguides { # get back an ordered set of horizontal guides
+    my ($img)=@_;
+    $i=0;
+    my @hguides;
+    while ($i=$img->findnext_guide($i)) {
+        if ($img->get_guide_orientation($i)){
+			$keyval = sprintf("%4d", $img->get_guide_position($i));
+            $hkeys{$keyval} = $i;
+            }
+        }
+    # need to sort them in order of their occurance in the image
+    foreach $key(sort keys %hkeys) {
+        push @hguides, $hkeys{$key};
+        } 
+    return @hguides;
+    }
+
+sub dosel { # do the selection
+    ($img, $savepath, $imgpath, $imgbasename, $l,$r,$t,$b, $i,$j) = @_;
+    $filename =~ m/^(.*)\.[^\.]*$/ ;
+    $imgname = "$imgbasename-$i-$j.gif";
+    $tmpimg = $img->channel_ops_duplicate;
+	# print "Cropping from $l to $r, $t to $b\n";
+    $tmpimg->crop($r-$l, $b-$t, $l, $t);
+    $tmplay = $tmpimg->active_drawable;
+    if (! $tmplay->indexed) {
+        $tmpimg->convert_indexed(1,256);
+        }
+    $tmpimg->gimp_file_save(-1,"$savepath$imgpath$imgname","$savepath$imgpath$imgname");
+    $tmpimg->delete;
+    return "$imgpath$imgname"; # what I want printed in html
+    } 
+
+sub html_table_start {
+    ($fn,$cellpadding,$cellspacing,$border,$capatalize) = @_;
+	$str = $capatalize ? "<TABLE CELLSPACING=$cellspacing CELLPADDING=$cellpadding BORDER=$border>\n" :
+                         "<table cellspacing=$cellspacing cellpadding=$cellpadding border=$border>\n" ;
+	print $fn $str;
+    }
+
+sub html_table_row_start {
+    ($fn, $capatalize) = @_;
+	$str = $capatalize ? "\t<TR>\n" : "\t<tr>\n";
+	print $fn $str;
+    }
+
+sub html_table_entry {
+    ($fn, $imgname, $width, $height, $capatalize) = @_;
+	$str = $capatalize ? "\t\t<TD><IMG SRC=\"$imgname\" WIDTH=\"$width\"HEIGHT=\"$height\"></TD>\n" :
+                         "\t\t<td><img src=\"$imgname\" width=\"$width\"height=\"$height\"></td>\n";
+	print $fn $str;
+    }
+
+sub html_table_row_end {
+    ($fn, $capatalize) = @_;
+	$str = $capatalize ? "\t</TR>\n" : "\t</tr>\n";
+	print $fn $str;
+    }
+
+sub html_table_end {
+    ($fn, $capatalize) = @_;
+	$str = $capatalize ? "</TABLE>\n":"</table>\n";
+	print $fn $str;
+    }
+
+# <tigert> Save-path: [_____________________][browse]
+# <tigert> html-file name: [_________________]
+# <tigert> image-basename [__________________]
+# <tigert> [x] use separate dir for images
+# <tigert> image directory: [___________________] 
+
+# later, decided to have UPPER/lower case HTML toggle
+# cellspacing: ___^
+
+register "perlotine", 
+         "Guilotine implemented ala perl, with html output", 
+         "Add guides to an image.  Then run this.  It will cut along the guides, and give you the html to reassemble the resulting images.",
+         "Seth Burgess", 
+         "Seth Burgess <sjburges\@gimp.org>", 
+         "1999-03-19",
+         "<Image>/Image/Transforms/Perl-o-tine", 
+         "*", 
+         [ 
+           [PF_STRING, "save_path", "The path to export the HTML to",$ENV{HOME}], 
+           [PF_STRING, "html_file_name", "Filename to export","perlotine.html"], 
+           [PF_STRING, "image_basename", "What to call the images","perlotine"], 
+           [PF_TOGGLE, "separate_image_dir", "Use a separate directory for images?",0],
+           [PF_STRING, "relative_image_path", "The path to export the images to, relative to the Save Path", "images/"], 
+           [PF_TOGGLE, "capitalize_tags", "Capatalize HTML tags?", 0], 
+           [PF_SPINNER, "cellspacing", "Add space between the table elements", 0, [0,15,1]],
+            ], sub {
+
+    my($img,$layer,$savepath, $htmlname, $imgbasename, $separate, $imgpath, $capatalize, $cellspacing) =@_;
+
+    @vert = get_vguides($img);
+    @horz = get_hguides($img);
+
+    if (!(scalar(@vert) || scalar(@horz))) { 
+        die ("No horizontal or vertical guides found. Aborted.");
+        }
+   # print @vert, " LEN = ", scalar(@vert), "\n";    
+   # print @horz, " LEN = ", scalar(@horz), "\n";    
+   # foreach $guide (@vert) {
+   #		print $img->get_guide_position($guide), "\n";
+   #		}
+
+
+	if (!($savepath=~ m,/$,)) {  # add a trailing slash if its not on there
+		$savepath = $savepath . "/";
+		} 
+	
+	if (!($imgpath=~ m,/$,)) {  # add a trailing slash if its not on there
+		$imgpath= $imgpath . "/";
+		} 
+	if (!$separate) { $imgpath = ""; }
+
+    open FILE, ">$savepath$htmlname" or die "Couldn't open $savepath$filename: $!\n";
+
+    $top=0;
+    html_table_start(\*FILE,0,$cellspacing,0,$capatalize);
+    for ($i=0; $i<=scalar(@horz); $i++) {
+        $bot = ($i>$#horz) ? $img->height : $img->get_guide_position($horz[$i]);
+        html_table_row_start(\*FILE, $capatalize);
+        $left=0;
+        for ($j=0; $j<=scalar(@vert); $j++) {
+            $right = ($j>$#vert) ? $img->width : $img->get_guide_position($vert[$j]);
+            $imgname = dosel($img, $savepath, $imgpath, $imgbasename, $left, $right, $top, $bot, $i, $j);    
+            html_table_entry(\*FILE, $imgname, $right-$left, $bot-$top, $capatalize);
+            $left = $right + $cellspacing; 
+            }
+        html_table_row_end(\*FILE, $capatalize);
+        $top = $bot + $cellspacing;
+        }
+    html_table_end(\*FILE, $capatalize);
+    return();
+};
+exit main;

plug-ins/perl/examples/prep4gif.pl

@@ -98,11 +98,11 @@ register
 	"<Image>/Filters/Misc/Prepare for GIF",
 	"RGB*",
 	[
-	 [PF_INT32, "Lower Threshold", "Lower Alpha Threshold", 64],
+	 [PF_INT32, "lower_threshold", "Lower Alpha Threshold", 64],
-	 [PF_INT32, "Growth", "How Much growth for safety ",1],
+	 [PF_INT32, "growth", "How Much growth for safety ",1],
-	 [PF_TOGGLE, "Convert To Indexed", "Convert Image to indexed", 0],
+	 [PF_TOGGLE, "convert_to_indexed", "Convert Image to indexed", 0],
-	 [PF_TOGGLE, "Dither", "Floyd-Steinberg Dithering?", 1],
+	 [PF_TOGGLE, "dither", "Floyd-Steinberg Dithering?", 1],
-	 [PF_INT32, "Colors", "Colors to quantize to", "255"],
+	 [PF_INT32, "colors", "Colors to quantize to", "255"],
 	],
 	\&prep;
 

plug-ins/perl/examples/randomblends

@@ -0,0 +1,57 @@
+#!/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);
+
+sub randint {
+    my ($int) = @_;
+    return int(rand()*$int +0.5);
+    }    
+
+register "random_blends", 
+         "Random Blends - take a guess.", 
+         "A random approach to art.  Just try it. It might be good.",
+         "Seth Burgess", 
+         "Seth Burgess <sjburges\@gimp.org>", 
+         "1999-03-18",
+         "<Image>/Filters/Render/Random Blends", 
+         "RGB*, GRAY*", 
+         [ 
+           [PF_SPINNER, "number", "How many gradients to apply", 7, [1,255,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?)
+	$oldgradient = gimp_gradients_get_active();
+    ($sel,$x1,$y1,$x2,$y2) = $img->gimp_selection_bounds;
+    srand();
+
+    @gradientlist = gimp_gradients_get_list();  
+    for ($i=0; $i<=$numgradients; $i++) {
+        gimp_gradients_set_active(@gradientlist[randint($#gradientlist)]);
+        $layer->gimp_blend(CUSTOM,  
+                           6,              # DIFFERENCE
+# I'd really like to alternate how many arguments in gradient type depending
+# on what version of gimp is being run.. Hints anyone? -sjb
+                           randint(10),      # gradient type
+                           randint(100),     # opacity
+                           0,                # offset
+                           randint(2),       # repeat
+                           0,3,0.2,          # disabled supersampling
+                           randint($x2-$x1)+$x1, # x1
+                           randint($y2-$y1)+$y1, # y1
+                           randint($x2-$x1)+$x1, # x2
+                           randint($y2-$y1)+$y1, # y2
+                           );
+        }
+    eval { $img->undo_push_group_end };
+	gimp_gradients_set_active($oldgradient);
+    return();
+};
+exit main;

plug-ins/perl/examples/sethspin.pl

@@ -85,13 +85,13 @@ register "seth_spin",
          "<Toolbox>/Xtns/Animation/Seth Spin",
          "*",
          [
-          [PF_DRAWABLE, "Source", "What drawable to spin from?"],
+          [PF_DRAWABLE, "source", "What drawable to spin from?"],
-          [PF_DRAWABLE, "Destination","What drawable to spin to?"],
+          [PF_DRAWABLE, "destination","What drawable to spin to?"],
-		  [PF_INT8, "Frames", "How many frames to use?", 16],
+		  [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_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_SLIDER, "perspective", "How much perspective effect to get", 40, [0,255,5]],
-		  [PF_TOGGLE, "Spin Back", "Also spin back?" , 1],
+		  [PF_TOGGLE, "spin_back", "Also spin back?" , 1],
-          [PF_TOGGLE, "Convert Indexed", "Convert to indexed?", 1],
+          [PF_TOGGLE, "convert_indexed", "Convert to indexed?", 1],
          ],
          [],
          ['gimp-1.1'],

plug-ins/perl/examples/stamps

@@ -8,7 +8,6 @@ sub stamps {
 
 	gimp_palette_set_background($fgcolor);
 	$img = gimp_image_new($size, $size, RGB);
-	$img = gimp_image_new($size, $size, RGB);
 	$layer = gimp_layer_new($img, $size, $size, RGB, "Layer 1", 100, NORMAL_MODE);
 	gimp_image_add_layer($layer, -1);
 	gimp_palette_set_background($bgcolor);

plug-ins/perl/examples/terral_text

@@ -45,8 +45,8 @@ register
 	[ 
 	  [ PF_RADIO, "solid_noise", "The Texture Type", 0, ["solid noise" => 1, "current picture" => 0]],
 	  [ PF_FONT, "helvetica", "Font Name", "-*-helvetica-medium-r-normal-*-*-240-*-*-p-*-iso8859-1" ],
-	  [ PF_STRING, "Text", "Enter your Text to be Terral-ified", "TerralText"],
+	  [ PF_STRING, "text", "Enter your Text to be Terral-ified", "TerralText"],
-	  [ PF_SLIDER, "Blur Amount", "Blur Amount", 10, [0,26,1]],
+	  [ PF_SLIDER, "blur_amount", "Blur Amount", 10, [0,26,1]],
 	], 
         [],
 sub {

plug-ins/perl/examples/tex-to-float

@@ -166,11 +166,11 @@ register "tex_string_to_float", "Turn a TeX-string into floating layer", "Takes
     "<Image>/Filters/Render/TeX String", 
     "*",
     [
-     [PF_STRING,  "Input file",     "TeX macro file to input"],
+     [PF_STRING,  "input_file",     "TeX macro file to input"],
-     [PF_STRING,  "TeX String",     "Enter TeX String"],
+     [PF_STRING,  "tex_string",     "Enter TeX String"],
-     [PF_VALUE,   "DPI",     "Resolution to render the text in",   "72"],
+     [PF_VALUE,   "dpi",     "Resolution to render the text in",   "72"],
-     [PF_VALUE,   "Magstep",     "TeX magstep",   "2"],
+     [PF_VALUE,   "magstep",     "TeX magstep",   "2"],
-     [PF_VALUE,   "Anti-aliasing",     "Anti-aliasing factor",   "4"],
+     [PF_VALUE,   "anti_aliasing",     "Anti-aliasing factor",   "4"],
     ],
     \&tex_string_to_float;
 

plug-ins/perl/examples/view3d.pl

@@ -19,9 +19,9 @@ register
     'Tom Rathborne', 'GPLv2', '1999-03-11',
     '<Image>/View/3D Surface',
     'GRAY', [
-        [ PF_BOOL, 'Polar', 'Radial view', 0],
+        [ PF_BOOL, 'polar', 'Radial view', 0],
-        [ PF_BOOL, 'Lines', 'Draw grid lines', 0],
+        [ PF_BOOL, 'lines', 'Draw grid lines', 0],
-        [ PF_BOOL, 'Smooth', 'Smooth surface normals', 1]
+        [ PF_BOOL, 'smooth', 'Smooth surface normals', 1]
     ], [],
 sub {
     my ($img, $dwb, $polar, $lines, $smooth) = @_;

plug-ins/perl/examples/webify.pl

@@ -16,9 +16,9 @@ register "webify",
          [
           [PF_BOOL,	"new",		"create a new image?", 1],
           [PF_BOOL,	"transparent",	"make transparent?", 1],
-          [PF_COLOUR,	"bg colour",	"the background colour to use for transparency", "white"],
+          [PF_COLOUR,	"bg_color",	"the background colour to use for transparency", "white"],
           [PF_SLIDER,	"threshold",	"the threshold to use for background detection", 3, [0, 255, 1]],
-          [PF_INT32,	"colours",	"how many colours to use (0 = don't convert to indexed)", 32],
+          [PF_INT32,	"colors",	"how many colours to use (0 = don't convert to indexed)", 32],
           [PF_BOOL,	"autocrop",	"autocrop at end?", 1],
          ],
          sub {

plug-ins/perl/examples/windy.pl

@@ -54,10 +54,10 @@ register
 	"<Image>/Filters/Distorts/Windify",
 	"*",
 	[
-	 [PF_INT32, "Angle", "Wind Angle, 0 is left", 120],
+	 [PF_INT32, "angle", "Wind Angle, 0 is left", 120],
-	 [PF_INT32, "Density", "How Much Is Blown",80],
+	 [PF_INT32, "density", "How Much Is Blown",80],
-	 [PF_VALUE, "Distance", "How Far Its Blown",30],
+	 [PF_VALUE, "distance", "How Far Its Blown",30],
-	 [PF_TOGGLE, "Smear?", "Smear on Edges (or Wrap)",0]
+	 [PF_TOGGLE, "smear", "Smear on Edges (or Wrap)",0]
 	],
 	\&windify;
 

plug-ins/perl/examples/xachlego.pl

@@ -42,8 +42,8 @@ register "xach_blocks",
          "<Image>/Filters/Map/Xach Blocks",
          "*",
          [
-          [PF_SLIDER,	"Block size",	"The size of the blocks...", 10, [0, 255, 1]],
+          [PF_SLIDER,	"block_size",	"The size of the blocks...", 10, [0, 255, 1]],
-          [PF_SLIDER,	"Knob factor",	"The size of your knob...", 67, [0, 100, 5]],
+          [PF_SLIDER,	"knob_factor",	"The size of your knob...", 67, [0, 100, 5]],
          ],
          sub {
    my($img,$drawable,$blocksize, $knobfactor)=@_;

plug-ins/perl/examples/xachshadow.pl

@@ -34,7 +34,7 @@ register "xach_shadows",
          "<Image>/Filters/Map/Xach Shadows",
          "RGB*, GRAY*",
          [
-          [PF_SLIDER,	"Block size",	"The size of the blocks...", 10, [0, 255, 1]],
+          [PF_SLIDER,	"block_size",	"The size of the blocks...", 10, [0, 255, 1]],
          ],
          sub {
    my($img,$drawable,$blocksize) =@_;

plug-ins/perl/examples/xachvision.pl

@@ -15,8 +15,8 @@ register "xachvision",
          "<Image>/Filters/Noise/Xach Vision",
          "RGB*, GRAY*",
          [
-          [PF_COLOR,	"Color",	"What Color to see the world in", [0, 255, 0]],
+          [PF_COLOR,	"color",	"What Color to see the world in", [0, 255, 0]],
-	  [PF_SLIDER,   "Added Noise", "How much noise to add", 25, [0,255,5]]
+	  [PF_SLIDER,   "added_noise", "How much noise to add", 25, [0,255,5]]
          ],
          sub {
    my($img,$drawable,$color,$amt) =@_;

plug-ins/perl/examples/yinyang

@@ -108,13 +108,13 @@ register("yinyang", "Render a stand-alone Yin/Yang image",
 	"Aaron Sherman", "(c) 1998, Aaron Sherman",
 	"1999a", "<Toolbox>/Xtns/Render/Yin-Yang", "*",
 	[
-		[PF_INT32, "Width", "Width", 256],
+		[PF_INT32, "width", "Width", 256],
-		[PF_INT32, "Height", "Height", 256],
+		[PF_INT32, "height", "Height", 256],
-		[PF_TOGGLE, "Insert eyes?", "", 1],
+		[PF_TOGGLE, "insert_eyes", "", 1],
-		[PF_TOGGLE, "Eyes are images?", "", 0],
+		[PF_TOGGLE, "eyes_are_images", "", 0],
-		[PF_STRING, "Top eye filename", "eye 1", ""],
+		[PF_STRING, "top_eye_filename", "eye 1", ""],
-		[PF_STRING, "Bottom eye filename", "eye 2", ""],
+		[PF_STRING, "aobttom_eye_filename", "eye 2", ""],
-		[PF_TOGGLE, "Anti-aliasing?", "", 1]
+		[PF_TOGGLE, "anti_aliasing", "", 1]
 	],
 	\&yinyang);
 

plug-ins/perl/scm2perl

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

plug-ins/perl/t/load.t

@@ -1,18 +1,10 @@
-use Test;
+$|=1;
-
+print "1..2\n";
-BEGIN {
-  plan tests => 2;
-}
-
-END {
-  ok(0) unless $loaded;
-}
 
 use Gimp qw(:consts);
-$loaded = 1;
+print "ok 1\n";
-ok(1);
 
-ok(SHARPEN,1);
+print "ok 2\n" if SHARPEN;
 
 
 

plug-ins/perl/t/loadlib.t

@@ -1,19 +1,11 @@
-use Test;
+$|=1;
+print "1..1\n";
 
-BEGIN {
+# trick Gimp into using the Gimp::Lib-interface.
-  plan tests => 2;
+BEGIN { @ARGV = '-gimp' }
-}
-
-END {
-  ok(0) unless $loaded;
-}
 
 use Gimp qw(:consts);
-use Gimp::Lib;
+print "ok 1\n";
-$loaded = 1;
-ok(1);
-
-ok(SHARPEN,1);
 
 
 

plug-ins/perl/t/run.t

@@ -1,19 +1,27 @@
-use Test;
+use Config;
 use vars qw($EXTENSIVE_TESTS $GIMPTOOL);
 
 # the most complicated thing is to set up a working gimp environment. its
 # difficult at best...
 
 BEGIN {
-  plan tests => 25;
+  $|=1;
+  print "1..26\n";
+  $count=0;
+  $Gimp::host = "spawn/";
+}
+
+sub ok($;$) {
+   print((@_==1 ? shift : $_[0] eq &{$_[1]}) ?
+         "ok " : "not ok ", ++$count, "\n");
+}
+
+sub skip($$;$) {
+   shift() ? print "ok ",++$count," # skip\n" : &ok;
 }
 
 END {
-  if($loaded and $dir) {
+#  system("rm","-rf",$dir);#d##FIXME#
-    system("rm","-rf",$dir); #d#FIXME
-  } else {
-    ok(0);
-  }
 }
 
 use Cwd;
@@ -25,59 +33,71 @@ ok(1);
 
 $n=!$EXTENSIVE_TESTS;
 
-skip($n,sub {($plugins = `$GIMPTOOL -n --install-admin-bin /bin/sh`) =~ s{^.*\s(.*?)(?:/+bin/sh)\r?\n?$}{$1}});
+skip($n,1,sub {($plugins = `$GIMPTOOL -n --install-admin-bin /bin/sh`) =~ s{^.*\s(.*?)(?:/+bin/sh)\r?\n?$}{$1}});
-skip($n,sub {-d $plugins});
+skip($n,1,sub {-d $plugins});
-skip($n,sub {-x "$plugins/script-fu"});
+skip($n,1,sub {-x "$plugins/script-fu"});
 
 use Gimp;
-$loaded = 1;
 ok(1);
 
 ok(RGBA_IMAGE || RGB_IMAGE);
-ok(RGB_IMAGE ? 1 : 1); # this shouldn't be a pattern match(!)
+ok(RGB_IMAGE ? 1 : 1); #  check for correct prototype
 
-sub net {
+sub tests {
    my($i,$l);
-   skip($n,sub{$i=new Image(10,10,RGB)});
+   skip($n,1,sub{0 != ($i=new Image(10,10,RGB))});
-   skip($n,ref $i);
+   skip($n,1,sub {!!ref $i});
-   skip($n,sub{$l=$i->layer_new(10,10,RGBA_IMAGE,"new layer",100,VALUE_MODE)});
+   skip($n,1,sub{0 != ($l=$i->layer_new(10,10,RGBA_IMAGE,"new layer",100,VALUE_MODE))});
-   skip($n,ref $l);
+   skip($n,1,sub {!!ref $l});
    
-   skip($n,sub{gimp_image_add_layer($l,0) || 1});
+   skip($n,1,sub{gimp_image_add_layer($l,0) || 1});
-   skip($n,sub{$l->get_name()},"new layer");
+   skip($n,"new layer",sub{$l->get_name()});
    
-   skip($n,sub{$l->paintbrush(50,[1,1,2,2,5,3,7,4,2,8]) || 1});
+   skip($n,1,sub{$l->paintbrush(50,[1,1,2,2,5,3,7,4,2,8]) || 1});
-   skip($n,sub{$l->paintbrush(30,4,[5,5,8,1]) || 1});
+   skip($n,1,sub{$l->paintbrush(30,4,[5,5,8,1]) || 1});
    
-   skip($n,sub{Plugin->sharpen(RUN_NONINTERACTIVE,$i,$l,10) || 1});
+   skip($n,1,sub{Plugin->sharpen(RUN_NONINTERACTIVE,$i,$l,10) || 1});
-   skip($n,sub{$l->sharpen(10) || 1});
+   skip($n,1,sub{$l->sharpen(10) || 1});
-   skip($n,sub{plug_in_sharpen($i,$l,10) || 1});
+   skip($n,1,sub{plug_in_sharpen($i,$l,10) || 1});
    
-   skip($n,sub{$i->delete || 1});
+   skip($n,1,sub{$i->delete || 1});
 }
 
 system("rm","-rf",$dir); #d#FIXME
-ok(sub {mkdir $dir,0700});
+ok(1,sub {mkdir $dir,0700});
-ok(sub {symlink "../Perl-Server","$dir/Perl-Server"});
+
-skip($n,sub {symlink "$plugins/script-fu","$dir/script-fu"});
+# copy the Perl-Server
-skip($n,sub {symlink "$plugins/sharpen","$dir/sharpen"});
+{
+   local(*X,*Y,$/);
+   open X,"<Perl-Server" or die "unable to read the Perl-Server";
+   my $s = <X>;
+   open Y,">$dir/Perl-Server.pl" or die "unable to write the Perl-Server";
+   print Y $Config{startperl},"\n",$s,<X>;
+   ok(1);
+}
+ok(1,sub { chmod 0700,"$dir/Perl-Server.pl" });
+
+skip($n,1,sub {symlink "$plugins/script-fu","$dir/script-fu"});
+skip($n,1,sub {symlink "$plugins/sharpen","$dir/sharpen"});
 
 ok (
   open RC,">$dir/gimprc" and
   print RC "(show-tips no)\n" and
+  print RC "(gimp_data_dir \"\")\n" and
+  print RC "(script-fu-path \"\")\n" and
   print RC "(plug-in-path \"$dir\")\n" and
   close RC
 );
 
 $ENV{'GIMP_DIRECTORY'}=$dir;
-$Gimp::host = "spawn/";
 
 if(!$n) {
    skip($n,1);
-   main;
+   Gimp::init;
+   tests;
 } else {
    skip($n,0);
-   net();
+   tests;
 }