gimp/tools/pdbgen/pdb/parasite.pdb

# The GIMP -- an image manipulation program
# Copyright (C) 1998 Jay Cox <jaycox@earthlink.net>

# 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 pdb_misc {
    $author = $copyright = 'Jay Cox';
    $date = '1998';
}

sub name_arg {{
    name => 'name',
    type => 'string',
    desc => "The name of the parasite to $_[0]"
}}

sub parasite_outarg {{
    name => 'parasite',
    type => 'parasite',
    desc => "The $_[0] parasite",
    init => 1
}}

sub drawable_arg () {{
    name => 'drawable',
    type => 'drawable',
    desc => 'The drawable'
}}

sub convert_proc {
    my ($pdb_type, $arg, $var, $core_type) = @_;
    my $desc = ($pdb_type =~ /^[aeiou]/ ? 'an ' : 'a ') . $pdb_type;

    foreach ($blurb, $help, $inargs[0]->{desc}) { s/the gimp/$desc/e }

    unshift @inargs, $arg;

    # ugly double substitution
    # gimp_parasite_copy -> GIMP_parasite_copy -> gimp_parasite_copy
    # because of a lack op perl knowledge :)  --Mitch

    $invoke{code} =~ s/gimp_parasite_copy/GIMP_parasite_copy/;

    $invoke{code} =~ s/gimp_/"gimp_$core_type\_"/e;
    $invoke{code} =~ s/gimp, /"$var, "/e;

    $invoke{code} =~ s/GIMP_parasite_copy/gimp_parasite_copy/;
}

# The defs

sub parasite_find {
    $blurb = 'Finds the named parasite.';

    $help = <<'HELP';
Finds and returns the named parasite that was previously attached to the gimp.
HELP

    &pdb_misc;

    @inargs = ( &name_arg('find') );

    @outargs = ( &parasite_outarg('found') );

    %invoke = (
	code => <<'CODE'
{
  parasite = gimp_parasite_copy (gimp_parasite_find (gimp, name));
  success = parasite != NULL;
}
CODE
    );
}

sub parasite_attach {
    $blurb = 'Add a parasite to the gimp.';

    $help = <<'HELP';
This procedure attaches a parasite to the gimp. It has no return values.
HELP

    &pdb_misc;

    @inargs = (
	{ name => 'parasite', type => 'parasite',
	  desc => 'The parasite to attach to the gimp' }
    );

    %invoke = ( code => 'gimp_parasite_attach (gimp, parasite);' );
}

sub parasite_detach {
    $blurb = 'Removes a parasite from the gimp.';

    $help = <<'HELP';
This procedure detaches a parasite from the gimp. It has no return values.
HELP

    &pdb_misc;

    @inargs = ( &name_arg('detach from the gimp.') );

    %invoke = ( code => 'gimp_parasite_detach (gimp, name);' );
}

sub parasite_list {
    $blurb = 'List all parasites.';

    $help = 'Returns a list of all currently attached parasites.';

    $author = $copyright = 'Marc Lehmann';
    $date = '1999';

    @outargs = (
	{ name => 'parasites', type => 'stringarray', void_ret => 1,
	  desc => 'The names of currently attached parasites',
	  array => { desc => 'The number of attached parasites' } }
    );

    %invoke = ( code => 'parasites = gimp_parasite_list (gimp, &num_parasites);' );
}

@headers = qw("core/gimp-parasites.h");

@procs = qw(parasite_find parasite_attach parasite_detach parasite_list);

@types = (
    ['drawable', '&drawable_arg' , 'GIMP_ITEM (drawable)', 'item'  ],
    ['image'   , '&std_image_arg', 'gimage',               'image' ]
);

foreach $type (@types) {
    foreach (@procs[0..3]) {
        my $desc = ($type->[0] =~ /^[aeiou]/ ? 'an ' : 'a ') . $type->[0];
        my $args = join(', ', map { /^&/ ? $_ : "'$_'" } @$type);
	my $pre = ""; my $post = "";

	if (/find/) { 
	    $pre = "\$blurb =~ s/\\.\$/ in $desc/;";
	}
	elsif (/list/) {
	    $pre = "\@inargs = ( $type->[1] );";
    	    $post = "\@inargs = ( $type->[1] ); \$outargs[0]->{init} = 1;";
	}

	eval <<SUB;
sub $type->[0]_$_ {
    \&$_;
    $pre
    &convert_proc($args);
    $post;
}
SUB

	push @procs, "$type->[0]_$_";
    }
}

%exports = (app => [@procs], lib => [@procs]);

$desc = 'Parasite procedures';

1;