package Gimp;

use strict;
use warnings;
our (
  $VERSION, @ISA, $AUTOLOAD, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, @EXPORT_FAIL,
  $interface_pkg, $interface_type, @PREFIXES,
  $function, $basename, $spawn_opts, $host,
);
use subs qw(init end lock unlock);

BEGIN {
   $VERSION = '2.33'; # going forward: 2.xx, or 2.xx_yy for dev
   eval {
      require XSLoader;
      XSLoader::load Gimp $VERSION;
   } or do {
      require DynaLoader;
      @ISA = qw(DynaLoader);
      bootstrap Gimp $VERSION;
   };
}

use Gimp::ColorDB;
use Carp qw(croak);

our @GUI_FUNCTIONS = qw(
   gimp_progress_init
   gimp_progress_update
   gimp_display_new
   gimp_display_delete
);

my @_procs = ('__', 'N_');
#my @_default = (@_procs, ':consts' ,':_auto2');
my @_default = (@_procs, ':consts');
my @POLLUTE_CLASSES;

sub import($;@) {
   no strict 'refs';
   my $pkg = shift;
   warn "$$-$pkg->import(@_)" if $Gimp::verbose >= 2;
   my $up = caller;
   my @export;

   # make sure we can call GIMP functions - start net conn if required
   my $net_init;
   map { $net_init = $1 if /net_init=(\S+)/; } @_;
   if ($interface_type eq "net" and not &Gimp::Net::initialized) {
      map { *{"Gimp::$_"} = \&{"Gimp::Constant::$_"} }
	 qw(RUN_INTERACTIVE RUN_NONINTERACTIVE);
      Gimp::Net::gimp_init(grep {defined} $net_init);
   }
   # do this here as not guaranteed access to GIMP before
   require Gimp::Constant;
   if (not defined &{$Gimp::Constant::EXPORT[-1]}) {
     warn "$$-Loading constants" if $Gimp::verbose >= 2;
     # now get constants from GIMP
     import Gimp::Constant;
   }

   @_=@_default unless @_;

   for(map { $_ eq ":DEFAULT" ? @_default : $_ } @_) {
      if ($_ eq ":auto") {
         push @export,@Gimp::Constant::EXPORT,@_procs;
         *{"$up\::AUTOLOAD"} = sub {
            croak "Cannot call '$AUTOLOAD' at this time" unless initialized();
            my ($class,$name) = $AUTOLOAD =~ /^(.*)::(.*?)$/;
            *{$AUTOLOAD} = sub { unshift @_, 'Gimp'; $AUTOLOAD = "Gimp::$name"; goto &AUTOLOAD };
            #*{$AUTOLOAD} = sub { Gimp->$name(@_) }; # old version
            goto &$AUTOLOAD;
         };
      } elsif ($_ eq ":pollute") {
	for my $class (@POLLUTE_CLASSES) {
	  push @{"$class\::ISA"}, "Gimp::$class";
	  push @{"$class\::PREFIXES"}, @{"Gimp::$class\::PREFIXES"};
	}
      } elsif ($_ eq ":consts") {
         push @export,@Gimp::Constant::EXPORT;
      } elsif ($_ eq ":param") {
         push @export,@Gimp::Constant::PARAMS;
      } elsif (/^interface=(\S+)$/) {
         croak __"interface=... tag is no longer supported\n";
      } elsif (/spawn_options=(\S+)/) {
         $spawn_opts = $1;
      } elsif (/net_init=(\S+)/) {
	 # already used above, no-op
      } elsif ($_ ne "") {
         push(@export,$_);
      } elsif ($_ eq "") {
         #nop #d#FIXME, Perl-Server requires this!
      } else {
         croak __"$_ is not a valid import tag for package $pkg";
      }
   }

   for(@export) {
      *{"$up\::$_"} = \&$_;
   }
}

# the monadic identity function
sub N_($) { shift }

my $gtk_init = 1;

sub gtk_init() {
   if ($gtk_init) {
      require Gtk2;
      Gtk2->init;
      Gtk2::Rc->parse (Gimp->gtkrc);
      $gtk_init = 0;
   }
}

# section on command-line handling/interface selection

($basename = $0) =~ s/^.*[\\\/]//;
$spawn_opts = "";
($function)=$0=~/([^\/\\]+)$/;

$Gimp::verbose=0 unless defined $Gimp::verbose;
# $Gimp::verbose=1;

$interface_type = "net";
if (@ARGV) {
   if ($ARGV[0] eq "-gimp") {
      $interface_type = "lib";
      # ignore other parameters completely
   } else {
      while(@ARGV) {
         $_=shift(@ARGV);
         if (/^-h$|^--?help$|^-\?$/) {
            $Gimp::help=1;
            print __<<EOF;
Usage: $basename [gimp-args...] [interface-args...] [script-args...]
       gimp-arguments are
           -h | -help | --help | -?   print some help
           -v | --verbose             verbose flag (ok more than once)
           --host|--tcp HOST[:PORT]   connect to HOST (optionally using PORT)
                                      (for more info, see Gimp::Net(3))
EOF
         } elsif (/^-v$|^--verbose$/) {
            $Gimp::verbose++;
         } elsif (/^--host$|^--tcp$/) {
            $host=shift(@ARGV);
         } else {
            unshift(@ARGV,$_);
            last;
         }
      }
   }
}

# section on error-handling

# section on callbacks

my %callback;

sub cbchain {
  map { @{$callback{$_} || []}; } @_;
}

