# 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 layer_dim_proc {
    my ($op, $morehelp, @args) = @_;

    $blurb = "\u$op the layer to the specified extents.";

    my $ops = $op =~ /e$/ ? "${op}s" : "${op}es";
    $help = <<HELP;
This procedure $ops the layer so that it's new width and height are equal to
the supplied parameters. $morehelp This operation only works if the layer has
been added to an image.
HELP

    &std_pdb_misc;

    @inargs = (
	&layer_arg,
	{ name => 'new_width', type => '0 < int32',
	  desc => 'New layer width: (%%desc%%)' },
	{ name => 'new_height', type => '0 < int32',
	  desc => 'New layer height: (%%desc%%)' },
    );
    push @inargs, @args;

    my $args = "";
    my $call;
    foreach (@args) {
	$args .= ', ' if $args;
	$args .= $_->{name};
    }

    if ($op eq 'scale') {
        $call = "gimp_item_scale_by_origin (GIMP_ITEM (layer), new_width, new_height, gimp->config->interpolation_type, NULL, $args);";
    } else {
        $call = "gimp_item_resize (GIMP_ITEM (layer), context, new_width, new_height, $args);";
    }

    $invoke{code} = <<"CODE";
{
  success = gimp_item_is_attached (GIMP_ITEM (layer));

  if (success)
    $call
}
CODE
}

sub layer_get_prop_proc {
    my ($prop, $type, $desc, $undo, $core_type, $core_var) = @_;

    $core_type = 'layer' unless $core_type;
    $core_var  = 'layer' unless $core_var;

    $blurb = "Get the $desc of the specified layer.";

    $help = "This procedure returns the specified layer's $desc. ";

    &std_pdb_misc;

    @inargs = ( &layer_arg );

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

    my $alias = "gimp_${core_type}_get_$prop ($core_var)";
    $alias = "g_strdup ($alias)" if $type eq 'string';
    $outargs[0]->{alias} .= "$alias";
}

sub layer_set_prop_proc {
    my ($prop, $type, $desc, $undo, $core_type, $core_var) = @_;

    $core_type = 'layer' unless $core_type;
    $core_var  = 'layer' unless $core_var;

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

    $help = "This procedure sets the specified layer's $desc. ";

    &std_pdb_misc;

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

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

    $invoke{code} = $undo ? "gimp_${core_type}_set_$prop ($core_var, $prop, TRUE);"
                          : "gimp_${core_type}_set_$prop ($core_var, $prop);";
}

sub layer_accessors {
    my ($prop, $type, $desc, $setting, $undo, $extra, $core_type, $core_var) = @_;

    $core_type = 'layer' unless $core_type;
    $core_var  = 'layer' unless $core_var;

    my (@extra, %extra); my $once = 0;

     my $change = "s/ ($desc)/'s \$1 setting/";
    (my $common = "\n; foreach (\$blurb, \$help) { $change }") =~ s/'s//;

    my %modify = (
	get => "$common \$outargs[0]->{desc} =~ $change;",
	set => "$common \$inargs[1]->{desc}  =~ $change;",
    );

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

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

	push @procs, $proc;

	eval <<SUB;
sub @{[ scalar caller ]}::$proc {
    \&layer_${_}_prop_proc('$prop', '$type', '$desc', $undo,
                           '$core_type', '$core_var');
    $extra{$_}
    @{[ $setting ? $modify{$_} : "" ]}
}
SUB
    }
}

sub layer_new {
    $blurb = 'Create a new layer.';

    $help = <<'HELP';
This procedure creates a new layer with the specified width, height, and type.
Name, opacity, and mode are also supplied parameters. The new layer still needs
to be added to the image, as this is not automatic. Add the new layer with the
'gimp_image_add_layer' command. Other attributes such as layer mask modes, and
offsets should be set with explicit procedure calls.
HELP

    &std_pdb_misc;

    @inargs = (
	&std_image_arg,
	{ name => 'width', type => '0 < int32',
	  desc => 'The layer width: (%%desc%%)' },
	{ name => 'height', type => '0 < int32',
	  desc => 'The layer height: (%%desc%%)' },
	{ name => 'type', type => 'enum GimpImageType',
	  desc => 'The layer type: { %%desc%% }' },
	{ name => 'name', type => 'string',
	  desc => 'The layer name', null_ok => 1 },
	{ name => 'opacity', type => '0 <= float <= 100',
	  desc => 'The layer opacity: (%%desc%%)' },
	{ name => 'mode', type => 'enum GimpLayerModeEffects',
	  desc => 'The layer combination mode: { %%desc%% }' }
    );
    $inargs[0]->{desc} .= ' to which to add the layer';

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

    %invoke = (
	code => <<'CODE'
{
  layer = gimp_layer_new (gimage,
                          width, height,
			  type,
                          name,
			  opacity / 100.0, mode);
  success = (layer != NULL);
}
CODE
    );
}

