Gimp::Fu - "easy to use" framework for Gimp scripts

  use Gimp;
  use Gimp::Fu;

  (this module uses Gtk, so make sure it's correctly installed)

   #!/path/to/your/perl

   use Gimp;
   use Gimp::Fu;

   register <many arguments>, sub {
      your code;
   }

   exit main;

   register
     "function_name",
     "blurb", "help",
     "author", "copyright",
     "date",
     "menu path",
     "image types",
     [
       [PF_TYPE,name,desc,optional-default,optional-extra-args],
       [PF_TYPE,name,desc,optional-default,optional-extra-args],
       # etc...
     ],
     [
       # like above, but for return values (optional)
     ],
     ['feature1', 'feature2'...], # optionally check for features
     sub { code };

package Gimp::Fu;

use Gimp ('croak', '__');
use Gimp::Data;
use File::Basename;

require Exporter;

sub PF_INT8	() { Gimp::PDB_INT8	};
sub PF_INT16	() { Gimp::PDB_INT16	};
sub PF_INT32	() { Gimp::PDB_INT32	};
sub PF_FLOAT	() { Gimp::PDB_FLOAT	};
sub PF_STRING	() { Gimp::PDB_STRING	};
sub PF_COLOR	() { Gimp::PDB_COLOR	};
sub PF_COLOUR	() { Gimp::PDB_COLOR	};
sub PF_IMAGE	() { Gimp::PDB_IMAGE	};
sub PF_LAYER	() { Gimp::PDB_LAYER	};
sub PF_CHANNEL	() { Gimp::PDB_CHANNEL	};
sub PF_DRAWABLE	() { Gimp::PDB_DRAWABLE	};

sub PF_TOGGLE	() { Gimp::PDB_END+1	};
sub PF_SLIDER	() { Gimp::PDB_END+2	};
sub PF_FONT	() { Gimp::PDB_END+3	};
sub PF_SPINNER	() { Gimp::PDB_END+4	};
sub PF_ADJUSTMENT(){ Gimp::PDB_END+5	}; # compatibility fix for script-fu _ONLY_
sub PF_BRUSH	() { Gimp::PDB_END+6	};
sub PF_PATTERN	() { Gimp::PDB_END+7	};
sub PF_GRADIENT	() { Gimp::PDB_END+8	};
sub PF_RADIO	() { Gimp::PDB_END+9	};
sub PF_CUSTOM	() { Gimp::PDB_END+10	};
sub PF_FILE	() { Gimp::PDB_END+11	};
sub PF_TEXT	() { Gimp::PDB_END+12	};

sub PF_BOOL	() { PF_TOGGLE		};
sub PF_INT	() { PF_INT32		};
sub PF_VALUE	() { PF_STRING		};

sub Gimp::RUN_FULLINTERACTIVE (){ Gimp::RUN_INTERACTIVE+100 };	# you don't want to know

%pf_type2string = (
         &PF_INT8	=> 'small integer',
         &PF_INT16	=> 'medium integer',
         &PF_INT32	=> 'integer',
         &PF_FLOAT	=> 'value',
         &PF_STRING	=> 'string',
         &PF_BRUSH	=> 'string',
         &PF_GRADIENT	=> 'string',
         &PF_PATTERN	=> 'string',
         &PF_COLOR	=> 'colour',
         &PF_FONT	=> 'XLFD',
         &PF_TOGGLE	=> 'boolean',
         &PF_SLIDER	=> 'integer',
         &PF_SPINNER	=> 'integer',
         &PF_ADJUSTMENT	=> 'integer',
         &PF_RADIO	=> 'string',
         &PF_CUSTOM	=> 'string',
         &PF_FILE	=> 'string',
         &PF_TEXT	=> 'string',
         &PF_IMAGE	=> 'path',
         &PF_LAYER	=> 'index',
         &PF_CHANNEL	=> 'index',
         &PF_DRAWABLE	=> 'index',
);

@_params=qw(PF_INT8 PF_INT16 PF_INT32 PF_FLOAT PF_VALUE PF_STRING PF_COLOR
            PF_COLOUR PF_TOGGLE PF_IMAGE PF_DRAWABLE PF_FONT PF_LAYER
            PF_CHANNEL PF_BOOL PF_SLIDER PF_INT PF_SPINNER PF_ADJUSTMENT
            PF_BRUSH PF_PATTERN PF_GRADIENT PF_RADIO PF_CUSTOM PF_FILE
            PF_TEXT);

#@EXPORT_OK = qw($run_mode save_image);

sub import {
   local $^W=0;
   my $up = caller;
   shift;
   @_ = (qw(register main),@_params) unless @_;
   for (@_) {
      if ($_ eq ":params") {
         push (@_, @_params);
      } else {
         *{"${up}::$_"} = \&$_;
      }
   }
}

sub carp {
   require Carp;
   goto &Carp::carp;
}

# Some Standard Arguments
my @image_params = ([&Gimp::PDB_IMAGE		, "image",	"The image to work on"],
                    [&Gimp::PDB_DRAWABLE	, "drawable",	"The drawable to work on"]);

my @load_params  = ([&Gimp::PDB_STRING	, "filename",	"The name of the file"],
                    [&Gimp::PDB_STRING	, "raw_filename","The name of the file"]);

my @save_params  = (@image_params, @load_params);

my @load_retvals = ([&Gimp::PDB_IMAGE		, "image",	"Output image"]);

my $image_retval = [&Gimp::PDB_IMAGE		, "image",	"The resulting image"];

# expand all the pod directives in string (currently they are only removed)
sub expand_podsections() {
   my $pod;
   for (@scripts) {
      $_->[2] ||= "=pod(NAME)";
      $_->[3] ||= "=pod(HELP)";
      $_->[4] ||= "=pod(AUTHOR)";
      $_->[5] ||= "=pod(AUTHOR)";
      $_->[6] ||= "=pod(DATE)";

      for (@{$_}[2,3,4,5,6]) {
         s/=pod\(([^)]*)\)/
                        require Gimp::Pod;
                        $pod ||= new Gimp::Pod;
                        $pod->section($1) || $pod->format;
                  /eg;
      }
   }
}