sub callback {
  warn "$$-Gimp::callback(@_)" if $Gimp::verbose >= 2;
  my $type = shift;
  my @cb;
  if ($type eq "-run") {
    local $function = shift;
    @cb = cbchain(qw(run lib), $function);
    die __"required callback 'run' not found for $function\n" unless @cb;
    # returning list of last func's return values
    my @retvals;
    for (@cb) {
      @retvals = &$_;
    }
    warn "$$-Gimp::callback returning(@retvals)" if $Gimp::verbose >= 2;
    @retvals;
  } elsif ($type eq "-net") {
    @cb = cbchain(qw(run net));
    die __"required callback 'net' not found for $function\n" unless @cb;
    # returning list of last func's return values
    my @retvals;
    for (@cb) {
      @retvals = &$_;
    }
    warn "$$-Gimp::callback returning(@retvals)" if $Gimp::verbose >= 2;
    @retvals;
  } elsif ($type eq "-query") {
    @cb = cbchain(qw(query));
    die __"required callback 'query' not found for $function\n" unless @cb;
    for (@cb) { &$_ }
  } elsif ($type eq "-quit") {
    @cb = cbchain(qw(quit));
    for (@cb) { &$_ }
  } elsif ($type eq "-proc") {
    @cb = cbchain(qw(proc));
    for (@cb) { &$_ }
  }
}

sub register_callback($$) {
   push @{$callback{$_[0]}}, $_[1];
   warn "$$-register_callback(@_)" if $Gimp::verbose >= 2;
}

sub on_query(&) { register_callback "query", $_[0] }
sub on_net  (&) { register_callback "net"  , $_[0] }
sub on_lib  (&) { register_callback "lib"  , $_[0] }
sub on_run  (&) { register_callback "run"  , $_[0] }
sub on_quit  (&) { register_callback "quit"  , $_[0] }
sub on_proc  (&) { register_callback "proc"  , $_[0] }

sub main {
   no strict 'refs';
   &{"$interface_pkg\::gimp_main"};
}

# section on interface_pkg

if ($interface_type=~/^lib$/i) {
   $interface_pkg="Gimp::Lib";
} elsif ($interface_type=~/^net$/i) {
   $interface_pkg="Gimp::Net";
} else {
   croak __"interface '$interface_type' unsupported.";
}
warn "$$-Using interface '$interface_type'" if $Gimp::verbose >= 2;

eval "require $interface_pkg" or croak $@;
$interface_pkg->import;
warn "$$-Finished loading '$interface_pkg'" if $Gimp::verbose >= 2;

# create some common aliases
for(qw(gimp_procedural_db_proc_exists gimp_call_procedure initialized)) {
   no strict 'refs';
   *$_ = \&{"$interface_pkg\::$_"};
}

*end   = \&{"$interface_pkg\::gimp_end"};
*lock  = \&{"$interface_pkg\::lock"};
*unlock= \&{"$interface_pkg\::unlock"};

# section on AUTOLOAD

my %ignore_function = (DESTROY => 1);

@PREFIXES=("gimp_", "");

sub ignore_functions(@) {
   warn "$$-IGNORING(@_)" if $Gimp::verbose >= 2;
   @ignore_function{@_}++;
}

