# 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 ($type, $arg, $var) = @_;
    my $desc = ($type =~ /^[aeiou]/ ? 'an ' : 'a ') . $type;

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

    unshift @inargs, $arg;

    $invoke{code} =~ s/gimp/"gimp_$type"/e;
    $invoke{code} =~ s/\(((?!gimp).*?(?:parasite|name))/"($var, $1"/e;
}

# The defs

sub parasite_new {
    $blurb = 'Creates a new parasite.';

    $help = 'Creates a new parasite unatached to to any image or drawable.';

    &pdb_misc;

    @inargs = (
	&name_arg('create'),
	{ name => 'flags', type => 'int32',
	  desc => 'The flags (1 == persistance)' },
	{ name => 'size', type => '0 <= int32',
	  desc => 'The size of the data in bytes' },
	{ name => 'data', type => 'string',
	  desc => 'The data', no_success => 1 }
    );

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

    %invoke = (
	code => <<'CODE'
{
  if (size > 0 && data == NULL)
    success = FALSE;
  else
    success = (parasite = parasite_new (name, flags, size, data)) != NULL;
}
CODE
    );
}

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 = parasite_copy (gimp_parasite_find (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 (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 => 'name', type => 'string',
	  desc => 'The name of the parasite to detach from the gimp.' }
    );

    %invoke = ( code => 'gimp_parasite_detach (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',
	  desc => 'The names of currently attached parasites',
	  array => { desc => 'The number of attached parasites' } }
    );

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

@headers = qw("libgimp/parasite.h" "gimpparasite.h" "gimpdrawable.h"
	      "gimpimage.h");

$extra{lib}->{protos} = <<'CODE';
void gimp_parasite_attach_new (gchar    *name,
			       gint      flags,
			       gint      size,
			       gpointer  data);
CODE

$extra{lib}->{code} = <<'CODE';
void
gimp_parasite_attach_new (gchar    *name,
			  gint      flags,
			  gint      size,
			  gpointer  data)
{
  Parasite *p = parasite_new (name, flags, size, data);
  gimp_parasite_attach (p);
  parasite_free (p);
}

CODE

@procs = qw(parasite_new parasite_find parasite_attach parasite_detach
	    parasite_list);

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

my %code;

foreach $type (@types) {
    foreach (@procs[1..4]) {
        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]_$_";
    }

    foreach (qw(protos code)) {
	my $code = $extra{lib}->{$_};
	$code =~ s/\t/' ' x 8/eg;
	$code =~ s/gimp/gimp_$type->[0]/g;
	$code =~ s/^ {8}/' ' x (length($type->[0]) + 9)/meg;
	while ($code =~ /^\t* {8}/m) { $code =~ s/^(\t*) {8}/$1\t/mg }

	$code{$_} .= $code;
    }
}


foreach (qw(protos code)) {
    $extra{lib}->{$_} .= $code{$_};
}

chop $extra{lib}->{code};

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

$desc = 'Parasite procedures';

1;
