927 lines
29 KiB
Perl
927 lines
29 KiB
Perl
package Gimp::Fu;
|
|
|
|
use Gimp ('croak', '__');
|
|
use Gimp::Data;
|
|
use File::Basename;
|
|
|
|
require Exporter;
|
|
|
|
=head1 NAME
|
|
|
|
Gimp::Fu - "easy to use" framework for Gimp scripts
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Gimp;
|
|
use Gimp::Fu;
|
|
|
|
(this module uses Gtk, so make sure it's correctly installed)
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Currently, there are only three functions in this module. This
|
|
fully suffices to provide a professional interface and the
|
|
ability to run this script from within the Gimp and standalone
|
|
from the commandline.
|
|
|
|
Dov Grobgeld has written an excellent tutorial for Gimp-Perl. While not
|
|
finished, it's definitely worth a look! You can find it at
|
|
C<http://imagic.weizmann.ac.il/~dov/gimp/perl-tut.html>.
|
|
|
|
=head1 INTRODUCTION
|
|
|
|
In general, a Gimp::Fu script looks like this:
|
|
|
|
#!/path/to/your/perl
|
|
|
|
use Gimp;
|
|
use Gimp::Fu;
|
|
|
|
register <many arguments>, sub {
|
|
your code;
|
|
}
|
|
|
|
exit main;
|
|
|
|
(This distribution comes with example scripts. One is
|
|
C<examples/example-fu.pl>, which is small Gimp::Fu-script you can take as
|
|
starting point for your experiments)
|
|
|
|
=cut
|
|
|
|
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 => 'image',
|
|
&PF_LAYER => 'layer',
|
|
&PF_CHANNEL => 'channel',
|
|
&PF_DRAWABLE => 'drawable',
|
|
);
|
|
|
|
@_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(DESCRIPTION)";
|
|
$_->[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 from string 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--;
|
|
}
|
|
} elsif (@args < @$params) {
|
|
push(@args,string2pf($_,$params->[@args]));
|
|
$interact--;
|
|
} else {
|
|
die __"too many arguments, use --help\n";
|
|
}
|
|
}
|
|
|
|
# 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);
|
|
}
|
|
};
|
|
|
|
=cut
|
|
|
|
=head2 THE REGISTER FUNCTION
|
|
|
|
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 };
|
|
|
|
=over 2
|
|
|
|
=item function name
|
|
|
|
The pdb name of the function, i.e. the name under which is will be
|
|
registered in the Gimp database. If it doesn't start with "perl_fu_",
|
|
"file_", "plug_in_" or "extension_", it will be prepended. If you
|
|
don't want this, prefix your function name with a single "+". The idea
|
|
here is that every Gimp::Fu plug-in will be found under the common
|
|
C<perl_fu_>-prefix.
|
|
|
|
=item blurb
|
|
|
|
A small description of this script/plug-in. Defaults to "=pod(NAME)" (see
|
|
the section on EMBEDDED POD DOCUMENTATION for an explanation of this
|
|
string).
|
|
|
|
=item help
|
|
|
|
A help text describing this script. Should be longer and more verbose than
|
|
C<blurb>. Default is "=pod(HELP)".
|
|
|
|
=item author
|
|
|
|
The name (and also the e-mail address if possible!) of the
|
|
script-author. Default is "=pod(AUTHOR)".
|
|
|
|
=item copyright
|
|
|
|
The copyright designation for this script. Important! Safe your intellectual
|
|
rights! The default is "=pod(AUTHOR)".
|
|
|
|
=item date
|
|
|
|
The "last modified" time of this script. There is no strict syntax here, but
|
|
I recommend ISO format (yyyymmdd or yyyy-mm-dd). Default value is "=pod(DATE)".
|
|
|
|
=item menu path
|
|
|
|
The menu entry Gimp should create. It should start either with <Image>, if
|
|
you want an entry in the image menu (the one that opens when clicking into
|
|
an image), <Toolbox>/Xtns, for the Xtns menu or <None> for none.
|
|
|
|
=item image types
|
|
|
|
The types of images your script will accept. Examples are "RGB", "RGB*",
|
|
"GRAY, RGB" etc... Most scripts will want to use "*", meaning "any type".
|
|
|
|
=item the parameter array
|
|
|
|
An array ref containing parameter definitions. These are similar to the
|
|
parameter definitions used for C<gimp_install_procedure>, but include an
|
|
additional B<default> value used when the caller doesn't supply one, and
|
|
optional extra arguments describing some types like C<PF_SLIDER>.
|
|
|
|
Each array element has the form C<[type, name, description, default_value, extra_args]>.
|
|
|
|
<Image>-type plugins get two additional parameters, image (C<PF_IMAGE>) and
|
|
drawable (C<PF_DRAWABLE>). Do not specify these yourself. Also, the
|
|
C<run_mode> argument is never given to the script, but its value can be
|
|
accessed in the package-global C<$run_mode>. The B<name> is used in the
|
|
dialog box as a hint, the B<description> will be used as a tooltip.
|
|
|
|
See the section PARAMETER TYPES for the supported types.
|
|
|
|
=item the return values
|
|
|
|
This is just like the parameter array, just that it describes the return
|
|
values. Of course, default values and the enhanced Gimp::Fu parameter
|
|
types don't make much sense here. (Even if they did, it's not implemented
|
|
anyway..). This argument is optional.
|
|
|
|
If you supply a parameter type (e.g. C<PF_IMAGE>) instead of a full
|
|
specification (C<[PF_IMAGE, ...]>), Gimp::Fu might supply some default
|
|
values. This is only implemented for C<PF_IMAGE> at the moment.
|
|
|
|
=item the features requirements
|
|
|
|
See L<Gimp::Features> for a description of which features can be checked
|
|
for. This argument is optional (but remember to specify an empty return
|
|
value array, C<[]>, if you want to specify it).
|
|
|
|
=item the code
|
|
|
|
This is either a anonymous sub declaration (C<sub { your code here; }>, or a
|
|
coderef, which is called when the script is run. Arguments (including the
|
|
image and drawable for <Image> plug-ins) are supplied automatically.
|
|
|
|
It is good practise to return an image, if the script creates one, or
|
|
C<undef>, since the return value is interpreted by Gimp::Fu (like displaying
|
|
the image or writing it to disk). If your script creates multiple pictures,
|
|
return an array.
|
|
|
|
=back
|
|
|
|
=head2 PARAMETER TYPES
|
|
|
|
=over 2
|
|
|
|
=item PF_INT8, PF_INT16, PF_INT32, PF_INT, PF_FLOAT, PF_STRING, PF_VALUE
|
|
|
|
Are all mapped to a string entry, since perl doesn't really distinguish
|
|
between all these datatypes. The reason they exist is to help other scripts
|
|
(possibly written in other languages! really!). It's nice to be able to
|
|
specify a float as 13.45 instead of "13.45" in C! C<PF_VALUE> is synonymous
|
|
to C<PF_STRING>, and <PF_INT> is synonymous to <PF_INT32>.
|
|
|
|
=item PF_COLOR, PF_COLOUR
|
|
|
|
Will accept a colour argument. In dialogs, a colour preview will be created
|
|
which will open a colour selection box when clicked.
|
|
|
|
=item PF_IMAGE
|
|
|
|
A gimp image.
|
|
|
|
=item PF_DRAWABLE
|
|
|
|
A gimp drawable (image, channel or layer).
|
|
|
|
=item PF_TOGGLE, PF_BOOL
|
|
|
|
A boolean value (anything perl would accept as true or false). The description
|
|
will be used for the toggle-button label!
|
|
|
|
=item PF_SLIDER
|
|
|
|
Uses a horizontal scale. To set the range and stepsize, append an array ref
|
|
(see Gtk::Adjustment for an explanation) C<[range_min, range_max, step_size,
|
|
page_increment, page_size]> as "extra argument" to the description array.
|
|
Default values will be substitued for missing entries, like in:
|
|
|
|
[PF_SLIDER, "alpha value", "the alpha value", 100, [0, 255, 1] ]
|
|
|
|
=item PF_SPINNER
|
|
|
|
The same as PF_SLIDER, except that this one uses a spinbutton instead of a scale.
|
|
|
|
=item PF_RADIO
|
|
|
|
In addition to a default value, an extra argument describing the various
|
|
options I<must> be provided. That extra argument must be a reference
|
|
to an array filled with C<Option-Name => Option-Value> pairs. Gimp::Fu
|
|
will then generate a horizontal frame with radio buttons, one for each
|
|
alternative. For example:
|
|
|
|
[PF_RADIO, "direction", "the direction to move to", 5, [Left => 5, Right => 7]]]
|
|
|
|
draws two buttons, when the first (the default, "Left") is activated, 5
|
|
will be returned. If the second is activated, 7 is returned.
|
|
|
|
=item PF_FONT
|
|
|
|
Lets the user select a font and returns a X Logical Font Descriptor (XLFD).
|
|
The default argument, if specified, must be a full XLFD specification, or a
|
|
warning will be printed. Please note that the gimp text functions using
|
|
these fontnames (gimp_text_..._fontname) ignore the size. You can extract
|
|
the size and dimension by using the C<xlfd_size> function.
|
|
|
|
In older Gimp-Versions a user-supplied string is returned.
|
|
|
|
=item PF_BRUSH, PF_PATTERN, PF_GRADIENT
|
|
|
|
Lets the user select a brush/pattern/gradient whose name is returned as a
|
|
string. The default brush/pattern/gradient-name can be preset.
|
|
|
|
=item PF_CUSTOM
|
|
|
|
PF_CUSTOM is for those of you requiring some non-standard-widget. You have
|
|
to supply a code reference returning three values as the extra argument:
|
|
|
|
(widget, settor, gettor)
|
|
|
|
C<widget> is Gtk widget that should be used.
|
|
|
|
C<settor> is a function that takes a single argument, the new value for
|
|
the widget (the widget should be updated accordingly).
|
|
|
|
C<gettor> is a function that should return the current value of the widget.
|
|
|
|
While the values can be of any type (as long as it fits into a scalar),
|
|
you should be prepared to get a string when the script is started from the
|
|
commandline or via the PDB.
|
|
|
|
=item PF_FILE
|
|
|
|
This represents a file system object. It usually is a file, but can be
|
|
anything (directory, link). It might not even exist at all.
|
|
|
|
=item PF_TEXT
|
|
|
|
Similar to PF_STRING, but the entry widget is much larger and has Load and
|
|
Save buttons.
|
|
|
|
=back
|
|
|
|
=head2 EMBEDDED POD DOCUMENTATION
|
|
|
|
The register functions expects strings (actually scalars) for
|
|
documentation, and nobody wants to embed long parts of documentation into
|
|
a string, cluttering the whole script.
|
|
|
|
Therefore, Gimp::Fu utilizes the Gimp::Pod module to display the full text
|
|
of the pod sections that are embedded in your scripts (see L<perlpod> for
|
|
an explanation of the POD documentation format) when the user hits the
|
|
"Help" button in the dialog box.
|
|
|
|
Since version 1.094, you can embed specific sections or the full pod
|
|
text into any of the blurb, help, author, copyright and date arguments
|
|
to the register functions. Gimp::Fu will look into all these strings
|
|
for sequences of the form "=pod(section-name)". If found, they will
|
|
be replaced by the text of the corresponding section from the pod
|
|
documentation. If the named section is not found (or is empty, as in
|
|
"=pod()"), the full pod documentation is embedded.
|
|
|
|
Most of the mentioned arguments have default values (see THE REGISTER
|
|
FUNCTION) that are used when the arguments are either undefined or empty
|
|
strings, making the register call itself much shorter and, IMHO, more
|
|
readable.
|
|
|
|
=cut
|
|
|
|
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]);
|
|
}
|
|
|
|
=cut
|
|
|
|
=head2 MISC. FUNCTIONS
|
|
|
|
=over
|
|
|
|
=item C<save_image(img,options_and_path)>
|
|
|
|
This is the internal function used to save images. As it does more than just
|
|
gimp_file_save, I thought it would be handy in other circumstances as well.
|
|
|
|
The C<img> is the image you want to save (which might get changed during
|
|
the operation!), C<options_and_path> denotes the filename and optinal
|
|
options. If there are no options, C<save_image> tries to deduce the filetype
|
|
from the extension. The syntax for options is
|
|
|
|
[IMAGETYPE[OPTIONS...]:]filespec
|
|
|
|
IMAGETYPE is one of GIF, JPG, JPEG, PNM or PNG, options include
|
|
|
|
options valid for all images
|
|
+F flatten the image (default depends on the image)
|
|
-F do not flatten the image
|
|
|
|
options for GIF and PNG images
|
|
+I do save as interlaced
|
|
-I do not save as interlaced (default)
|
|
|
|
options for GIF animations (use with -F)
|
|
+L save as looping animation
|
|
-L save as non-looping animation (default)
|
|
-Dn default frame delay (default is 0)
|
|
-Pn frame disposal method: 0=don't care, 1 = combine, 2 = replace
|
|
|
|
options for PNG images
|
|
-Cn use compression level n
|
|
-E Do not skip ancillary chunks (default)
|
|
+E Skip ancillary chunks
|
|
|
|
options for JPEG images
|
|
-Qn use quality "n" to save file (JPEG only)
|
|
-S do not smooth (default)
|
|
+S smooth before saving
|
|
|
|
some examples:
|
|
|
|
test.jpg save the image as a simple jpeg
|
|
JPG:test.jpg the same
|
|
JPG-Q70:test.jpg the same but force a quality of 70
|
|
GIF-I-F:test.jpg save a gif image(!) named test.jpg
|
|
non-interlaced and without flattening
|
|
|
|
=back
|
|
|
|
=cut
|
|
|
|
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__
|
|
|
|
=head1 AUTHOR
|
|
|
|
Marc Lehmann <pcg@goof.com>
|
|
|
|
=head1 SEE ALSO
|
|
|
|
perl(1), L<Gimp>.
|
|
|
|
=cut
|