gimp/tools/pdbgen/pdb/image.pdb

# The GIMP -- an image manipulation program
# Copyright (C) 1995 Spencer Kimball and Peter Mattis

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

# "Perlized" from C source by Manish Singh <yosh@gimp.org>

sub layer_arg () {{
    name => 'layer',
    type => 'layer',
    desc => 'The layer'
}}

sub channel_arg () {{
    name => 'channel',
    type => 'channel',
    desc => 'The channel'
}}

sub new_dim_args {
    foreach (qw(width height)) {
	push @inargs, { name => "new_$_", type => '0 < int32',
			desc => "New image $_: %%desc%%" }
    }
}

sub image_list_proc {
    my $type = shift;

    $blurb = "Returns the list of ${type}s contained in the specified image.";

    $help = <<HELP;
This procedure returns the list of ${type}s contained in the specified image. 
HELP

    &std_pdb_misc;
    
    @inargs = ( &std_image_arg );

    @outargs = (
	{ name => "${type}_ids", type => 'int32array', init => 1,
	  desc => "The list of ${type}s contained in the image",
	  array => { name => "num_${type}s", init => 1,
		     desc => "The number of ${type}s contained in the image" } }
    );

    %invoke = (
	vars => [ 'GList *list = NULL', 'int i' ],
	code => <<CODE
{
  list = GIMP_LIST (gimage->${type}s)->list;
  num_${type}s = g_list_length (list);

  if (num_${type}s)
    {
      ${type}_ids = g_new (gint32, num_${type}s);
      for (i = 0; i < num_${type}s; i++, list = g_list_next (list))
	${type}_ids[i] = gimp_item_get_ID (GIMP_ITEM (list->data));
    }
}
CODE
    );
}

sub type_move {
    my ($type, $op, $pos) = @_;
    my $extra = "";

    if ($op =~ /_/) {
	($op, $extra) = $op =~ /([^_]+)_(.*)/;
	$extra =~ s/_/ /g;
    }

    my $layer = "";
    $layer = ', or the layer has no alpha channel' if $type eq 'layer';

    $blurb = "\u$op the specified $type in the image's $type stack";
    $blurb .= " $extra of stack" if $extra;

    $help = <<HELP;
This procedure ${op}s the specified $type one step in the existing $type stack.
It will not move the $type if there is no $type $pos it$layer.
HELP
    $help =~ s/one step in/"$extra of"/e if $extra;

    @inargs = (
	&std_image_arg,
	&{"${type}_arg"}
    );
    $inargs[1]->{desc} .= " to $op $extra";

    if ($extra) {
	$extra =~ s/ /_/g;
	$extra = "_$extra";
    }

    %invoke = (
	code => "success = gimp_image_${op}_$type$extra (gimage, $type);"
    );
}

sub image_get_prop_proc {
    my ($prop, $type, $desc, $func) = @_;

    if ($desc =~ /\bis\b/) {
	$blurb = "Returns if the specified image's $desc.";
	$help = "This procedure returns if the specified image's $desc. ";
    } else {
	$blurb = "Returns the specified image's $desc.";
	$help = "This procedure returns the specified image's $desc. ";
    }

    &std_pdb_misc;

    @inargs = ( &std_image_arg );

    @outargs = (
	{ name => $prop, type => $type,
	  desc => "The $desc", no_declare => 1 }
    );

    my $alias = $func ? "gimp_image_get_$prop (gimage)" : "gimage->$prop";
    $alias = "g_strdup ($alias)" if $type eq 'string';
    $outargs[0]->{alias} .= "$alias";

    if ($type eq 'color') {
	$outargs[0]->{init} = 1;
	delete @{$outargs[0]}{qw(alias no_declare)};

	$invoke{code} = "{\n  color = g_new (guchar, 3);\n";
	foreach (map { "${_}_PIX" } qw(RED GREEN BLUE)) {
	    $invoke{code} .= "  $prop\[$_] = image->col[$_];\n";
	}
	$invoke{code} .= "}\n";
    }
}

sub image_set_prop_proc {
    my ($prop, $type, $desc, $func) = @_;

    if ($desc =~ /\bis\b/) {
	$blurb = "Sets if the specified image's $desc.";
	$help = "This procedure sets if the specified image's $desc. ";
    } else {
	$blurb = "Sets the specified image's $desc.";
	$help = "This procedure sets the specified image's $desc. ";
    }

    &std_pdb_misc;

    @inargs = (
	&std_image_arg,
	{ name => $prop, type => $type,
	  desc => "The new image $desc" }
    );

    if ($type =~ /float/) {
	$inargs[1]->{desc} .= ' (%%desc%%)';
    }

    $invoke{code} = $func ? "gimp_image_set_$prop (gimage, $prop);"
			  : "gimage->$prop = $prop;";

    if ($type eq 'color') {
	%invoke = (
	    vars => [ 'int i' ],
	    code => <<CODE
for (i = 0; i < 3; i++)
  gimage->col[i] = $prop\[i];
CODE
	);
    }
}

sub image_accessors {
    my ($prop, $type, $desc, $func, $extra) = @_;
    my (@extra, %extra); my $once = 0;

    ref($extra) ? (@extra = @$extra) : (@extra = ($extra, $extra));
    %extra = map { $once++ ? 'set' : 'get', $_ ? $_ : "" } @extra;

    foreach (sort keys %extra) {
	my $proc = "image_${_}_$prop";

	push @procs, $proc;

	eval <<SUB;
sub @{[ scalar caller ]}::$proc {
    \&image_${_}_prop_proc('$prop', '$type', '$desc', $func);
    $extra{$_}
}
SUB
    }
}

# The defs