# the old value of the trace flag
my $old_trace;

sub interact {
   eval { require Gtk };

   if ($@) {
      my @res = map {
         die __"the gtk perl module is required to run\nthis plug-in in interactive mode\n" unless defined $_->[3];
         $_->[3];
      } @types;
      Gimp::logger(message => __"the gtk perl module is required to open a dialog\nwindow, running with default values",
                   fatal => 1, function => $function);
      return (1,@res);
   }

   require Gimp::UI;
   goto &Gimp::UI::interact;
}

sub fu_feature_present($$) {
   my ($feature,$function)=@_;
   require Gimp::Feature;
   if (Gimp::Feature::present($feature)) {
      1;
   } else {
      Gimp::Feature::missing(Gimp::Feature::describe($feature),$function);
      0;
   }
}

sub this_script {
   return $scripts[0] unless $#scripts;
   # well, not-so-easy-day today
   require File::Basename;
   my $exe = File::Basename::basename($0);
   my @names;
   for my $this (@scripts) {
      my $fun = (split /\//,$this->[1])[-1];
      $fun =~ s/^(?:perl_fu|plug_in)_//;
      return $this if lc($exe) eq lc($fun);
      push(@names,$fun);
   }
   die __"function '$exe' not found in this script (must be one of ".join(", ",@names).")\n";
}

my $latest_image;

sub string2pf($$) {
   my($s,$type,$name,$desc)=($_[0],@{$_[1]});
   if($type==PF_STRING
      || $type==PF_FONT
      || $type==PF_PATTERN
      || $type==PF_BRUSH
      || $type==PF_CUSTOM
      || $type==PF_FILE
      || $type==PF_TEXT
      || $type==PF_RADIO	# for now! #d#
      || $type==PF_GRADIENT) {
      $s;
   } elsif($type==PF_INT8
           || $type==PF_INT16
           || $type==PF_INT32
           || $type==PF_SLIDER
           || $type==PF_SPINNER
           || $type==PF_ADJUSTMENT) {
      die __"$s: not an integer\n" unless $s==int($s);
      $s*1;
   } elsif($type==PF_FLOAT) {
      $s*1;
   } elsif($type==PF_COLOUR) {
      $s=Gimp::canonicalize_colour($s);
   } elsif($type==PF_TOGGLE) {
      $s?1:0;
   #} elsif($type==PF_IMAGE) {
   } else {
      die __"conversion to type $pf_type2string{$type} is not yet implemented\n";
   }
}

# set options read from the command line
my $outputfile;

# mangle argument switches to contain only a-z0-9 and the underscore,
# for easier typing.
sub mangle_key {
   my $key = shift;
   $key=~y/A-Z /a-z_/;
   $key=~y/a-z0-9_//cd;
   $key;
}

Gimp::on_net {
   no strict 'refs';
   my $this = this_script;
   my(%map,@args);
   my($interact)=1;

   my($perl_sub,$function,$blurb,$help,$author,$copyright,$date,
      $menupath,$imagetypes,$params,$results,$features,$code,$type)=@$this;

   for(@$features) {
      return unless fu_feature_present($_, $function);
   }

   # %map is a hash that associates (mangled) parameter names to parameter index
   @map{map mangle_key($_->[1]), @{$params}} = (0..$#{$params});

   # Parse the command line
   while(defined($_=shift @ARGV)) {
      if (/^-+(.*)$/) {
	 if($1 eq "i" or $1 eq "interact") {
	   $interact=1e6;
	 } elsif($1 eq "o" or $1 eq "output") {
	   $outputfile=shift @ARGV;
	 } elsif($1 eq "info") {
	   print __"no additional information available, use --help\n";
	   exit 0;
	 } else {
           my $arg=shift @ARGV;
	   my $idx=$map{$1};
	   die __"$_: illegal switch, try $0 --help\n" unless defined($idx);
	   $args[$idx]=string2pf($arg,$params->[$idx]);
	   $interact--;
	 }
      } else {
         push(@args,string2pf($_,$params->[@args]));
	 $interact--;
      }
   }

   # Fill in default arguments
   foreach my $i (0..@$params-1) {
       next if defined $args[$i];
       my $entry = $params->[$i];
       $args[$i] = $entry->[3];             # Default value
       die __"parameter '$entry->[1]' is not optional\n" unless defined $args[$i] || $interact>0;
   }

   # Go for it
   $perl_sub->(($interact>0 ? &Gimp::RUN_FULLINTERACTIVE : &Gimp::RUN_NONINTERACTIVE),
               @args);
};

Gimp::on_query {
   expand_podsections;
   script:
   for(@scripts) {
      my($perl_sub,$function,$blurb,$help,$author,$copyright,$date,
         $menupath,$imagetypes,$params,$results,$features,$code,$type,
         $defargs)=@$_;

      for (@$results) {
         next if ref $_;
         if ($_ == &Gimp::PDB_IMAGE) {
            $_ = $image_retval;
         }
      }

      for(@$features) {
         next script unless fu_feature_present($_,$function);
      }

      # guess the datatype. yeah!
      sub datatype(@) {
         for(@_) {
            return Gimp::PDB_STRING unless /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/; # perlfaq4
            return Gimp::PDB_FLOAT  unless /^[+-]?\d+$/; # again
         }
         return Gimp::PDB_INT32;
      }
      sub odd_values(@) {
         my %x = @_; values %x;
      }

      for(@$params) {
         $_->[0]=Gimp::PDB_INT32	if $_->[0] == PF_TOGGLE;
         $_->[0]=Gimp::PDB_STRING	if $_->[0] == PF_FONT;
         $_->[0]=Gimp::PDB_STRING	if $_->[0] == PF_BRUSH;
         $_->[0]=Gimp::PDB_STRING	if $_->[0] == PF_PATTERN;
         $_->[0]=Gimp::PDB_STRING	if $_->[0] == PF_GRADIENT;
         $_->[0]=Gimp::PDB_STRING	if $_->[0] == PF_CUSTOM;
         $_->[0]=Gimp::PDB_STRING	if $_->[0] == PF_FILE;
         $_->[0]=Gimp::PDB_STRING	if $_->[0] == PF_TEXT;
         $_->[0]=datatype(odd_values(@{$_->[4]})) if $_->[0] == PF_RADIO;
         $_->[0]=datatype($_->[3],@{$_->[4]}) if $_->[0] == PF_SLIDER;
         $_->[0]=datatype($_->[3],@{$_->[4]}) if $_->[0] == PF_SPINNER;
         $_->[0]=datatype($_->[3],@{$_->[4]}) if $_->[0] == PF_ADJUSTMENT;
      }

      # Gtk not installed -> do not install menu entry
      if (@$params > $defargs) {
         require Gimp::Feature;
         undef $menupath unless Gimp::Feature::present('gtk');
      }
      
      Gimp->gimp_install_procedure($function,$blurb,$help,$author,$copyright,$date,
                                   $menupath,$imagetypes,$type,
                                   [[Gimp::PDB_INT32,"run_mode","Interactive, [non-interactive]"],
                                    @$params],
                                   $results);

      Gimp::logger(message => 'OK', function => $function, fatal => 0);
   }
};

sub register($$$$$$$$$;@) {
   no strict 'refs';
   my($function,$blurb,$help,$author,$copyright,$date,
      $menupath,$imagetypes,$params)=splice(@_,0,9);
   my($results,$features,$code,$type,$defargs);

   $results  = (ref $_[0] eq "ARRAY") ? shift : [];
   $features = (ref $_[0] eq "ARRAY") ? shift : [];
   $code = shift;

   for($menupath) {
      if (/^<Image>\//) {
         $type = &Gimp::PLUGIN;
         unshift @$params, @image_params;
         $defargs = @image_params;
      } elsif (/^<Load>\//) {
         $type = &Gimp::PLUGIN;
         unshift @$params, @load_params;
         unshift @$results, @load_retvals;
         $defargs = @load_params;
      } elsif (/^<Save>\//) {
         $type = &Gimp::PLUGIN;
         unshift @$params, @save_params;
         $defargs = @save_params;
      } elsif (/^<Toolbox>\//) {
         $type = &Gimp::EXTENSION;
         $defargs = 0;
      } elsif (/^<None>/) {
         $type = &Gimp::EXTENSION;
         $defargs = 0;
      } else {
         die __"menupath _must_ start with <Image>, <Toolbox>, <Load>, <Save> or <None>!";
      }
   }
   undef $menupath if $menupath eq "<None>";#d#

   @_==0 or die __"register called with too many or wrong arguments\n";

   for my $p (@$params,@$results) {
      next unless ref $p;
      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_|file_)/ || $function =~ s/^\+//;

   $function=~/^[0-9a-z_]+(-ALT)?$/ or carp __"$function: function name contains unusual characters, good style is to use only 0-9, a-z and _";

   Gimp::logger message => __"function name contains dashes instead of underscores",
                function => $function, fatal => 0
      if $function =~ y/-//;

   my $perl_sub = sub {
      $run_mode = shift;	# global!
      my(@pre,@defaults,@lastvals,$input_image);

      if (@defaults) {
         for (0..$#{$params}) {
	    $params->[$_]->[3]=$defaults[$_];
	 }
      }

      # supplement default arguments
      for (0..$#{$params}) {
         $_[$_]=$params->[$_]->[3] unless defined($_[$_]);
      }

      for($menupath) {
         if (/^<Image>\//) {
            @_ >= 2 or die __"<Image> plug-in called without both image and drawable arguments!\n";
            @pre = (shift,shift);
         } elsif (/^<Toolbox>\// or !defined $menupath) {
            # valid ;)
         } elsif (/^<Load>\//) {
            @_ >= 2 or die __"<Load> plug-in called without the 3 standard arguments!\n";
            @pre = (shift,shift);
         } elsif (/^<Save>\//) {
            @_ >= 4 or die __"<Save> plug-in called without the 5 standard arguments!\n";
            @pre = (shift,shift,shift,shift);
         } elsif (defined $_) {
            die __"menupath _must_ start with <Image>, <Toolbox>, <Load>, <Save> or <None>!";
         }
      }
      if ($run_mode == &Gimp::RUN_INTERACTIVE
          || $run_mode == &Gimp::RUN_WITH_LAST_VALS) {
         my $fudata = $Gimp::Data{"$function/_fu_data"};

         if ($run_mode == &Gimp::RUN_WITH_LAST_VALS && $fudata) {
            @_ = @$fudata;
         } else {
            if (@_) {
               # prevent the standard arguments from showing up in interact
               my @hide = splice @$params, 0, scalar@pre;

               my $res;
               local $^W=0; # perl -w is braindamaged
               # gimp is braindamaged, is doesn't deliver useful values!!
               ($res,@_)=interact($function,$blurb,$help,$params,@{$fudata});
               return unless $res;

               unshift @$params, @hide;
            }
         }
      } elsif ($run_mode == &Gimp::RUN_FULLINTERACTIVE) {
         if (@_) {
            my($res);
            ($res,@_)=interact($function,$blurb,$help,$params,@pre,@_);
            undef @pre;
            return unless $res;
         }
      } elsif ($run_mode == &Gimp::RUN_NONINTERACTIVE) {
         # nop
      } else {
         die __"run_mode must be INTERACTIVE, NONINTERACTIVE or RUN_WITH_LAST_VALS\n";
      }
      $input_image = $_[0]   if ref $_[0]   eq "Gimp::Image";
      $input_image = $pre[0] if ref $pre[0] eq "Gimp::Image";

      $Gimp::Data{"$function/_fu_data"}=[@_];

      print $function,"(",join(",",(@pre,@_)),")\n" if $Gimp::verbose;

      Gimp::set_trace ($old_trace);
      my @imgs = &$code(@pre,@_);
      $old_trace = Gimp::set_trace (0);

      if ($menupath !~ /^<Load>\//) {
         if (@imgs) {
            for my $i (0..$#imgs) {
               my $img = $imgs[$i];
               next unless defined $img;
               if (ref $img eq "Gimp::Image") {
                  if ($outputfile) {
                     my $path = sprintf $outputfile,$i;
                     if ($#imgs and $path eq $outputfile) {
                        $path=~s/\.(?=[^.]*$)/$i./; # insert image number before last dot
                     }
                     print "saving image $path\n" if $Gimp::verbose;
                     save_image($img,$path);
                     $img->delete;
                  } elsif ($run_mode != &Gimp::RUN_NONINTERACTIVE) {
                     $img->display_new unless $input_image && $$img == $$input_image;
                  }
               } elsif (!@$results) {
                  warn __"WARNING: $function returned something that is not an image: \"$img\"\n";
               }
            }
         }
         Gimp->displays_flush;
      }

      Gimp::set_trace ($old_trace);
      wantarray ? @imgs : $imgs[0];
   };

   Gimp::register_callback($function,$perl_sub);
   push(@scripts,[$perl_sub,$function,$blurb,$help,$author,$copyright,$date,
                  $menupath,$imagetypes,$params,$results,$features,$code,$type,
                  $defargs]);
}

sub save_image($$) {
   my($img,$path)=@_;
   my($interlace,$flatten,$quality,$type,$smooth,$compress,$loop,$dispose);

   $interlace=0;
   $quality=0.75;
   $smooth=0;
   $compress=7;
   $loop=0;
   $delay=0;
   $dispose=0;
   $noextra=0;

   $_=$path=~s/^([^:]+):// ? $1 : "";
   $type=uc($1) if $path=~/\.([^.]+)$/;
   $type=uc($1) if s/^(GIF|JPG|JPEG|PNM|PNG)//i;
   while($_ ne "") {
      $interlace=$1 eq "+", 	next if s/^([-+])[iI]//;
      $flatten=$1 eq "+", 	next if s/^([-+])[fF]//;
      $noextra=$1 eq "+",	next if s/^([-+])[eE]//;
      $smooth=$1 eq "+", 	next if s/^([-+])[sS]//;
      $quality=$1*0.01,		next if s/^-[qQ](\d+)//;
      $compress=$1,		next if s/^-[cC](\d+)//;
      $loop=$1 eq "+",		next if s/^([-+])[lL]//;
      $delay=$1,		next if s/^-[dD](\d+)//;
      $dispose=$1,		next if s/^-[pP](\d+)//;
      croak __"$_: unknown/illegal file-save option";
   }
   $flatten=(()=$img->get_layers)>1 unless defined $flatten;

   $img->flatten if $flatten;

   # always save the active layer
   my $layer = $img->get_active_layer;

   if ($type eq "JPG" or $type eq "JPEG") {
      eval { $layer->file_jpeg_save($path,$path,$quality,$smooth,1) };
      $layer->file_jpeg_save($path,$path,$quality,$smooth,1,$interlace,"",0,1,0,0) if $@;
   } elsif ($type eq "GIF") {
      unless ($layer->is_indexed) {
         eval { $img->convert_indexed(1,256) };
         $img->convert_indexed(2,&Gimp::MAKE_PALETTE,256,1,1,"") if $@;
      }
      $layer->file_gif_save($path,$path,$interlace,$loop,$delay,$dispose);
   } elsif ($type eq "PNG") {
      $layer->file_png_save($path,$path,$interlace,$compress,(!$noextra) x 5);
   } elsif ($type eq "PNM") {
      $layer->file_pnm_save($path,$path,1);
   } else {
      $layer->gimp_file_save($path,$path);
   }
}

# provide some clues ;)
sub print_switches {
   my($this)=@_;
   for(@{$this->[9]}) {
      my $type=$pf_type2string{$_->[0]};
      my $key=mangle_key($_->[1]);
      printf "           -%-25s %s%s\n","$key $type",$_->[2],defined $_->[3] ? " [$_->[3]]" : "";
   }
}

sub main {
   $old_trace = Gimp::set_trace (0);
   if ($Gimp::help) {
      my $this=this_script;
      print __"       interface-arguments are
                      -o | --output <filespec>   write image to disk, don't display
                      -i | --interact            let the user edit the values first
              script-arguments are
";
      print_switches ($this);
   } else {
      Gimp::main;
   }
}

1;
__END__