dnrops
/
gimp
mirror of https://github.com/GNOME/gimp.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

see plug-ins/perl/Changes

This commit is contained in:
Marc Lehmann 1999-03-14 03:41:20 +00:00
parent 3337702777
commit c22ed41f24
23 changed files with 561 additions and 449 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
plug-ins/perl/Changes
View File

@ -1,6 +1,6 @@
Revision history for Gimp-Perl extension.
- added examples/yinyang, examples/image_tile.
- added examples/yinyang, examples/image_tile, examples/stamps.
- bangpath is no longer updated inplace. As a result, only plug-ins
that are going to get installed are being fixed, the examples are
not.
@ -8,6 +8,10 @@ Revision history for Gimp-Perl extension.
error handling.
- reworked callback handling, should be more flexible in the future.
- changed implementation of PF_CUSTOM (still untested).
- fixed some rather scientific memory leaks, fixed more bugs.
- the case when "not enough arguments" were supplied for a function
was not reliably detected.
- gimp_progress_init now accepts either one or two arguments.
1.061 Fri Mar 12 21:27:26 CET 1999
- closed big, BIG security hole on password authenticitation

30
plug-ins/perl/Gimp.pm
View File

@ -5,7 +5,7 @@ use Carp;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD %EXPORT_TAGS @EXPORT_FAIL
@_consts @_procs $interface_pkg $interface_type @_param @_al_consts
@PREFIXES $_PROT_VERSION
@gimp_gui_functions $function $ignore_die
@gimp_gui_functions $function
$help $verbose $host);
require DynaLoader;
@ -269,6 +269,8 @@ EOF
my @log;
my $caller;
my $ignore_die;
my $in_quit;
sub format_msg {
$_=shift;
@ -297,12 +299,12 @@ sub logger {
$args{function} = "" unless defined $args{function};
$args{fatal} = 1 unless defined $args{fatal};
push(@log,[$file,@args{'function','message','fatal'}]);
print STDERR format_msg($log[-1]),"\n" if $verbose || $interface_type eq 'net';
print STDERR format_msg($log[-1]),"\n";
_initialized_callback if initialized();
}
sub die_msg {
logger(message => substr($_[0],0,-1), fatal => 1, function => 'DIE');
logger(message => substr($_[0],0,-1), fatal => 1, function => 'ERROR');
}
sub call_callback {
@ -328,14 +330,17 @@ sub callback {
} elsif ($type eq "-query") {
call_callback 1,"query";
} elsif ($type eq "-quit") {
local $ignore_die = 0;
$ignore_die = 1;
call_callback 0,"quit";
undef $ignore_die;
}
}
sub main {
$caller=caller;
&{"${interface_pkg}::gimp_main"};
#d# #D# # BIG BUG LURKING SOMEWHERE
# just calling exit() will be too much for bigexitbug.pl
xs_exit(&{"${interface_pkg}::gimp_main"});
}
# same as main, but callbacks are ignored
@ -346,7 +351,7 @@ sub quiet_main {
$SIG{__DIE__} = sub {
if (!$^S && $ignore_die) {
die_msg $_[0];
initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit main();
initialized() ? die "BE QUIET ABOUT THIS DIE\n" : xs_exit(main());
} else {
die $_[0];
}
@ -356,7 +361,7 @@ $SIG{__WARN__} = sub {
if ($ignore_die) {
warn $_[0];
} else {
logger(message => substr($_[0],0,-1), fatal => 0, function => 'WARN');
logger(message => substr($_[0],0,-1), fatal => 0, function => 'WARNING');
}
};
@ -401,7 +406,7 @@ sub ignore_functions(@) {
sub _croak($) {
$_[0] =~ s/ at .*? line \d+.*$//s;
Carp::croak $_[0];
croak($_[0]);
}
sub AUTOLOAD {
@ -643,7 +648,14 @@ In a Gimp::Fu-script, you should call C<Gimp::Fu::main> instead:
exit main; # Gimp::Fu::main is exported by default as well.
This is similar to Gtk, Tk or similar modules, where you have to call the
main eventloop.
main eventloop. Attention: although you call C<exit> with the result of
C<main>, the main function might not actually return. This depends on both
the version of Gimp and the version of the Gimp-Perl module that is in
use. Do not depend on C<main> to return at all, but still call C<exit>
immediately.
If you need to do cleanups before exiting you should use the C<quit>
callback (which is not yet available if you use Gimp::Fu).
=head1 CALLBACKS

19
plug-ins/perl/Gimp.xs
View File

@ -81,21 +81,28 @@ void
_exit()
CODE:
#ifdef HAVE__EXIT
_exit(0);
_exit(0);
#elif defined(SIGKILL)
raise(SIGKILL);
raise(SIGKILL);
#else
raise(9);
raise(9);
#endif
abort();
abort();
void
xs_exit(status)
int status
CODE:
exit (status);
# this one is for prefix mismatch check.
# should be replaced by a generic config mechanism
char *
_gimp_prefix()
CODE:
RETVAL = GIMP_PREFIX;
RETVAL = GIMP_PREFIX;
OUTPUT:
RETVAL
RETVAL
BOOT:
{

5
plug-ins/perl/Gimp/Feature.pm
View File

@ -41,7 +41,8 @@ sub import {
while(@_) {
$_=shift;
s/^:// and need($_);
s/^://;
need($_);
}
}
@ -115,7 +116,7 @@ Gimp::Features - check for specific features to be present before registering th
or
use Gimp::Features qw(:feature1 :feature2 ...);
use Gimp::Features qw(feature1 feature2 ...);
=head1 DESCRIPTION

3
plug-ins/perl/Gimp/Fu.pm
View File

@ -64,6 +64,9 @@ In general, a Gimp::Fu script looks like this:
C<examples/example-fu.pl>, which is small Gimp::Fu-script you can take as
starting point for your experiments)
Attention: at the moment it's neccessary to always import the C<Gimp::Fu>
module after the C<Gimp> module.
=cut
sub PF_INT8 () { PARAM_INT8 };

13
plug-ins/perl/Gimp/Lib.pm
View File

@ -35,6 +35,14 @@ sub import {}
bootstrap Gimp::Lib $VERSION;
# various functions for 1.0 compatibility
sub gimp_progress_init {
push @_,-1 if @_<2;
eval { gimp_call_procedure "gimp_progress_init",@_ };
gimp_call_procedure "gimp_progress_init",shift if $@;
}
# functions to "autobless" where the autobless mechanism
# does not work.
@ -72,11 +80,12 @@ sub gimp_tile_bpp { $_[0]->{_bpp} }
sub gimp_tile_shadow { $_[0]->{_shadow} }
sub gimp_tile_gdrawable { $_[0]->{_gdrawable} }
# be careful not to require AUTOLOAD here
sub Gimp::PixelRgn::DESTROY {
my $self = shift;
return unless $self =~ /=HASH/;
$self->{_drawable}->{_id}->update($self->{_x},$self->{_y},$self->{_w},$self->{_h})
if $self->dirty;
gimp_call_procedure "gimp_drawable_update",$self->{_drawable}->{_id},$self->{_x},$self->{_y},$self->{_w},$self->{_h}
if gimp_pixel_rgn_dirty($self);
};
# this is here to be atomic over the perl-server

678
plug-ins/perl/Gimp/Lib.xs
View File

@ -118,7 +118,7 @@ SV *new_tile (GTile *tile, SV *gdrawable)
hv_store (hv, "_eheight" , 8, newSViv (tile->eheight) , 0);
hv_store (hv, "_bpp" , 4, newSViv (tile->bpp) , 0);
hv_store (hv, "_shadow" , 7, newSViv (tile->shadow) , 0);
hv_store (hv, "_gdrawable" ,10, newSVsv (gdrawable) , 0);
hv_store (hv, "_gdrawable" ,10, SvREFCNT_inc (gdrawable) , 0);
if (!stash)
stash = gv_stashpv (PKG_TILE, 1);
@ -129,12 +129,12 @@ SV *new_tile (GTile *tile, SV *gdrawable)
GDrawable *old_gdrawable (SV *sv)
{
if (!(sv_derived_from (sv, PKG_GDRAWABLE)
&& SvROK (sv)
&& SvTYPE (SvRV (sv)) == SVt_PVHV))
&& SvROK (sv)
&& SvTYPE (SvRV (sv)) == SVt_PVHV))
croak ("argument is not of type " PKG_GDRAWABLE);
/* the next line lacks any type of checking. */
return (GDrawable *)SvIV(*(hv_fetch ((HV*)SvRV(sv), "_gdr", 4, 0)));
return (GDrawable *)SvIV(*(hv_fetch ((HV*)SvRV(sv), "_gdrawable", 10, 0)));
}
GTile *old_tile (SV *sv)
@ -274,8 +274,8 @@ perl_paramdef_count (GParamDef *arg, int count)
if (args[index].data.datatype || !args[index-1].data.d_int32) \
{ \
for (j = 0; j < args[index-1].data.d_int32; j++) \
trace_printf (frmt ## "%s", (ctype) args[index].data.datatype[j], \
j < args[index-1].data.d_int32 - 1 ? ", " : ""); \
trace_printf (frmt ## "%s", (ctype) args[index].data.datatype[j], \
j < args[index-1].data.d_int32 - 1 ? ", " : ""); \
} \
else \
trace_printf ("(UNINITIALIZED)"); \
@ -305,75 +305,75 @@ dump_params (int nparams, GParam *args, GParamDef *params)
for (i = 0; i < nparams; i++)
{
if ((trace & TRACE_TYPE) == TRACE_TYPE)
if (params[i].type >= 0 && params[i].type < PARAM_END+1)
trace_printf ("%s ", ptype[params[i].type]);
else
trace_printf ("T%d ", params[i].type);
if (params[i].type >= 0 && params[i].type < PARAM_END+1)
trace_printf ("%s ", ptype[params[i].type]);
else
trace_printf ("T%d ", params[i].type);
if ((trace & TRACE_NAME) == TRACE_NAME)
trace_printf ("%s=", params[i].name);
trace_printf ("%s=", params[i].name);
switch (args[i].type)
{
case PARAM_INT32: trace_printf ("%d", args[i].data.d_int32); break;
case PARAM_INT16: trace_printf ("%d", args[i].data.d_int16); break;
case PARAM_INT8: trace_printf ("%d", (guint8) args[i].data.d_int8); break;
case PARAM_FLOAT: trace_printf ("%f", args[i].data.d_float); break;
case PARAM_STRING: trace_printf ("\"%s\"", args[i].data.d_string); break;
case PARAM_DISPLAY: trace_printf ("%d", args[i].data.d_display); break;
case PARAM_IMAGE: trace_printf ("%d", args[i].data.d_image); break;
case PARAM_LAYER: trace_printf ("%d", args[i].data.d_layer); break;
case PARAM_CHANNEL: trace_printf ("%d", args[i].data.d_channel); break;
case PARAM_DRAWABLE: trace_printf ("%d", args[i].data.d_drawable); break;
case PARAM_SELECTION: trace_printf ("%d", args[i].data.d_selection); break;
case PARAM_BOUNDARY: trace_printf ("%d", args[i].data.d_boundary); break;
case PARAM_PATH: trace_printf ("%d", args[i].data.d_path); break;
case PARAM_STATUS: trace_printf ("%d", args[i].data.d_status); break;
case PARAM_INT32ARRAY: dump_printarray (args, i, gint32, d_int32array, "%d"); break;
case PARAM_INT16ARRAY: dump_printarray (args, i, gint16, d_int16array, "%d"); break;
case PARAM_INT8ARRAY: dump_printarray (args, i, guint8, d_int8array , "%d"); break;
case PARAM_FLOATARRAY: dump_printarray (args, i, gfloat, d_floatarray, "%f"); break;
case PARAM_STRINGARRAY: dump_printarray (args, i, char* , d_stringarray, "'%s'"); break;
case PARAM_COLOR:
trace_printf ("[%d,%d,%d]",
args[i].data.d_color.red,
args[i].data.d_color.green,
args[i].data.d_color.blue);
break;
{
case PARAM_INT32: trace_printf ("%d", args[i].data.d_int32); break;
case PARAM_INT16: trace_printf ("%d", args[i].data.d_int16); break;
case PARAM_INT8: trace_printf ("%d", (guint8) args[i].data.d_int8); break;
case PARAM_FLOAT: trace_printf ("%f", args[i].data.d_float); break;
case PARAM_STRING: trace_printf ("\"%s\"", args[i].data.d_string); break;
case PARAM_DISPLAY: trace_printf ("%d", args[i].data.d_display); break;
case PARAM_IMAGE: trace_printf ("%d", args[i].data.d_image); break;
case PARAM_LAYER: trace_printf ("%d", args[i].data.d_layer); break;
case PARAM_CHANNEL: trace_printf ("%d", args[i].data.d_channel); break;
case PARAM_DRAWABLE: trace_printf ("%d", args[i].data.d_drawable); break;
case PARAM_SELECTION: trace_printf ("%d", args[i].data.d_selection); break;
case PARAM_BOUNDARY: trace_printf ("%d", args[i].data.d_boundary); break;
case PARAM_PATH: trace_printf ("%d", args[i].data.d_path); break;
case PARAM_STATUS: trace_printf ("%d", args[i].data.d_status); break;
case PARAM_INT32ARRAY: dump_printarray (args, i, gint32, d_int32array, "%d"); break;
case PARAM_INT16ARRAY: dump_printarray (args, i, gint16, d_int16array, "%d"); break;
case PARAM_INT8ARRAY: dump_printarray (args, i, guint8, d_int8array , "%d"); break;
case PARAM_FLOATARRAY: dump_printarray (args, i, gfloat, d_floatarray, "%f"); break;
case PARAM_STRINGARRAY: dump_printarray (args, i, char* , d_stringarray, "'%s'"); break;
case PARAM_COLOR:
trace_printf ("[%d,%d,%d]",
args[i].data.d_color.red,
args[i].data.d_color.green,
args[i].data.d_color.blue);
break;
#if GIMP_PARASITE
case PARAM_PARASITE:
{
gint32 found = 0;
trace_printf ("[%s, ", args[i].data.d_parasite.name);
if (args[i].data.d_parasite.flags & PARASITE_PERSISTENT)
{
trace_printf ("PARASITE_PERSISTENT");
found |= PARASITE_PERSISTENT;
}
if (args[i].data.d_parasite.flags & ~found)
{
if (found)
trace_printf ("|");
trace_printf ("%d", args[i].data.d_parasite.flags & ~found);
}
trace_printf (", %d bytes data]", args[i].data.d_parasite.size);
}
break;
case PARAM_PARASITE:
{
gint32 found = 0;
trace_printf ("[%s, ", args[i].data.d_parasite.name);
if (args[i].data.d_parasite.flags & PARASITE_PERSISTENT)
{
trace_printf ("PARASITE_PERSISTENT");
found |= PARASITE_PERSISTENT;
}
if (args[i].data.d_parasite.flags & ~found)
{
if (found)
trace_printf ("|");
trace_printf ("%d", args[i].data.d_parasite.flags & ~found);
}
trace_printf (", %d bytes data]", args[i].data.d_parasite.size);
}
break;
#endif
default:
trace_printf ("(?%d?)", args[i].type);
}
default:
trace_printf ("(?%d?)", args[i].type);
}
if ((trace & TRACE_DESC) == TRACE_DESC)
trace_printf ("\t\"%s\"\n\t", params[i].description);
trace_printf ("\t\"%s\"\n\t", params[i].description);
else if (i < nparams - 1)
trace_printf (", ");
trace_printf (", ");
}
@ -391,55 +391,55 @@ convert_array2paramdef (AV *av, GParamDef **res)
if (av_len (av) >= 0)
for(;;)
{
int idx;
for (idx = 0; idx <= av_len (av); idx++)
{
SV *sv = *av_fetch (av, idx, 0);
SV *type = 0;
SV *name = 0;
SV *help = 0;
if (SvROK (sv) && SvTYPE (SvRV (sv)) == SVt_PVAV)
{
AV *av = (AV *)SvRV(sv);
SV **x;
if ((x = av_fetch (av, 0, 0))) type = *x;
if ((x = av_fetch (av, 1, 0))) name = *x;
if ((x = av_fetch (av, 2, 0))) help = *x;
}
else if (SvIOK(sv))
type = sv;
int idx;
for (idx = 0; idx <= av_len (av); idx++)
{
SV *sv = *av_fetch (av, idx, 0);
SV *type = 0;
SV *name = 0;
SV *help = 0;
if (SvROK (sv) && SvTYPE (SvRV (sv)) == SVt_PVAV)
{
AV *av = (AV *)SvRV(sv);
SV **x;
if ((x = av_fetch (av, 0, 0))) type = *x;
if ((x = av_fetch (av, 1, 0))) name = *x;
if ((x = av_fetch (av, 2, 0))) help = *x;
}
else if (SvIOK(sv))
type = sv;
if (type)
{
if (def)
{
if (is_array (SvIV (type)))
{
def->type = PARAM_INT32;
def->name = "array_size";
def->description = "the size of the following array";
def++;
}
def->type = SvIV (type);
def->name = name ? SvPV (name, dc) : 0;
def->description = help ? SvPV (help, dc) : 0;
def++;
}
else
count += 1 + !!is_array (SvIV (type));
}
else
croak ("malformed paramdef, expected [PARAM_TYPE,\"NAME\",\"DESCRIPTION\"] or PARAM_TYPE");
}
if (def)
break;
*res = def = g_new (GParamDef, count);
if (type)
{
if (def)
{
if (is_array (SvIV (type)))
{
def->type = PARAM_INT32;
def->name = "array_size";
def->description = "the size of the following array";
def++;
}
def->type = SvIV (type);
def->name = name ? SvPV (name, dc) : 0;
def->description = help ? SvPV (help, dc) : 0;
def++;
}
else
count += 1 + !!is_array (SvIV (type));
}
else
croak ("malformed paramdef, expected [PARAM_TYPE,\"NAME\",\"DESCRIPTION\"] or PARAM_TYPE");
}
if (def)
break;
*res = def = g_new (GParamDef, count);
}
else
*res = 0;
@ -452,15 +452,15 @@ param_stash (GParamType type)
{
static HV *bless_hv[PARAM_END]; /* initialized to zero */
static char *bless[PARAM_END] = {
0 , 0 , 0 , 0 , 0 ,
0 , 0 , 0 , 0 , 0 ,
PKG_COLOR , PKG_REGION , PKG_DISPLAY , PKG_IMAGE , PKG_LAYER ,
PKG_CHANNEL , PKG_DRAWABLE , PKG_SELECTION , 0 , 0 ,
0 , 0 , 0 , 0 , 0 ,
0 , 0 , 0 , 0 , 0 ,
PKG_COLOR , PKG_REGION , PKG_DISPLAY , PKG_IMAGE , PKG_LAYER ,
PKG_CHANNEL , PKG_DRAWABLE , PKG_SELECTION , 0 , 0 ,
#if GIMP_PARASITE
PKG_PARASITE,
PKG_PARASITE,
#endif
0
};
0
};
if (bless [type] && !bless_hv [type])
bless_hv [type] = gv_stashpv (bless [type], 1);
@ -487,15 +487,15 @@ unbless (SV *sv, char *type, char *croak_str)
{
if (sv_isobject (sv))
if (type == PKG_ANY
|| (type == PKG_ANYABLE && (sv_derived_from (sv, PKG_DRAWABLE)
|| sv_derived_from (sv, PKG_LAYER)
|| sv_derived_from (sv, PKG_CHANNEL)))
|| sv_derived_from (sv, type))
|| (type == PKG_ANYABLE && (sv_derived_from (sv, PKG_DRAWABLE)
|| sv_derived_from (sv, PKG_LAYER)
|| sv_derived_from (sv, PKG_CHANNEL)))
|| sv_derived_from (sv, type))
{
if (SvTYPE (SvRV (sv)) == SVt_PVMG)
return SvIV (SvRV (sv));
else
strcpy (croak_str, "only blessed scalars accepted here");
if (SvTYPE (SvRV (sv)) == SVt_PVMG)
return SvIV (SvRV (sv));
else
strcpy (croak_str, "only blessed scalars accepted here");
}
else
sprintf (croak_str, "argument type %s expected (not %s)", type, HvNAME(SvSTASH(SvRV(sv))));
@ -541,19 +541,19 @@ canonicalize_colour (char *err, SV *sv, GParamColor *c)
if (SvROK(sv))
{
if (SvTYPE(SvRV(sv)) == SVt_PVAV)
{
AV *av = (AV *)SvRV(sv);
if (av_len(av) == 2)
{
c->red = SvIV(*av_fetch(av, 0, 0));
c->green = SvIV(*av_fetch(av, 1, 0));
c->blue = SvIV(*av_fetch(av, 2, 0));
}
else
sprintf (err, "a color must have three components (array elements)");
}
{
AV *av = (AV *)SvRV(sv);
if (av_len(av) == 2)
{
c->red = SvIV(*av_fetch(av, 0, 0));
c->green = SvIV(*av_fetch(av, 1, 0));
c->blue = SvIV(*av_fetch(av, 2, 0));
}
else
sprintf (err, "a color must have three components (array elements)");
}
else
sprintf (err, "illegal type for colour specification");
sprintf (err, "illegal type for colour specification");
}
else
sprintf (err, "unable to grok colour specification");
@ -576,7 +576,7 @@ canonicalize_colour (char *err, SV *sv, GParamColor *c)
if (as_ref) \
av = newAV (); \
else \
EXTEND (sp, arg[-1].data.d_int32); \
EXTEND (SP, arg[-1].data.d_int32); \
for (j = 0; j < arg[-1].data.d_int32; j++) \
if (as_ref) \
av_push (av, newsv (arg->data.datatype[j])); \
@ -609,31 +609,31 @@ push_gimp_sv (GParam *arg, int array_as_ref)
case PARAM_PATH: sv = newSViv(arg->data.d_path ); break;
case PARAM_STATUS: sv = newSViv(arg->data.d_status ); break;
case PARAM_STRING:
sv = arg->data.d_string ? neuSVpv(arg->data.d_string)
: &PL_sv_undef;
break;
sv = arg->data.d_string ? neuSVpv(arg->data.d_string)
: &PL_sv_undef;
break;
case PARAM_COLOR:
{
/* difficult */
AV *av = newAV ();
av_push (av, newSViv (arg->data.d_color.red));
av_push (av, newSViv (arg->data.d_color.green));
av_push (av, newSViv (arg->data.d_color.blue));
sv = (SV *)av; /* no newRV, since we're getting autoblessed! */
}
break;
{
/* difficult */
AV *av = newAV ();
av_push (av, newSViv (arg->data.d_color.red));
av_push (av, newSViv (arg->data.d_color.green));
av_push (av, newSViv (arg->data.d_color.blue));
sv = (SV *)av; /* no newRV, since we're getting autoblessed! */
}
break;
#if GIMP_PARASITE
case PARAM_PARASITE:
{
AV *av = newAV ();
av_push (av, neuSVpv (arg->data.d_parasite.name));
av_push (av, newSViv (arg->data.d_parasite.flags));
av_push (av, newSVpv (arg->data.d_parasite.data, arg->data.d_parasite.size));
sv = (SV *)av; /* no newRV, since we're getting autoblessed! */
}
break;
{
AV *av = newAV ();
av_push (av, neuSVpv (arg->data.d_parasite.name));
av_push (av, newSViv (arg->data.d_parasite.flags));
av_push (av, newSVpv (arg->data.d_parasite.data, arg->data.d_parasite.size));
sv = (SV *)av; /* no newRV, since we're getting autoblessed! */
}
break;
#endif
/* did I say difficult before???? */
@ -642,11 +642,11 @@ push_gimp_sv (GParam *arg, int array_as_ref)
case PARAM_INT8ARRAY: push_gimp_av (arg, d_int8array , newSVu8, array_as_ref); break;
case PARAM_FLOATARRAY: push_gimp_av (arg, d_floatarray , newSVnv, array_as_ref); break;
case PARAM_STRINGARRAY: push_gimp_av (arg, d_stringarray, neuSVpv, array_as_ref); break;
default:
croak ("dunno how to return param type %d", arg->type);
/* sv = sv_newmortal ();*/
abort ();
croak ("dunno how to return param type %d", arg->type);
/* sv = newSV ();*/
/* abort ();*/
}
if (sv)
@ -666,7 +666,7 @@ push_gimp_sv (GParam *arg, int array_as_ref)
arg[-1].data.d_int32 = av_len (av) + 1; \
arg->data.datatype = g_new (type, av_len (av) + 1); \
for (i = 0; i <= av_len (av); i++) \
arg->data.datatype[i] = svxv (*av_fetch (av, i, 0)); \
arg->data.datatype[i] = svxv (*av_fetch (av, i, 0)); \
} \
else \
{ \
@ -677,8 +677,8 @@ push_gimp_sv (GParam *arg, int array_as_ref)
#define sv2gimp_extract_noref(fun,str) \
fun(sv); \
if (SvROK(sv)) \
sprintf (croak_str, "Unable to convert a reference to type '%s'\n", str); \
if (SvROK(sv)) \
sprintf (croak_str, "Unable to convert a reference to type '%s'\n", str); \
break;
/*
* convert a perl scalar into a GParam, return true if
@ -712,8 +712,8 @@ convert_sv2gimp (char *croak_str, GParam *arg, SV *sv)
arg->data.d_image = gimp_layer_get_image_id (unbless(sv, PKG_LAYER , croak_str));
else if (sv_derived_from (sv, PKG_CHANNEL ))
arg->data.d_image = gimp_channel_get_image_id (unbless(sv, PKG_CHANNEL , croak_str));
else if (sv_derived_from (sv, PKG_IMAGE) || !SvROK (sv))
{
else if (sv_derived_from (sv, PKG_IMAGE) || !SvROK (sv))
{
arg->data.d_image = unbless(sv, PKG_IMAGE , croak_str); break;
}
else
@ -723,32 +723,32 @@ convert_sv2gimp (char *croak_str, GParam *arg, SV *sv)
break;
case PARAM_COLOR:
canonicalize_colour (croak_str, sv, &arg->data.d_color);
break;
canonicalize_colour (croak_str, sv, &arg->data.d_color);
break;
#if GIMP_PARASITE
case PARAM_PARASITE:
if (SvROK(sv))
{
if (SvTYPE(SvRV(sv)) == SVt_PVAV)
{
AV *av = (AV *)SvRV(sv);
if (av_len(av) == 2)
{
arg->data.d_parasite.name = SvPv(*av_fetch(av, 0, 0));
arg->data.d_parasite.flags = SvIV(*av_fetch(av, 1, 0));
arg->data.d_parasite.data = SvPV(*av_fetch(av, 2, 0), arg->data.d_parasite.size);
}
else
sprintf (croak_str, "illegal parasite specification, expected three array members");
}
else
sprintf (croak_str, "illegal parasite specification, arrayref expected");
}
else
sprintf (croak_str, "illegal parasite specification, reference expected");
break;
if (SvROK(sv))
{
if (SvTYPE(SvRV(sv)) == SVt_PVAV)
{
AV *av = (AV *)SvRV(sv);
if (av_len(av) == 2)
{
arg->data.d_parasite.name = SvPv(*av_fetch(av, 0, 0));
arg->data.d_parasite.flags = SvIV(*av_fetch(av, 1, 0));
arg->data.d_parasite.data = SvPV(*av_fetch(av, 2, 0), arg->data.d_parasite.size);
}
else
sprintf (croak_str, "illegal parasite specification, expected three array members");
}
else
sprintf (croak_str, "illegal parasite specification, arrayref expected");
}
else
sprintf (croak_str, "illegal parasite specification, reference expected");
break;
#endif
case PARAM_INT32ARRAY: av2gimp (arg, sv, d_int32array , gint32 , Sv32); break;
@ -756,9 +756,9 @@ convert_sv2gimp (char *croak_str, GParam *arg, SV *sv)
case PARAM_INT8ARRAY: av2gimp (arg, sv, d_int8array , gint8 , SvIV); break;
case PARAM_FLOATARRAY: av2gimp (arg, sv, d_floatarray , gdouble, SvNV); break;
case PARAM_STRINGARRAY: av2gimp (arg, sv, d_stringarray, gchar *, SvPv); break;
default:
sprintf (croak_str, "dunno how to pass arg type %d", arg->type);
sprintf (croak_str, "dunno how to pass arg type %d", arg->type);
}
return 1;
@ -773,13 +773,13 @@ destroy_params (GParam *arg, int count)
for (i = 0; i < count; i++)
switch (arg[i].type)
{
case PARAM_INT32ARRAY: g_free (arg[i].data.d_int32array); break;
case PARAM_INT16ARRAY: g_free (arg[i].data.d_int16array); break;
case PARAM_INT8ARRAY: g_free (arg[i].data.d_int8array); break;
case PARAM_FLOATARRAY: g_free (arg[i].data.d_floatarray); break;
case PARAM_STRINGARRAY: g_free (arg[i].data.d_stringarray); break;
default: ;
case PARAM_INT32ARRAY: g_free (arg[i].data.d_int32array); break;
case PARAM_INT16ARRAY: g_free (arg[i].data.d_int16array); break;
case PARAM_INT8ARRAY: g_free (arg[i].data.d_int8array); break;
case PARAM_FLOATARRAY: g_free (arg[i].data.d_floatarray); break;
case PARAM_STRINGARRAY: g_free (arg[i].data.d_stringarray); break;
default: ;
}
g_free (arg);
@ -803,26 +803,17 @@ destroy_paramdefs (GParamDef *arg, int count)
}
#endif
/* calls Gimp::die_msg. */
static void gimp_die_msg (char *msg)
static void simple_perl_call (char *function, char *arg1)
{
char *argv[2];
argv[0] = msg;
argv[0] = arg1;
argv[1] = 0;
perl_call_argv ("Gimp::die_msg", G_DISCARD, argv);
perl_call_argv (function, G_DISCARD|G_EVAL, argv);
}
/* first check wether the procedure exists at all. */
static void try_call (char *name)
{
char *argv[2];
argv[0] = name;
argv[1] = 0;
perl_call_argv ("Gimp::callback", G_DISCARD, argv);
}
#define gimp_die_msg(msg) simple_perl_call ("Gimp::die_msg" , (msg))
#define try_call(cb) simple_perl_call ("Gimp::callback", (cb) )
static void pii_init (void) { try_call ("-init" ); }
static void pii_query(void) { try_call ("-query"); }
@ -835,6 +826,7 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
dSP;
STRLEN dc;
int i, count;
char *err_msg = 0;
@ -848,9 +840,15 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
GParamDef *params;
GParamDef *return_defs;
if (return_vals) /* the libgimp is soooooooo braindamaged. */
{
destroy_params (return_vals, nreturn_vals);
return_vals = 0;
}
if (gimp_query_procedure (name, &proc_blurb, &proc_help, &proc_author,
&proc_copyright, &proc_date, &proc_type, &_nparams, &nreturn_vals,
&params, &return_defs) == TRUE)
&proc_copyright, &proc_date, &proc_type, &_nparams, &nreturn_vals,
&params, &return_defs) == TRUE)
{
g_free (proc_blurb);
g_free (proc_help);
@ -862,90 +860,92 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
ENTER;
SAVETMPS;
PUSHMARK(sp);
PUSHMARK(SP);
XPUSHs (newSVpv ("-run", 4));
XPUSHs (newSVpv (name, 0));
EXTEND (SP, 3);
PUSHs (sv_2mortal (newSVpv ("-run", 4)));
PUSHs (sv_2mortal (newSVpv (name, 0)));
if (nparams)
{
EXTEND (sp, perl_param_count (param, nparams));
PUTBACK;
for (i = 0; i < nparams; i++)
{
if (i < nparams-1 && is_array (param[i+1].type))
i++;
push_gimp_sv (param+i, nparams > 2);
}
SPAGAIN;
}
{
EXTEND (SP, perl_param_count (param, nparams));
PUTBACK;
for (i = 0; i < nparams; i++)
{
if (i < nparams-1 && is_array (param[i+1].type))
i++;
push_gimp_sv (param+i, nparams > 2);
}
SPAGAIN;
}
else
PUTBACK;
count = perl_call_pv ("Gimp::callback", G_EVAL
| (nparams ? 0 : G_NOARGS)
| (nreturn_vals == 0 ? G_VOID|G_DISCARD : nreturn_vals == 1 ? G_SCALAR : G_ARRAY));
| (nreturn_vals == 0 ? G_VOID|G_DISCARD : nreturn_vals == 1 ? G_SCALAR : G_ARRAY));
SPAGAIN;
if (count == 1 && !SvOK (TOPs))
{
POPs;
count = 0;
}
{
POPs;
count = 0;
}
if (SvTRUE (ERRSV))
{
if (strEQ ("BE QUIET ABOUT THIS DIE\n", SvPV (ERRSV, dc)))
{
nreturn_vals = 1;
return_vals = g_new (GParam, 1);
return_vals->type = PARAM_STATUS;
return_vals->data.d_status = STATUS_SUCCESS;
*xnreturn_vals = nreturn_vals;
*xreturn_vals = return_vals;
}
else
err_msg = g_strdup (SvPV (ERRSV, dc));
}
{
if (strEQ ("BE QUIET ABOUT THIS DIE\n", SvPV (ERRSV, dc)))
{
nreturn_vals = 0;
return_vals = g_new (GParam, 1);
return_vals->type = PARAM_STATUS;
return_vals->data.d_status = STATUS_SUCCESS;
*xnreturn_vals = nreturn_vals+1;
*xreturn_vals = return_vals;
}
else
err_msg = g_strdup (SvPV (ERRSV, dc));
}
else
{
int i;
char errmsg [MAX_STRING];
errmsg [0] = 0;
return_vals = (GParam *) g_new0 (GParam, nreturn_vals + 1);
return_vals->type = PARAM_STATUS;
return_vals->data.d_status = STATUS_SUCCESS;
*xnreturn_vals = nreturn_vals;
*xreturn_vals = return_vals++;
{
int i;
char errmsg [MAX_STRING];
errmsg [0] = 0;
return_vals = (GParam *) g_new0 (GParam, nreturn_vals+1);
return_vals->type = PARAM_STATUS;
return_vals->data.d_status = STATUS_SUCCESS;
*xnreturn_vals = nreturn_vals+1;
*xreturn_vals = return_vals++;
for (i = nreturn_vals; i-- && count; )
{
return_vals[i].type = return_defs[i].type;
if ((i >= nreturn_vals-1 || !is_array (return_defs[i+1].type))
&& convert_sv2gimp (errmsg, &return_vals[i], TOPs))
{
--count;
POPs;
}
if (errmsg [0])
{
err_msg = g_strdup (errmsg);
break;
}
}
if (count && !err_msg)
err_msg = strdup_printf ("plug-in returned %d more values than expected", count);
}
for (i = nreturn_vals; i-- && count; )
{
return_vals[i].type = return_defs[i].type;
if ((i >= nreturn_vals-1 || !is_array (return_defs[i+1].type))
&& convert_sv2gimp (errmsg, &return_vals[i], TOPs))
{
--count;
POPs;
}
if (errmsg [0])
{
err_msg = g_strdup (errmsg);
break;
}
}
if (count && !err_msg)
err_msg = strdup_printf ("plug-in returned %d more values than expected", count);
}
while (count--)
POPs;
POPs;
destroy_paramdefs (return_defs, nreturn_vals);
PUTBACK;
FREETMPS;
LEAVE;
}
@ -958,13 +958,13 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
g_free (err_msg);
if (return_vals)
destroy_params (*xreturn_vals, nreturn_vals+1);
destroy_params (*xreturn_vals, nreturn_vals+1);
nreturn_vals = 1;
nreturn_vals = 0;
return_vals = g_new (GParam, 1);
return_vals->type = PARAM_STATUS;
return_vals->data.d_status = STATUS_EXECUTION_ERROR;
*xnreturn_vals = nreturn_vals;
*xnreturn_vals = nreturn_vals+1;
*xreturn_vals = return_vals;
}
}
@ -1062,9 +1062,9 @@ gimp_main(...)
else
croak ("arguments to main not yet supported!");
gimp_is_initialized = 1;
gimp_is_initialized = 1;
RETVAL = gimp_main (argc, argv);
gimp_is_initialized = 0;
gimp_is_initialized = 0;
}
OUTPUT:
RETVAL
@ -1074,28 +1074,28 @@ PROTOTYPES: ENABLE
int
initialized()
CODE:
RETVAL = gimp_is_initialized;
RETVAL = gimp_is_initialized;
OUTPUT:
RETVAL
int
gimp_major_version()
CODE:
RETVAL = gimp_major_version;
RETVAL = gimp_major_version;
OUTPUT:
RETVAL
int
gimp_minor_version()
CODE:
RETVAL = gimp_minor_version;
RETVAL = gimp_minor_version;
OUTPUT:
RETVAL
int
gimp_micro_version()
CODE:
RETVAL = gimp_micro_version;
RETVAL = gimp_micro_version;
OUTPUT:
RETVAL
@ -1227,21 +1227,21 @@ gimp_call_procedure (proc_name, ...)
trace_printf (" = ");
}
if (j != items-1)
if (j != items-1 || i < nparams)
{
if (trace & TRACE_CALL)
trace_printf ("[unfinished]\n");
sprintf (croak_str, "%s arguments (%d) for function '%s'",
j == items ? "not enough" : "too many", (int)items-1, proc_name);
(j == items || i < nparams) ? "not enough" : "too many", (int)items-1, proc_name);
if (nparams)
destroy_params (args, nparams);
}
else
{
values = gimp_run_procedure2 (proc_name, &nvalues, nparams, args);
values = gimp_run_procedure2 (proc_name, &nvalues, nparams, args);
if (nparams)
destroy_params (args, nparams);
@ -1251,33 +1251,33 @@ gimp_call_procedure (proc_name, ...)
trace_printf ("\n");
}
if (values && values[0].type == PARAM_STATUS)
{
if (values[0].data.d_status == STATUS_EXECUTION_ERROR)
sprintf (croak_str, "%s: procedural database execution failed", proc_name);
else if (values[0].data.d_status == STATUS_CALLING_ERROR)
sprintf (croak_str, "%s: procedural database execution failed on invalid input arguments", proc_name);
else if (values[0].data.d_status == STATUS_SUCCESS)
{
EXTEND(sp, perl_paramdef_count (return_vals, nvalues-1));
PUTBACK;
for (i = 0; i < nvalues-1; i++)
{
if (values && values[0].type == PARAM_STATUS)
{
if (values[0].data.d_status == STATUS_EXECUTION_ERROR)
sprintf (croak_str, "%s: procedural database execution failed", proc_name);
else if (values[0].data.d_status == STATUS_CALLING_ERROR)
sprintf (croak_str, "%s: procedural database execution failed on invalid input arguments", proc_name);
else if (values[0].data.d_status == STATUS_SUCCESS)
{
EXTEND(SP, perl_paramdef_count (return_vals, nvalues-1));
PUTBACK;
for (i = 0; i < nvalues-1; i++)
{
if (i < nvalues-2 && is_array (values[i+2].type))
i++;
push_gimp_sv (values+i+1, nvalues > 2+1);
}
SPAGAIN;
}
else
sprintf (croak_str, "unsupported status code: %d\n", values[0].data.d_status);
}
else
sprintf (croak_str, "gimp returned, well.. dunno how to interpret that...");
}
SPAGAIN;
}
else
sprintf (croak_str, "unsupported status code: %d\n", values[0].data.d_status);
}
else
sprintf (croak_str, "gimp returned, well.. dunno how to interpret that...");
}
}
error:
@ -1411,7 +1411,7 @@ gimp_get_data(id)
}
#endif
XPUSHs (data);
XPUSHs (sv_2mortal (data));
}
void
@ -1452,7 +1452,7 @@ gimp_drawable_get(drawable_ID)
mg = mg_find (sv, '~');
mg->mg_virtual = &vtbl_gdrawable;
hv_store (hv, "_gdr" , 4, sv , 0);
hv_store (hv, "_gdrawable" ,10, sv , 0);
hv_store (hv, "_width" , 6, newSViv (gdr->width) , 0);
hv_store (hv, "_height" , 7, newSViv (gdr->height) , 0);
hv_store (hv, "_ntile_rows" ,11, newSViv (gdr->ntile_rows) , 0);
@ -1552,15 +1552,15 @@ gimp_pixel_rgn_init(gdrawable, x, y, width, height, dirty, shadow)
gimp_pixel_rgn_init (pr, old_gdrawable (gdrawable), x, y, width, height, dirty, shadow);
hv_store (hv, "_rgn" , 4, sv , 0);
hv_store (hv, "_x" , 2, newSViv (pr->x) , 0);
hv_store (hv, "_y" , 2, newSViv (pr->y) , 0);
hv_store (hv, "_w" , 2, newSViv (pr->w) , 0);
hv_store (hv, "_h" , 2, newSViv (pr->h) , 0);
hv_store (hv, "_rgn" , 4, sv , 0);
hv_store (hv, "_x" , 2, newSViv (pr->x) , 0);
hv_store (hv, "_y" , 2, newSViv (pr->y) , 0);
hv_store (hv, "_w" , 2, newSViv (pr->w) , 0);
hv_store (hv, "_h" , 2, newSViv (pr->h) , 0);
hv_store (hv, "_rowstride",10, newSViv (pr->rowstride) , 0);
hv_store (hv, "_bpp" , 4, newSViv (pr->bpp) , 0);
hv_store (hv, "_shadow" , 7, newSViv (pr->shadow) , 0);
hv_store (hv, "_drawable",9, newSVsv (gdrawable) , 0);
hv_store (hv, "_bpp" , 4, newSViv (pr->bpp) , 0);
hv_store (hv, "_shadow" , 7, newSViv (pr->shadow) , 0);
hv_store (hv, "_drawable" , 9, SvREFCNT_inc (gdrawable) , 0);
if (!stash)
stash = gv_stashpv (PKG_PIXELRGN, 1);
@ -1573,8 +1573,8 @@ gimp_pixel_rgn_init(gdrawable, x, y, width, height, dirty, shadow)
guint
gimp_pixel_rgn_dirty(pr)
GPixelRgn * pr
CODE:
RETVAL = pr->dirty;
CODE:
RETVAL = pr->dirty;
OUTPUT:
RETVAL
@ -1771,13 +1771,13 @@ gimp_patterns_get_pattern_data(name)
if (nreturn_vals == 7
&& return_vals[0].data.d_status == STATUS_SUCCESS)
{
EXTEND (sp, 5);
EXTEND (SP, 5);
PUSHs (newSVpv (return_vals[1].data.d_string, 0));
PUSHs (newSViv (return_vals[2].data.d_int32));
PUSHs (newSViv (return_vals[3].data.d_int32));
PUSHs (newSViv (return_vals[4].data.d_int32));
PUSHs (newSVpvn(return_vals[6].data.d_int8array, return_vals[5].data.d_int32));
PUSHs (sv_2mortal (newSVpv (return_vals[1].data.d_string, 0)));
PUSHs (sv_2mortal (newSViv (return_vals[2].data.d_int32)));
PUSHs (sv_2mortal (newSViv (return_vals[3].data.d_int32)));
PUSHs (sv_2mortal (newSViv (return_vals[4].data.d_int32)));
PUSHs (sv_2mortal (newSVpvn(return_vals[6].data.d_int8array, return_vals[5].data.d_int32)));
}
gimp_destroy_params (return_vals, nreturn_vals);