my %proc2deprecated = (
  # needed to get the Perl-Server up and running
  gimp_procedural_db_query => 0,
  gimp_procedural_db_proc_exists => 0,
  gimp_enums_get_type_names => 0,
  gimp_enums_list_type => 0,
  gimp_install_procedure => 0,
);
my $deprecations_loaded = 0;
sub deprecated {
  warn "$$-deprecated(@_)" if $Gimp::verbose >= 2;
  my $proc = shift;
  unless ($deprecations_loaded or defined $proc2deprecated{$proc}) {
    $deprecations_loaded = 1;
    map { s#-#_#g; $proc2deprecated{$_}++ }
      Gimp->procedural_db_query('.*', '.*deprecated.*', ('.*') x 5);
  }
  $proc2deprecated{$proc} = !!$proc2deprecated{$proc};
}

sub recroak { $_[0] =~ /\n$/ ? die shift : croak shift; }
sub exception_strip {
  my ($file, $e) = @_;
  $file =~ s#\..*##;
  $e =~ s# at $file\S+ line \d+\.\n\Z##;
  $e;
}
sub AUTOLOAD {
  my $autoload_copy = $AUTOLOAD; # needed as if autoload inside, not restored
  warn "$$-AUTOLOAD $autoload_copy(@_)" if $Gimp::verbose >= 2;
  no strict 'refs';
  goto &$autoload_copy if defined &$autoload_copy; # happens if :auto, not if method call
  my ($class,$name) = $autoload_copy =~ /^(.*)::(.*?)$/;
  for(@{"$class\::PREFIXES"}) {
    my $sub = $_.$name;
    if (exists $ignore_function{$sub}) {
      *{$autoload_copy} = sub { () };
      goto &$autoload_copy;
    } elsif (UNIVERSAL::can('Gimp::Util',$sub)) {
      my $ref = \&{"Gimp::Util::$sub"};
      *{$autoload_copy} = sub {
	shift unless ref $_[0];
	my @r = eval { &$ref };
	recroak exception_strip(__FILE__, $@) if $@; wantarray ? @r : $r[0];
      };
      goto &$autoload_copy;
    } elsif (UNIVERSAL::can($interface_pkg,$sub)) {
      my $ref = \&{"$interface_pkg\::$sub"};
      *{$autoload_copy} = sub {
	shift unless ref $_[0];
	my @r = eval { &$ref };
	recroak exception_strip(__FILE__, $@) if $@; wantarray ? @r : $r[0];
      };
      goto &$autoload_copy;
    } elsif (not deprecated($sub) and gimp_procedural_db_proc_exists($sub)) {
      *{$autoload_copy} = sub {
	warn "$$-gimp_call_procedure{0}(@_)" if $Gimp::verbose >= 2;
	shift unless ref $_[0];
	unshift @_, $sub;
	warn "$$-gimp_call_procedure{1}(@_)" if $Gimp::verbose >= 2;
	my @r = eval { gimp_call_procedure (@_) };
	recroak exception_strip(__FILE__, $@) if $@; wantarray ? @r : $r[0];
      };
      goto &$autoload_copy;
    }
  }
  croak __"function/macro \"$name\" not found in $class";
}

# section on classes

sub _pseudoclass {
  my ($class, @prefixes)= @_;
  unshift @prefixes,"";
  no strict 'refs';
  *{"Gimp::$class\::AUTOLOAD"} = \&AUTOLOAD;
  push @{"Gimp::$class\::PREFIXES"}, @prefixes;
  push @{"Gimp::$class\::ISA"}, 'Gimp::Base';
  push @POLLUTE_CLASSES, $class;
  @{"Gimp::$class\::PREFIXES"}; # to suppress only-once warning
}

my @plugin_prefixes = qw(plug_in_ perl_fu_ script_fu_);
my @image_prefixes = (qw(gimp_image_ gimp_), @plugin_prefixes);
my @item_prefixes = (qw(gimp_item_), @image_prefixes);
my @drawable_prefixes = (qw(gimp_drawable_), @item_prefixes);

_pseudoclass qw(Item		), @item_prefixes;
_pseudoclass qw(Layer		gimp_layer_ gimp_floating_sel_), @drawable_prefixes;
_pseudoclass qw(Image		), @image_prefixes;
_pseudoclass qw(Drawable	), @drawable_prefixes;
_pseudoclass qw(Selection	gimp_selection_);
_pseudoclass qw(Vectors		gimp_vectors_);
_pseudoclass qw(Channel		gimp_channel_), @drawable_prefixes;
_pseudoclass qw(Display		gimp_display_ gimp_);
_pseudoclass qw(Plugin		), @plugin_prefixes;
_pseudoclass qw(Gradient	gimp_gradient_);
_pseudoclass qw(Gradients	gimp_gradients_);
_pseudoclass qw(Edit		gimp_edit_);
_pseudoclass qw(Progress	gimp_progress_);
_pseudoclass qw(Parasite	);

push @Gimp::Drawable::ISA, qw(Gimp::Item);
push @Gimp::Vectors::ISA, qw(Gimp::Item);
push @Gimp::Channel::ISA, qw(Gimp::Drawable);
push @Gimp::Layer::ISA, qw(Gimp::Drawable);

# "C"-Classes
_pseudoclass qw(GimpDrawable	gimp_gdrawable_);
_pseudoclass qw(PixelRgn	gimp_pixel_rgn_);
_pseudoclass qw(Tile		gimp_tile_);

# Classes without GIMP-Object
_pseudoclass qw(Palette		gimp_palette_);
_pseudoclass qw(Context         gimp_context_);
_pseudoclass qw(Brushes		gimp_brush_ gimp_brushes_);
_pseudoclass qw(Brush		gimp_brush_);
_pseudoclass qw(Edit		gimp_edit_);
_pseudoclass qw(Patterns	gimp_patterns_);
_pseudoclass qw(Pattern	        gimp_pattern_);

{
package Gimp::PixelRgn;
use vars qw(@CARP_NOT); # package scope
@CARP_NOT = qw(Gimp);

sub new($$$$$$$$) {
   shift;
   my $self = eval { Gimp::PixelRgn->init(@_); };
   die "Args=(@_): ".$@ if $@;
   $self;
}
}

{
package Gimp::Parasite;
sub is_type($$)		{ $_[0]->[0] eq $_[1] }
sub is_persistent($)	{ $_[0]->[1] & &Gimp::PARASITE_PERSISTENT }
sub is_error($)		{ !defined $_[0]->[0] }
sub has_flag($$)	{ $_[0]->[1] & $_[1] }
sub copy($)		{ [@{$_[0]}] }
sub name($)		{ $_[0]->[0] }
sub flags($)		{ $_[0]->[1] }
sub data($)		{ $_[0]->[2] }
sub compare($$)		{ $_[0]->[0] eq $_[1]->[0] and
			  $_[0]->[1] eq $_[1]->[1] and
			  $_[0]->[2] eq $_[1]->[2] }
sub new($$$$)		{ shift; [@_] }
use overload '""' => sub { ref($_[0])."->new([@{[ join ', ', @{$_[0]} ]}])"; };
sub id			{ goto &name; }
}

{
package Gimp::Base;
use overload '""' => sub { ref($_[0]).'->existing('.${$_[0]}.')'; };
sub existing($$) {
  my $id = $_[1];
  my $self = bless \$id, $_[0];
  Gimp::croak "$id not valid $_[0]" unless $self->is_valid;
  $self;
}
sub become($$) {
  warn "$$-".__PACKAGE__."::become(@_)" if $Gimp::verbose >= 2;
  my ($self, $class) = @_;
  my $old_class = ref $self;
  bless $self, $class;
  unless ($self->is_valid) {
    warn "$$-$self->is_valid false" if $Gimp::verbose >= 2;
    bless $self, $old_class;
    Gimp::croak "$_[0] not valid $class"
  }
  $self;
}
sub id { ${+shift} }
}

sub Gimp::Channel::is_valid { shift->is_channel }
sub Gimp::Drawable::is_valid { shift->is_drawable }
sub Gimp::Layer::is_valid { shift->is_layer }
sub Gimp::Selection::is_valid { shift->is_selection }
sub Gimp::Vectors::is_valid { shift->is_vectors }

1;
__END__
=head1 NAME

Gimp - Write GIMP extensions/plug-ins/load- and save-handlers in Perl

=head1 SYNOPSIS

  use Gimp;
  use Gimp::Fu;		# easy scripting environment

  podregister {
    # your code
    my $image = new Gimp::Image (600, 300, RGB);
    my $bg = $image->layer_new(
      600,300,RGB_IMAGE,"Background",100,NORMAL_MODE
    );
    $image->insert_layer($bg, 1, 0);
    $image->edit_fill($bg, FOREGROUND_FILL);
    eval { Gimp::Display->new($image); };
    $image;
  };

  exit main;
  __END__
  =head1 NAME

  example_function - Short description of the function

  =head1 SYNOPSIS

  <Image>/File/Create/Patterns/Example...

  =head1 DESCRIPTION

  Longer description of the function...

=head1 DESCRIPTION

Gimp-Perl is a module for writing plug-ins, extensions, standalone
scripts, and file-handlers for the GNU Image Manipulation Program (GIMP).
It can be used to automate repetitive tasks, achieve a precision hard
to get through manual use of GIMP, interface to a web server, or other
tasks that involve GIMP.

It is developed on Linux, and should work with similar OSes.
This is a release of Gimp-Perl for gimp-2.8. It is not compatible with
version 2.6 or below of GIMP.

To jump straight into how to write GIMP plugins, see L<Gimp::Fu>:
it is recommended for scripts not requiring custom interfaces
or specialized execution. If you B<do> need a custom interface, see
C<examples/example-no-fu> - although L<Gimp::Fu> does also offer custom
widgets, see the same script using Gimp::Fu in C<examples/fade-alpha>.
Lots of other examples are in the C<examples/> directory of your gimp-perl
source tree, some of which will be installed in your plug-ins directory
if you are running from a package.

Using the C<Help/Procedure Browser> is a good way to learn GIMP's
Procedural Database (PDB). For referencing functions you already know of,
the included script L<gimpdoc> is useful. B<Be warned Gimp-Perl does
not allow use of deprecated GIMP procedures>. You'll thank me in time.

Some highlights:

=over 4

=item *

Access to GIMP's Procedural Database (PDB) for manipulation of
most objects.

=item *

Program with either a fully object-oriented syntax, or a (deprecated)
plain PDB (scheme-like) interface.

=item *

Scripts that use Gimp::Fu can be accessed seamlessly either from
GIMP's menus, other scripting interfaces like Script-Fu, or from the
command line (execute the plugin with the C<--help> flag for more
information).

In the latter case, Gimp::Fu can either connect to a GIMP already running,
or start up its own.

=item *

Access the pixel-data functions using L<PDL> (see L<Gimp::PixelRgn>)
giving the same level of control as a C plug-in, with a data language
wrapper.

=item *

Over 50 example scripts to give you a good starting point, or use out
of the box.

=back

=head1 IMPORT TAGS

Place these in your C<use Gimp qw(...)> command to have added features
available to your plug-in.

=head2 :consts

All constants found by querying GIMP (BG_IMAGE_FILL, RUN_NONINTERACTIVE,
NORMAL_MODE, PDB_INT32 etc.).

=head2 :param

Import constants for plugin parameter types (PDB_INT32, PDB_STRING
etc.) only.

=head2 net_init=I<options>

This is how to use Gimp-Perl in "net mode". Previous versions of this
package required a call to Gimp::init. This is no longer necessary. The
technical reason for this change is that when C<Gimp.pm> loads, it must
connect to GIMP to load its constants, like C<PDB_INT32>.

Possible options include C<spawn/gui> or C<unix/path/to/socket>. See
L<Gimp::Net/ENVIRONMENT> for other possibilities. If this is not
specified, C<Gimp> will try various options, falling back to C<spawn>
which starts a new GIMP instance.

It is important that C<Gimp> be able to connect to an instance of GIMP
one way or another: otherwise, it will not be able to load the various
constants on which modules rely. The connection is made when
C<Gimp::import> is called, after C<Gimp> has been compiled - so don't
put C<use Gimp ();>

=head2 spawn_options=I<options>

Set default spawn options to I<options>, see L<Gimp::Net>.

=head2 :DEFAULT

The default set: C<':consts', 'N_', '__'>. (C<'__'> is used for i18n
purposes).

=head2 ''

Over-ride (don't import) the defaults.

=head2 :auto (DEPRECATED)

Import constants as above, as well as all libgimp and PDB functions
automagically into the caller's namespace.  This will overwrite your
AUTOLOAD function, if you have one. The AUTOLOAD function that gets
installed can only be used with PDB functions whose first argument is
a reference (including objects):

 use Gimp qw(:auto);
 Gimp->displays_flush; # fine
 my $name = $layer->get_name; # also fine
 gimp_quit(0); # will lose its parameter, due to Perl's OO implementation!
 Gimp->quit(0); # works correctly
 gimp_image_undo_disable($image); # as does this, by a coincidence

This tag is deprecated, and you will be far better off using Gimp-Perl
solely in OO mode.

=head2 :pollute (DEPRECATED)

In previous version of C<gimp-perl>, you could refer to GIMP classes
as either e.g. Gimp::Image, B<and> as Image. Now in order to not pollute
the namespace, the second option will be available only when this option
is specified.

=head1 ARCHITECTURE

There are two modes of operation: the perl is called by GIMP (as a
plugin/filter) ("B<plugin mode>"), or GIMP is called by perl (which uses the
Gimp::Net functionality) - either connecting to an existing GIMP process
("B<net mode>"), or starting its own one ("B<batch mode>").

=head2 Plugin

There are four "entry points" into GIMP plugins: B<init>, B<query>,
B<run>, and B<quit>. Gimp-Perl provides hooks for the last 3; the first
is implicitly done as the script executes, then either query or run,
then quit on exit.

The perl script is written as a plug-in, probably using C<Gimp::Fu>.
GIMP, on start-up, runs all the plug-ins in its plugins directory at
startup (including all the perl scripts) in "query" mode.

Any plugin will register itself as a GIMP "procedure" in the PDB, during
its run in "query" mode.

When such a procedure is called, either from the menu system or a
scripting interface, the plugin will be run in "run" mode, and GIMP will
supply it with the appropriate arguments.

=head2 From outside GIMP

The script will use C<Gimp> as above, and use GIMP functions as it
wishes. If you are using GIMP interactively, you need to run the Perl
Server (under "Filters/Perl") to allow your script to connect. Otherwise,
the script will start its own GIMP, in "batch mode".  Either way,
your script, when it uses GIMP procedures (and Gimp-Perl functions),
will actually be communicating with the Perl server running under GIMP.

The architecture may be visualised like this:

 perlscript <-> Gimp::Net <-> Perl-Server <-> Gimp::Lib <-> GIMP

This has certain consequences; native GIMP objects like images and layers
obviously persist between Perl method calls, but C<libgimp> entities such
as C<GimpDrawable>, with the perl interface L<Gimp::PixelRgn>, require
special handling. Currently they do not work when used over C<Gimp::Net>.

=head1 OUTLINE OF A GIMP PLUG-IN

All plug-ins (running in "plugin mode") I<must> finish with a call to
C<Gimp::main>.

The return code should be immediately handed out to exit:

 exit Gimp::main;

It used to be the case that before the call to C<Gimp::main>, I<no>
other PDB function could be called. This is no longer the case (see
L</"net_init=I<options>">), but there is no point in doing so outside of a
"run" hook (unless you have the privilege and joy of writing test modules
for Gimp-Perl!).

In a C<Gimp::Fu>-script, it will actually call C<Gimp::Fu::main> instead
of C<Gimp::main>:

 exit main; # Gimp::Fu::main is exported by default when using Gimp::Fu

This is similar to Gtk, Tk or similar modules, where you have to call the
main eventloop.

Although you call C<exit> with the result of C<main>, the main function
might not actually return. This depends on both the version of GIMP and
the version of the Gimp-Perl module that is in use.  Do not depend on
C<main> to return at all, but still call C<exit> immediately.

=head2 CALLBACKS

The C<Gimp> module provides routines to be optionally filled in by a
plug-in writer.  This does not apply if using C<Gimp::Fu>, as these are
done automatically. These are specifically how your program can fit into
the model of query, run and quit hooks.

The additional C<on_proc> is how to supply code that will be run every
time a GIMP PDB call is made. This is mainly useful for updating the
progress bar on a plugin.

=head3 Gimp::on_query

Do any activities that must be performed at GIMP startup, when the
plugin is queried.  Should typically have at least one call to
C<Gimp-E<gt>install_procedure>.

=head3 Gimp::on_net

Run when the plugin is executed from the command line, either in "net
mode" via the Perl-Server, or "batch mode".

=head3 Gimp::on_lib

Run only when called from within GIMP, i.e. in "plugin mode".

=head3 Gimp::on_run

Run when anything calls it (network or lib).

=head3 Gimp::on_quit

Run when plugin terminates - allows a plugin (or extension, see below)
to clean up after itself before it actually exits.

=head3 Gimp::on_proc

Run each time a PDB call is made. Currently only operates in "lib mode".

=head1 OUTLINE OF A GIMP EXTENSION

A GIMP extension is a special type of plugin. Once started, it stays
running all the time. Typically during its run-initialisation (not on
query) it will install temporary procedures. A module, L<Gimp::Extension>,
has been provided to make it easy to write extensions.

If it has no parameters, then rather than being run when called, either
from a menu or a scripting interface, it is run at GIMP startup.

An extension can receive and act on messages from GIMP, unlike a plugin,
which can only initiate requests and get responses. This does mean the
extension needs to fit in with GIMP's event loop (the L<Glib> event loop
in fact - use this by using L<Gtk2>). This is easy. In its C<run> hook,
the extension simply needs to run C<Gimp-E<gt>extension_ack> after it
has initialised itself (including installing any temporary
procedures). Then, if it wants to just respond to GIMP events:

  # to deal only with GIMP events:
  Gimp->extension_ack;
  Gimp->extension_process(0) while 1;

or also other event sources (including a GUI, or L<Glib::IO>):

  # to deal with other events:
  Gimp::gtk_init;
  Gimp->extension_ack; # GIMP locks until this is done
  Gimp->extension_enable; # adds a Glib handler for GIMP messages
  my $tcp = IO::Socket::INET->new(
    Type => SOCK_STREAM, LocalPort => $port, Listen => 5, ReuseAddr => 1,
    ($host ? (LocalAddr => $host) : ()),
  ) or die __"unable to create listening tcp socket: $!\n";
  Glib::IO->add_watch(fileno($tcp), 'in', sub {
    warn "$$-setup_listen_tcp WATCHER(@_)" if $Gimp::verbose;
    my ($fd, $condition, $fh) = @_;
    my $h = $fh->accept or die __"unable to accept tcp connection: $!\n";
    my ($port,$host) = ($h->peerport, $h->peerhost);
    new_connection($h);
    slog __"accepted tcp connection from $host:$port";
    &Glib::SOURCE_CONTINUE;
  }, $tcp);
  Gtk2->main; # won't return if GIMP quits, but
	      # GIMP will call your quit callback

A working, albeit trivial, example is provided in
C<examples/example-extension>. A summarised example:

  use Gimp;
  Gimp::register_callback extension_gp_test => sub {
    # do some relevant initialisation here
    Gimp->install_temp_proc(
      "perl_fu_temp_demo", "help", "blurb", "id", "id", "2014-04-11",
      "<Toolbox>/Xtns/Perl/Test/Temp Proc demo", undef,
      &Gimp::TEMPORARY,
      [ [ &Gimp::PDB_INT32, 'run_mode', 'Run-mode', 0 ], ],
      [],
    );
    Gimp->extension_ack;
    Gimp->extension_process(0) while 1;
  };
  Gimp::register_callback perl_fu_temp_demo => sub {
    my ($run_mode) = @_;
    # here could bring up UI if $run_mode == RUN_INTERACTIVE
  };
  Gimp::on_query {
     Gimp->install_procedure(
	"extension_gp_test", "help", "blurb", "id", "id", "2014-04-11",
	undef, undef,
	&Gimp::EXTENSION,
	[], [],
     );
  };
  exit Gimp::main;

A more substantial, working, example can be seen in the Perl Server
extension that enables "net mode": C<examples/Perl-Server>.

=head1 AVAILABLE GIMP FUNCTIONS

There are two different flavours of GIMP functions: those from
the Procedural Database (the B<PDB>), and functions from B<libgimp>
(the C-language interface library).

You can get a listing and description of every PDB function by starting
GIMP's C<Help/Procedure Browser> extension. Perl requires you to change
"-" (dashes) to "_" (underscores).

=head1 OBJECT-ORIENTED SYNTAX

Gimp-Perl uses some tricks to map the procedural PDB functions onto full
classes, with methods. These effectively implement object-oriented C,
not coincidentally in the style of Glib Objects. GIMP plans to move to
fully supporting Glib Objects, which may mean some (or no) changes to
the Gimp-Perl programming interface. The OO interface may well become
stricter than the current quite thin mapping. This is why the C<:auto>
method of accessing GIMP functions is deprecated.

Therefore, the guidance is that if you can do it as an object method, do
- and use the shortest method name that works; no C<gimp_>, no
C<gimp_layer_>, etc. The key indication is whether the first argument
is an object of the classes given below, and the GIMP function call:
C<gimp_image_*> is always either an image object method, or a class
method. If the first two arguments are an image and a drawable, call the
method on the drawable, with the exception of C<gimp_image_insert_layer>,
which we can tell from the prefix is an image method.

If you can't, use a deeper class than just C<Gimp>: C<Gimp::Context>, etc.
Otherwise, you have to use C<Gimp-E<gt>>, and that's fine.

=head2 AVAILABLE CLASSES

Classes for which objects are created:

  Gimp::Base # purely virtual
    +-Gimp::Color
    +-Gimp::Image
    +-Gimp::Selection
    +-Gimp::Display
    +-Gimp::Parasite
    +-Gimp::Item
        +-Gimp::Vectors
        +-Gimp::Drawable
          +-Gimp::Layer
          +-Gimp::Channel

Classes for which non-PDB objects are created (see L<Gimp::PixelRgn>):

  Gimp::GimpDrawable
  Gimp::PixelRgn
  Gimp::Tile

Classes for which objects are not created:

  Gimp
  Gimp::Brush
  Gimp::Brushes
  Gimp::Context
  Gimp::Edit
  Gimp::Gradient
  Gimp::Gradients
  Gimp::Palette
  Gimp::Pattern
  Gimp::Patterns
  Gimp::Plugin
  Gimp::Progress

=head3 Gimp::Base

Methods:

=head4 $object->become($class)

Allows an object of one class to change its class to another, but with
the same ID. If a method call of C<is_valid> returns false, an exception
will be thrown. It is intended for use in plugins, e.g. where GIMP passes
a C<Gimp::Drawable>, but you need a C<Gimp::Layer>:

  my ($image, $drawable, $color) = @_;
  $drawable->become('Gimp::Layer'); # now can call layer methods on it

Returns C<$object>.

=head4 $class->existing($id)

Allows you to instantiate a Gimp-Perl object with the given C<$class>
and C<$id>. The same check as above is done, throwing an exception
if failed.

=head4 $object->id

Returns the underlying GIMP identifier, an integer.

=head4 $object->is_valid

Returns true if the object is a valid object of the relevant class.
Subclasses use appropriate GIMP functions: e.g. Gimp::Layer uses
C<gimp_item_is_layer>.

=head4 stringify

It also provides a "stringify" overload method, so debugging output can
be more readable.

=head3 Gimp::Parasite

Self-explanatory methods:

=head4 $parasite = Gimp::Parasite-E<gt>new($name, $flags, $data)

C<$name> and C<$data> are perl strings, C<flags> is the numerical flag value.

=head4 $parasite-E<gt>name

=head4 $parasite-E<gt>flags

=head4 $parasite-E<gt>data

=head4 $parasite-E<gt>has_flag($flag)

=head4 $parasite-E<gt>is_type($type)

=head4 $parasite-E<gt>is_persistent

=head4 $parasite-E<gt>is_error

=head4 $different_parasite = $parasite-E<gt>copy

=head4 $parasite-E<gt>compare($other_parasite)

=head2 SPECIAL METHODS

Some methods behave differently from how you'd expect, or methods uniquely
implemented in Perl (that is, not in the PDB). All of these must be
invoked using the method syntax (C<Gimp-E<gt>> or C<$object-E<gt>>).

=head3 Gimp->install_procedure

Takes as parameters C<(name, blurb, help, author, copyright, date,
menu_path, image_types, type, params[, return_vals])>.

Mostly the same as gimp_install_procedure from the C library. The
parameters and return values for the functions are each specified as an
array ref containing array-refs with three elements,
C<[PARAM_TYPE, "NAME", "DESCRIPTION"]>, e.g.:

  Gimp::on_query {
     Gimp->install_procedure(
	$Gimp::Net::PERLSERVERPROC, "Gimp-Perl scripts net server",
	"Allow scripting GIMP with Perl providing Gimp::Net server",
	"Marc Lehmann <pcg\@goof.com>", "Marc Lehmann", "1999-12-02",
	N_"<Image>/Filters/Languages/_Perl/_Server", undef,
	$Gimp::Net::PERLSERVERTYPE,
	[
	 [&Gimp::PDB_INT32, "run_mode", "Interactive, [non-interactive]"],
	 [&Gimp::PDB_INT32, "flags", "internal flags (must be 0)"],
	 [&Gimp::PDB_INT32, "extra", "multi-purpose"],
	 [&Gimp::PDB_INT32, "verbose", "Gimp verbose var"],
	],
	[],
     );
  };

=head3 Gimp::Progress->init(message,[display])

=head3 Gimp::Progress->update(percentage)

Initializes or updates a progress bar. In networked modules these are a no-op.

=head3 Gimp::Image-E<gt>list

=head3 $image-E<gt>get_layers

=head3 $image-E<gt>get_channels

These functions return what you would expect: an array of images, layers or
channels. The reason why this is documented is that the usual way to return
C<PDB_INT32ARRAY>s would be to return a B<reference> to an B<array of
integers>, rather than blessed objects:

  perl -MGimp -e '@x = Gimp::Image->list; print "@x\n"'
  # returns: Gimp::Image->existing(7) Gimp::Image->existing(6)

=head3 $drawable-E<gt>bounds, $gdrawable-E<gt>bounds

Returns an array (x,y,w,h) containing the upper left corner and the
size of currently selected parts of the drawable, just as needed by
C<Gimp::PixelRgn-E<gt>new> and similar functions. Exist for objects of
both C<Gimp::Drawable> and C<Gimp::GimpDrawable>.

=head2 NORMAL METHODS

If you call a method, C<Gimp> tries to find a GIMP function by
prepending a number of prefixes until it finds a valid function:

 $image = Gimp->image_new(...); # calls gimp_image_new(...)
 $image = Gimp::Image->new(...); # calls gimp_image_new as well
 $image = new Gimp::Image(...); # the same in green
 Gimp::Palette->set_foreground(...); # calls gimp_palette_set_foreground(..)
 $image->histogram(...); # calls gimp_histogram($image,...), since
			 # gimp_image_histogram does not exist

Return values from functions are automatically blessed to their
corresponding classes, e.g.:

 $image = new Gimp::Image(...);	# $image is now blessed to Gimp::Image
 $image->height;		# calls gimp_image_height($image)
 $image->flatten;		# likewise gimp_flatten($image)

The object argument (C<$image> in the above examples) is prepended to the
argument list - this is how Perl does OO.

Another shortcut: many functions want a (redundant) image argument, like

 $image->shear ($layer, ...)

Since all you want is to shear the C<$layer>, not the C<$image>, this is
confusing as well. In cases like this, Gimp-Perl allows you to write:

 $layer->shear (...)

And automatically infers the additional IMAGE-type argument.

Because method call lookup also search the C<plug_in_>, C<perl_fu_> and
C<script_fu_> namespaces, any plugin can automatically become a method
for an image or drawable (see below).

As the (currently) last goodie, if the first argument is of type INT32, its
name is "run_mode" and there are no other ambiguities, you can omit it, i.e.
these five calls are equivalent:

 plug_in_gauss_rle(RUN_NONINTERACTIVE, $image, $layer, 8, 1, 1);
 plug_in_gauss_rle($image, $layer, 8, 1, 1);
 plug_in_gauss_rle($layer, 8, 1, 1);
 $layer->plug_in_gauss_rle(8, 1, 1);
 $layer->gauss_rle(8, 1, 1);

You can call all sorts of sensible and not-so-sensible functions,
so this feature can be abused:

 patterns_list Gimp::Image;	# will call gimp_patterns_list
 quit Gimp::Plugin;		# will quit the Gimp, not an Plugin.

there is no image involved here whatsoever...

The 'gimpdoc' script will also return OO variants when functions
are described.  For example:

  gimpdoc image_new

has a section:

  SOME SYNTAX ALTERNATIVES
       $image = Gimp->image_new (width,height,type)
       $image = new Gimp::Image (width,height,type)
       $image = image_new Gimp::Display (width,height,type)

=head1 SPECIAL FUNCTIONS

In this section, you can find descriptions of special functions, functions
that have unexpected calling conventions/semantics or are otherwise
interesting. All of these functions must either be imported explicitly
or called using a namespace override (C<Gimp::>), not as methods
(C<Gimp-E<gt>>).

=head2 Gimp::main()

Should be called immediately when perl is initialized. Arguments are not
supported. Initializations can later be done in the init function.

=head2 Gimp::gtk_init()

Initialize Gtk in a similar way GIMP itself did. This automatically
parses GIMP's gtkrc and sets a variety of default settings, including
visual, colormap, gamma, and shared memory.

=head2 Gimp::set_rgb_db(filespec)

Use the given rgb database instead of the default one. The format is
the same as the one used by the X11 Consortiums rgb database (you might
have a copy in /usr/lib/X11/rgb.txt). You can view the default database
with C<perldoc -m Gimp::ColorDB>, at the end of the file; the default
database is similar, but not identical to the X11 default C<rgb.txt>.

=head2 Gimp::initialized()

this function returns true whenever it is safe to call GIMP functions. This is
usually only the case after gimp_main has been called.

=head2 Gimp::register_callback(gimp_function_name, perl_function)

Using this function you can override the standard Gimp-Perl behaviour of
calling a perl subroutine of the same name as the GIMP function.

The first argument is the name of a registered gimp function that you want
to overwrite ('perl_fu_make_something'), and the second argument can be
either a name of the corresponding perl sub (C<'Elsewhere::make_something'>)
or a code reference (C<\&my_make>).

=head2 Gimp::canonicalize_colour

Take in a color specifier in a variety of different formats, and return
a valid GIMP color specifier (a C<GimpRGB>), consisting of 3 or 4 numbers
in the range between 0 and 1.0. Can also be called as
C</Gimp::canonicalize_color>.

For example:

 $color = canonicalize_colour ("#ff00bb"); # html format
 $color = canonicalize_colour ([255,255,34]); # RGB
 $color = canonicalize_colour ([255,255,34,255]); # RGBA
 $color = canonicalize_colour ([1.0,1.0,0.32]); # actual GimpRGB
 $color = canonicalize_colour ('red'); # uses the color database

Note that bounds checking is somewhat lax; this assumes relatively
good input.

=head2 gimp_tile_*, gimp_pixel_rgn_*, gimp_drawable_get

With these functions you can access the raw pixel data of drawables. They
are documented in L<Gimp::PixelRgn>.

=head2 server_eval(string)

This evaluates the given string in array context and returns the
results. It's similar to C<eval>, but with two important differences: the
evaluating always takes place on the server side/server machine (which
might be the same as the local one) and compilation/runtime errors are
reported as runtime errors (i.e. throwing an exception).

=head1 PROCEDURAL SYNTAX (DEPRECATED)

To call PDB functions or libgimp functions, you I<can>
(but shouldn't) treat them like normal procedural perl (this requires
the use of the C<:auto> import tag - see L</":auto (DEPRECATED)">):

 gimp_item_set_name($layer, 'bob'); # $layer is an object (i.e. ref) - works
 gimp_palette_set_foreground([20,5,7]); # works because of array ref
 gimp_palette_set_background("cornsilk"); # colour turned into array ref!

=head1 DEBUGGING AIDS

How to debug your scripts:

=over 4

=item $Gimp::verbose

If set to true, will make Gimp-Perl say what it's doing on STDERR.
If you want it to be set during loading C<Gimp.pm>, make sure to do so
in a prior C<BEGIN> block:

 BEGIN { $Gimp::verbose = 1; }
 use Gimp;

Currently three levels of verbosity are supported:

  0: silence
  1: some info - generally things done only once
  2: all the info

=item GLib debugging

GIMP makes use of GLib. Environment variables including
C<G_DEBUG>, and setting C<G_SLICE> to
C<always-malloc>, control some behaviour. See
L<https://developer.gnome.org/glib/unstable/glib-running.html>
for details. Additionally, the behaviour of C<malloc> can
be controlled with other environment variables as shown at
L<http://man7.org/linux/man-pages/man3/mallopt.3.html>, especially
setting C<MALLOC_CHECK_> (note trailing underscore) to 3.

=back

=head1 SUPPORTED GIMP DATA TYPES

GIMP supports different data types like colors, regions, strings. In
C, these are represented as (C<GIMP_PDB_> omitted for brevity - in
Gimp-Perl, they are constants starting C<PDB_>):

=over 4

=item INT32, INT16, INT8, FLOAT, STRING

normal Perl scalars. Anything except STRING will be mapped
to a Perl-number.

=item INT32ARRAY, INT16ARRAY, INT8ARRAY, FLOATARRAY, STRINGARRAY, COLORARRAY

array refs containing scalars of the same type, i.e. [1, 2, 3, 4]. Gimp-Perl
implicitly swallows or generates a preceeding integer argument because the
preceding argument usually (this is a de-facto standard) contains the number
of elements.

=item COLOR

on input, either an array ref with 3 or 4 elements (i.e. [0.1,0.4,0.9]
or [233,40,40]), a X11-like string ("#rrggbb") or a colour name
("papayawhip") (see L</"Gimp::set_rgb_db(filespec)">).

=item DISPLAY, IMAGE, LAYER, CHANNEL, DRAWABLE, SELECTION, VECTORS, ITEM

these will be mapped to corresponding objects (IMAGE => Gimp::Image). In
verbose output you will see small integers (the image/layer/etc..-ID)

=item PARASITE

represented as a C<Gimp::Parasite> object (see above).

=item STATUS

Not yet supported, except implicitly - this is how exceptions (from
"die") get returned in "net mode".

=back

=head1 AUTHOR

Marc Lehmann <pcg@goof.com> (pre-2.0)

Seth Burgess <sjburge@gimp.org> (2.0+)

Kevin Cozens (2.2+)

Ed J (with oversight and guidance from Kevin Cozens) (2.3)

Ed J (2.3000_01+)

=head1 SEE ALSO

perl(1), gimp(1), L<Gimp::Fu>, L<Gimp::PixelRgn>, L<Gimp::UI>,
L<Gimp::Util>, L<Gimp::Data>, L<Gimp::Net>, and L<Gimp::Lib>.