sub image_list {
    $blurb = 'Returns the list of images currently open.';

    $help = <<'HELP';
This procedure returns the list of images currently open in the GIMP.
HELP

    &image_list_proc('image');

    undef @inargs;

    foreach ($blurb, $help, $outargs[0]->{desc}, $outargs[0]->{array}->{desc}) {
	s/contained.*/currently open/
    }

    $blurb .= '.';
    $help  .= ' in the GIMP.';

    for ($invoke{code}) {
	s/list = .*$/gimp_container_foreach (gimp->images, gimlist_cb, &list);/m;
	s/ITEM/IMAGE/;
	s/gimp_item_get_ID/gimp_image_get_ID/;
    }
}

sub image_new {
    $blurb = 'Creates a new image with the specified width, height, and type.';

    $help = <<'HELP';
Creates a new image, undisplayed with the specified extents and type. A layer
should be created and added before this image is displayed, or subsequent calls
to 'gimp_display_new' with this image as an argument will fail. Layers can be
created using the 'gimp_layer_new' commands. They can be added to an image
using the 'gimp_image_add_layer' command.
HELP

    &std_pdb_misc;

    @inargs = (
	{ name => 'type', type => 'enum GimpImageBaseType',
	  desc => 'The type of image: { %%desc%% }' }
    );

    foreach (qw(height width)) {
	unshift @inargs, { name => $_, type => '0 < int32',
			   desc => "The $_ of the image" }
    }

    @outargs = (
	{ name => 'image', type => 'image', alias => 'gimage', init => 1, 
	  desc => 'The ID of the newly created image' }
    );

    %invoke = (
	code => <<'CODE'
success = (gimage = gimp_create_image (gimp, width, height, type, FALSE)) != NULL;
CODE
    );
}