sub layer_copy {
    $blurb = 'Copy a layer.';

    $help = <<'HELP';
This procedure copies the specified layer and returns the copy. The newly
copied layer is for use within the original layer's image. It should not be
subsequently added to any other image. The copied layer can optionally have an
added alpha channel. This is useful if the background layer in an image is
being copied and added to the same image.
HELP

    &std_pdb_misc;

    @inargs = (
	&layer_arg,
	{ name => 'add_alpha', type => 'boolean',
	  desc => 'Add an alpha channel to the copied layer' }
    );
    $inargs[0]->{desc} .= ' to copy';

    @outargs = (
	{ name => 'layer_copy', type => 'layer', init => 1, wrap => 1,
	  desc => 'The newly copied layer' }
    );

    %invoke = (
	code => 'success = (layer_copy = GIMP_LAYER (gimp_item_duplicate (GIMP_ITEM (layer), G_TYPE_FROM_INSTANCE (layer), add_alpha))) != NULL;'
    );
}

sub layer_create_mask {
    $blurb = 'Create a layer mask for the specified specified layer.';

    $help = <<'HELP';
This procedure creates a layer mask for the specified layer. Layer masks serve
as an additional alpha channel for a layer. A number of ifferent types of
masks are allowed for initialisation: completely white masks (which will
leave the layer fully visible), completely black masks (which will give the
layer complete transparency, the layer's already existing alpha channel
(which will leave the layer fully visible, but which may be more useful than
a white mask), the current selection or a grayscale copy of the layer. The
layer mask still needs to be added to the layer. This can be done with a call
to 'gimp_layer_add_mask'.
HELP

    &std_pdb_misc;

    @inargs = (
	&layer_arg,
 	{ name => 'mask_type', type => 'enum GimpAddMaskType',
	  desc => 'The type of mask: { %%desc%% }' }
    );
    $inargs[0]->{desc} .= ' to which to add the mask';

    @outargs = (
	{ name => 'mask', type => 'layer_mask',
	  desc => 'The newly created mask', init => 1 }
    );

    %invoke = (
	code => <<'CODE'
success = (mask = gimp_layer_create_mask (layer, (GimpAddMaskType) mask_type)) != NULL;
CODE
    );
}

sub layer_add_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 = (
	&layer_arg,
	{ name => 'mask', type => 'layer_mask',
	  desc => 'The mask to add to the layer' }
    );
    $inargs[0]->{desc} .= ' to receive the mask';

    %invoke = (
	code => <<'CODE'
{
  success = gimp_item_is_attached (GIMP_ITEM (layer));

  if (success)
    gimp_layer_add_mask (layer, mask, TRUE);
}
CODE
    );
}

sub layer_remove_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 = (
	&layer_arg,
	{ name => 'mode', type => 'enum GimpMaskApplyMode',
	  desc => 'Removal mode: { %%desc%% }' }
    );
    $inargs[0]->{desc} .= ' from which to remove mask';

    %invoke = ( code => <<'CODE'
{
  success = gimp_item_is_attached (GIMP_ITEM (layer));

  if (success)
    gimp_layer_apply_mask (layer, mode, TRUE);
}
CODE
    );
}

sub layer_scale {
    my $arg = { name => 'local_origin', type => 'boolean',
		desc => 'Use a local origin (as opposed to the image origin)' };

    &layer_dim_proc('scale', <<'HELP', $arg);
The "local_origin" parameter specifies whether to scale from the center of the
layer, or from the image origin.
HELP
}

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

    &layer_dim_proc('resize', <<'HELP', @args);
Offsets are also provided which describe the position of the previous layer's
content.
HELP
}

