More stuff

-Yosh
This commit is contained in:
Manish Singh 1999-03-21 02:14:08 +00:00
parent 4d171c215e
commit bd48a01053
18 changed files with 507 additions and 180 deletions

View File

@ -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";
$success = 1;
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;
}
}
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";
if (exists $_->{on_success}) {
$code .= ' ' x 2 . "if (success)\n";
$code .= &format_code_frag($_->{on_success}, 1);
$tests++;
}
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;
}
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}->{vars}) {
foreach (@{$proc->{invoke}->{vars}}) {
$invoker .= ' ' x 2 . $_ . ";\n";
if (exists $proc->{invoke}->{pass_through}) {
my $invoke = $proc->{invoke};
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});
}
my $code = $proc->{invoke}->{code};
if ($success) {
$marshal .= <<CODE;
if (!success)
return procedural_db_return_args (\&${name}_proc, FALSE);
chomp $code;
$code =~ s/\t/' ' x 8/eg;
CODE
}
if ($code =~ /^\s*\{\s*\n.*\n\s*\}\s*$/s && !$success) {
$code =~ s/^\s*\{\s*\n//s;
$code =~ s/\n\s*}\s*$//s;
$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
my $frag = $_->{code};
$frag =~ s/%%arg%%/"argv[$pos].value.pdb_$type"/e;
$code .= &format_code_frag($frag, 0);
$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));
$code = ' ' x 2 . "if (success)\n" . $code if $success;
$success = ($code =~ /success =/) unless $success;
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;
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;

View File

@ -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);

View File

@ -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' }
}
);

View File

@ -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);

View File

@ -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, $_;
}

View File

@ -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' }
};
}

View File

@ -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'
{

View File

@ -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
);

View File

@ -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
);

View File

@ -0,0 +1,64 @@
# 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;

View File

@ -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',

View File

