Commit bd48a010 authored by Manish Singh's avatar Manish Singh
Browse files

More stuff

-Yosh
parent 4d171c21
......@@ -41,6 +41,25 @@ sub quotewrap {
$str;
}
sub format_code_frag {
my ($code, $indent) = @_;
chomp $code;
$code =~ s/\t/' ' x 8/eg;
if (!$indent && $code =~ /^\s*{\s*\n.*\n\s*}\s*$/s) {
$code =~ s/^\s*{\s*\n//s;
$code =~ s/\n\s*}\s*$//s;
}
else {
$code =~ s/^/' ' x ($indent ? 4 : 2)/meg;
}
$code =~ s/^ {8}/\t/mg;
$code .= "\n";
$code;
}
sub declare_args {
my $proc = shift;
my $out = shift;
......@@ -53,7 +72,7 @@ sub declare_args {
foreach (@args) {
my $arg = $arg_types{(&arg_parse($_->{type}))[0]};
if ($arg->{array} && (not exists $_->{array})) {
if ($arg->{array} && !exists $_->{array}) {
warn "Array without number of elements param in $proc->{name}";
}
......@@ -64,8 +83,8 @@ sub declare_args {
}
$result .= ";\n";
if (exists $arg->{id_headers}) {
foreach (@{$arg->{id_headers}}) {
if (exists $arg->{headers}) {
foreach (@{$arg->{headers}}) {
$out->{headers}->{$_}++;
}
}
......@@ -76,7 +95,7 @@ sub declare_args {
$result;
}
sub make_args {
sub make_arg_recs {
my $proc = shift;
my $result = "";
......@@ -86,8 +105,7 @@ sub make_args {
my @args = @{$proc->{$_}} if exists $proc->{$_};
if (scalar @args) {
$result .= "\nstatic ProcArg $proc->{name}_${_}[] =";
$result .= "\n{\n";
$result .= "\nstatic ProcArg $proc->{name}_${_}[] =\n{\n";
foreach $arg (@{$proc->{$_}}) {
my ($type, $name, @remove) = &arg_parse($arg->{type});
......@@ -115,7 +133,7 @@ sub make_args {
CODE
}
$result =~ s/,\n$/\n/;
$result =~ s/,\n$/\n/s;
$result .= "};\n";
}
}
......@@ -124,11 +142,10 @@ CODE
}
sub marshal_inargs {
my $proc = shift;
my ($proc, $argc) = @_;
my $result = "";
my %decls;
my $argc = 0;
my @inargs = @{$proc->{inargs}} if exists $proc->{inargs};
......@@ -139,19 +156,28 @@ sub marshal_inargs {
my $var = &arg_vname($_);
if (exists $arg->{id_func}) {
my $test = exists $_->{on_success} ? '!=' : '==';
$result .= <<CODE;
if (($var = $arg->{id_func} (args[$argc].value.pdb_$type)) $test NULL)
$var = $arg->{id_func} (args[$argc].value.pdb_$type);
CODE
$result .= <<CODE if exists $_->{on_success};
$_->{on_success}
else
CODE
$result .= ' ' x 4 . "success = FALSE;\n";
if (!exists $_->{no_success}) {
$result .= ' ' x 2 . "if ($var ";
$result .= exists $_->{on_success} ? '!=' : '==';
$result .= " NULL)\n";
if (exists $_->{on_success}) {
$result .= &format_code_frag($_->{on_success}, 1);
$result .= ' ' x 2 . "else\n";
}
$result .= ' ' x 4 . "success = FALSE;\n";
if (exists $_->{on_fail}) {
$result .= &format_code_frag($_->{on_fail}, 1);
}
$success = 1;
$success = 1;
}
}
else {
my $code = ' ' x 2 . "$var =";
......@@ -218,21 +244,35 @@ CODE
$code .= "$extra;\n";
}
}
if ($code =~ /success/) {
if ($success) {
$code =~ s/^/' ' x 4/meg;
$code =~ s/^ {8}/\t/mg;
if ($code =~ /success/) {
my $tests = 0;
$code .= ' ' x 4 . "}\n";
$result .= ' ' x 2 . "if (success)\n" . ' ' x 4 . "{\n";
}
else {
$success_init = 0;
}
if (exists $_->{on_success}) {
$code .= ' ' x 2 . "if (success)\n";
$code .= &format_code_frag($_->{on_success}, 1);
$tests++;
}
$success = 1;
if (exists $_->{on_fail}) {
$code .= ' ' x 2;
$code .= $tests ? "else\n" : "if (success)\n";
$code .= &format_code_frag($_->{on_fail}, 1);
}
if ($success) {
$code =~ s/^/' ' x 4/meg;
$code =~ s/^ {8}/\t/mg;
$code .= ' ' x 4 . "}\n";
$result .= ' ' x 2 . "if (success)\n" . ' ' x 4 . "{\n";
}
else {
$success_init = 0;
}
$success = 1;
}
}
$result .= $code;
......@@ -324,51 +364,128 @@ CODE
$out->{code} .= "\nstatic Argument *\n";
$out->{code} .= "${name}_invoker (Argument *args)\n{\n";
my $invoker = "";
$invoker .= ' ' x 2 . "Argument *return_args;\n" if scalar @outargs;
$invoker .= &declare_args($proc, $out, qw(inargs outargs));
my $code = "";
if (exists $proc->{invoke}->{pass_through}) {
my $invoke = $proc->{invoke};
if (exists $proc->{invoke}->{vars}) {
foreach (@{$proc->{invoke}->{vars}}) {
$invoker .= ' ' x 2 . $_ . ";\n";
my $argc = 0;
$argc += @{$invoke->{pass_args}} if exists $invoke->{pass_args};
$argc += @{$invoke->{make_args}} if exists $invoke->{make_args};
my %pass; my @passgroup;
my $before = 0; my $contig = 0; my $pos = -1;
if (exists $invoke->{pass_args}) {
foreach (@{$invoke->{pass_args}}) {
$pass{$_}++;
$_ - 1 == $before ? $contig = 1 : $pos++;
push @{$passgroup[$pos]}, $_;
$before = $_;
}
}
$code .= ' ' x 2 . "int i;\n" if $contig;
$code .= ' ' x 2 . "Argument argv[$argc];\n";
my $tempproc; $pos = 0;
foreach (@{$proc->{inargs}}) {
$_->{argpos} = $pos++;
push @{$tempproc->{inargs}}, $_ if !exists $pass{$_->{argpos}};
}
}
$invoker.= &marshal_inargs($proc);
$code .= &declare_args($tempproc, $out, qw(inargs)) . "\n";
$invoker .= "\n" if $invoker && $invoker !~ /\n\n/s;
my $marshal = "";
foreach (@{$tempproc->{inargs}}) {
my $argproc; $argproc->{inargs} = [ $_ ];
$marshal .= &marshal_inargs($argproc, $_->{argpos});
}
if ($success) {
$marshal .= <<CODE;
if (!success)
return procedural_db_return_args (\&${name}_proc, FALSE);
my $code = $proc->{invoke}->{code};
CODE
}
$marshal = substr($marshal, 1) if $marshal;
$code .= $marshal;
foreach (@passgroup) {
$code .= ($#$_ ? <<LOOP : <<CODE) . "\n";
for (i = $_->[0]; i < @{[ $_->[$#$_] + 1 ]}; i++)
argv[i] = args[i];
LOOP
argv[$_->[0]] = args[$_->[0]];
CODE
}
if (exists $invoke->{make_args}) {
$pos = 0;
foreach (@{$invoke->{make_args}}) {
while (exists $pass{$pos}) { $pos++ }
my $arg = $arg_types{(&arg_parse($_->{type}))[0]};
my $type = &arg_ptype($arg);
$code .= <<CODE;
argv[$pos].arg_type = PDB_$arg->{name};
CODE
chomp $code;
$code =~ s/\t/' ' x 8/eg;
my $frag = $_->{code};
$frag =~ s/%%arg%%/"argv[$pos].value.pdb_$type"/e;
$code .= &format_code_frag($frag, 0);
if ($code =~ /^\s*\{\s*\n.*\n\s*\}\s*$/s && !$success) {
$code =~ s/^\s*\{\s*\n//s;
$code =~ s/\n\s*}\s*$//s;
$pos++;
}
$code .= "\n";
}
$code .= <<CODE;
return $invoke->{pass_through}_invoker (argv);
}
CODE
}
else {
$code =~ s/^/' ' x 2/meg;
$code =~ s/^/' ' x 2/meg if $success;
}
$code =~ s/^ {8}/\t/mg;
my $invoker = "";
$invoker .= ' ' x 2 . "Argument *return_args;\n" if scalar @outargs;
$invoker .= &declare_args($proc, $out, qw(inargs outargs));
if (exists $proc->{invoke}->{vars}) {
foreach (@{$proc->{invoke}->{vars}}) {
$invoker .= ' ' x 2 . $_ . ";\n";
}
}
$invoker .= &marshal_inargs($proc, 0);
$invoker .= "\n" if $invoker && $invoker !~ /\n\n/s;
$code = ' ' x 2 . "if (success)\n" . $code if $success;
$success = ($code =~ /success =/) unless $success;
my $frag = &format_code_frag($proc->{invoke}->{code}, $success);
$frag = ' ' x 2 . "if (success)\n" . $frag if $success;
$success = ($frag =~ /success =/) unless $success;
$code .= $invoker . $frag;
$code .= "\n" if $frag =~ /\n\n/s || $invoker;
$code .= &marshal_outargs($proc) . "}\n";
}
if ($success) {
$success_init = 0 if $proc->{invoke}->{success} eq 'NONE';
$out->{code} .= ' ' x 2 . "gboolean success";
$out->{code} .= " = $proc->{invoke}->{success}" if $success_init;
$out->{code} .= ";\n";
my $header = ' ' x 2 . "gboolean success";
$header .= " = $proc->{invoke}->{success}" if $success_init;
$header .= ";\n";
$out->{code} .= $header;
}
$out->{code} .= $invoker . $code . "\n";
$out->{code} .= "\n" if $code =~ /\n/s || $invoker;
$out->{code} .= &marshal_outargs($proc) . "}\n";
$out->{code} .= $code;
$out->{code} .= &make_args($proc, qw(inargs outargs));
$out->{code} .= &make_arg_recs($proc, qw(inargs outargs));
$out->{code} .= <<CODE;
......
......@@ -18,12 +18,24 @@
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
BEGIN {
$srcdir = '.';
$destdir = '.';
}
use lib $srcdir;
use Text::Wrap qw(wrap $columns);
$columns = 79;
require 'util.pl';
eval <<'CODE';
*write_file = \&Gimp::CodeGen::util::write_file;
*FILE_EXT = \$Gimp::CodeGen::util::FILE_EXT;
CODE
$FILE_EXT = $FILE_EXT;
my $header = <<'HEADER';
:# The GIMP -- an image manipulation program
:# Copyright (C) 1999 Manish Singh <yosh@gimp.org>
......@@ -188,6 +200,8 @@ ENTRY
$code =~ s/,\n$/\n/s;
open OUTFILE, "> $destdir/enums.pl";
$outfile = "$destdir/enums.pl$FILE_EXT";
open OUTFILE, "> $outfile";
print OUTFILE $header, $code, $footer;
close OUTFILE;
&write_file($outfile);
......@@ -29,6 +29,18 @@ package Gimp::CodeGen::enums;
WEB_PALETTE => '2',
MONO_PALETTE => '3',
CUSTOM_PALETTE => '4' }
},
ChannelOffsetType =>
{ contig => 1,
symbols => [ qw(OFFSET_BACKGROUND OFFSET_TRANSPARENT) ],
mapping => { OFFSET_BACKGROUND => '0',
OFFSET_TRANSPARENT => '1' }
},
SizeType =>
{ contig => 1,
symbols => [ qw(PIXELS POINTS) ],
mapping => { PIXELS => '0',
POINTS => '1' }
}
);
......
......@@ -17,4 +17,4 @@
# Modify this list for the groups to parse in the pdb directory
@groups = qw(gdisplay edit floating_sel undo palette gradient
convert);
convert channel_ops text gimprc parasite);
......@@ -138,7 +138,7 @@ CODE
$return_marshal = "" unless $once++;
if (exists $_->{num}) {
if (not exists $_->{no_lib}) {
if (!exists $_->{no_lib}) {
$arglist .= "gint \*$_->{name}, ";
push @arraynums, $_;
}
......
......@@ -35,34 +35,37 @@ package Gimp::CodeGen::pdb;
display => { name => 'DISPLAY',
type => 'GDisplay *',
headers => [ qw("gdisplay.h") ],
id_func => 'gdisplay_get_ID',
id_ret_func => '$var->ID',
id_headers => [ qw("gdisplay.h") ] },
id_ret_func => '$var->ID' },
image => { name => 'IMAGE',
type => 'GimpImage *',
headers => [ qw("procedural_db.h") ],
id_func => 'pdb_id_to_image',
id_ret_func => 'pdb_image_to_id ($var)',
id_headers => [ qw("procedural_db.h") ] },
id_ret_func => 'pdb_image_to_id ($var)' },
layer => { name => 'LAYER',
type => 'GimpLayer *',
headers => [ qw("drawable.h" "layer.h") ],
id_func => 'layer_get_ID',
id_ret_func => 'drawable_ID (GIMP_DRAWABLE ($var))',
id_headers => [ qw("drawable.h" "layer.h") ] },
id_ret_func => 'drawable_ID (GIMP_DRAWABLE ($var))' },
channel => { name => 'CHANNEL',
type => 'Channel *',
headers => [ qw("drawable.h" "channel.h") ],
id_func => 'channel_get_ID',
id_ret_func => 'drawable_ID (GIMP_DRAWABLE ($var))',
id_headers => [ qw("drawable.h" "channel.h") ] },
id_ret_func => 'drawable_ID (GIMP_DRAWABLE ($var))' },
drawable => { name => 'DRAWABLE',
type => 'GimpDrawable *',
headers => [ qw("drawable.h") ],
id_func => 'gimp_drawable_get_ID',
id_ret_func => 'drawable_ID (GIMP_DRAWABLE ($var))',
id_headers => [ qw("drawable.h") ] },
id_ret_func => 'drawable_ID (GIMP_DRAWABLE ($var))' },
selection => { name => 'SELECTION',
type => 'Channel *',
headers => [ qw("drawable.h" "channel.h") ],
id_func => 'channel_get_ID',
id_ret_func => 'drawable_ID (GIMP_DRAWABLE ($var))',
id_headers => [ qw("drawable.h" "channel.h") ] },
id_ret_func => 'drawable_ID (GIMP_DRAWABLE ($var))' },
parasite => { name => 'PARASITE', type => 'Parasite *',
headers => [ qw("libgimp/parasite.h") ] },
boundary => { name => 'BOUNDARY', type => 'gpointer ' }, # ??? FIXME
path => { name => 'PATH' , type => 'gpointer ' }, # ??? FIXME
......@@ -97,11 +100,9 @@ sub arg_parse {
return @retvals;
}
elsif ($arg =~ /^([+-.\d].*?)? \s*
(<=|<)? \s*
(\w+) \s*
(<=|<)? \s*
([\d\.-].*?)?
elsif ($arg =~ /^(?:([+-.\d].*?) \s* (<=|<))?
\s* (\w+) \s*
(?:(<=|<) \s* ([+-.\d].*?))?
/x) {
return ($3, $1, $2 ? $testmap{$2} : $2, $5, $4 ? $testmap{$4} : $4);
}
......@@ -115,7 +116,7 @@ sub arg_ptype {
elsif ($arg->{type} =~ /\*/) { 'pointer' }
elsif ($arg->{type} =~ /boolean/) { 'int' }
elsif ($arg->{type} =~ /int/) { 'int' }
elsif ($arg->{type} =~ /float/) { 'float' }
elsif ($arg->{type} =~ /double/) { 'float' }
else { 'pointer' }
};
}
......
......@@ -38,7 +38,7 @@ HELP
desc => 'The drawable to offset' },
{ name => 'wrap_around', type => 'boolean',
desc => 'wrap image around or fill vacated regions' },
{ name => 'fill_type', type => 'enum GimpOffsetType',
{ name => 'fill_type', type => 'enum ChannelOffsetType',
desc => 'fill vacated regions of drawable with background or
transparent: %%desc%%' },
{ name => 'offset_x', type => 'int32',
......@@ -48,7 +48,7 @@ HELP
);
%invoke = (
headers => [ qw(channel_ops.h) ],
headers => [ qw("channel_ops.h") ],
vars => ['GimpImage *gimage'],
code => <<'CODE'
{
......
......@@ -47,7 +47,7 @@ HELP
if (gimage->layers == NULL)
success = FALSE;
else
success = ((gdisp = gdisplay_new (gimage, scale)) != NULL);
success = (gdisp = gdisplay_new (gimage, scale)) != NULL;
}
CODE
);
......
......@@ -47,7 +47,7 @@ HELP
if (gimage->layers == NULL)
success = FALSE;
else
success = ((gdisp = gdisplay_new (gimage, scale)) != NULL);
success = (gdisp = gdisplay_new (gimage, scale)) != NULL;
}
CODE
);
......
# 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>
# The defs
sub gimprc_query {
$blurb = <<'BLURB';
Queries the gimprc file parser for information on a specified token.
BLURB
$help = <<'HELP';
This procedure is used to locate additional information contained in the gimprc
file considered extraneous to the operation of the GIMP. Plug-ins that need
configuration information can expect it will be stored in the user's gimprc
file and can use this procedure to retrieve it. This query procedure will
return the value associated with the specified token. This corresponds _only_
to entries with the format: (<token> <value>). The value must be a string.
Entries not corresponding to this format will cause warnings to be issued on
gimprc parsing a nd will not be queryable.
HELP
&std_pdb_misc;
$date = '1997';
@inargs = (
{ name => 'token', type => 'string',
desc => 'The token to query for' }
);
@outargs = (
{ name => 'value', type => 'string',
desc => 'The value associated with the queried token',
alias => 'g_strdup (value)', no_declare => 1 }
);
%invoke = (
headers => [ qw("gimprc.h") ],
vars => ['gchar *value'],
code => 'success = (value = gimprc_find_token (token)) != NULL;'
);
}
@procs = qw(gimprc_query);
%exports = (app => [@procs]);
$desc = 'Gimprc procedures';
1;
......@@ -36,7 +36,7 @@ HELP
@inargs = (
{ name => 'name', type => 'string',
desc => 'The gradient name ("" means current active gradient)' }
desc => 'The gradient name ("" means current active gradient)' },
{ name => 'sample_size', type => '0 < int32 < 10000',
desc => 'The size of the sample to return when the gradient is
changed $desc',
......
......@@ -161,7 +161,7 @@ Fill the area specified either by the current selection if there is one, or by
a seed fill starting at the specified coordinates.
BLURB
$help = <<'HELP'
$help = <<'HELP';
This tool requires information on the paint application mode, and the fill
mode, which can either be in the foreground color, or in the currently active
pattern. If there is no selection, a seed fill is executed at the specified
......@@ -172,12 +172,12 @@ the composite image will be used instead of that for the specified drawable.
This is equivalent to sampling for colors after merging all visible layers. In
the case of merged sampling, the x,y coordinates are relative to the image's
origin; otherwise, they are relative to the drawable's origin.
HELP;
HELP
&std_pdb_misc;
my $validity = 'This parameter is only valid when there is no selection in
the specified image.'
the specified image.';
my $coord = "The \$a coordinate of this bucket fill's application.
$validity";
......@@ -187,16 +187,16 @@ HELP;
desc => 'The type of fill: %%desc%%' },
{ name => paint_mode, type => 'enum PaintMode',
desc => 'The paint application mode: %%desc%%' },
{ name => opacity, type => '0 <= float <= 100',
{ name => 'opacity', type => '0 <= float <= 100',
desc => 'The opacity of the final bucket fill %%desc%%' },
{ name => threshold, type => '0 <= float <= 255',
{ name => 'threshold', type => '0 <= float <= 255',
desc => "The threshold determines how extensive the seed fill will
be. It's value is specified in terms of intensity levels
%%desc%%. $validity" },
&sample_merged_arg,