sub layer_resize_to_image_size {
    $blurb = 'Resize a layer to the image size.';

    $help = <<'HELP';
This procedure resizes the layer so that it's new width and height are equal to
the width and height of its image container.
HELP

    $author = $copyright = 'Manish Singh';
    $date = '2003';

    @inargs = ( &layer_arg );
    $inargs[0]->{desc} .= ' to resize';

    %invoke = ( code => <<'CODE' );
{
  success = gimp_item_is_attached (GIMP_ITEM (layer));

  if (success)
    gimp_layer_resize_to_image (layer, context);
}
CODE
}

sub layer_translate {
    $blurb = 'Translate the layer by the specified offsets.';

    $help = <<'HELP';
This procedure translates the layer by the amounts specified in the x and y
arguments. These can be negative, and are considered offsets from the current
position. This command only works if the layer has been added to an image. All
additional layers contained in the image which have the linked flag set to TRUE
w ill also be translated by the specified offsets.
HELP

    &std_pdb_misc;

    @inargs = ( &layer_arg );
    foreach (qw(x y)) {
	push @inargs, { name => "off$_", type => 'int32',
			desc => "Offset in $_ direction" }
    }

    %invoke = ( code => <<'CODE');
{
  GimpImage *gimage = gimp_item_get_image (GIMP_ITEM (layer));

  gimp_image_undo_group_start (gimage, GIMP_UNDO_GROUP_ITEM_DISPLACE,
                               _("Move Layer"));

  gimp_item_translate (GIMP_ITEM (layer), offx, offy, TRUE);

  if (gimp_item_get_linked (GIMP_ITEM (layer)))
    gimp_item_linked_translate (GIMP_ITEM (layer), offx, offy, TRUE);

  gimp_image_undo_group_end (gimage);
}
CODE
}

sub layer_add_alpha {
    $blurb = <<'BLURB';
Add an alpha channel to the layer if it doesn't already have one.
BLURB

    $help = <<'HELP';
This procedure adds an additional component to the specified layer if it does
not already possess an alpha channel. An alpha channel makes it possible to
move a layer from the bottom of the layer stack and to clear and erase to
transparency, instead of the background color. This transforms images of type
RGB to RGBA, GRAY to GRAYA, and INDEXED to INDEXEDA.
HELP

    &std_pdb_misc;

    @inargs = ( &layer_arg );

    %invoke = ( code => 'gimp_layer_add_alpha (layer);' );
}

sub layer_set_offsets {
    &layer_translate;

    $blurb = 'Set the layer offsets.';

    $help = <<'HELP';
This procedure sets the offsets for the specified layer. The offsets are
relative to the image origin and can be any values. This operation is valid
only on layers which have been added to an image.
HELP

    foreach (qw(x y)) {
	$invoke{code} =~
	    s/(off$_),/$1 - GIMP_ITEM (layer)->offset_$_,/;
    }
}

sub layer_get_mask {
    $blurb = "Get the specified layer's mask if it exists.";

    $help = <<'HELP';
This procedure returns the specified layer's mask, or -1 if none exists.
HELP

    &std_pdb_misc;

    @inargs = ( &layer_arg );

    @outargs = (
	{ name => 'mask', type => 'channel',
	  desc => 'The layer mask',
	  alias => 'layer->mask', no_declare => 1,
	  return_fail => -1 }
    );
}

sub layer_from_mask {
    $blurb = "Get the specified mask's layer.";

    $help = <<'HELP';
This procedure returns the specified mask's layer , or -1 if none exists.
HELP

    $author = $copyright = 'Geert Jordaens';
    $date = '2004';

    $since = '2.2';

    @inargs = (
        { name => 'mask', type => 'layer_mask',
          desc => 'Mask for which to return the layer' }
    );

    @outargs = (
        { name => 'layer', type => 'layer', init => 1,
          desc => 'The mask\'s layer',
	  return_fail => -1 }
    );

    %invoke = (
        code => <<'CODE'
{
  layer = gimp_layer_mask_get_layer (mask);
}
CODE
    );
}

