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 => [ 'GSList *list = NULL', 'int i' ],
	code => <<CODE
{
  list = gimage->${type}s;
  num_${type}s = g_slist_length (list);

  if (num_${type}s)
    {
      ${type}_ids = g_new (gint32, num_${type}s);
      for (i = 0; i < num_${type}s; i++, list = list->next)
	${type}_ids[i] = drawable_ID (GIMP_DRAWABLE (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 = gimage_${op}_$type$extra (gimage, $type) != NULL;"
    );
}

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

    $blurb = "Returns the $desc of the specified image.";

    $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 ? "gimage_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{headers} = [ qw("gimpimage.h") ];

	$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) = @_;

    $blurb = "Set the $desc of the specified image.";

    $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 ? "gimage_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 list_images {
    $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 = .*$/gimage_foreach (gimlist_cb, &list);/m;
	s/DRAWABLE/IMAGE/;
	s/drawable_ID/pdb_image_to_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 = gimage_new (width, height, type)) != 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("cursorutil.h") ],
	code => <<'CODE'
{
  gimp_add_busy_cursors_until_idle ();
  gimage_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 = (
	code => <<'CODE'
{
  gimp_add_busy_cursors_until_idle ();
  gimage_scale (gimage, new_width, new_height);
}
CODE
    );
}

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

    $help = <<'HELP';
If there are no other references to this image it will be deleted. Other
references are possible when more than one view to an image exists.
HELP

    &std_pdb_misc;

    @inargs = ( &std_image_arg );

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

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 => 'gimage_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 => 'gimage_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 = gimage_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 MergeType (no FLATTEN_IMAGE)',
	  desc => 'The type of merge: { %%desc%% }' }
    );

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

    %invoke = (
	code => <<'CODE'
{
  layer = gimage_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 MergeType (no FLATTEN_IMAGE)',
	  desc => 'The type of merge: { %%desc%% }' }
    );

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

    %invoke = (
	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 = (
	code => 'success = (layer = gimage_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} = "{\n  if ("; my $once = 0;
    foreach (qw(color gray indexed)) {
	my $base = $_ eq 'color' ? 'RGB' : uc($_);
	$invoke{code} .= ' ' x 6 if $once++;
	$invoke{code} .= <<CODE
(drawable_$_ (GIMP_DRAWABLE (layer)) && gimage_base_type (gimage) != $base) ||
CODE
    }
    $invoke{code} =~ s/ \|\|\n$/)\n/s;

    $invoke{code} .= <<'CODE';
    success = FALSE;
  else
    success = gimage_add_layer (gimage, layer, MAX (position, -1)) != NULL;
}
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 => 'gimage_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 = gimage_add_layer_mask (gimage, layer, mask) != 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 MaskApplyMode',
	  desc => 'Removal mode: { %%desc%% }' }
    );
    $inargs[1]->{desc} .= ' from which to remove mask';

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

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 = gimage_add_channel (gimage, channel, MAX (position, -1)) != NULL;
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 => 'gimage_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 = gimage_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 = gimage_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 INDEXED, this pointer will be NULL.
HELP

    &std_pdb_misc;

    @inargs = ( &std_image_arg );

    @outargs = (
	{ name => 'cmap', type => 'int8array', init => 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 (gint8, num_bytes);
  memcpy (cmap, gimage_cmap (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',
	  desc => "The new colormap values",
	  array => { name => 'num_bytes', type => '0 <= int32 <= 768',
		     desc => 'Number of bytes in the colormap array:
			      %%desc%%' } }
    );

    %invoke = (
	headers => [ qw("gdisplay.h") ],
	code => <<'CODE'
{
  if (gimage->num_cols && gimage->cmap)
    {
      g_free (gimage->cmap);
      gimage->cmap = NULL;
    }
  if (num_bytes)
    {
      gimage->cmap = g_new (guchar, COLORMAP_SIZE);
      memcpy (gimage->cmap, cmap, num_bytes);
    }
  gimage->num_cols = num_bytes / 3;

  /* A colormap alteration affects the whole image */
  gdisplays_update_area (gimage, 0, 0, gimage->width, gimage->height);
}
CODE
    );
}

sub image_enable_undo {
    $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_disable_undo' 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 = gimage_enable_undo (gimage);' );
}

sub image_disable_undo {
    $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_enable_undo' 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 = gimage_disable_undo (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 cre
ating 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 => 'gimage_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 = gimage_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 = (
	headers => [ qw("layer_pvt.h") ],
	vars => [ 'Layer *floating_sel' ],
	code => <<'CODE'
{
  floating_sel = gimage_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 width. 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 = gimage_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 ChannelType (no AUXILLARY_CHANNEL)',
			     desc => 'The image component: { %%desc%% }' });

    $invoke{code} = <<'SUCCESS';
{
  if (component == GRAY_CHANNEL)
    success = gimage_base_type (gimage) == GRAY;
  else if (component == INDEXED_CHANNEL)
    success = gimage_base_type (gimage) == INDEXED;
  else
    success = gimage_base_type (gimage) == 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, and 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/get_//;
CODE

&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]} };

    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->{alias} = "gimage->$arg->{name}";
	$arg->{no_declare} = 1;
	$arg->{desc} .= "in the $coord-axis, in dots per inch";
	$count++;
    }
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 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 pixles are returned 
in the RGB[A] format. The bpp return value gives the number of bytes in 
the image. The alpha channel also returned if the image has one.
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',
	  desc => 'The thumbnail data', init => 1,
	  array => { name => 'thumbnail_data_count',
		     desc => 'The number of pixels in thumbnail data',
		     alias => 'num_pixels', init => 1 } }
    );

    %invoke = (
	headers => [ qw(<glib.h> <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_image_construct_composite_preview(gimage,req_width,req_height);
	  num_pixels = buf->height * buf->width * buf->bytes;
	  thumbnail_data = (gint8 *)g_new (gint8, num_pixels);
          g_memmove (thumbnail_data, temp_buf_data (buf), num_pixels);
	  width = buf->width;	
	  height = buf->height;
	  bpp = buf->bytes;
	}
}
CODE
    );
}


@headers = qw(<string.h> "gimage.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(list_images image_new image_resize image_scale image_delete
		   image_free_shadow image_get_layers image_get_channels
		   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_active_drawable image_base_type image_get_cmap
		   image_set_cmap image_enable_undo image_disable_undo
		   image_clean_all image_floating_selection
		   image_floating_sel_attached_to image_thumbnail);
%exports = (app => [@procs]);

$desc = 'Image';

1;