Lossa stuff

-Yosh
This commit is contained in:
Manish Singh 1999-04-23 06:55:37 +00:00
parent f40a836e6c
commit 91048780fe
22 changed files with 999 additions and 217 deletions

View File

@ -111,7 +111,12 @@ sub declare_args {
my @args = @{$proc->{$_}} if exists $proc->{$_};
foreach (@args) {
my $arg = $arg_types{(&arg_parse($_->{type}))[0]};
my ($type, $name) = &arg_parse($_->{type});
my $arg = $arg_types{$type};
if ($type eq 'enum') {
$out->{headers}->{qq/"$enums{$name}->{header}"/}++
}
if ($arg->{array} && !exists $_->{array}) {
warn "Array without number of elements param in $proc->{name}";
@ -241,9 +246,13 @@ CODE
$result .= &make_arg_test($_, sub { ${$_[0]} =~ s/==/!=/ },
"$var == NULL");
}
elsif ($pdbtype eq 'tattoo') {
$result .= &make_arg_test($_, sub { ${$_[0]} =~ s/==/!=/ },
'$var == 0');
}
elsif ($pdbtype eq 'unit') {
$result .= &make_arg_test($_, sub { ${$_[0]} = "!(${$_[0]})" },
'unit < UNIT_PIXEL || unit >= ' .
"$var < UNIT_PIXEL || $var >= " .
'gimp_unit_get_number_of_units ()');
}
elsif ($pdbtype eq 'enum' && !$enums{$typeinfo[0]}->{contig}) {
@ -606,21 +615,6 @@ CODE
GPL
my $internal = "$destdir/internal_procs.h$FILE_EXT";
open INTERNAL, "> $internal" or die "Can't open $cmdfile: $!\n";
print INTERNAL $gpl;
my $guard = "__INTERNAL_PROCS_H__";
print INTERNAL <<HEADER;
#ifndef $guard
#define $guard
void internal_procs_init (void);
#endif /* $guard */
HEADER
close INTERNAL;
&write_file($internal);
my $group_procs = ""; my $longest = 0;
my $once = 0; my $pcount = 0.0;
foreach $group (@main::groups) {
@ -630,7 +624,9 @@ HEADER
delete $out->{headers}->{q/"procedural_db.h"/};
my $headers = "";
foreach (sort keys %{$out->{headers}}) { $headers .= "#include $_\n" }
foreach (sort map { s/^</!/; $_ } keys %{$out->{headers}}) {
s/^\!/</; $headers .= "#include $_\n";
}
my $extra = {};
if (exists $main::grp{$group}->{extra}->{app}) {
@ -665,20 +661,38 @@ HEADER
$pcount += $out->{pcount};
}
$internal = "$destdir/internal_procs.c$FILE_EXT";
open INTERNAL, "> $internal" or die "Can't open $cmdfile: $!\n";
print INTERNAL $gpl;
print INTERNAL qq@#include "app_procs.h"\n\n@;
print INTERNAL qq@#include "libgimp/gimpintl.h"\n\n@;
print INTERNAL "/* Forward declarations for registering PDB procs */\n\n";
foreach (@group_decls) {
print INTERNAL "void $_" . ' ' x ($longest - length $_) . " (void);\n";
if (!exists $ENV{PDBGEN_GROUPS}) {
my $internal = "$destdir/internal_procs.h$FILE_EXT";
open IFILE, "> $internal" or die "Can't open $cmdfile: $!\n";
print IFILE $gpl;
my $guard = "__INTERNAL_PROCS_H__";
print IFILE <<HEADER;
#ifndef $guard
#define $guard
void internal_procs_init (void);
#endif /* $guard */
HEADER
close IFILE;
&write_file($internal);
$internal = "$destdir/internal_procs.c$FILE_EXT";
open IFILE, "> $internal" or die "Can't open $cmdfile: $!\n";
print IFILE $gpl;
print IFILE qq@#include "config.h"\n\n@;
print IFILE qq@#include "app_procs.h"\n\n@;
print IFILE qq@#include "libgimp/gimpintl.h"\n\n@;
print IFILE "/* Forward declarations for registering PDB procs */\n\n";
foreach (@group_decls) {
print IFILE "void $_" . ' ' x ($longest - length $_) . " (void);\n";
}
chop $group_procs;
print IFILE "\n/* $total total procedures registered total */\n\n";
print IFILE "void\ninternal_procs_init (void)\n{\n$group_procs}\n";
close IFILE;
&write_file($internal);
}
chop $group_procs;
print INTERNAL "\n/* $total total procedures registered total */\n\n";
print INTERNAL "void\ninternal_procs_init (void)\n{\n$group_procs}\n";
close INTERNAL;
&write_file($internal);
}
1;

View File

@ -229,9 +229,12 @@ while (<>) {
$nicks = ",\n\t nicks => { " . $nicks . " }";
}
$ARGV =~ m@([^/]*)$@;
$code .= <<ENTRY;
: $enumname =>
: { contig => $contig,
: header => '$1',
: symbols => [ qw($symbols) ],
: mapping => { $mapping }$nicks
: },

View File

@ -22,6 +22,7 @@ package Gimp::CodeGen::enums;
%enums = (
ConvertPaletteType =>
{ contig => 1,
header => 'convert.h',
symbols => [ qw(MAKE_PALETTE REUSE_PALETTE WEB_PALETTE
MONO_PALETTE CUSTOM_PALETTE) ],
mapping => { MAKE_PALETTE => '0',
@ -32,18 +33,21 @@ package Gimp::CodeGen::enums;
},
ChannelOffsetType =>
{ contig => 1,
header => 'channel_ops.h',
symbols => [ qw(OFFSET_BACKGROUND OFFSET_TRANSPARENT) ],
mapping => { OFFSET_BACKGROUND => '0',
OFFSET_TRANSPARENT => '1' }
},
SizeType =>
{ contig => 1,
header => 'text_tool.h',
symbols => [ qw(PIXELS POINTS) ],
mapping => { PIXELS => '0',
POINTS => '1' }
},
GimpFillType =>
{ contig => 1,
header => 'gimpdrawable.h',
symbols => [ qw(FOREGROUND_FILL BACKGROUND_FILL WHITE_FILL
TRANSPARENT_FILL NO_FILL) ],
mapping => { FOREGROUND_FILL => '0',
@ -54,6 +58,7 @@ package Gimp::CodeGen::enums;
},
GimpImageType =>
{ contig => 1,
header => 'gimpimage.h',
symbols => [ qw(RGB_GIMAGE RGBA_GIMAGE GRAY_GIMAGE GRAYA_GIMAGE
INDEXED_GIMAGE INDEXEDA_GIMAGE) ],
mapping => { RGB_GIMAGE => '0',
@ -71,6 +76,7 @@ package Gimp::CodeGen::enums;
},
GimpImageBaseType =>
{ contig => 1,
header => 'gimpimage.h',
symbols => [ qw(RGB GRAY INDEXED) ],
mapping => { RGB => '0',
GRAY => '1',
@ -78,6 +84,7 @@ package Gimp::CodeGen::enums;
},
ChannelType =>
{ contig => 1,
header => 'gimpimage.h',
symbols => [ qw(Red Green Blue Gray Indexed Auxillary) ],
mapping => { Red => '0',
Green => '1',
@ -88,6 +95,7 @@ package Gimp::CodeGen::enums;
},
MergeType =>
{ contig => 1,
header => 'gimpimage.h',
symbols => [ qw(ExpandAsNecessary ClipToImage ClipToBottomLayer
FlattenImage) ],
mapping => { ExpandAsNecessary => '0',
@ -97,13 +105,13 @@ package Gimp::CodeGen::enums;
},
PDBArgType =>
{ contig => 1,
header => 'procedural_db.h',
symbols => [ qw(PDB_INT32 PDB_INT16 PDB_INT8 PDB_FLOAT PDB_STRING
PDB_INT32ARRAY PDB_INT16ARRAY PDB_INT8ARRAY
PDB_FLOATARRAY PDB_STRINGARRAY PDB_COLOR
PDB_REGION PDB_DISPLAY PDB_IMAGE PDB_LAYER
PDB_CHANNEL PDB_DRAWABLE PDB_SELECTION
PDB_BOUNDARY PDB_PATH PDB_PARASITE PDB_STATUS
PDB_END) ],
PDB_BOUNDARY PDB_PATH PDB_PARASITE PDB_STATUS) ],
mapping => { PDB_INT32 => '0',
PDB_INT16 => '1',
PDB_INT8 => '2',
@ -125,11 +133,11 @@ package Gimp::CodeGen::enums;
PDB_BOUNDARY => '18',
PDB_PATH => '19',
PDB_PARASITE => '20',
PDB_STATUS => '21',
PDB_END => '22' }
PDB_STATUS => '21' }
},
PDBStatusType =>
{ contig => 1,
header => 'procedural_db.h',
symbols => [ qw(PDB_EXECUTION_ERROR PDB_CALLING_ERROR
PDB_PASS_THROUGH PDB_SUCCESS) ],
mapping => { PDB_EXECUTION_ERROR => '0',
@ -139,15 +147,18 @@ package Gimp::CodeGen::enums;
},
PDBProcType =>
{ contig => 1,
symbols => [ qw(PDB_INTERNAL PDB_PLUGIN PDB_EXTENSION
PDB_TEMPORARY) ],
header => 'procedural_db.h',
symbols => [ qw(PDB_INTERNAL PDB_PLUGIN PDB_EXTENSION) ],
mapping => { PDB_INTERNAL => '0',
PDB_PLUGIN => '1',
PDB_EXTENSION => '2',
PDB_TEMPORARY => '3' }
PDB_EXTENSION => '2' },
nicks => { PDB_INTERNAL => 'INTERNAL',
PDB_PLUGIN => 'PLUGIN',
PDB_EXTENSION => 'EXTENSION' }
},
LayerModeEffects =>
{ contig => 1,
header => 'paint_funcs.h',
symbols => [ qw(NORMAL_MODE DISSOLVE_MODE BEHIND_MODE
MULTIPLY_MODE SCREEN_MODE OVERLAY_MODE
DIFFERENCE_MODE ADDITION_MODE SUBTRACT_MODE
@ -193,6 +204,7 @@ package Gimp::CodeGen::enums;
},
GradientType =>
{ contig => 1,
header => 'blend.h',
symbols => [ qw(LINEAR BILINEAR RADIAL SQUARE CONICAL_SYMMETRIC
CONICAL_ASYMMETRIC SHAPEBURST_ANGULAR
SHAPEBURST_SPHERICAL SHAPEBURST_DIMPLED
@ -211,6 +223,7 @@ package Gimp::CodeGen::enums;
},
BlendMode =>
{ contig => 1,
header => 'blend.h',
symbols => [ qw(FG_BG_RGB_MODE FG_BG_HSV_MODE FG_TRANS_MODE
CUSTOM_MODE) ],
mapping => { FG_BG_RGB_MODE => '0',
@ -224,6 +237,7 @@ package Gimp::CodeGen::enums;
},
RepeatMode =>
{ contig => 1,
header => 'blend.h',
symbols => [ qw(REPEAT_NONE REPEAT_SAWTOOTH REPEAT_TRIANGULAR) ],
mapping => { REPEAT_NONE => '0',
REPEAT_SAWTOOTH => '1',
@ -231,6 +245,7 @@ package Gimp::CodeGen::enums;
},
BucketFillMode =>
{ contig => 1,
header => 'bucket_fill.h',
symbols => [ qw(FG_BUCKET_FILL BG_BUCKET_FILL PATTERN_BUCKET_FILL) ],
mapping => { FG_BUCKET_FILL => '0',
BG_BUCKET_FILL => '1',
@ -238,12 +253,14 @@ package Gimp::CodeGen::enums;
},
CloneType =>
{ contig => 1,
header => 'clone.h',
symbols => [ qw(IMAGE_CLONE PATTERN_CLONE) ],
mapping => { IMAGE_CLONE => '0',
PATTERN_CLONE => '1' }
},
ConvolveType =>
{ contig => 1,
header => 'convolve.h',
symbols => [ qw(BLUR_CONVOLVE SHARPEN_CONVOLVE CUSTOM_CONVOLVE) ],
mapping => { BLUR_CONVOLVE => '0',
SHARPEN_CONVOLVE => '1',
@ -254,6 +271,7 @@ package Gimp::CodeGen::enums;
},
ChannelOps =>
{ contig => 1,
header => 'channel.h',
symbols => [ qw(ADD SUB REPLACE INTERSECT) ],
mapping => { ADD => '0',
SUB => '1',
@ -262,6 +280,7 @@ package Gimp::CodeGen::enums;
},
BrushApplicationMode =>
{ contig => 1,
header => 'paint_core.h',
symbols => [ qw(HARD SOFT PRESSURE) ],
mapping => { HARD => '0',
SOFT => '1',
@ -269,6 +288,7 @@ package Gimp::CodeGen::enums;
},
PaintApplicationMode =>
{ contig => 1,
header => 'paint_core.h',
symbols => [ qw(CONSTANT INCREMENTAL) ],
mapping => { CONSTANT => '0',
INCREMENTAL => '1' },
@ -276,6 +296,7 @@ package Gimp::CodeGen::enums;
},
GradientPaintMode =>
{ contig => 1,
header => 'paint_core.h',
symbols => [ qw(ONCE_FORWARD ONCE_BACKWARDS LOOP_SAWTOOTH
LOOP_TRIANGLE ONCE_END_COLOR) ],
mapping => { ONCE_FORWARD => '0',
@ -286,6 +307,7 @@ package Gimp::CodeGen::enums;
},
ChannelLutType =>
{ contig => 1,
header => 'lut_funcs.h',
symbols => [ qw(VALUE_LUT RED_LUT GREEN_LUT BLUE_LUT ALPHA_LUT) ],
mapping => { VALUE_LUT => '0',
RED_LUT => '1',
@ -300,6 +322,7 @@ package Gimp::CodeGen::enums;
},
ShearType =>
{ contig => 1,
header => 'shear_tool.h',
symbols => [ qw(HORZ_SHEAR VERT_SHEAR) ],
mapping => { HORZ_SHEAR => '0',
VERT_SHEAR => '1' },
@ -308,6 +331,7 @@ package Gimp::CodeGen::enums;
},
TransferMode =>
{ contig => 1,
header => 'color_balance.h',
symbols => [ qw(SHADOWS MIDTONES HIGHLIGHTS) ],
mapping => { SHADOWS => '0',
MIDTONES => '1',
@ -315,6 +339,7 @@ package Gimp::CodeGen::enums;
},
HueRange =>
{ contig => 1,
header => 'hue_saturation.h',
symbols => [ qw(ALL_HUES RED_HUES YELLOW_HUES GREEN_HUES CYAN_HUES
BLUE_HUES MAGENTA_HUES) ],
mapping => { ALL_HUES => '0',

View File

@ -19,4 +19,4 @@
@groups = qw(gdisplay edit floating_sel undo palette gradient convert
channel_ops gimprc drawable parasite paths gradient_select
unit procedural_db brushes text_tool brush_select color
misc tools);
misc tools channel patterns pattern_select);

View File

@ -172,7 +172,7 @@ CODE
}
}
foreach (@arraynums) { $return_marshal .= "\*$_->{name} = 0;\n "; }
foreach (@arraynums) { $return_marshal .= "\*$_->{name} = 0;\n " }
$return_marshal =~ s/\n $/\n\n /s if scalar(@arraynums);
$return_marshal .= <<CODE;
@ -252,20 +252,49 @@ CODE
}
if ($arglist) {
# We don't need the last comma in the declaration
$arglist =~ s/, $//;
my @arglist = ();
my $longest = 0; my $indirect = 0;
foreach (split(/, /, $arglist)) {
my ($type, $var) = /(\w+) ((?:\w|\*)+)/;
my $num = scalar @{[ $var =~ /\*/g ]};
push @arglist, [ $type, $var, $num ];
$longest = length $type if $longest < length $type;
$indirect = $num if $indirect < $num;
}
$longest += $indirect + 1;
my $once = 0; $arglist = "";
foreach (@arglist) {
my ($type, $var, $num) = @$_;
my $space = $longest - length($type) - $num;
$arglist .= ",\n\t" if $once++;
$arglist .= $type . ' ' x $space . $var;
}
$arglist =~ s/ +/ / if !$#arglist;
}
else {
$arglist = "void";
}
my $funcname = "gimp_$name";
# Our function prototype for the headers
push @{$out->{proto}}, "$rettype gimp_$name ($arglist);\n";
(my $hrettype = $rettype) =~ s/ //g;
push @{$out->{proto}}, "$hrettype gimp_$name ($arglist);\n";
my $clist = $arglist;
$clist =~ s/\t/' ' x (length("gimp_$name") + 2)/eg;
$clist =~ s/ {8}/\t/g;
$out->{code} .= <<CODE;
$rettype
gimp_$name ($arglist)
gimp_$name ($clist)
{
GParam *return_vals;
gint nreturn_vals;$return_args$color
@ -314,6 +343,46 @@ LGPL
$extra = $main::grp{$group}->{extra}->{lib}
}
my ($longest1, $longest2, $longest3) = (0, 0, 0); my @arglist = ();
foreach (@{$out->{proto}}) {
my $len; my $arglist = [ split(' ', $_, 3) ];
$len = length($arglist->[0]);
$longest1 = $len if $longest1 < $len;
$len = length($arglist->[1]);
$longest2 = $len if $longest2 < $len;
my @arg = split(' ', $arglist->[2]);
if ($#arg) {
$len = index($arglist->[2], $arg[1]);
$len -= scalar($arg[1] =~ /\*/g);
$longest3 = $len if $longest3 < $len;
}
push @arglist, $arglist;
}
@{$out->{proto}} = ();
foreach (@arglist) {
my ($type, $func, $arglist) = @$_;
my @args = split(/,/, $arglist); $arglist = "";
foreach (@args) {
my $len = $longest3 - scalar(/ /g);
$len -= scalar(/\*/g);
s/(\s*\w+)\s+/$1 . ' ' x $len/e;
$arglist .= $_;
$arglist .= "," if !/;\n$/;
}
my $arg = $type;
$arg .= ' ' x ($longest1 - length($type) + 1) . $func;
$arg .= ' ' x ($longest2 - length($func) + 1) . $arglist;
$arg =~ s/\t/' ' x ($longest1 + $longest2 + 3)/eg;
$arg =~ s/ {8}/\t/g;
push @{$out->{proto}}, $arg;
}
my $body;
$body = $extra->{decls} if exists $extra->{decls};
foreach (@{$out->{proto}}) { $body .= $_ }

View File

@ -74,6 +74,7 @@ package Gimp::CodeGen::pdb;
# Special cases
enum => { name => 'INT32', type => 'gint32 ' },
boolean => { name => 'INT32', type => 'gboolean ' },
tattoo => { name => 'INT32', type => 'gint32 ' },
unit => { name => 'INT32', type => 'GUnit ' },
region => { name => 'REGION', type => 'gpointer ' } # not supported

View File

@ -45,7 +45,7 @@ sub brushes_popup {
made' },
{ name => 'popup_title', type => 'string', alias => 'title',
desc => 'Title to give the brush popup window' },
{ name => 'initial_brush', type => 'string',
{ name => 'initial_brush', type => 'string', alias => 'brush',
desc => 'The name of the brush to set as the first selected',
no_success => 1 },
&brush_args
@ -57,7 +57,7 @@ sub brushes_popup {
{
if ((prec = procedural_db_lookup (name)))
{
if (initial_brush && strlen (initial_brush))
if (brush && strlen (brush))
newdialog = brush_select_new (title, brush, opacity, spacing,
paint_mode);
else
@ -68,7 +68,7 @@ sub brushes_popup {
newdialog->callback_name = g_strdup (name);
/* Add to active brush dialogs list */
active_dialogs = g_slist_append (active_dialogs, newdialog);
brush_active_dialogs = g_slist_append (brush_active_dialogs, newdialog);
}
else
success = FALSE;
@ -94,9 +94,9 @@ sub brushes_close_popup {
code => <<'CODE'
{
if ((prec = procedural_db_lookup (name)) &&
(bsp = brush_get_brushselect (name))
(bsp = brush_get_brushselect (name)))
{
active_dialogs = g_slist_remove (active_dialogs, bsp);
brush_active_dialogs = g_slist_remove (brush_active_dialogs, bsp);
if (GTK_WIDGET_VISIBLE (bsp->shell))
gtk_widget_hide (bsp->shell);
@ -105,7 +105,7 @@ sub brushes_close_popup {
if (bsp != brush_select_dialog)
{
gtk_widget_destroy (bsp->shell);
grad_select_free (bsp);
brush_select_free (bsp);
}
}
else
@ -131,11 +131,12 @@ sub brushes_set_popup {
);
%invoke = (
headers => [ qw("gimpbrushlist.h") ],
vars => [ 'ProcRecord *prec', 'BrushSelectP bsp' ],
code => <<'CODE'
{
if ((prec = procedural_db_lookup (name)) &&
(bsp = brush_get_brushselect (name))
(bsp = brush_get_brushselect (name)))
{
GimpBrushP active = gimp_brush_list_get_brush (brush_list, brush_name);
@ -177,7 +178,7 @@ $extra{app}->{code} = <<'CODE';
static BrushSelectP
brush_get_brushselect (gchar *name)
{
GSList *list = active_dialogs;
GSList *list = brush_active_dialogs;
BrushSelectP bsp;
while (list)

View File

@ -23,7 +23,7 @@ sub brush_arg () {{
desc => 'The brush name'
}}
sub dim_args {
sub dim_args () {
my @args;
foreach (qw(width height)) {
push @args, { name => $_, type => 'int32', desc => "The brush $_" };
@ -80,7 +80,7 @@ HELP
* some future date, so we could tell if things blew up when reparsing
* the list (for whatever reason).
* - Seth "Yes, this is a kludge" Burgess
* <sjburges@ou.edu>
* <sjburges@gimp.org>
*/
brushes_init (FALSE);
@ -156,7 +156,7 @@ HELP
&std_pdb_misc;
@outargs = ( &opacity_arg );
$outargs[0]->{alias} = 'gimp_brush_get_opacity () * 100.0';
$outargs[0]->{alias} = 'paint_options_get_opacity () * 100.0';
$outargs[0]->{no_declare} = 1;
}
@ -173,7 +173,7 @@ HELP
@inargs = ( &opacity_arg );
%invoke = ( code => 'gimp_brush_set_opacity (opacity / 100.0);' );
%invoke = ( code => 'paint_options_set_opacity (opacity / 100.0);' );
}
sub brushes_get_spacing {
@ -189,7 +189,7 @@ HELP
&std_pdb_misc;
@outargs = ( &spacing_arg );
$outargs[0]->{alias} = 'gimp_brush_get_spacing ()';
$outargs[0]->{alias} = 'gimp_brush_get_spacing (get_active_brush ())';
$outargs[0]->{no_declare} = 1;
}
@ -206,7 +206,9 @@ HELP
@inargs = ( &spacing_arg );
%invoke = ( code => 'gimp_brush_set_spacing (spacing);' );
%invoke = (
code => 'gimp_brush_set_spacing (get_active_brush(), spacing);'
);
}
sub brushes_get_paint_mode {
@ -222,12 +224,12 @@ HELP
&std_pdb_misc;
@outargs = ( &paint_mode_arg );
$outargs[0]->{alias} = 'gimp_brush_get_paint_mode ()';
$outargs[0]->{alias} = 'paint_options_get_paint_mode ()';
$outargs[0]->{no_declare} = 1;
}
sub brushes_set_paint_mode {
$blurb = 'Set the brush paint_mode.';
$blurb = 'Set the brush paint mode.';
$help = <<'HELP';
This procedure modifies the paint_mode setting for the current brush. This
@ -239,7 +241,7 @@ HELP
@inargs = ( &paint_mode_arg );
%invoke = ( code => 'gimp_brush_set_paint_mode (paint_mode);' );
%invoke = ( code => 'paint_options_set_paint_mode (paint_mode);' );
}
sub brushes_list {
@ -262,7 +264,7 @@ HELP
);
%invoke = (
vars => [ 'GSList *list', 'int i = 0' ],
vars => [ 'GSList *list = NULL', 'int i = 0' ],
code => <<'CODE'
{
brushes = g_new (char *, brush_list->num_brushes);
@ -309,18 +311,19 @@ HELP
$outargs[1]->{alias} = '1.0';
$outargs[3]->{alias} = '0';
push @outargs, { name => 'mask_data', type => 'int8array',
push @outargs, { name => 'mask_data', type => 'int8array', init => 1,
desc => 'The brush mask data',
array => { name => 'length',
array => { name => 'length', init => 1,
desc => 'Length of brush mask data' } };
%invoke = (
headers => [ qw(<string.h>) ],
vars => [ 'GimpBrushP brushp = NULL' ],
code => <<'CODE'
{
if (strlen (name))
{
GSList list = GIMP_LIST (brush_list)->list;
GSList *list = GIMP_LIST (brush_list)->list;
success = FALSE;
@ -351,7 +354,7 @@ CODE
);
}
@headers = qw("gimpbrushlist.h");
@headers = qw("gimplist.h" "gimpbrush.h" "gimpbrushlistP.h" "paint_options.h");
@procs = qw(brushes_refresh brushes_get_brush brushes_set_brush
brushes_get_opacity brushes_set_opacity brushes_get_spacing
@ -361,5 +364,4 @@ CODE
$desc = 'Brushes';
&brushes_get_paint_mode;
1;

View File

@ -0,0 +1,243 @@
# 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 channel_get_prop_proc {
my ($prop, $type, $desc, $func) = @_;
$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 = $func ? "channel_get_$prop (channel)" : "channel->$prop";
$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("gimpimage.h") ];
$invoke{code} = "{\n color = g_new (guchar, 3);\n";
foreach (map { "${_}_PIX" } qw(RED GREEN BLUE)) {
$invoke{code} .= " $prop\[$_] = channel->col[$_];\n";
}
$invoke{code} .= "}\n";
}
}
sub channel_set_prop_proc {
my ($prop, $type, $desc, $func) = @_;
$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" }
);
$invoke{code} = $func ? "channel_set_$prop (channel, $prop);"
: "channel->$prop = $prop;";
if ($type eq 'color') {
%invoke = (
vars => [ 'int i' ],
code => <<CODE
for (i = 0; i < 3; i++)
channel->col[i] = $prop\[i];
CODE
);
}
}
sub channel_accessors {
my ($prop, $type, $desc, $func, $extra) = @_;
my (@extra, %extra); my $once = 0;
ref($extra) ? (@extra = @$extra) : (@extra = ($extra, $extra));
%extra = map { $once++ ? 'set' : 'get', $_ ? $_ : "" } @extra;
foreach (keys %extra) {
my $proc = "channel_${_}_$prop";
push @procs, $proc;
eval <<SUB;
sub @{[ scalar caller ]}::$proc {
\&channel_${_}_prop_proc('$prop', '$type', '$desc', $func);
$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%%)', alias => 'opacity_arg' },
{ name => 'color', type => 'color',
desc => 'The channel compositing color' }
);
$inargs[0]->{desc} .= ' to which to add the channel';
@outargs = (
{ name => 'channel', type => 'channel',
desc => 'The newly created channel', init => 1 }
);
%invoke = (
vars => [ 'int opacity' ],
code => <<'CODE'
{
opacity = (int) ((opacity_arg * 255) / 100);
channel = channel_new (gimage, width, height, name, opacity, 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 = (
{ name => 'channel', type => 'channel',
desc => 'The channel to copy' }
);
@outargs = (
{ name => 'channel_copy', type => 'channel', init => 1,
desc => 'The newly copied channel', alias => 'copy' }
);
%invoke = ( code => 'success = (copy = channel_copy (channel)) != NULL;' );
}
sub channel_delete {
$blurb = 'Delete a channel.';
$help = <<'HELP';
This procedure deletes the specified channel. This does not need to be done if
a gimage containing this channel was already deleted.
HELP
&std_pdb_misc;
@inargs = (
{ name => 'channel', type => 'channel',
desc => 'The channel to delete' }
);
%invoke = ( code => 'channel_delete (channel);' );
}
&channel_accessors('name', 'string', 'name', 1,
[ undef, '$inargs[1]->{no_success} = 1' ]);
&channel_accessors('visible', 'boolean', 'visibility', 0,
[ '$outargs[0]->{alias} =~
s/(channel)/GIMP_DRAWABLE ($1)/',
'$invoke{code} =~
s/(channel)/GIMP_DRAWABLE ($1)/' ]);
&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', 0,
[ '$outargs[0]->{alias} =
"(channel->opacity * 100.0) / 255.0"',
'$invoke{code} =~
s%(opacity);$%(int) (($1 * 255) / 100);%' ]);
&channel_accessors('color', 'color', 'compositing color', 0);
&channel_accessors('tattoo', 'tattoo', 'tattoo', 1,
<<'CODE');
$blurb = 'Returns the tattoo associated with the specified channel.';
$help = <<'HELP';
This procedure returns the tattoo associated with the specified channel. 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
@headers = qw("channel.h" "channel_pvt.h");
$#procs--;
unshift @procs, qw(channel_new channel_copy channel_delete);
%exports = (app => [@procs]);
$desc = 'Channel';
1;

View File

@ -74,14 +74,14 @@ HELP
@outargs = (
{ name => 'new_image', type => 'image',
desc => 'the new, duplicated image',
alias => 'new_gimage' }
desc => 'The new, duplicated image',
alias => 'new_gimage', init => 1 }
);
%invoke = (
headers => [ qw("gimage.h") ],
code => <<'CODE'
success = ((new_gimage = duplicate ((void *) gimage)) != NULL);
success = (new_gimage = duplicate (gimage)) != NULL;
CODE
);
}

View File

@ -187,8 +187,8 @@ HELP
foreach $where ('upper left', 'lower right') {
foreach (qw(x y)) {
push @outargs, { name => "$_$pos", type => 'int32',
desc => '$_ coordinate of the $where corner of
selection bounds' }
desc => "$_ coordinate of the $where corner of
selection bounds" }
}
$pos++;
}
@ -221,7 +221,7 @@ sub drawable_type {
$help = "This procedure returns the drawable's type.";
&drawable_prop_proc("the drawable's type", 'type', 'enum GimpImageType',
'type',"The drawable's type: %%desc%%");
'type', "The drawable's type: { %%desc%% }");
delete $inargs[0]->{no_success};
}
@ -249,7 +249,7 @@ HELP
&drawable_prop_proc("the drawable's type with alpha", 'type_with_alpha',
'enum GimpImageType (no RGB_GIMAGE, GRAY_GIMAGE,
INDEXED_GIMAGE)', 'type_with_alpha',
"The drawable's type with alpha: %%desc%%");
"The drawable's type with alpha: { %%desc%% }");
}
sub drawable_color {
@ -321,6 +321,51 @@ sub drawable_channel {
&drawable_is_proc('channel');
}
sub drawable_get_pixel {
$blurb = 'Gets the value of the pixel at the specified coordinates.';
$help = <<'HELP';
This procedure gets the pixel value at the specified coordinates. The
'num_channels' argument must always be equal to the bytes-per-pixel value for
the specified drawable.
HELP
&std_pdb_misc;
$date = '1997';
&drawable_coord_args();
@outargs = ( &pixel_arg );
$outargs[0]->{init} = $outargs[0]->{array}->{init} = 1;
%invoke = (
vars => [ 'gint8 *p', 'gint b', 'Tile *tile' ],
code => <<'CODE'
{
if (x < drawable_width (drawable) && y < drawable_height (drawable))
{
num_channels = drawable_bytes (drawable);
pixel = g_new (gint8, num_channels);
tile = tile_manager_get_tile (drawable_data (drawable), x, y,
TRUE, TRUE);
x %= TILE_WIDTH;
y %= TILE_WIDTH;
p = tile_data_pointer (tile, y, x);
for (b = 0; b < num_channels; b++)
pixel[b] = p[b];
tile_release (tile, FALSE);
}
else
success = FALSE;
}
CODE
);
}
sub drawable_set_pixel {
$blurb = 'Sets the value of the pixel at the specified coordinates.';
@ -362,50 +407,6 @@ CODE
);
}
sub drawable_get_pixel {
$blurb = 'Gets the value of the pixel at the specified coordinates.';
$help = <<'HELP';
This procedure gets the pixel value at the specified coordinates. The
'num_channels' argument must always be equal to the bytes-per-pixel value for
the specified drawable.
HELP
&std_pdb_misc;
$date = '1997';
&drawable_coord_args();
@outargs = ( &pixel_arg );
%invoke = (
vars => [ 'gint8 *p', 'gint b', 'Tile *tile' ],
code => <<'CODE'
{
if (x < drawable_width (drawable) && y < drawable_height (drawable)
{
num_channels = drawable_bytes (drawable);
pixel = g_new (gint8, num_channels);
tile = tile_manager_get_tile (drawable_data (drawable), x, y,
TRUE, TRUE);
x %= TILE_WIDTH;
y %= TILE_WIDTH;
p = tile_data_pointer (tile, y, x);
for (b = 0; b < num_channels; b++)
pixel[b] = p[b];
tile_release (tile, FALSE);
}
else
success = FALSE;
}
CODE
);
}
sub drawable_set_image {
$blurb = 'Set image where drawable belongs to.';
@ -432,8 +433,8 @@ HELP
drawable_has_alpha drawable_type_with_alpha drawable_color
drawable_gray drawable_indexed drawable_bytes drawable_width
drawable_height drawable_offsets drawable_layer
drawable_layer_mask drawable_channel drawable_set_pixel
drawable_get_pixel drawable_set_image);
drawable_layer_mask drawable_channel drawable_get_pixel
drawable_set_pixel drawable_set_image);
%exports = (app => [@procs], lib => [@procs]);
$desc = 'Drawable procedures';

View File

@ -27,7 +27,7 @@ sub gradients_get_list {
$help = <<'HELP';
This procedure returns a list of the gradients that are currently loaded in the
gradient editor. You can later use the gimp-gradients-set-active function to
gradient editor. You can later use the gimp_gradients_set_active function to
set the active gradient.
HELP
@ -42,7 +42,6 @@ HELP
);
%invoke = (
headers => [ qw("gradient.h") ],
vars => [ 'gradient_t *grad', 'GSList *list', 'int i = 0' ],
success => 'NONE',
code => <<'CODE'
@ -77,10 +76,7 @@ HELP
alias => 'g_strdup (curr_gradient->name)', no_declare => 1 }
);
%invoke = (
headers => [ qw("gradient.h") ],
code => 'success = curr_gradient != NULL;'
);
%invoke = ( code => 'success = curr_gradient != NULL;' );
}
sub gradients_set_active {
@ -101,10 +97,7 @@ HELP
desc => 'The name of the gradient to set' }
);
%invoke = (
headers => [ qw("gradient.h") ],
code => 'success = grad_set_grad_to_name (name);'
);
%invoke = ( code => 'success = grad_set_grad_to_name (name);' );
}
sub sample_num_arg {
@ -114,9 +107,9 @@ sub sample_num_arg {
sub sample_outargs {
@outargs = (
{ name => 'color_samples', type => 'floatarray',
{ name => 'color_samples', type => 'floatarray', init => 1,
desc => 'Color samples: { R1, G1, B1, A1, ..., Rn, Gn, Bn, An }',
array => { name => 'array_length', no_lib => 1,
array => { name => 'array_length', no_lib => 1, init => 1,
desc => 'Length of the color_samples array (4 *
num_samples)' } }
);
@ -140,7 +133,6 @@ HELP
&sample_outargs;
%invoke = (
headers => [ qw("gradient.h") ],
vars => [ 'gdouble pos, delta', 'gdouble r, g, b, a', 'gdouble *pv' ],
code => <<'CODE'
{
@ -217,7 +209,7 @@ CODE
);
}
@headers = qw("gradient.h");
@headers = qw("gradient_header.h" "gradient.h");
@procs = qw(gradients_get_list gradients_get_active gradients_set_active
gradients_sample_uniform gradients_sample_custom);

View File

@ -65,7 +65,7 @@ sub gradients_popup {
newdialog->sample_size = sample_size;
/* Add to active gradient dialogs list */
active_dialogs = g_slist_append (active_dialogs, newdialog);
grad_active_dialogs = g_slist_append (grad_active_dialogs, newdialog);
}
else
success = FALSE;
@ -91,9 +91,9 @@ sub gradients_close_popup {
code => <<'CODE'
{
if ((prec = procedural_db_lookup (name)) &&
(gsp = gradients_get_gradientselect (name))
(gsp = gradients_get_gradientselect (name)))
{
active_dialogs = g_slist_remove (active_dialogs, gsp);
grad_active_dialogs = g_slist_remove (grad_active_dialogs, gsp);
if (GTK_WIDGET_VISIBLE (gsp->shell))
gtk_widget_hide (gsp->shell);
@ -131,8 +131,8 @@ sub gradients_set_popup {
vars => [ 'ProcRecord *prec', 'GradSelectP gsp' ],
code => <<'CODE'
{
if ((prec = procedural_db_lookup (name)) &&
(gsp = gradients_get_gradientselect (name))
if ((prec = procedural_db_lookup (pdbname)) &&
(gsp = gradients_get_gradientselect (pdbname)))
{
GSList *tmp;
gradient_t *active = NULL;
@ -144,7 +144,7 @@ sub gradients_set_popup {
{
active = tmp->data;
if (!strcmp (gradient_name, active->name)
if (!strcmp (gradient_name, active->name))
break; /* We found the one we want */
pos++;
@ -189,15 +189,14 @@ HELP
desc => 'The gradient name',
alias => 'g_strdup (grad->name)', no_declare => 1 },
{ name => 'grad_data', type => 'floatarray', alias => 'values',
desc => 'The gradient sample data',
desc => 'The gradient sample data', init => 1,
array => { name => 'width',
desc => 'The gradient sample width (r,g,b,a)',
alias => 'sample_size * 4', no_declare => 1 } }
);
%invoke = (
headers => [ qw("gradient_select.h") ],
vars => [ 'gradient_t *grad' ],
vars => [ 'gradient_t *oldgrad, *grad = NULL' ],
code => <<'CODE'
{
if (strlen (name))
@ -234,6 +233,7 @@ HELP
pv = values = g_new (gdouble, i * 4);
oldgrad = curr_gradient;
curr_gradient = grad;
while (i--)
@ -255,13 +255,13 @@ CODE
);
}
@headers = qw("gradient_select.h");
@headers = qw("gradient_header.h" "gradient.h");
$extra{app}->{code} = <<'CODE';
static GradSelectP
gradients_get_gradientselect(gchar *name)
{
GSList *list = active_dialogs;
GSList *list = grad_active_dialogs;
GradSelectP gsp;
while (list)

View File

@ -27,7 +27,7 @@ sub gradients_get_list {
$help = <<'HELP';
This procedure returns a list of the gradients that are currently loaded in the
gradient editor. You can later use the gimp-gradients-set-active function to
gradient editor. You can later use the gimp_gradients_set_active function to
set the active gradient.
HELP
@ -42,7 +42,6 @@ HELP
);
%invoke = (
headers => [ qw("gradient.h") ],
vars => [ 'gradient_t *grad', 'GSList *list', 'int i = 0' ],
success => 'NONE',
code => <<'CODE'
@ -77,10 +76,7 @@ HELP
alias => 'g_strdup (curr_gradient->name)', no_declare => 1 }
);
%invoke = (
headers => [ qw("gradient.h") ],
code => 'success = curr_gradient != NULL;'
);
%invoke = ( code => 'success = curr_gradient != NULL;' );
}
sub gradients_set_active {
@ -101,10 +97,7 @@ HELP
desc => 'The name of the gradient to set' }
);
%invoke = (
headers => [ qw("gradient.h") ],
code => 'success = grad_set_grad_to_name (name);'
);
%invoke = ( code => 'success = grad_set_grad_to_name (name);' );
}
sub sample_num_arg {
@ -114,9 +107,9 @@ sub sample_num_arg {
sub sample_outargs {
@outargs = (
{ name => 'color_samples', type => 'floatarray',
{ name => 'color_samples', type => 'floatarray', init => 1,
desc => 'Color samples: { R1, G1, B1, A1, ..., Rn, Gn, Bn, An }',
array => { name => 'array_length', no_lib => 1,
array => { name => 'array_length', no_lib => 1, init => 1,
desc => 'Length of the color_samples array (4 *
num_samples)' } }
);
@ -140,7 +133,6 @@ HELP
&sample_outargs;
%invoke = (
headers => [ qw("gradient.h") ],
vars => [ 'gdouble pos, delta', 'gdouble r, g, b, a', 'gdouble *pv' ],
code => <<'CODE'
{
@ -217,7 +209,7 @@ CODE
);
}
@headers = qw("gradient.h");
@headers = qw("gradient_header.h" "gradient.h");
@procs = qw(gradients_get_list gradients_get_active gradients_set_active
gradients_sample_uniform gradients_sample_custom);

View File

@ -39,6 +39,6 @@ HELP
@procs = qw(version);
%exports = (app => [@procs]);
$desc = 'Miscellaneous procedures';
$desc = 'Miscellaneous';
1;

View File

@ -34,7 +34,8 @@ sub name_arg {{
sub parasite_outarg {{
name => 'parasite',
type => 'parasite',
desc => "The $_[0] parasite"
desc => "The $_[0] parasite",
init => 1
}}
sub drawable_arg () {{
@ -49,7 +50,7 @@ sub drawable_convert {
unshift @inargs, &drawable_arg;
$invoke{code} =~ s/gimp/gimp_drawable/;
$invoke{code} =~ s/\((.*?(?:parasite|name))/(drawable, $1/;
$invoke{code} =~ s/\(((?!gimp).*?(?:parasite|name))/(drawable, $1/;
}
sub parasite_new {
@ -83,7 +84,7 @@ CODE
);
}
sub parasite_find {
sub find_parasite {
$blurb = 'Finds the named parasite.';
$help = <<'HELP';
@ -98,12 +99,15 @@ HELP
%invoke = (
code => <<'CODE'
success = (parasite = parasite_copy (gimp_parasite_find (name))) != NULL;
{
parasite = parasite_copy (gimp_find_parasite (name));
success = parasite != NULL;
}
CODE
);
}
sub parasite_attach {
sub attach_parasite {
$blurb = 'Add a parasite to the gimp.';
$help = <<'HELP';
@ -117,10 +121,10 @@ HELP
desc => 'The parasite to attach to the gimp' }
);
%invoke = ( code => 'gimp_parasite_attach (parasite);' );
%invoke = ( code => 'gimp_attach_parasite (parasite);' );
}
sub parasite_detach {
sub detach_parasite {
$blurb = 'Removes a parasite from the gimp.';
$help = <<'HELP';
@ -134,7 +138,7 @@ HELP
desc => 'The name of the parasite to detach from the gimp.' }
);
%invoke = ( code => 'gimp_parasite_detach (name);' );
%invoke = ( code => 'gimp_detach_parasite (name);' );
}
sub parasite_list {
@ -154,24 +158,19 @@ sub parasite_list {
%invoke = ( code => 'parasites = gimp_parasite_list (&num_parasites);' );
}
sub drawable_parasite_find {
&parasite_find;
sub drawable_find_parasite {
&find_parasite;
&drawable_convert;
$blurb =~ s/\.$/in a drawable./;
$help =~ s/the gimp/a drawable/;
unshift @inargs, &drawable_arg;
$invoke{code} =~ s/gimp/gimp_drawable/;
}
sub drawable_parasite_attach {
&parasite_attach;
sub drawable_attach_parasite {
&attach_parasite;
&drawable_convert;
}
sub drawable_parasite_detach {
&parasite_detach;
sub drawable_detach_parasite {
&detach_parasite;
&drawable_convert;
}
@ -180,27 +179,28 @@ sub drawable_parasite_list {
@inargs = ( &drawable_arg );
&drawable_convert;
@inargs = ( &drawable_arg );
$outargs[0]->{init} = 1;
}
@headers = qw("libgimp/parasite.h" "gimpparasite.h" "gimpdrawable.h");
$extra{lib}->{protos} = <<'CODE';
void gimp_parasite_attach_new (const char *name, int flags, int size
void gimp_attach_new_parasite (const char *name, int flags, int size
const void *data);
CODE
$extra{lib}->{code} = <<'CODE';
void
gimp_parasite_attach_new (const char *name, int flags, int size,
gimp_attach_new_parasite (const char *name, int flags, int size,
const void *data)
{
Parasite *p = parasite_new (name, flags, size, data);
gimp_parasite_attach (p);
gimp_attach_parasite (p);
parasite_free (p);
}
CODE
@procs = qw(parasite_new parasite_find parasite_attach parasite_detach
@procs = qw(parasite_new find_parasite attach_parasite detach_parasite
parasite_list);
push @procs, map { 'drawable_' . $_ } @procs[1..4];
%exports = (app => [@procs], lib => [@procs[1..3]]);

View File

@ -0,0 +1,173 @@
# 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 pdb_misc {
$author = $copyright = 'Andy Thomas';
$date = '1998';
}
sub patterns_popup {
$blurb = 'Invokes the Gimp pattern selection.';
$help = 'This procedure popups the pattern selection dialog.';
&pdb_misc;
@inargs = (
{ name => 'pattern_callback', type => 'string', alias => 'name',
desc => 'The callback PDB proc to call when pattern selection is
made' },
{ name => 'popup_title', type => 'string', alias => 'title',
desc => 'Title to give the pattern popup window' },
{ name => 'initial_pattern', type => 'string', alias => 'pattern',
desc => 'The name of the pattern to set as the first selected',
no_success => 1 },
);
%invoke = (
vars => [ 'ProcRecord *prec', 'PatternSelectP newdialog' ],
code => <<'CODE'
{
if ((prec = procedural_db_lookup (name)))
{
if (pattern && strlen (pattern))
newdialog = pattern_select_new (title, pattern);
else
newdialog = pattern_select_new (title, NULL);
/* Add to list of proc to run when pattern changes */
newdialog->callback_name = g_strdup (name);
/* Add to active pattern dialogs list */
pattern_active_dialogs = g_slist_append (pattern_active_dialogs, newdialog);
}
else
success = FALSE;
}
CODE
);
}
sub patterns_close_popup {
$blurb = 'Popdown the Gimp pattern selection.';
$help = 'This procedure closes an opened pattern selection dialog.';
&pdb_misc;
@inargs = (
{ name => 'pattern_callback', type => 'string', alias => 'name',
desc => 'The name of the callback registered for this popup' }
);
%invoke = (
vars => [ 'ProcRecord *prec', 'PatternSelectP psp' ],
code => <<'CODE'
{
if ((prec = procedural_db_lookup (name)) &&
(psp = pattern_get_patternselect (name)))
{
pattern_active_dialogs = g_slist_remove (pattern_active_dialogs, psp);
if (GTK_WIDGET_VISIBLE (psp->shell))
gtk_widget_hide (psp->shell);
/* Free memory if poping down dialog which is not the main one */
if (psp != pattern_select_dialog)
{
gtk_widget_destroy (psp->shell);
pattern_select_free (psp);
}
}
else
success = FALSE;
}
CODE
);
}
sub patterns_set_popup {
$blurb = 'Sets the current pattern selection in a popup.';
$help = $blurb;
&pdb_misc;
@inargs = (
{ name => 'pattern_callback', type => 'string', alias => 'name',
desc => 'The name of the callback registered for this popup' },
{ name => 'pattern_name', type => 'string',
desc => 'The name of the pattern to set as selected' },
);
%invoke = (
vars => [ 'ProcRecord *prec', 'PatternSelectP psp' ],
code => <<'CODE'
{
if ((prec = procedural_db_lookup (name)) &&
(psp = pattern_get_patternselect (name)))
{
GPatternP active = pattern_list_get_pattern (pattern_list, pattern_name);
if (active)
{
/* Must alter the wigdets on screen as well */
psp->pattern = active;
pattern_select_select (psp, active->index);
}
else
success = FALSE;
}
else
success = FALSE;
}
CODE
);
}
@headers = qw("pattern_select.h");
$extra{app}->{code} = <<'CODE';
static PatternSelectP
pattern_get_patternselect (gchar *name)
{
GSList *list = pattern_active_dialogs;
PatternSelectP psp;
while (list)
{
psp = (PatternSelectP) list->data;
if (!strcmp (name, psp->callback_name))
return psp;
list = list->next;
}
return NULL;
}
CODE
@procs = qw(patterns_popup patterns_close_popup patterns_set_popup);
%exports = (app => [@procs]);
$desc = 'Pattern UI';
1;

View File

@ -0,0 +1,227 @@
# 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 pattern_arg () {{
name => 'name',
type => 'string',
desc => 'The pattern name'
}}
sub dim_args () {
my @args;
foreach (qw(width height)) {
push @args, { name => $_, type => 'int32', desc => "The pattern $_" };
}
@args;
}
sub pattern_outargs {
foreach (@outargs) {
my $alias = "patternp->$_->{name}";
$alias = "g_strdup ($alias)" if $_->{type} eq 'string';
$alias =~ s/patternp/patternp->mask/ if $_->{name} =~ /width|height/;
$_->{alias} = $alias;
$_->{no_declare} = 1;
}
}
# The defs
sub patterns_get_pattern {
$blurb = 'Retrieve information about the currently active pattern.';
$help = <<'HELP';
This procedure retrieves information about the currently active pattern. This
includes the pattern name, and the pattern extents (width and height). All
clone and bucket-fill operations with patterns will use this pattern to control
the application of paint to the image.
HELP
&std_pdb_misc;
@outargs = (
&pattern_arg,
&dim_args,
);
&pattern_outargs;
%invoke = (
vars => [ 'GPatternP patternp' ],
code => 'success = (patternp = get_active_pattern ()) != NULL;'
);
}
sub patterns_set_pattern {
$blurb = 'Set the specified pattern as the active pattern.';
$help = <<'HELP';
This procedure allows the active pattern mask to be set by specifying its name.
The name is simply a string which corresponds to one of the names of the
installed patterns. If there is no matching pattern found, this procedure will
return an error. Otherwise, the specified pattern becomes active and will be
used in all subsequent paint operations.
HELP
&std_pdb_misc;
@inargs = ( &pattern_arg );
%invoke = (
vars => [ 'GPatternP patternp', 'GSList *list' ],
code => <<'CODE'
{
list = pattern_list;
success = FALSE;
while (list)
{
patternp = (GPatternP) list->data;
if (!strcmp (patternp->name, name))
{
select_pattern (patternp);
success = TRUE;
break;
}
list = list->next;
}
}
CODE
);
}
sub patterns_list {
$blurb = 'Retrieve a complete listing of the available patterns.';
$help = <<'HELP';
This procedure returns a complete listing of available GIMP patterns. Each name
returned can be used as input to the 'gimp_patterns_set_pattern'.
HELP
&std_pdb_misc;
@outargs = (
{ name => 'pattern_list', type => 'stringarray',
desc => 'The list of pattern names',
alias => 'patterns',
array => { name => 'num_patterns',
desc => 'The number of patterns in the pattern list',
alias => 'num_patterns', no_declare => 1 } }
);
%invoke = (
vars => [ 'GSList *list = NULL', 'int i = 0' ],
code => <<'CODE'
{
patterns = g_new (char *, num_patterns);
success = (list = pattern_list) != NULL;
while (list)
{
patterns[i++] = g_strdup (((GPatternP) list->data)->name);
list = list->next;
}
}
CODE
);
}
sub patterns_get_pattern_data {
$blurb = <<'BLURB';
Retrieve information about the currently active pattern (including data).
BLURB
$help = <<'HELP';
This procedure retrieves information about the currently active pattern. This
includes the pattern name, and the pattern extents (width and height). It also
returns the pattern data.
HELP
$author = $copyright = 'Andy Thomas';
$date = '1998';
@inargs = ( &pattern_arg );
$inargs[0]->{desc} = 'the pattern name ("" means current active pattern)';
@outargs = (
&pattern_arg,
&dim_args,
);
&pattern_outargs;
push @outargs, { name => 'mask_bpp', type => 'int32', init => 1,
desc => 'Pattern bytes per pixel',
alias => 'patternp->mask->bytes', no_declare => 1 },
{ name => 'mask_data', type => 'int8array', init => 1,
desc => 'The pattern mask data',
array => { name => 'length', init => 1,
desc => 'Length of pattern mask data' } };
%invoke = (
headers => [ qw(<string.h>) ],
vars => [ 'GPatternP patternp = NULL' ],
code => <<'CODE'
{
if (strlen (name))
{
GSList *list = pattern_list;
success = FALSE;
while (list)
{
patternp = (GPatternP) list->data;
if (!strcmp (patternp->name, name))
{
success = TRUE;
break;
}
list = list->next;
}
}
else
success = (patternp = get_active_pattern ()) != NULL;
if (success)
{
length = patternp->mask->height * patternp->mask->width *
patternp->mask->bytes;
mask_data = g_new (gint8, length);
g_memmove (mask_data, temp_buf_data (patternp->mask), length);
}
}
CODE
);
}
@headers = qw("patterns.h");
@procs = qw(patterns_get_pattern patterns_set_pattern patterns_list
patterns_get_pattern_data);
%exports = (app => [@procs]);
$desc = 'Patterns';
1;

View File

@ -17,24 +17,20 @@
# "Perlized" from C source by Manish Singh <yosh@gimp.org>
sub proc_name_arg {{
sub proc_name_arg () {{
name => 'procedure',
type => 'string',
desc => 'The procedure name',
alias => 'proc_name'
}}
sub regex_arg {
my $type = shift;
}
sub data_ident_arg {{
sub data_ident_arg () {{
name => 'identifier',
type => 'string',
desc => 'The identifier associated with data'
}}
sub data_bytes_arg {{
sub data_bytes_arg () {{
name => 'bytes',
type => '0 < int32',
desc => 'The number of bytes in the data',
@ -42,7 +38,7 @@ sub data_bytes_arg {{
no_declare => 1
}}
sub data_arg {{
sub data_arg () {{
name => 'data',
type => 'int8array',
desc => 'A byte array containing data',
@ -50,7 +46,7 @@ sub data_arg {{
}}
sub arg_info_proc {
my $type = shift; my $long_type = shift; my $real_type = shift;
my ($type, $long_type, $real_type) = @_;
$blurb = <<BLURB;
Queries the procedural database for information on the specified procedure's
@ -73,7 +69,7 @@ HELP
@outargs = (
{ name => "${type}_type", type => 'enum PDBArgType',
desc => "The type of $long_type %%desc%%",
desc => "The type of $long_type { %%desc%% }",
alias => "${type}->arg_type", no_declare => 1 },
{ name => "${type}_name", type => 'string',
desc => "The name of the $long_type",
@ -84,7 +80,7 @@ HELP
);
%invoke = (
vars => [ 'ProcRecord *proc;' ],
vars => [ 'ProcRecord *proc', "ProcArg *$type = NULL" ],
code => <<CODE
{
proc = procedural_db_lookup (proc_name);
@ -119,6 +115,7 @@ HELP
);
%invoke = (
headers => [ qw(<stdio.h>) ],
code => <<'CODE'
{
if ((procedural_db_out = fopen (filename, "w")))
@ -126,6 +123,8 @@ HELP
g_hash_table_foreach (procedural_ht, procedural_db_print_entry, NULL);
fclose (procedural_db_out);
}
else
success = FALSE;
}
CODE
);
@ -181,7 +180,7 @@ HELP
);
%invoke = (
headers => [ qw("regex.h") ],
headers => [ qw(<stdlib.h> "regex.h") ],
vars => [ 'PDBQuery pdb_query' ],
code => <<CODE
{
@ -207,8 +206,8 @@ This procedure returns information on the specified procedure. A short blurb,
detailed help, author(s), copyright information, procedure type, number of
input, and number of return values are returned. For specific information on
each input argument and return value, use the
'gimp-procedural-db-query-proc-arg' and
'gimp-procedural-db-query-proc-val' procedures.
'gimp_procedural_db_query_proc_arg' and
'gimp_procedural_db_query_proc_val' procedures.
HELP
&std_pdb_misc;
@ -228,7 +227,7 @@ HELP
{ name => 'date', type => 'string',
desc => 'Copyright date' },
{ name => 'proc_type', type => 'enum PDBProcType',
desc => 'The procedure type: %%desc%%' },
desc => 'The procedure type: { %%desc%% }' },
{ name => 'num_args', type => 'int32',
desc => 'The number of input arguments' },
{ name => 'num_values', type => 'int32',
@ -242,6 +241,7 @@ HELP
}
%invoke = (
vars => [ 'ProcRecord *proc = NULL' ],
code => <<'CODE'
success = (proc = procedural_db_lookup (proc_name)) != NULL;
CODE
@ -274,9 +274,10 @@ HELP
@outargs = ( &data_arg );
$outargs[0]->{alias} = 'data_copy';
$outargs[0]->{init} = 1;
%invoke = (
vars => [ 'PDBData *data', 'char *data_copy', 'GList *list' ],
vars => [ 'PDBData *data = NULL', 'GList *list' ],
code => <<'CODE'
{
success = FALSE;
@ -318,7 +319,7 @@ HELP
@outargs = ( &data_bytes_arg );
%invoke = (
vars => [ 'PDBData *data', 'GList *list' ],
vars => [ 'PDBData *data = NULL', 'GList *list' ],
code => <<'CODE'
{
success = FALSE;
@ -379,7 +380,6 @@ HELP
g_free (data->data);
data->identifier = g_strdup (identifier);
data->bytes = bytes;
data->data = g_new (char, data->bytes);
memcpy (data->data, (char *) data_src, data->bytes);
}
@ -387,6 +387,8 @@ CODE
);
}
@headers = qw("config.h" "libgimp/gimpintl.h");
$extra{app}->{decls} = <<'CODE';
/* Query structure */
typedef struct _PDBQuery PDBQuery;
@ -414,9 +416,27 @@ struct _PDBData
gchar *data;
};
static FILE *procedural_db_out = NULL;
static GList *data_list = NULL;
static char *proc_type_str[] =
{
N_("Internal GIMP procedure"),
N_("GIMP Plug-In"),
N_("GIMP Extension"),
N_("Temporary Procedure")
};
static const char * const type_str[] =
{
CODE
foreach (@{$Gimp::CodeGen::enums::enums{PDBArgType}->{symbols}}) {
$extra{app}->{decls} .= qq/ "$_",\n/;
}
$extra{app}->{decls} =~ s/,\n$/\n};\n/;
$extra{app}->{code} = <<'CODE';
static int
match_strings (regex_t *preg,
@ -455,14 +475,13 @@ procedural_db_query_entry (gpointer key,
pdb_query->num_procs++;
pdb_query->list_of_procs = g_realloc (pdb_query->list_of_procs,
(sizeof (gchar **) * pdb_query->num_procs));
pdb_query->list_of_procs[pdb_query->num_procs - 1] = g_strdup (proc->n
ame);
pdb_query->list_of_procs[pdb_query->num_procs - 1] = g_strdup (proc->name);
}
}
}
static void
output_string (gchar *string)
output_string (const char *string)
{
fprintf (procedural_db_out, "\"");
while (*string)
@ -545,6 +564,21 @@ procedural_db_print_entry (gpointer key,
g_string_free (buf, TRUE);
}
/* This really doesn't belong here, but it depends on your generated type_str
* array.
*/
const char *
pdb_type_name (gint type)
{
if (type >= 0 && type <= PDB_END)
return type_str[type];
else
return g_strdup_printf ("(PDB type %d unknown)", type);
/* Yeah, we leak the memory. But then you shouldn't try and
* get the name of a PDB type that doesn't exist, should you.
*/
}
CODE
@procs = qw(procedural_db_dump procedural_db_query procedural_db_proc_info

View File

@ -201,7 +201,7 @@ HELP
unit_set_deletion_flag unit_get_identifier unit_get_factor
unit_get_digits unit_get_symbol unit_get_abbreviation
unit_get_singular unit_get_plural);
%exports = (app => [@procs]);
%exports = (app => [@procs], lib => [@procs]);
$desc = 'Units';

View File

@ -26,10 +26,23 @@ BEGIN {
use lib $srcdir;
BEGIN {
# Some important stuff
require 'pdb.pl';
require 'enums.pl';
require 'util.pl';
# What to do?
require 'groups.pl';
if (exists $ENV{PDBGEN_GROUPS}) {
@groups = split(' ', $ENV{PDBGEN_GROUPS});
}
}
# Stifle "used only once" warnings
$destdir = $destdir;
%pdb = ();
@groups = ();
# The actual parser (in a string so we can eval it in another namespace)
$evalcode = <<'CODE';
@ -101,9 +114,6 @@ $evalcode = <<'CODE';
}
CODE
# What to do?
require 'groups.pl';
# Slurp in the PDB defs
foreach $file (@groups) {
print "Processing $srcdir/pdb/$file.pdb...\n";
@ -111,11 +121,6 @@ foreach $file (@groups) {
die $@ if $@;
}
# Some important stuff
require 'pdb.pl';
require 'enums.pl';
require 'util.pl';
# Squash whitespace into just single spaces between words
sub trimspace { for (${$_[0]}) { s/\s+/ /gs; s/^ //; s/ $//; } }

View File

@ -26,7 +26,7 @@ $FILE_EXT = ".tmp.$$";
sub write_file {
my $file = shift; my $realfile = $file;
$realfile =~ s/$FILE_EXT//;
$realfile =~ s/$FILE_EXT$//;
if (-e $realfile) {
if (cmp($realfile, $file)) {
cp($realfile, "$realfile~") if $DEBUG_OUTPUT;