sub layer_is_floating_sel {
    $blurb = 'Is the specified layer a floating selection?';

    $help = <<'HELP';
This procedure returns whether the layer is a floating selection. Floating
selections are special cases of layers which are attached to a specific
drawable.
HELP

    &std_pdb_misc;

    @inargs = ( &layer_arg );

    @outargs = (
	{ name => 'is_floating_sel', type => 'boolean',
	  desc => 'Non-zero if the layer is a floating selection',
	  alias => 'gimp_layer_is_floating_sel (layer)', no_declare => 1 }
    );
}

sub layer_new_from_drawable {
    $blurb = 'Create a new layer by copying an existing drawable.';

    $help = <<'HELP';
This procedure creates a new layer as a copy of the specified drawable.  The
new layer still needs to be added to the image, as this is not automatic.  Add
the new layer with the 'gimp_image_add_layer' command. Other attributes such
as layer mask modes, and offsets should be set with explicit procedure calls.
HELP

    &std_pdb_misc;

    @inargs = (
	{ name => 'drawable', type => 'drawable',
	  desc => 'The source drawable from where the new layer is copied' },
	{ name => 'dest_image', type => 'image',
	  desc => 'The destination image to which to add the layer' }
     );

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

    %invoke = (
	code => <<'CODE'
{
  GType     new_type;
  GimpItem *new_item;

  if (GIMP_IS_LAYER (drawable))
    new_type = G_TYPE_FROM_INSTANCE (drawable);
  else
    new_type = GIMP_TYPE_LAYER;

  if (dest_image == gimp_item_get_image (GIMP_ITEM (drawable)))
    new_item = gimp_item_duplicate (GIMP_ITEM (drawable), new_type, TRUE);
  else
    new_item = gimp_item_convert (GIMP_ITEM (drawable), dest_image, new_type, TRUE);

  if (new_item)
    layer_copy = GIMP_LAYER (new_item);
  else
    success = FALSE;
}
CODE
    );
}

&layer_accessors('preserve_trans', 'boolean', 'preserve transperancy', 1, 1);

&layer_accessors('apply_mask', 'boolean', 'apply mask', 0, 0,
		 [ <<'CODE1', <<'CODE2' ]);
    $help .= <<'HELP';
If the value is non-zero, then the layer mask for this layer is currently being
composited with the layer's alpha channel.
HELP
CODE1
    $help .= <<'HELP';
This controls whether the layer's mask is currently affecting the alpha
channel. If there is no layer mask, this function will return an error.
HELP
CODE2

&layer_accessors('show_mask', 'boolean', 'show mask', 0, 0,
		 [ <<'CODE1', <<'CODE2' ]);
    $help .= <<'HELP';
If the value is non-zero, then the layer mask for this layer is currently being
shown instead of the layer.
HELP
CODE1
    $help .= <<'HELP';
This controls whether the layer or it's mask is visible. Non-zero values
indicate that the mask should be visible. If the layer has no mask, then this
function returns an error.
HELP
CODE2

&layer_accessors('edit_mask', 'boolean', 'show mask', 0, 0,
		 [ <<'CODE1', <<'CODE2' ]);
    $help .= <<'HELP';
 If the value is non-zero, then the layer mask for this layer is currently
active, and not the layer.
HELP
CODE1
    $help .= <<'HELP';
This controls whether the layer or it's mask is currently active for editing.
If the specified layer has no layer mask, then this procedure will return an
error.
HELP
CODE2

&layer_accessors('opacity', '0 <= float <= 100', 'opacity', 0, 1,
		 [ '$outargs[0]->{alias} =
		        "gimp_layer_get_opacity (layer) * 100.0"',
		   '$invoke{code} =~
			s%opacity, %opacity / 100.0, %' ]);

&layer_accessors('mode', 'enum GimpLayerModeEffects', 'combination mode', 0, 1);

@headers = qw("config/gimpcoreconfig.h" "core/gimp.h" "core/gimpimage-undo.h"
              "core/gimpitem-linked.h" "pdb_glue.h" "gimp-intl.h");

unshift @procs, qw(layer_new layer_new_from_drawable layer_copy
                   layer_add_alpha
                   layer_scale layer_resize layer_resize_to_image_size
		   layer_translate layer_set_offsets
                   layer_create_mask layer_get_mask layer_from_mask
                   layer_add_mask layer_remove_mask
		   layer_is_floating_sel);
%exports = (app => [@procs], lib => [@procs]);

$desc = 'Layer';

1;