sub image_resize {
    $blurb = 'Resize the image to the specified extents.';

    $help = <<'HELP';
This procedure resizes the image so that it's new width and height are equal to
the supplied parameters. Offsets are also provided which describe the position
of the previous image's content. No bounds checking is currently provided, so
don't supply parameters that are out of bounds. All channels within the image
are resized according to the specified parameters; this includes the image
selection mask. All layers within the image are repositioned according to the
specified offsets.
HELP

    &std_pdb_misc;

    @inargs = ( &std_image_arg );
    &new_dim_args;

    foreach (qw(x y)) {
	push @inargs, { name => "off$_", type => 'int32',
			desc => "$_ offset between upper left corner of old and
				 new images: (new - old)" }
    }

    %invoke = (
	headers => [ qw("core/gimpimage-resize.h") ],
	code => <<'CODE'
{
  gimp_image_resize (gimage, new_width, new_height, offx, offy);
}
CODE
    );
}

sub image_scale {
    $blurb = 'Scale the image to the specified extents.';

    $help = <<'HELP';
This procedure scales the image so that it's new width and height are equal to
the supplied parameters. Offsets are also provided which describe the position
of the previous image's content. No bounds checking is currently provided, so
don't supply parameters that are out of bounds. All channels within the image
are scaled according to the specified parameters; this includes the image
selection mask. All layers within the image are repositioned according to the
specified offsets.
HELP

    &std_pdb_misc;

    @inargs = ( &std_image_arg );
    &new_dim_args;

    %invoke = (
	headers => [ qw("core/gimpimage-scale.h") ],
	code => <<'CODE'
{
  gimp_image_scale (gimage, new_width, new_height,
                    gimp->config->interpolation_type,
                    NULL, NULL);
}
CODE
    );
}

sub image_crop {
    $blurb = 'Crop the image to the specified extents.';

    $help = <<'HELP';
This procedure crops the image so that it's new width and height are equal to
the supplied parameters. Offsets are also provided which describe the position
of the previous image's content. All channels and layers within the image are 
cropped to the new image extents; this includes the image selection mask. If
any parameters are out of range, an error is returned.
HELP

    &std_pdb_misc;

    @inargs = (
	&std_image_arg,
	{ name => 'new_width', type => '0 < int32',
	  desc => 'New image width: (0 < new_width <= width)' },
	{ name => 'new_height', type => '0 < int32',
	  desc => 'New image height: (0 < new_height <= height)' },
	{ name => 'offx', type => '0 <= int32',
	  desc => 'x offset: (0 <= offx <= (width - new_width))' },
	{ name => 'offy', type => '0 <= int32',
	  desc => 'y offset: (0 <= offy <= (height - new_height))' }
    );

    %invoke = (
	headers => [ qw("core/gimpimage-crop.h") ],
	code => <<'CODE'
{
  if (new_width > gimage->width || new_height > gimage->height ||
      offx > (gimage->width - new_width) ||
      offy > (gimage->height - new_height))
    success = FALSE;
  else
    gimp_image_crop (gimage, offx, offy, offx + new_width, offy + new_height,
		     FALSE, TRUE);
}
CODE
    );
}

sub image_delete {
    $blurb = 'Delete the specified image.';

    $help = <<'HELP';
If there are no displays associated with this image it will be deleted. 
This means that you can not delete an image through the PDB that was
created by the user. If the associated display was however created 
through the PDB and you know the display ID, you may delete the display.
Removal of the last associated display will then delete the image.
HELP

    &std_pdb_misc;

    @inargs = ( &std_image_arg );

    %invoke = ( code => <<'CODE' );
{
  if (gimage->disp_count == 0)
    {
      g_object_unref (G_OBJECT (gimage));
      success = TRUE;
    }
}
CODE
}

sub image_free_shadow {
    $blurb = "Free the specified image's shadow data (if it exists).";

    $help = <<'HELP';
This procedure is intended as a memory saving device. If any shadow memory has
been allocated, it will be freed automatically on a call to
'gimp_image_delete'.
HELP

    &std_pdb_misc;

    @inargs = ( &std_image_arg );

    %invoke = ( code => 'gimp_image_free_shadow (gimage);' );
}

sub image_get_layers {
    &image_list_proc('layer');

    $help .= 'The order of layers is from topmost to bottommost.';
}

sub image_get_channels {
    &image_list_proc('channel');

    $help .= <<'HELP';
This does not include the selection mask, or layer masks. The order is from
topmost to bottommost.
HELP
}

sub image_unset_active_channel {
    $blurb = 'Unsets the active channel in the specified image.';

    $help = <<'HELP';
If an active channel exists, it is unset. There then exists no active channel,
and if desired, one can be set through a call to 'Set Active Channel'. No error
is returned in the case of no existing active channel.
HELP

    &std_pdb_misc;

    @inargs = ( &std_image_arg );

    %invoke = ( code => 'gimp_image_unset_active_channel (gimage);' );
}

sub image_pick_correlate_layer {
    $blurb = 'Find the layer visible at the specified coordinates.';

    $help = <<'HELP';
This procedure finds the layer which is visible at the specified coordinates.
Layers which do not qualify are those whose extents do not pass within the
specified coordinates, or which are transparent at the specified coordinates.
This procedure will return -1 if no layer is found.
HELP

    &std_pdb_misc;

    @inargs = ( &std_image_arg );
    foreach (qw(x y)) {
	push @inargs, { name => $_, type => 'int32',
			desc => "The $_ coordinate for the pick" }
    }

    @outargs = (
	{ name => 'layer', type => 'layer', init => 1,
	  desc => 'The layer found at the specified coordinates' }
    );

    %invoke = (
	code => 'layer = gimp_image_pick_correlate_layer (gimage, x, y);'
    );
}

sub image_raise_layer {
    &type_move('layer', 'raise', 'above');
    &std_pdb_misc;
}

sub image_lower_layer {
    &type_move('layer', 'lower', 'below');
    &std_pdb_misc;
}

sub image_raise_layer_to_top {
    &type_move('layer', 'raise_to_top', 'above');
    $copyright = "Wolfgang Hofer";
    $author = $copyright . ", Sven Neumann";
    $date = 1998;
}

sub image_lower_layer_to_bottom {
    &type_move('layer', 'lower_to_bottom', 'below');
    $copyright = "Wolfgang Hofer";
    $author = $copyright . ", Sven Neumann";
    $date = 1998;
}

sub image_merge_visible_layers {
    $blurb = 'Merge the visible image layers into one.';

    $help = <<'HELP';
This procedure combines the visible layers into a single layer using the
specified merge type. A merge type of EXPAND_AS_NECESSARY expands the final
layer to encompass the areas of the visible layers. A merge type of
CLIP_TO_IMAGE clips the final layer to the extents of the image. A merge type
of CLIP_TO_BOTTOM_LAYER clips the final layer to the size of the bottommost
layer.
HELP

    &std_pdb_misc;

    @inargs = (
	&std_image_arg,
	{ name => 'merge_type',
	  type => 'enum GimpMergeType (no GIMP_FLATTEN_IMAGE)',
	  desc => 'The type of merge: { %%desc%% }' }
    );

    @outargs = (
	{ name => 'layer', type => 'layer', init => 1,
	  desc => 'The resulting layer' }
    );

    %invoke = (
	headers => [ qw("core/gimpimage-merge.h") ],
	code => <<'CODE'
{
  layer = gimp_image_merge_visible_layers (gimage, merge_type);
  success = layer != NULL;
}
CODE
    );
}

sub image_merge_down {
    $blurb = 'Merge the layer passed and the first visible layer below.';

    $help = <<'HELP';
This procedure combines the passed layer and the first visible layer below it
using the specified merge type. A merge type of EXPAND_AS_NECESSARY expands the
final layer to encompass the areas of the visible layers. A merge type of
CLIP_TO_IMAGE clips the final layer to the extents of the image. A merge type
of CLIP_TO_BOTTOM_LAYER clips the final layer to the size of the bottommost
layer.
HELP

    $author = $copyright = 'Larry Ewing';
    $date = '1998';

    @inargs = (
	&std_image_arg,
	{ name => 'merge_layer', type => 'layer',
	  desc => 'The layer to merge down from' },
	{ name => 'merge_type', 
	  type => 'enum GimpMergeType (no GIMP_FLATTEN_IMAGE)',
	  desc => 'The type of merge: { %%desc%% }' }
    );

    @outargs = (
	{ name => 'layer', type => 'layer', init => 1,
	  desc => 'The resulting layer' }
    );

    %invoke = (
	headers => [ qw("core/gimpimage-merge.h") ],
	code => <<'CODE'
{
  layer = gimp_image_merge_down (gimage, merge_layer, merge_type);
  success = layer != NULL;
}
CODE
    );
}

sub image_flatten {
    $blurb = <<'BLURB';
Flatten all visible layers into a single layer. Discard all invisible layers.
BLURB

    $help = <<'HELP';
This procedure combines the visible layers in a manner analogous to merging
with the CLIP_TO_IMAGE merge type. Non-visible layers are discarded, and the
resulting image is stripped of its alpha channel.
HELP

    &std_pdb_misc;

    @inargs = ( &std_image_arg );

    @outargs = (
	{ name => 'layer', type => 'layer', init => 1,
	  desc => 'The resulting layer' }
    );

    %invoke = (
	headers => [ qw("core/gimpimage-merge.h") ],
	code => 'success = (layer = gimp_image_flatten (gimage)) != NULL;'
    );
}

sub image_add_layer {
    $blurb = 'Add the specified layer to the image.';

    $help = <<'HELP';
This procedure adds the specified layer to the gimage at the given position. If
the position is specified as -1, then the layer is inserted at the top of the
layer stack. If the layer to be added has no alpha channel, it must be added at
position 0. The layer type must be compatible with the image base type.
HELP

    &std_pdb_misc;

    @inargs = (
	&std_image_arg,
	&layer_arg,
	{ name => 'position', type => 'int32',
	  desc => 'The layer position' }
    );

    $invoke{code} = <<'CODE';
{
  if (GIMP_IMAGE_TYPE_BASE_TYPE (gimp_drawable_type (GIMP_DRAWABLE (layer))) !=
      gimp_image_base_type (gimage))
    {
      success = FALSE;
    }
  else
    {
      success = gimp_image_add_layer (gimage, layer, MAX (position, -1));
    }
}
CODE
}

sub image_remove_layer {
    $blurb = 'Remove the specified layer from the image.';

    $help = <<'HELP';
This procedure removes the specified layer from the image. If the layer doesn't
exist, an error is returned. If there are no layers left in the image, this
call will fail. If this layer is the last layer remaining, the image will
become empty and have no active layer.
HELP

    &std_pdb_misc;

    @inargs = (
	&std_image_arg,
	&layer_arg
    );

    %invoke = ( code => 'gimp_image_remove_layer (gimage, layer);' );
}

sub image_add_layer_mask {
    $blurb = 'Add a layer mask to the specified layer.';

    $help = <<'HELP';
This procedure adds a layer mask to the specified layer. Layer masks serve as
an additional alpha channel for a layer. This procedure will fail if a number
of prerequisites aren't met. The layer cannot already have a layer mask. The
specified mask must exist and have the same dimensions as the layer. Both the
mask and the layer must have been created for use with the specified image.
HELP

    &std_pdb_misc;

    @inargs = (
	&std_image_arg,
	&layer_arg,
	{ name => 'mask', type => 'layer_mask',
	  desc => 'The mask to add to the layer' }
    );
    $inargs[1]->{desc} .= ' to receive the mask';

    %invoke = (
	code => <<'CODE'
success = gimp_layer_add_mask (layer, mask, TRUE) != NULL;
CODE
    );
}

sub image_remove_layer_mask {
    $blurb = 'Remove the specified layer mask from the layer.';

    $help = <<'HELP';
This procedure removes the specified layer mask from the layer. If the mask
doesn't exist, an error is returned.
HELP

    &std_pdb_misc;

    @inargs = (
	&std_image_arg,
	&layer_arg,
	{ name => 'mode', type => 'enum GimpMaskApplyMode',
	  desc => 'Removal mode: { %%desc%% }' }
    );
    $inargs[1]->{desc} .= ' from which to remove mask';

    %invoke = ( code => 'gimp_layer_apply_mask (layer, mode, TRUE);' );
}

sub image_raise_channel {
    &type_move('channel', 'raise', 'above');
    &std_pdb_misc;
}

sub image_lower_channel {
    &type_move('layer', 'lower', 'below');
    &std_pdb_misc;
}

sub image_add_channel {
    $blurb = 'Add the specified channel to the image.';

    $help = <<'HELP';
This procedure adds the specified channel to the image. The position channel is
not currently used, so the channel is always inserted at the top of the channel
stack.
HELP

    &std_pdb_misc;

    @inargs = (
	&std_image_arg,
	&channel_arg,
	{ name => 'position', type => 'int32',
	  desc => 'The channel position' }
    );

    %invoke = (
	code => <<'CODE'
success = gimp_image_add_channel (gimage, channel, MAX (position, -1));
CODE
    );
}

sub image_remove_channel {
    $blurb = 'Remove the specified channel from the image.';

    $help = <<'HELP';
This procedure removes the specified channel from the image. If the channel
doesn't exist, an error is returned.
HELP

    &std_pdb_misc;

    @inargs = (
	&std_image_arg,
	&channel_arg
    );

    %invoke = ( code => 'gimp_image_remove_channel (gimage, channel);' );
}

sub image_active_drawable {
    $blurb = "Get the image's active drawable";

    $help = <<'HELP';
This procedure returns the ID of the image's active drawable. This can be
either a layer, a channel, or a layer mask. The active drawable is specified by
the active image channel. If that is -1, then by the active image layer. If the
active image layer has a layer mask and the layer mask is in edit mode, then
the layer mask is the active drawable.
HELP

    &std_pdb_misc;

    @inargs = ( &std_image_arg );

    @outargs = (
	{ name => 'drawable', type => 'drawable', init => 1,
	  desc => 'The active drawable' }
    );

    %invoke = (
	code => <<'CODE'
success = (drawable = gimp_image_active_drawable (gimage)) != NULL;
CODE
    );
}

sub image_base_type {
    $blurb = 'Get the base type of the image.';

    $help = <<'HELP';
This procedure returns the image's base type. Layers in the image must be of
this subtype, but can have an optional alpha channel.
HELP

    &std_pdb_misc;

    @inargs = ( &std_image_arg );

    @outargs = (
	{ name => 'base_type', type => 'enum GimpImageBaseType', init => 1,
	  desc => "The image's base type: { %%desc%% }" }
    );

    %invoke = ( code => 'base_type = gimp_image_base_type (gimage);' );
}

sub image_get_cmap {
    $blurb = "Returns the image's colormap";

    $help = <<'HELP';
This procedure returns an actual pointer to the image's colormap, as well as
the number of bytes contained in the colormap. The actual number of colors in
the transmitted colormap will be "num_bytes" / 3. If the image is not of base
type GIMP_INDEXED, this pointer will be NULL.
HELP

    &std_pdb_misc;

    @inargs = ( &std_image_arg );

    @outargs = (
	{ name => 'cmap', type => 'int8array', init => 1, wrap => 1,
	  desc => "The image's colormap",
	  array => { name => 'num_bytes', init => 1,
		     desc => 'Number of bytes in the colormap array:
			      %%desc%%' } }
    );

    %invoke = (
	code => <<'CODE'
{
  num_bytes = gimage->num_cols * 3;
  cmap = g_new (guint8, num_bytes);
  memcpy (cmap, gimp_image_get_colormap (gimage), num_bytes);
}
CODE
    );
}

sub image_set_cmap {
    $blurb = "Sets the entries in the image's colormap.";

    $help = <<'HELP';
This procedure sets the entries in the specified image's colormap. The number
of entries is specified by the "num_bytes" parameter and corresponds to the
number of INT8 triples that must be contained in the "cmap" array. The actual
number of colors in the transmitted colormap is "num_bytes" / 3.
HELP

    &std_pdb_misc;

    @inargs = (
	&std_image_arg,
	{ name => 'cmap', type => 'int8array', wrap => 1,
	  desc => "The new colormap values",
	  array => { name => 'num_bytes', type => '0 <= int32 <= 768',
		     desc => 'Number of bytes in the colormap array:
			      %%desc%%' } }
    );

    %invoke = ( code => <<'CODE'
{
  if (gimage->cmap == NULL)
    gimage->cmap = g_new (guchar, COLORMAP_SIZE);

  if (num_bytes)
    memcpy (gimage->cmap, cmap, num_bytes);

  gimage->num_cols = num_bytes / 3;

  gimp_image_colormap_changed (gimage, -1);
}
CODE
    );
}

sub image_undo_is_enabled {
    $blurb = "Check if the image's undo stack is enabled.";

    $help = <<'HELP';
This procedure checks if the image's undo stack is currently enabled or
disabled.  This is useful when several plugins or scripts call each other
and want to check if their caller has already used 'gimp_image_undo_disable'
or 'gimp_image_undo_freeze'.
HELP

    $author = $copyright = 'Raphael Quinet';
    $date = '1999';

    @inargs = ( &std_image_arg );

    @outargs = (
	{ name => 'enabled', type => 'boolean', init => 1,
	  desc => 'True if undo is enabled for this image' }
    );

    %invoke = ( code => 'enabled = gimp_image_undo_is_enabled (gimage);' );
}

sub image_undo_enable {
    $blurb = "Enable the image's undo stack.";

    $help = <<'HELP';
This procedure enables the image's undo stack, allowing subsequent operations
to store their undo steps. This is generally called in conjunction with
'gimp_image_undo_disable' to temporarily disable an image undo stack.
HELP

    &std_pdb_misc;

    @inargs = ( &std_image_arg );

    @outargs = (
	{ name => 'enabled', type => 'boolean',
	  desc => 'True if the image undo has been enabled',
	  alias => 'success ? TRUE : FALSE', no_declare => 1 }
    );

    %invoke = ( code => 'success = gimp_image_undo_enable (gimage);' );
}

sub image_undo_disable {
    $blurb = "Disable the image's undo stack.";

    $help = <<'HELP';
This procedure disables the image's undo stack, allowing subsequent operations
to ignore their undo steps. This is generally called in conjunction with
'gimp_image_undo_enable' to temporarily disable an image undo stack. This is
advantageous because saving undo steps can be time and memory intensive.
HELP

    &std_pdb_misc;

    @inargs = ( &std_image_arg );

    @outargs = (
	{ name => 'disabled', type => 'boolean',
	  desc => 'True if the image undo has been disabled',
	  alias => 'success ? TRUE : FALSE', no_declare => 1 }
    );

    %invoke = ( code => 'success = gimp_image_undo_disable (gimage);' );
}

sub image_undo_thaw {
    $blurb = "Thaw the image's undo stack.";

    $author = $copyright = 'Adam D. Moss';
    $date = '1999';

    $help = <<'HELP';
This procedure thaws the image's undo stack, allowing subsequent operations to 
store their undo steps. This is generally called in conjunction with 
'gimp_image_undo_freeze' to temporarily freeze an image undo stack.  
'gimp_image_undo_thaw' does NOT free the undo stack as
'gimp_image_undo_enable' does, so is suited for situations where one wishes to 
leave the undo stack in the same state in which one found it despite 
non-destructively playing with the image in the meantime.  An example would be 
in-situ plugin previews.  Balancing freezes and thaws and ensuring image 
consistancy is the responsibility of the caller.
HELP

    @inargs = ( &std_image_arg );

    @outargs = (
	{ name => 'thawed', type => 'boolean',
	  desc => 'True if the image undo has been thawed',
	  alias => 'success ? TRUE : FALSE', no_declare => 1 }
    );

    %invoke = ( code => 'success = gimp_image_undo_thaw (gimage);' );
}

sub image_undo_freeze {
    $blurb = "Freeze the image's undo stack.";

    $author = $copyright = 'Adam D. Moss';
    $date = '1999';

    $help = <<'HELP';
This procedure freezes the image's undo stack, allowing subsequent operations
to ignore their undo steps.  This is generally called in conjunction with 
'gimp_image_undo_thaw' to temporarily disable an image undo stack.  This is 
advantageous because saving undo steps can be time and memory intensive.  
'gimp_image_undo_{freeze,thaw}' and 'gimp_image_undo_{disable,enable}' differ 
in that the former does not free up all undo steps when undo is thawed, so is 
more suited to interactive in-situ previews.  It is important in this case 
that the image is back to the same state it was frozen in before thawing, else 
'undo' behaviour is undefined.
HELP

    @inargs = ( &std_image_arg );

    @outargs = (
	{ name => 'frozen', type => 'boolean',
	  desc => 'True if the image undo has been frozen',
	  alias => 'success ? TRUE : FALSE', no_declare => 1 }
    );

    %invoke = ( code => 'success = gimp_image_undo_freeze (gimage);' );
}

sub image_clean_all {
    $blurb = 'Set the image dirty count to 0.';

    $help = <<'HELP';
This procedure sets the specified image's dirty count to 0, allowing operations
to occur without having a 'dirtied' image. This is especially useful for
creating and loading images which should not initially be considered dirty, even
though layers must be created, filled, and installed in the image.
HELP

    &std_pdb_misc;

    @inargs = ( &std_image_arg );

    %invoke = ( code => 'gimp_image_clean_all (gimage);' );
}

sub image_floating_selection {
    $blurb = 'Return the floating selection of the image.';

    $help = <<'HELP';
This procedure returns the image's floating_sel, if it exists. If it doesn't
exist, -1 is returned as the layer ID.
HELP

    &std_pdb_misc;

    @inargs = ( &std_image_arg );

    @outargs = (
	{ name => 'floating_sel', type => 'layer', init => 1,
	  desc => "The image's floating selection",
	  return_fail => -1 }
    );

    %invoke = ( code => 'floating_sel = gimp_image_floating_sel (gimage);' );
}

sub image_floating_sel_attached_to {
    $blurb = 'Return the drawable the floating selection is attached to.';

    $help = <<'HELP';
This procedure returns the drawable the image's floating selection is attached
to, if it exists. If it doesn't exist, -1 is returned as the drawable ID.
HELP

    $author = $copyright = 'Wolfgang Hofer';
    $date = '1998';

    @inargs = ( &std_image_arg );

    @outargs = (
	{ name => 'drawable', type => 'drawable', init => 1,
	  desc => 'The drawable the floating selection is attached to',
	  return_fail => -1 }
    );

    %invoke = (
	vars => [ 'GimpLayer *floating_sel' ],
	code => <<'CODE'
{
  floating_sel = gimp_image_floating_sel (gimage);

  if (floating_sel)
    drawable = GIMP_DRAWABLE (GIMP_LAYER (floating_sel)->fs.drawable);
  else
    drawable = NULL;
}
CODE
    );
}

foreach (qw(width height)) {
    push @procs, "image_$_";
    eval <<SUB;
sub image_$_ {
    \$blurb = 'Return the $_ of the image';

    \$help = <<'HELP';
This procedure returns the image's $_. This value is independent of any of
the layers in this image. This is the "canvas" $_.
HELP

    \&std_pdb_misc;

    \@inargs = ( \&std_image_arg );

    \@outargs = (
	{ name => '$_', type => 'int32',
	  desc => "The image's $_",
	  alias => 'gimage->$_', no_declare => 1 }
    );
}
SUB
}

&image_accessors('active_layer', 'layer', 'active layer', 1,
		 [ <<'CODE1', <<'CODE2' ]);
    $invoke{code} = "active_layer = $outargs[0]->{alias};";
    delete @{$outargs[0]}{qw(alias no_declare)};
    $outargs[0]->{return_fail} = -1;
    $outargs[0]->{init} = 1;

    $help = <<'HELP';
If there is an active layer, its ID will be returned, otherwise, -1.  If a
channel is currently active, then no layer will be. If a layer mask is active,
then this will return the associated layer.
HELP
CODE1
    $help = <<'HELP';
If the layer exists, it is set as the active layer in the image. Any previous
active layer or channel is set to inactive. An exception is a previously
existing floating selection, in which case this procedure will return an
execution error.
HELP
CODE2

&image_accessors('active_channel', 'channel', 'active channel', 1,
		 [ <<'CODE1', <<'CODE2' ]);
    $invoke{code} = "active_channel = $outargs[0]->{alias};";
    delete @{$outargs[0]}{qw(alias no_declare)};
    $outargs[0]->{return_fail} = -1;
    $outargs[0]->{init} = 1;

    $help = <<'HELP';
If there is an active channel, this will return the channel ID, otherwise, -1.
HELP
CODE1
    $help = <<'HELP';
If the channel exists, it is set as the active channel in the image. Any
previous active channel or channel is set to inactive. An exception is a
previously existing floating selection, in which case this procedure will
return an execution error.
HELP
CODE2

&image_accessors('selection', 'selection', 'selection', 1,
		 [ <<'CODE', undef ]);
    $invoke{code} = "success = (selection = gimp_image_get_mask (gimage)) != NULL;";
    delete @{$outargs[0]}{qw(alias no_declare)};
    $outargs[0]->{desc} .= ' channel';
    $outargs[0]->{init} = 1;

    $help = <<'HELP';
This will always return a valid ID for a selection -- which is represented as a
channel internally.
HELP
CODE
$#procs--;

my $comp_arg = <<'CODE';
    splice @inargs, 1, 0, ({ name => 'component',
			     type => 'enum GimpChannelType (no AUXILLARY_CHANNEL)',
			     desc => 'The image component: { %%desc%% }' });

    $invoke{code} = <<'SUCCESS';
{
  if (component == GIMP_GRAY_CHANNEL)
    success = gimp_image_base_type (gimage) == GIMP_GRAY;
  else if (component == GIMP_INDEXED_CHANNEL)
    success = gimp_image_base_type (gimage) == GIMP_INDEXED;
  else
    success = gimp_image_base_type (gimage) == GIMP_RGB;
}
SUCCESS
CODE

my $comp_help = <<'CODE';
	$help =~ s/(component)/$1 (i.e. Red, Green, Blue intensity channels
			       in an RGB image)/;
	$help =~ s/\. $/ /;
	$help .= <<HELP;
or in%%type%% -- whether or not it can be %%action%%. If the specified component
is not valid for the image type, an error is returned.
HELP
CODE

my %comp_action = (
    active => 'modified',
    visible => 'seen'
);

foreach (sort keys %comp_action) {
    my $help = $comp_help;

    $help =~ s/%%type%%/$_/e;
    $help =~ s/%%action%%/$comp_action{$_}/e;

    &image_accessors("component_$_", 'boolean', "image component is $_", 1,
		     [ <<CODE1, <<CODE2 ]);
	$comp_arg;
	\$outargs[0]->{name} = '$_';
	\$outargs[0]->{desc} = 'Component is $_ (%%desc%%)';

	chop \$outargs[0]->{alias};
	\$outargs[0]->{alias} .= ', component)';
	$help;
CODE1
	my \$code = <<CODE;

  if (success)
    \$invoke{code}
CODE
	$comp_arg;
	\$invoke{code} =~ s/}/"\$code}"/e;
	\$invoke{code} =~ s/ component_$_/ component, $_/;
	\$inargs[2]->{name} = '$_';
	\$inargs[2]->{desc} = 'Component is $_ (%%desc%%)';
 	$help;
CODE2
}

&image_accessors('filename', 'string', 'filename', 1,
		 [ <<'CODE', undef ]);
    $help =~ s/\. $//;
    $help .= <<'HELP';
 -- if it was loaded or has since been saved. Otherwise, returns NULL.
HELP

    $outargs[0]->{alias} =~ s/g_strdup \((.*)\)/$1/;
CODE

&image_accessors('name', 'string', 'name', 1,
		 [ <<'CODE1', undef ]);
    delete @{$outargs[0]}{qw(alias no_declare)};

    %invoke = (
	vars => [ 'gchar *filename' ],
	code => <<'CODE2'
{
  filename = gimp_image_get_filename (gimage);

  if (filename)
    {
      name = g_path_get_basename (filename);
      g_free (filename);
    }
  else
    name = g_strdup (_("Untitled"));
}
CODE2
    );
CODE1
$#procs--;

&image_accessors('resolution', 'float', 'resolution', 0,
		 [ <<'CODE1', <<'CODE2' ]);
    $help =~ s/\. $/ /;
    $help .= <<'HELP';
in dots per inch. This value is independent of any of the layers in this image.
HELP

    $author = $copyright = 'Austin Donnelly';
    $date = '1998';

    push @outargs, { %{$outargs[0]} };
    $outargs[0]->{void_ret} = 1;

    my $count = 0;
    foreach $coord (qw(x y)) {
	foreach (qw(name alias)) {
	    $outargs[$count]->{$_} =~ s/res/"${coord}res"/e
	}
	$outargs[$count++]->{desc} .= "in the $coord-axis, in dots per inch";
    }
CODE1
    $help =~ s/\. $/ /;
    $help .= <<'HELP';
in dots per inch. This value is independent of any of the layers in this image.
No scaling or resizing is performed.
HELP

    $author = $copyright = 'Austin Donnelly';
    $date = '1998';

    push @inargs, { %{$inargs[1]} };

    my $count = 1; undef %invoke;
    foreach $coord (qw(x y)) {
	my $arg = $inargs[$count];
	$arg->{name} =~ s/res/"${coord}res"/e;
	$arg->{desc} .= "in the $coord-axis, in dots per inch";
	$count++;
    }

    $invoke{code} = <<'CODE';
{
  if (!FINITE (xresolution) || 
      xresolution < GIMP_MIN_RESOLUTION || xresolution > GIMP_MAX_RESOLUTION ||
      !FINITE (yresolution) || 
      yresolution < GIMP_MIN_RESOLUTION || yresolution > GIMP_MAX_RESOLUTION)
    {
      g_message (_("Image resolution is out of bounds,\n" 
                   "using the default resolution instead."));
      success = FALSE;
    }
  else
    {
      gimage->xresolution = xresolution;
      gimage->yresolution = yresolution;
    }
}
CODE
CODE2

my $unit_help = <<'HELP';
This value is independent of any of the layers in this image. See the
gimp_unit_* procedure definitions for the valid range of unit IDs and a
description of the unit system.
HELP

my $unit_misc = <<'CODE';
    $author = $copyright = 'Michael Natterer';
    $date = '1998';
CODE
&image_accessors('unit', 'unit (min GIMP_UNIT_INCH)', 'unit', 0,
		 [ <<CODE1, <<CODE2 ]);
    \$help .= '$unit_help';
    $unit_misc
CODE1
    \$help .= 'No scaling or resizing is performed. $unit_help';
    $unit_misc
CODE2

foreach (qw(layer channel)) {
    push @procs, "image_get_${_}_by_tattoo";
    eval <<SUB;
sub image_get_${_}_by_tattoo {
    \$blurb = 'Find a $_ with a given tattoo in an image.';

    \$help = <<'HELP';
This procedure returns the $_ with the given tattoo in the specified image.
HELP

    \$author = \$copyright = 'Jay Cox';
    \$date = '1998';

    \@inargs = (
	\&std_image_arg,
	{ name => 'tattoo', type => 'tattoo',
	  desc => 'The tattoo of the $_ to find' }
    );

    \@outargs = (
	{ name => '$_', type => '$_', init => 1,
	  desc => 'The $_ with the specified tattoo' }
    );

    \%invoke = (
	code => <<'CODE'
{
  $_ = gimp_image_get_${_}_by_tattoo (gimage, tattoo);
  success = $_ != NULL;
}
CODE
    );
}
SUB
}

sub preview_dim_args () {
    my @args;
    foreach (qw(width height bpp)) {
	push @args, { name => $_, type => 'int32', desc => "The previews $_", init => 1 };
    }
    @args;
}

sub image_thumbnail {
    $blurb = 'Get a thumbnail of an image.';

    $help = <<'HELP';
This function gets data from which a thumbnail of an image preview can be 
created. Maximum x or y dimension is 128 pixels. The pixels are returned in the
RGB[A] format. The bpp return value gives the number of bits per pixel in the 
image. If the image has an alpha channel, it is also returned.
HELP

    $author = $copyright = 'Andy Thomas';
    $date = '1999';

    @inargs = (
    	&std_image_arg,
	{ name => 'width', type => '0 < int32',
	  desc => 'The thumbnail width',
	  alias => 'req_width' },
	{ name => 'height', type => '0 < int32',
	  desc => 'The thumbnail height',
	  alias => 'req_height' }
    );

    @outargs = (
	&preview_dim_args,
        { name => 'thumbnail_data', type => 'int8array', wrap => 1,
	  desc => 'The thumbnail data', init => 1,
	  array => { name => 'thumbnail_data_count',
		     desc => 'The number of bytes in thumbnail data',
		     alias => 'num_bytes', init => 1 } }
    );
    $outargs[0]->{void_ret} = 1;

    %invoke = (
	headers => [ qw(<string.h>) ],
	code => <<'CODE'
{
  TempBuf * buf;
  gint dwidth, dheight;

  if (req_width <= 128 && req_height <= 128)
    {	
      /* Adjust the width/height ratio */
      dwidth = gimage->width;
      dheight = gimage->height;

      if (dwidth > dheight)
        req_height = (req_width * dheight) / dwidth;
      else
	req_width = (req_height * dwidth) / dheight;

      buf = gimp_viewable_get_new_preview (GIMP_VIEWABLE (gimage),
				           req_width,
				           req_height);
      num_bytes = buf->height * buf->width * buf->bytes;
      thumbnail_data = g_new (guint8, num_bytes);
      g_memmove (thumbnail_data, temp_buf_data (buf), num_bytes);
      width = buf->width;	
      height = buf->height;
      bpp = buf->bytes;
      temp_buf_free (buf);
    }
}
CODE
    );
}

sub image_get_tattoo_state {
    $blurb = 'Returns the tattoo state associated with the image.';

    $help = <<'HELP';
This procedure returns the tattoo state of the image. Use only by 
save/load plugins that wish to preserve an images tattoo state. Using this 
function at other times will produce unexpected results.
HELP

    $author = $copyright = 'Andy Thomas';
    $date = '2000';

    @inargs = ( &std_image_arg );

    @outargs = (
	{ name => 'tattoo', type => 'int32',
	  desc => 'The tattoo state associated with the image', init => 1  }
    );

    %invoke = (
	code => <<'CODE'
{
tattoo = gimp_image_get_tattoo_state(gimage);
}
CODE
    );
}

sub image_set_tattoo_state {
    $blurb = 'Set the tattoo state associated with the image.';

    $help = <<'HELP';
This procedure sets the tattoo state of the image. Use only by 
save/load plugins that wish to preserve an images tattoo state. Using this 
function at other times will produce unexpected results. A full check of 
uniqueness of states in layers, channels and paths will be performed by this
procedure and a execution failure will be returned if this fails. A failure 
will also be returned if the new tattoo state value is less than the maximum
tattoo value from all of the tattoos from the paths,layers and channels. After
the image data has been loaded and all the tattoos have been set then this is 
the last procedure that should be called. If effectively does a status check 
on the tattoo values that have been set to make sure that all is OK.
HELP

    $author = $copyright = 'Andy Thomas';
    $date = '2000';

    @inargs = (
	&std_image_arg,
	{ name => 'tattoo', type => 'int32',
	  desc => 'The new tattoo state of the image'
	}
    );

    %invoke = (
	code => <<'CODE'
{
	success = gimp_image_set_tattoo_state(gimage,tattoo);
}
CODE
    );
}

sub image_duplicate {
    $blurb = 'Duplicate the specified image';

    $help = <<'HELP';
This procedure duplicates the specified image, copying all layers, channels,
and image information.
HELP

    &std_pdb_misc;
    $date = '1997';

    @inargs = ( &std_image_arg );

    @outargs = ( 
	{ name => 'new_image', type => 'image',
	  desc => 'The new, duplicated image',
	  alias => 'new_gimage', init => 1 }
    );

    %invoke = (
	headers => [ qw("core/gimpimage-duplicate.h") ],
        code => <<'CODE'
success = (new_gimage = gimp_image_duplicate (gimage)) != NULL;
CODE
    );
}


@headers = qw(<string.h> "core/gimp.h" "core/gimpcontainer.h"
              "core/gimpcoreconfig.h" "core/gimplist.h" "core/gimpunit.h"
              "base/temp-buf.h" "libgimpmath/gimpmath.h"
              "libgimpbase/gimpbase.h"
              "libgimp/gimpintl.h");

$extra{app}->{code} = <<'CODE';
/* Yuup, this is somewhat unsmooth, to say the least */

static void
gimlist_cb (gpointer im,
	    gpointer data)
{
  GSList **l = (GSList **) data;
  *l = g_slist_prepend (*l, im);
}
CODE

unshift @procs, qw(image_list image_new image_delete image_base_type
                   image_resize image_scale image_crop
		   image_free_shadow
                   image_get_layers image_get_channels
		   image_active_drawable image_unset_active_channel
                   image_pick_correlate_layer
		   image_raise_layer image_lower_layer image_raise_layer_to_top
		   image_lower_layer_to_bottom
                   image_merge_visible_layers image_merge_down
                   image_flatten
                   image_add_layer image_remove_layer
                   image_add_layer_mask image_remove_layer_mask
                   image_raise_channel image_lower_channel
                   image_add_channel image_remove_channel
                   image_get_cmap image_set_cmap
                   image_undo_is_enabled image_undo_enable
		   image_undo_disable image_undo_freeze image_undo_thaw
		   image_clean_all image_floating_selection
		   image_floating_sel_attached_to image_thumbnail
		   image_set_tattoo_state image_get_tattoo_state
		   image_duplicate);
%exports = (app => [@procs], lib => [@procs]);

$desc = 'Image';

1;