@ -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,
{ name => x, type => 'float',
{ name => 'x', type => 'float',
desc => eval qq/{\$a = 'x'; "$coord";}/ },
{ name => y, type => 'float',
{ name => 'y', type => 'float',
desc => eval qq/{\$a = 'y';"$coord";}/ }
);
@ -214,12 +214,12 @@ CODE
}
sub by_color_select {
$blurb = <<'BLURB'
$blurb = <<'BLURB';
Create a selection by selecting all pixels (in the specified drawable) with the
same (or similar) color to that specified.
BLURB
$help = <<'HELP'
$help = <<'HELP';
This tool creates a selection over the specified image. A by-color selection is
determined by the supplied color under the constraints of the specified
threshold. Essentially, all pixels (in the drawable) that have color
@ -260,11 +260,11 @@ CODE
}
sub clone {
$blurb = <<'BLURB'
$blurb = <<'BLURB';
Clone from the source to the dest drawable using the current brush
BLURB
$help = <<'HELP'
$help = <<'HELP';
This tool clones (copies) from the source drawable starting at the specified
source coordinates to the dest drawable. If the "clone_type" argument is set
to PATTERN-CLONE, then the current pattern is used as the source and the
@ -373,7 +373,7 @@ HELP
&drawable_arg,
{ name => 'pressure', type => '0 <= float <= 100',
desc => 'The pressure: %%desc%%' },
{ name => 'convolve_type', type 'enum Convolve (no CUSTOM)',
{ name => 'convolve_type', type => 'enum Convolve (no CUSTOM)',
desc => 'Convolve type: %%desc%%' },
&stroke_arg
);
@ -479,7 +479,7 @@ HELP
&drawable_arg,
&stroke_arg,
{ name => 'hardness', type => 'enum EraserHardness',
desc => '%%desc%%' }
desc => '%%desc%%' },
{ name => 'method', type => 'enum EraserMethod',
desc => '%%desc%%' }
);
@ -839,9 +839,9 @@ HELP
{ name => 'y', type => 'float',
desc => 'y coordinate of upper-left corner of rectangle' },
{ name => 'width', type => '0 < float',
desc => 'The width of the rectangle: %%desc%%' }
desc => 'The width of the rectangle: %%desc%%' },
{ name => 'height', type => '0 < float',
desc => 'The height of the rectangle: %%desc%%' }
desc => 'The height of the rectangle: %%desc%%' },
&operation_arg,
&feather_select_args,
);
@ -876,7 +876,7 @@ HELP
@inargs = (
&drawable_arg,
{ name => 'interpolation', type => 'boolean',
desc => 'Whether to use interpolation' }
desc => 'Whether to use interpolation' },
{ name => 'angle', type => 'float',
desc => 'The angle of rotation (radians)' }
);
@ -1046,7 +1046,7 @@ HELP
@inargs = (
&drawable_arg,
{ name => 'interpolation', type => 'boolean',
desc => 'Whether to use interpolation' }
desc => 'Whether to use interpolation' },
{ name => 'shear_type', type => 'enum ShearType',
desc => 'Type of shear: %%desc%%' },
{ name => 'magnitude', type => 'float',

View File

@ -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,
{ name => x, type => 'float',
{ name => 'x', type => 'float',
desc => eval qq/{\$a = 'x'; "$coord";}/ },
{ name => y, type => 'float',
{ name => 'y', type => 'float',
desc => eval qq/{\$a = 'y';"$coord";}/ }
);
@ -214,12 +214,12 @@ CODE
}
sub by_color_select {
$blurb = <<'BLURB'
$blurb = <<'BLURB';
Create a selection by selecting all pixels (in the specified drawable) with the
same (or similar) color to that specified.
BLURB
$help = <<'HELP'
$help = <<'HELP';
This tool creates a selection over the specified image. A by-color selection is
determined by the supplied color under the constraints of the specified
threshold. Essentially, all pixels (in the drawable) that have color
@ -260,11 +260,11 @@ CODE
}
sub clone {
$blurb = <<'BLURB'
$blurb = <<'BLURB';
Clone from the source to the dest drawable using the current brush
BLURB
$help = <<'HELP'
$help = <<'HELP';
This tool clones (copies) from the source drawable starting at the specified
source coordinates to the dest drawable. If the "clone_type" argument is set
to PATTERN-CLONE, then the current pattern is used as the source and the
@ -373,7 +373,7 @@ HELP
&drawable_arg,
{ name => 'pressure', type => '0 <= float <= 100',
desc => 'The pressure: %%desc%%' },
{ name => 'convolve_type', type 'enum Convolve (no CUSTOM)',
{ name => 'convolve_type', type => 'enum Convolve (no CUSTOM)',
desc => 'Convolve type: %%desc%%' },
&stroke_arg
);
@ -479,7 +479,7 @@ HELP
&drawable_arg,
&stroke_arg,
{ name => 'hardness', type => 'enum EraserHardness',
desc => '%%desc%%' }
desc => '%%desc%%' },
{ name => 'method', type => 'enum EraserMethod',
desc => '%%desc%%' }
);
@ -839,9 +839,9 @@ HELP
{ name => 'y', type => 'float',
desc => 'y coordinate of upper-left corner of rectangle' },
{ name => 'width', type => '0 < float',
desc => 'The width of the rectangle: %%desc%%' }
desc => 'The width of the rectangle: %%desc%%' },
{ name => 'height', type => '0 < float',
desc => 'The height of the rectangle: %%desc%%' }
desc => 'The height of the rectangle: %%desc%%' },
&operation_arg,
&feather_select_args,
);
@ -876,7 +876,7 @@ HELP
@inargs = (
&drawable_arg,
{ name => 'interpolation', type => 'boolean',
desc => 'Whether to use interpolation' }
desc => 'Whether to use interpolation' },
{ name => 'angle', type => 'float',
desc => 'The angle of rotation (radians)' }
);
@ -1046,7 +1046,7 @@ HELP
@inargs = (
&drawable_arg,
{ name => 'interpolation', type => 'boolean',
desc => 'Whether to use interpolation' }
desc => 'Whether to use interpolation' },
{ name => 'shear_type', type => 'enum ShearType',
desc => 'Type of shear: %%desc%%' },
{ name => 'magnitude', type => 'float',

View File

@ -0,0 +1,68 @@
# 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>
# The defs
sub pdb_misc {
$author = $copyright = 'Jay Cox';
$date = 1998;
}
sub parasite_new {
$blurb = 'Creates a new parasite.';
$help = 'Creates a new parasite unatached to to any image or drawable.';
&pdb_misc;
@inargs = (
{ name => 'name', type => 'string',
desc => 'The name of the parasite to create', no_success => 1 },
{ name => 'flags', type => 'int32',
desc => 'The flags (persistance == 1)' },
{ name => 'size', type => '0 <= int32',
desc => 'The size of the data in bytes' },
{ name => 'data', type => 'string',
desc => 'The data', no_success => 1 }
);
@outargs = (
{ name => 'parasite', type => 'parasite',
desc => 'The new parasite' }
);
%invoke = (
headers => [ qw("libgimp/parasite.h") ],
code => <<'CODE'
{
if (size > 0 && data == NULL)
success = FALSE;
else
success = (parasite = parasite_new (name, flags, size, data)) != NULL;
}
CODE
);
}
@procs = qw(parasite_new);
%exports = (app => [@procs]);
$desc = 'Parasite procedures';
1;

View File

@ -141,7 +141,7 @@ HELP
{
name => 'procedure_names',
type => 'stringarray',
desc => 'The list of procedure names'
desc => 'The list of procedure names',
alias => 'pdb_query.list_or_procs'
}
);
@ -175,7 +175,7 @@ CODE
sub procedural_db_proc_info {
$alias{lib} = 'query_procedure';
$blurb = <<'BLURB'
$blurb = <<'BLURB';
Queries the procedural database for information on the specified procedure.
BLURB
@ -253,7 +253,7 @@ HELP
@globals = ('static GList *data_list = NULL');
%invoke = (
headers => [ qw("procedural.db.h" ],
headers => [ qw("procedural.db.h") ],
vars => ['PDBData *data', 'char *data_copy', 'GList *list'],
code => <<'CODE'
{
@ -300,7 +300,7 @@ HELP
$outargs[0]->{alias} = 'data->bytes';
%invoke = (
headers => [ qw("procedural.db.h" ],
headers => [ qw("procedural.db.h") ],
vars => ['PDBData *data', 'GList *list'],
code => <<'CODE'
{
@ -340,7 +340,7 @@ HELP
$inargs[2]->{alias} = 'data_src';
%invoke = (
headers => [ qw("procedural.db.h" ],
headers => [ qw("procedural.db.h") ],
vars => ['PDBData *data = NULL', 'GList *list'],
code => <<'CODE'
{

View File

@ -38,6 +38,13 @@ sub fontname_arg () {{
Conventions)'
}}
sub size_args () {(
{ name => 'size', type => '0 < float',
desc => 'The size of text in either pixels or points' },
{ name => 'size_type', type => 'enum SizeType',
desc => 'The units of specified size: %%desc%%' }
)}
sub render_args () {(
&std_image_arg,
{ name => 'drawable', type => 'drawable',
@ -49,21 +56,16 @@ sub render_args () {(
desc => 'The y coordinate for the top of the text bounding box' },
&text_arg,
{ name => 'border', type => '-1 <= int32',
desc => 'The size of the border: %%desc%%' }
&std_antialias_arg
desc => 'The size of the border: %%desc%%' },
&std_antialias_arg,
&size_args
)}
sub size_args () {(
{ name => 'size', type => '0 < float',
desc => 'The size of text in either pixels or points' },
{ name => 'size_type', type => 'enum SizeType',
desc => 'The units of specified size: %%desc%%' }
)}
@props = qw(foundry family weight slant set-width spacing registry encoding);
sub font_prop_args {
my @result;
foreach (qw(foundry family weight slant set-width spacing registry
encoding)) {
foreach (@props) {
my $var = $_;
$var =~ s/-/_/g;
@ -87,6 +89,15 @@ sub extents_outargs {
}
}
sub fontname_makeargs {
my @args;
foreach (map { s/-/_/; uc } @props) {
push @args, { type => 'string',
code => "%%arg%% = text_get_field (fontname, $_);" }
}
@args;
}
sub text {
$blurb = <<'BLURB';
Add text at the specified location as a floating selection or a new layer.
@ -109,19 +120,18 @@ appear as a new layer. Finally, a border can be specified around the final
rendered text. The border is measured in pixels.
HELP
&pdb_misc;
&pdb_misc;
@inargs = (
@inargs = (
&render_args,
&size_args,
&font_prop_args
);
);
&render_outargs;
&render_outargs;
%invoke = (
%invoke = (
headers => [ qw("text_tool.h") ],
vars => ['GimpImage *gimage', 'gchar *fontname[2048]'],
vars => ['gchar *fontname[2048]'],
code => <<'CODE'
{
if (antialias)
@ -132,13 +142,13 @@ HELP
if (success)
success = text_get_xlfd (size, size_type, foundry, family, weight,
slant, set_width, spacing, registry, encoding,
slant, set_width, spacing, registry, encoding,
fontname);
if (success)
{
text_layer = text_render (gimage, drawable, x, y, fontname, text,
border, antialias);
border, antialias);
success = text_layer != NULL;
}
}
@ -170,12 +180,13 @@ HELP
code => <<'CODE'
{
success = text_get_xlfd (size, size_type, foundry, family, weight,
slant, set_width, spacing, registry, encoding,
slant, set_width, spacing, registry, encoding,
fontname);
if (success)
success = text_get_extents (fontname, text, &width, &height, &ascent,
&descent);
&descent);
}
CODE
);
}
@ -197,19 +208,59 @@ than non-antialiased text; the resulting floating selection or layer, however,
will require the same amount of memory with or without antialiasing. If the
specified drawable parameter is valid, the text will be created as a floating
selection attached to the drawable. If the drawable parameter is not valid
(-1), the text will appear as a new layer. Finally, a border can be specified
(-1), the text will appear as a new layer. Finally, a border can be specified
around the final rendered text. The border is measured in pixels.
HELP
&pdb_misc;
$author .= ', Sven Neumann';
$author .= ' & Sven Neumann';
@inargs = (
&render_args,
&fontname_arg
);
&render_outargs;
%invoke = (
headers => [ qw("text_tool.h") ],
pass_through => 'text',
pass_args => [ 0..8 ],
make_args => [ &fontname_makeargs ]
);
}
sub text_get_extents_fontname {
$blurb = 'Get extents of the bounding box for the specified text.';
$help = <<'HELP';
This tool returns the width and height of a bounding box for the specified text
string with the specified font information. Ascent and descent for the
specified font are returned as well.
HELP
&pdb_misc;
$author .= ' & Sven Neumann';
@inargs = (
&text_arg,
&size_args,
&fontname_arg
);
&extents_outargs;
%invoke = (
headers => [ qw("text_tool.h") ],
pass_through => 'text_get_extents',
pass_args => [ 0..2 ],
make_args => [ &fontname_makeargs ]
);
}
@procs = qw(text text_get_extents text_fontname text_get_extents_fontname);
%exports = (app => [@procs]);
$desc = 'Text procedures';
1;

View File

@ -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,
{ name => x, type => 'float',
{ name => 'x', type => 'float',
desc => eval qq/{\$a = 'x'; "$coord";}/ },
{ name => y, type => 'float',
{ name => 'y', type => 'float',
desc => eval qq/{\$a = 'y';"$coord";}/ }
);
@ -214,12 +214,12 @@ CODE
}
sub by_color_select {
$blurb = <<'BLURB'
$blurb = <<'BLURB';
Create a selection by selecting all pixels (in the specified drawable) with the
same (or similar) color to that specified.
BLURB
$help = <<'HELP'
$help = <<'HELP';
This tool creates a selection over the specified image. A by-color selection is
determined by the supplied color under the constraints of the specified
threshold. Essentially, all pixels (in the drawable) that have color
@ -260,11 +260,11 @@ CODE
}
sub clone {
$blurb = <<'BLURB'
$blurb = <<'BLURB';
Clone from the source to the dest drawable using the current brush
BLURB
$help = <<'HELP'
$help = <<'HELP';
This tool clones (copies) from the source drawable starting at the specified
source coordinates to the dest drawable. If the "clone_type" argument is set
to PATTERN-CLONE, then the current pattern is used as the source and the
@ -373,7 +373,7 @@ HELP
&drawable_arg,
{ name => 'pressure', type => '0 <= float <= 100',
desc => 'The pressure: %%desc%%' },
{ name => 'convolve_type', type 'enum Convolve (no CUSTOM)',
{ name => 'convolve_type', type => 'enum Convolve (no CUSTOM)',
desc => 'Convolve type: %%desc%%' },
&stroke_arg
);
@ -479,7 +479,7 @@ HELP
&drawable_arg,
&stroke_arg,
{ name => 'hardness', type => 'enum EraserHardness',
desc => '%%desc%%' }
desc => '%%desc%%' },
{ name => 'method', type => 'enum EraserMethod',
desc => '%%desc%%' }
);
@ -839,9 +839,9 @@ HELP
{ name => 'y', type => 'float',
desc => 'y coordinate of upper-left corner of rectangle' },
{ name => 'width', type => '0 < float',
desc => 'The width of the rectangle: %%desc%%' }
desc => 'The width of the rectangle: %%desc%%' },
{ name => 'height', type => '0 < float',
desc => 'The height of the rectangle: %%desc%%' }
desc => 'The height of the rectangle: %%desc%%' },
&operation_arg,
&feather_select_args,
);
@ -876,7 +876,7 @@ HELP
@inargs = (
&drawable_arg,
{ name => 'interpolation', type => 'boolean',
desc => 'Whether to use interpolation' }
desc => 'Whether to use interpolation' },
{ name => 'angle', type => 'float',
desc => 'The angle of rotation (radians)' }
);
@ -1046,7 +1046,7 @@ HELP
@inargs = (
&drawable_arg,
{ name => 'interpolation', type => 'boolean',
desc => 'Whether to use interpolation' }
desc => 'Whether to use interpolation' },
{ name => 'shear_type', type => 'enum ShearType',
desc => 'Type of shear: %%desc%%' },
{ name => 'magnitude', type => 'float',

View File

@ -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,
{ name => x, type => 'float',
{ name => 'x', type => 'float',
desc => eval qq/{\$a = 'x'; "$coord";}/ },
{ name => y, type => 'float',
{ name => 'y', type => 'float',
desc => eval qq/{\$a = 'y';"$coord";}/ }
);
@ -214,12 +214,12 @@ CODE
}
sub by_color_select {
$blurb = <<'BLURB'
$blurb = <<'BLURB';
Create a selection by selecting all pixels (in the specified drawable) with the
same (or similar) color to that specified.
BLURB
$help = <<'HELP'
$help = <<'HELP';
This tool creates a selection over the specified image. A by-color selection is
determined by the supplied color under the constraints of the specified
threshold. Essentially, all pixels (in the drawable) that have color
@ -260,11 +260,11 @@ CODE
}
sub clone {
$blurb = <<'BLURB'
$blurb = <<'BLURB';
Clone from the source to the dest drawable using the current brush
BLURB
$help = <<'HELP'
$help = <<'HELP';
This tool clones (copies) from the source drawable starting at the specified
source coordinates to the dest drawable. If the "clone_type" argument is set
to PATTERN-CLONE, then the current pattern is used as the source and the
@ -373,7 +373,7 @@ HELP
&drawable_arg,
{ name => 'pressure', type => '0 <= float <= 100',
desc => 'The pressure: %%desc%%' },
{ name => 'convolve_type', type 'enum Convolve (no CUSTOM)',
{ name => 'convolve_type', type => 'enum Convolve (no CUSTOM)',
desc => 'Convolve type: %%desc%%' },
&stroke_arg
);
@ -479,7 +479,7 @@ HELP
&drawable_arg,
&stroke_arg,
{ name => 'hardness', type => 'enum EraserHardness',
desc => '%%desc%%' }
desc => '%%desc%%' },
{ name => 'method', type => 'enum EraserMethod',
desc => '%%desc%%' }
);
@ -839,9 +839,9 @@ HELP
{ name => 'y', type => 'float',
desc => 'y coordinate of upper-left corner of rectangle' },
{ name => 'width', type => '0 < float',
desc => 'The width of the rectangle: %%desc%%' }
desc => 'The width of the rectangle: %%desc%%' },
{ name => 'height', type => '0 < float',
desc => 'The height of the rectangle: %%desc%%' }
desc => 'The height of the rectangle: %%desc%%' },
&operation_arg,
&feather_select_args,
);
@ -876,7 +876,7 @@ HELP
@inargs = (
&drawable_arg,
{ name => 'interpolation', type => 'boolean',
desc => 'Whether to use interpolation' }
desc => 'Whether to use interpolation' },
{ name => 'angle', type => 'float',
desc => 'The angle of rotation (radians)' }
);
@ -1046,7 +1046,7 @@ HELP
@inargs = (
&drawable_arg,
{ name => 'interpolation', type => 'boolean',
desc => 'Whether to use interpolation' }
desc => 'Whether to use interpolation' },
{ name => 'shear_type', type => 'enum ShearType',
desc => 'Type of shear: %%desc%%' },
{ name => 'magnitude', type => 'float',