Gimp/tools/pdbgen/pdb/channel.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 channel_arg () {{
    name => 'channel',
    type => 'channel',
    desc => 'The channel'
}}

sub operation_arg () {{
    name => 'operation',
    type => 'enum GimpChannelOps',
    desc => 'The selection operation: { %%desc%% }'
}}

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

    $core_type = 'channel' unless $core_type;
    $core_var  = 'channel' unless $core_var;

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

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

    &std_pdb_misc;

    @inargs = ( &channel_arg );

    @outargs = (
	{ name => $prop, type => $type,
	  desc => "The channel $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";

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

	$invoke{headers} = [ qw("core/gimpimage.h") ];

	$invoke{code} = <<'CODE'
{
  gimp_channel_get_color (channel, &color);
}
CODE
    }
}

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

    $core_type = 'channel' unless $core_type;
    $core_var  = 'channel' unless $core_var;

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

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

    &std_pdb_misc;

    @inargs = (
	&channel_arg,
	{ name => $prop, type => $type,
	  desc => "The new channel $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);";

    if ($type eq 'color') {
	%invoke = (
	    code => <<'CODE'
{
  GimpRGB rgb_color = color;

  rgb_color.a = channel->color.a;
  gimp_channel_set_color (channel, &rgb_color, TRUE);
}
CODE
	);
    }
}

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

    $core_type = 'channel' unless $core_type;
    $core_var  = 'channel' unless $core_var;

    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 = "channel_${_}_$prop";

	push @procs, $proc;

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

sub channel_new {
    $blurb = 'Create a new channel.';

    $help = <<'HELP';
This procedure creates a new channel with the specified width and height. Name,
opacity, and color are also supplied parameters. The new channel still needs to
be added to the image, as this is not automatic. Add the new channel with the
'gimp_image_add_channel' command. Other attributes such as channel show masked,
should be set with explicit procedure calls. The channel's contents are
undefined initially.
HELP

    &std_pdb_misc;

    @inargs = (
	&std_image_arg,
	{ name => 'width', type => '0 < int32',
	  desc => 'The channel width: (%%desc%%)' },
	{ name => 'height', type => '0 < int32',
	  desc => 'The channel height: (%%desc%%)' },
	{ name => 'name', type => 'string',
	  desc => 'The channel name' },
	{ name => 'opacity', type => '0 <= float <= 100',
	  desc => 'The channel opacity: (%%desc%%)' },
	{ name => 'color', type => 'color',
	  desc => 'The channel compositing color'
	}
    );
    $inargs[0]->{desc} .= ' to which to add the channel';

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

    %invoke = (
	code => <<'CODE'
{
  GimpRGB rgb_color = color;

  rgb_color.a = opacity / 100.0;
  channel = gimp_channel_new (gimage, width, height, name, &rgb_color);
  success = channel != NULL;
}
CODE
    );
}

sub channel_copy {
    $blurb = 'Copy a channel.';

    $help = <<'HELP';
This procedure copies the specified channel and returns the copy.
HELP

    &std_pdb_misc;

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

    @outargs = (
	{ name => 'channel_copy', type => 'channel', init => 1,
	  desc => 'The newly copied channel', alias => 'copy' }
    );

    %invoke = ( code => 'success = (copy = GIMP_CHANNEL (gimp_item_duplicate (GIMP_ITEM (channel), G_TYPE_FROM_INSTANCE (channel), FALSE))) != NULL;' );
}

sub channel_delete {
    $blurb = 'Delete a channel.';

    $help = <<'HELP';
This procedure deletes the specified channel. This must not be done if the 
gimage containing this channel was already deleted or if the channel was 
already removed from the image. The only case in which this procedure is
useful is if you want to get rid of a channel which has not yet been
added to an image.
HELP

    &std_pdb_misc;

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

    %invoke = ( code => <<'CODE' );
{
  if (! gimp_item_get_image (GIMP_ITEM (channel)))
    {
      g_object_unref (channel);
      success = TRUE;
    }

}
CODE
}

sub channel_combine_masks {
    $blurb = 'Combine two channel masks.';

    $help = <<'HELP';
This procedure combines two channel masks.  The result is stored
in the first channel.
HELP

    &std_pdb_misc;

    @inargs = ( &channel_arg, &channel_arg, &operation_arg );
	       
    foreach my $i (0,1) {
        foreach my $unused (qw(name desc)) {
  	  $inargs[$i]{$unused} .= $i + 1;
        }
    }

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

    %invoke = (
        headers => [ qw("core/gimpchannel-combine.h") ],
        code => <<'CODE'
{
  gimp_channel_combine_mask (channel1, channel2, operation, offx, offy);
}
CODE
    );
}

&channel_accessors('name', 'string', 'name', 0, [ undef, <<'CODE' ],
$invoke{code} =~ s/gimp_object_set_name/gimp_item_rename/;
$invoke{code} =~ s/GIMP_OBJECT/GIMP_ITEM/;
CODE
                   'object', 'GIMP_OBJECT (channel)');

&channel_accessors('visible', 'boolean', 'visibility', 1, undef,
                   'item', 'GIMP_ITEM (channel)');

&channel_accessors('show_masked', 'boolean', 'composite method', 0,
		   <<'CODE');
    $help .= <<'HELP'
If it is non-zero, then the channel is composited with the image so that masked
regions are shown. Otherwise, selected regions are shown.
HELP
CODE

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

&channel_accessors('color', 'color', 'compositing color', 0,
                   [ '$outargs[0]->{void_ret} = 1', '' ]);

&channel_accessors('tattoo', 'tattoo', 'tattoo', 0,
		   <<'CODE', 'item', 'GIMP_ITEM (channel)');
    $help .= <<'HELP';
A tattoo is a unique and permanent identifier attached to a channel that can be
used to uniquely identify a channel within an image even between sessions.
HELP

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

unshift @procs, qw(channel_new channel_copy channel_delete
		   channel_combine_masks);
%exports = (app => [@procs], lib => [@procs]);

$desc = 'Channel';

1;