3
plug-ins/perl/Gimp/Net.pm
View File

@ -236,7 +236,8 @@ sub gimp_init {
sub gimp_end {
$initialized = 0;
close $server_fh;
close $server_fh if $server_fh;
undef $server_fh;
kill 'KILL',$gimp_pid if $gimp_pid;
undef $gimp_pid;
}

10
plug-ins/perl/Gimp/PDL.pm
View File

@ -18,7 +18,7 @@ sub Gimp::Tile::get_data($) {
my($tile)=@_;
my($pdl)=new_from_specification PDL (byte,width(),height(),
$tile->bpp > 1 ? $tile->bpp : ());
${$pdl->get_dataref} = &Gimp::Tile::_get_data;
${$pdl->get_dataref} = Gimp::Tile::_get_data(@_);
$pdl->upd_data;
return $pdl;
};
@ -26,7 +26,7 @@ sub Gimp::Tile::get_data($) {
sub Gimp::PixelRgn::get_pixel {
my($rgn)=@_;
my($pdl)=new_from_specification PDL (byte,$_[0]->bpp);
${$pdl->get_dataref} = &Gimp::PixelRgn::_get_pixel;
${$pdl->get_dataref} = Gimp::PixelRgn::_get_pixel(@_);
$pdl->upd_data;
return $pdl;
};
@ -34,7 +34,7 @@ sub Gimp::PixelRgn::get_pixel {
sub Gimp::PixelRgn::get_col {
my($rgn)=@_;
my($pdl)=new_from_specification PDL (byte,$_[0]->bpp,$_[3]);
${$pdl->get_dataref} = &Gimp::PixelRgn::__get_col;
${$pdl->get_dataref} = Gimp::PixelRgn::__get_col(@_);
$pdl->upd_data;
return $pdl;
};
@ -42,14 +42,14 @@ sub Gimp::PixelRgn::get_col {
sub Gimp::PixelRgn::get_row {
my($rgn)=@_;
my($pdl)=new_from_specification PDL (byte,$_[0]->bpp,$_[3]);
${$pdl->get_dataref} = &Gimp::PixelRgn::_get_row;
${$pdl->get_dataref} = Gimp::PixelRgn::_get_row(@_);
$pdl->upd_data;
return $pdl;
};
sub Gimp::PixelRgn::get_rect {
my($pdl)=new_from_specification PDL (byte,$_[0]->bpp,$_[3],$_[4]);
${$pdl->get_dataref} = &Gimp::PixelRgn::_get_rect;
${$pdl->get_dataref} = Gimp::PixelRgn::_get_rect(@_);
$pdl->upd_data;
return $pdl;
};

1
plug-ins/perl/Gimp/Util.pm
View File

@ -271,7 +271,6 @@ sub gimp_image_layertype {
sub gimp_image_add_new_layer {
my ($image,$index,$filltype,$alpha)=@_;
print "ALPHA $alpha\n";
my $layer = new Layer ($image, $image->width, $image->height, $image->layertype (defined $alpha ? $alpha : 1), join(":",(caller)[1,2]), 100, NORMAL_MODE);
$layer->fill (defined $filltype ? $filltype : BG_IMAGE_FILL);
$image->add_layer ($layer, $index*1);

2
plug-ins/perl/MANIFEST
View File

@ -68,3 +68,5 @@ examples/sethspin.pl
examples/animate_cells
examples/yinyang
examples/image_tile
examples/stamps

2
plug-ins/perl/Makefile.PL
View File

@ -9,7 +9,7 @@ $|=1;
qw(windy.pl prep4gif.pl webify.pl PDB alpha2color.pl tex-to-float ditherize.pl
border.pl view3d.pl feedback.pl xachlego.pl xachshadow.pl parasite-editor
scratches.pl blowinout.pl terral_text xachvision.pl gimpmagick perlcc
sethspin.pl animate_cells image_tile yinyang
sethspin.pl animate_cells image_tile yinyang stamps
);
@shebang = (map("examples/$_",@examples),
qw(Perl-Server examples/example-net.pl examples/homepage-logo.pl

2
plug-ins/perl/TODO
View File

@ -22,7 +22,7 @@ important issues
* Gimp::Fu import after Gimp? use Gimp::main for Gimp::Fu??
* generic config query mechanism
* Gimp->server_eval()
* supply a gimp-1.1 compatible gimp_progress_init
[DONE] * supply a gimp-1.1 compatible gimp_progress_init
* install scripts in share/
[DONE] * fix auto-edit shebang for check-ins
[DONE] * gimp-tiles are not accessible in any way..

2
plug-ins/perl/examples/PDB
View File

@ -2,7 +2,7 @@
#BEGIN {$^W=1};
use Gimp::Feature qw(:perl-5.005 :gtk);
use Gimp::Feature qw(perl-5.005 gtk);
use Gimp (':consts');
use Gimp::Fu;
use Gtk;

4
plug-ins/perl/examples/blowinout.pl
View File

@ -3,7 +3,7 @@
# Blow In/Out
# John Pitney
use Gimp;
use Gimp 1.06;
use Gimp::Fu;
# print "hello there\n";
@ -102,6 +102,8 @@ register
[PF_RADIO, "direction", "Blow direction", 0, [["In", 1],["Out", 0]]],
[PF_RADIO, "series", "Kind of series", 1, [["Arithmetic",1],["Geometric",0]]]
],
[],
['gtk-1.2'],
\&blowinout;
exit main;

2
plug-ins/perl/examples/border.pl
View File

@ -2,7 +2,7 @@
#BEGIN {$^W=1};
use Gimp::Feature qw(:pdl);
use Gimp::Feature qw(pdl);
use Gimp;
use Gimp::Fu;
use Gimp::PDL;

2
plug-ins/perl/examples/gimpmagick
View File

@ -1,6 +1,6 @@
#!/usr/bin/perl
use Gimp::Feature qw(:gtk :perl-5.005);
use Gimp::Feature qw(gtk perl-5.005);
use Gimp 1.06;
use Gimp::Fu;
use Gtk;

2
plug-ins/perl/examples/parasite-editor
View File

@ -2,7 +2,7 @@
#BEGIN {$^W=1};
use Gimp::Feature qw(:perl-5.005 :gtk);
use Gimp::Feature qw(perl-5.005 gtk);
use Gimp ();
use Gimp::Fu;
use Gtk;

2
plug-ins/perl/examples/perlcc
View File

@ -56,7 +56,7 @@ sub generate_log {
sub gtkview_log {
if ($_[0]) {
destroy $_[0];
$_[0]->destroy;
undef $_[0];
} else {
my($title,$log)=@_[1,2];

160
plug-ins/perl/examples/sethspin.pl
View File

@ -1,34 +1,28 @@
#!/usr/bin/perl
#!/usr/bin/perl -w
# This one's all mine. Well, its GPL but I"m the author and creator.
# I think you need gimp 1.1 or better for this - if you don't, please let
# This one's all mine. Well, its GPL/Artisitic but I"m the author and creator. # I think you need gimp 1.1 or better for this - if you don't, please let
# me know
# As a fair warning, some of this code is a bit ugly. But thats perl for ya :)
#
# Revision History:
# 1.0 - Initial (too early) release
# 1.1 - Second (still ugly) release: Made the perspective setting actually do
# something
# 1.2 - Used some of the convienence functions, and made things a little eaiser
# from the user's standpoint too. Also moved it from the
# Filters->Animations-> menu to Xtns->Animations. I think its
# clearer whats going on this way. It also works w/ any 2 layers now.
# Seth Burgess
# <sjburges@gimp.org>
use Gimp;
use Gimp 1.06;
use Gimp::Fu;
use Gimp::Util;
# Gimp::set_trace(TRACE_ALL);
sub hideallbut {
($img, @butlist) = @_;
@layers = $img->get_layers();
foreach $layer (@layers) {
if ($layer->get_visible()) {
$layer->set_visible(0);
}
}
foreach $but (@butlist) {
if (! $layers[$but]->get_visible()) {
$layers[$but]->set_visible(1);
}
}
};
sub saw { # a sawtooth function on PI
($val) = @_;
if ($val < 3.14159/2.0) {
@ -42,40 +36,34 @@ sub saw { # a sawtooth function on PI
}
else {
return (-1+$val/3.14159);
};
};
}
}
sub spin_layer {
my ($img, $spin, $dest, $numframes) = @_;
# Now lets spin it!
sub spin_layer { # the function for actually spinning the layer
my ($img, $spin, $dest, $numframes, $prp) = @_;
# Now lets spin it!
$stepsize = 3.14159/$numframes; # in radians
for ($i=0; $i<=3.14159; $i+=$stepsize) {
# create a new layer for spinning
if ($i < 3.14159/2.0) {
$framelay = $spin->layer_copy(1);
}
else {
$framelay = $dest->layer_copy(1);
}
$framelay = ($i < 3.14159/2.0) ? $spin->copy(1) : $dest->copy(1);
$img->add_layer($framelay, 0);
# spin it a step
$img->selection_all();
@x = $img->selection_bounds();
# x[1],x[2] x[3],x[2]
# x[1],x[4] x[3],x[4]
$psp = 0.2; # The perspective amount
$floater = $framelay->perspective(1,
$x[1]+saw($i)*$psp*$framelay->width,$x[2]+$spin->height *sin($i)/2,
$x[3]-saw($i)*$psp*$framelay->width,$x[2]+$spin->height *sin($i)/2,
$x[1]-saw($i)*$psp*$framelay->width,$x[4]-$spin->height *sin($i)/2,
$x[3]+saw($i)*$psp*$framelay->width,$x[4]-$spin->height *sin($i)/2);
$floater->floating_sel_to_layer();
$x[1]+saw($i)*$prp*$framelay->width,$x[2]+$spin->height *sin($i)/2,
$x[3]-saw($i)*$prp*$framelay->width,$x[2]+$spin->height *sin($i)/2,
$x[1]-saw($i)*$prp*$framelay->width,$x[4]-$spin->height *sin($i)/2,
$x[3]+saw($i)*$prp*$framelay->width,$x[4]-$spin->height *sin($i)/2);
$floater->floating_sel_to_layer;
# fill entire layer with background
$framelay->fill(1); # BG-IMAGE-FILL
}
for ($i=0; $i<$numframes; $i++) {
hideallbut($img, $i, $i+1);
@all_layers = $img->get_layers();
$img->set_visible($all_layers[$i],$all_layers[$i+1]);
$img->merge_visible_layers(0);
}
@all_layers = $img->get_layers();
@ -85,64 +73,90 @@ sub spin_layer {
# clean up my temporary layers
$img->remove_layer($all_layers[$numframes]);
$img->remove_layer($all_layers[$numframes+1]);
};
}
register "seth_spin",
"Seth Spin",
"Take one image. Spin it about the horizontal axis, and end up with another image. I made it for easy web buttons.",
"Seth Burgess",
"Seth Burgess <sjburges\@gimp.org>",
"1.0",
"<Image>/Filters/Animation/Seth Spin",
"RGB*, GRAY*",
"1.0.1",
"<Toolbox>/Xtns/Animation/Seth Spin",
"*",
[
[PF_DRAWABLE, "Source", "What drawable to spin from?"],
[PF_DRAWABLE, "Destination","What drawable to spin to?"],
[PF_INT8, "Frames", "How many frames to use?", 8],
[PF_COLOR, "Background", "What color to use for background if not transparent", [0,0,0]],
[PF_SLIDER, "Perspective", "How much perspective effect to get", 40, [0,255,5]],
[PF_TOGGLE, "Spin Back", "Should it also spin back? Will double the number of frames", 1],
[PF_INT8, "Frames", "How many frames to use?", 16],
[PF_COLOR, "Background", "What color to use for background if not transparent", [0,0,0]],
[PF_SLIDER, "Perspective", "How much perspective effect to get", 40, [0,255,5]],
[PF_TOGGLE, "Spin Back", "Also spin back?" , 1],
[PF_TOGGLE, "Convert Indexed", "Convert to indexed?", 1],
],
[],
['gimp-1.1'],
sub {
my($img,$src,$dest,$frames,$color,$psp,$spinback) =@_;
eval { $img->undo_push_group_start };
my($src,$dest,$frames,$color,$psp,$spinback,$indexed) =@_;
$maxwide = ($src->width > $dest->width) ? $src->width : $dest->width;
$maxhigh = ($src->height > $dest->height) ? $src->height: $dest->height;
$img = gimp_image_new($maxwide, $maxhigh, RGB);
$tmpimglayer = $img->add_new_layer(0,3,1);
$oldbackground = gimp_palette_get_background();
gimp_palette_set_background($color);
# Create the new layer that the spin will occur on...
$src->edit_copy();
$spinlayer = $src->edit_paste(1);
$spinlayer = $tmpimglayer->edit_paste(1);
$spinlayer->floating_sel_to_layer();
$dest->edit_copy();
$destlayer = $dest->edit_paste(1);
$destlayer = $tmpimglayer->edit_paste(1);
$destlayer->floating_sel_to_layer();
spin_layer($img, $spinlayer, $destlayer, $frames);
$tmpimglayer->remove_layer;
$spinlayer->resize($maxwide, $maxhigh, $spinlayer->offsets);
$destlayer->resize($maxwide, $maxhigh, $destlayer->offsets);
# work around for PF_SLIDER when < 1
$psp = $psp/255.0;
# need an even number of frames for spinback
if ($frames%2 && $spinback) {
$frames++;
gimp_message("An even number of frames is needed for spin back.\nAdjusted frames up to $frames");
}
spin_layer($img, $spinlayer, $destlayer, $spinback ? $frames/2 : $frames-1, $psp);
# it makes ugly sounds on the next line, but no harm is done.
$img->set_visible($img->add_new_layer(1),($img->get_layers)[0]);
$img->merge_visible_layers(0);
if ($spinback) {
@layerlist = $img->get_layers();
$img->add_layer($layerlist[$frames]->copy(0),0);
$img->remove_layer($layerlist[$frames]);
$img->add_layer($layerlist[$frames/2]->copy(0),0);
@layerlist = $img->get_layers();
spin_layer($img, $layerlist[1], $layerlist[0], $frames);
$realframes = 2*$frames;
spin_layer($img, $layerlist[1], $layerlist[0], $frames/2, $psp);
$img->remove_layer(($img->get_layers)[0]);
}
else {
$realframes = $frames;
}
# unhide and name layers
@all_layers = $img->get_layers();
for ($i=0; $i<$realframes ; $i++) {
$all_layers[$i]->set_visible(1);
$all_layers[$i]->set_name("Spin Layer $i");
}
gimp_palette_set_background($oldbackground);
eval { $img->undo_push_group_end };
gimp_displays_flush();
# unhide and name layers
@all_layers = $img->get_layers;
$img->set_visible(@all_layers);
for ($i=1; $i<=$frames ; $i++) {
$all_layers[$i-1]->set_name("Spin Layer $i (50ms)");
}
$all_layers[$frames-1]->set_name("Spin Layer SRC (250ms)");
if ($spinback) {
$all_layers[$frames/2-1]->set_name("Spin Layer DEST (250ms)");
}
else { $all_layers[0]->set_name("Spin Layer DEST (250ms)")}
$img->display_new;
# indexed conversion wants a display for some reason
if ($indexed) { $img->convert_indexed(1,255); }
gimp_palette_set_background($oldbackground);
return();
};

56
plug-ins/perl/examples/stamps Executable file
View File

@ -0,0 +1,56 @@
#!/usr/bin/perl
use Gimp qw( :auto );
use Gimp::Fu;
sub stamps {
my ($size, $bgcolor, $fgcolor, $diameter, $gap) = @_;
gimp_palette_set_background($fgcolor);
$img = gimp_image_new($size, $size, RGB);
$img = gimp_image_new($size, $size, RGB);
$layer = gimp_layer_new($img, $size, $size, RGB, "Layer 1", 100, NORMAL_MODE);
gimp_image_add_layer($layer, -1);
gimp_palette_set_background($bgcolor);
$layer->gimp_edit_fill;
gimp_palette_set_background($fgcolor);
my $ncircles = int(($size + $gap) / ($diameter + $gap));
$x = 0;
for ($i=0; $i<$ncircles; $i++) {
gimp_ellipse_select($img,
$x, 0,
$diameter, $diameter,
REPLACE, 1, 0, 0);
gimp_ellipse_select($img,
0, $x,
$diameter, $diameter,
REPLACE, 1, 0, 0);
$x = $x + $diameter + $gap;
gimp_palette_set_foreground($fgcolor);
gimp_edit_fill($layer);
gimp_selection_none($img);
}
$layer->channel_ops_offset(1, 0, -($diameter / 2), -($diameter / 2));
return $img;
}
register "stamps",
"Makes stamp-like perforations",
"Default values are not bad!",
"claesg\@algonet.se",
"Claes G Lindblad",
"990314",
"<Toolbox>/Xtns/Render/Stamps",
"*",
[
[PF_INT32, "size", "Img size", 90],
[PF_COLOR, "fgcolor", "fg color", [255, 255, 255]],
[PF_COLOR, "bgcolor", "bg color", [0, 0, 0]],
[PF_INT32, "diameter", "Diameter", 10],
[PF_INT32, "gap", "Gap", 5]
],
\&stamps;
exit main;

4
plug-ins/perl/examples/terral_text
View File

@ -39,7 +39,7 @@ register
"Otherwise, it overwrites the current layer and uses a solid noise",
"Seth Burgess",
"Seth Burgess <sjburges\@gimp.org>",
"1999-02-26",
"1999-03-14",
"<Image>/Filters/Render/Terral Text",
"RGB*,GRAY*",
[
@ -48,6 +48,8 @@ register
[ PF_STRING, "Text", "Enter your Text to be Terral-ified", "TerralText"],
[ PF_SLIDER, "Blur Amount", "Blur Amount", 10, [0,26,1]],
],
[],
['gtk-1.2'],
sub {
($img, $pattern, $solidnoise, $font, $text, $blur) = @_;
$oldbg = gimp_palette_get_background();

2
plug-ins/perl/examples/view3d.pl
View File

@ -3,7 +3,7 @@
BEGIN { $^W=1 }
use strict;
use Gimp::Feature qw(:pdl);
use Gimp::Feature qw(pdl);
BEGIN { eval "use PDL::Graphics::TriD"; $@ and Gimp::Feature::missing('PDL TriD (OpenGL) support') }
use Gimp;
use Gimp::Fu;