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-23 21:21:11 +00:00
parent 1a3398f0bb
commit 16e6b8bd1d
39 changed files with 652 additions and 348 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
plug-ins/perl/Changes
View File

@ -1,5 +1,6 @@
Revision history for Gimp-Perl extension.
1.071 Tue Mar 23 13:47:10 CET 1999
- changed the definition of PF_RADIO, simplifying it (it ain't no C).
- Gimp::Fu scripts try to run with default arguments if Gtk is not
available.
@ -10,6 +11,15 @@ Revision history for Gimp-Perl extension.
bangpath.
- added font_map. re-added xachshadow.pl, which was mysteriously
missing.
- fixed Gimp::Util::set_state.
- improved get/set_state functions.
- added perlotine, randomblends and innerbevel plugins.
- improved t/run.t and server spawn robustness.
- Makefile.PL wrongly required the Gimp.pm in the current directory.
- made the 5.004 + gimp-1.0 combination work by working around another
bug in 5.004.
- fixed reporting of errors at startup time.
- enforcing argument name style. Eat it or die!
1.07 Mon Mar 15 01:27:05 CET 1999
- added examples/yinyang, examples/image_tile, examples/stamps.

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

@ -162,6 +162,7 @@ sub import($;@) {
if ($_ eq ":auto") {
push(@export,@_consts,@_procs);
*{"${up}::AUTOLOAD"} = sub {
croak "cannot autoload '$AUTOLOAD' at this time" unless initialized();
my ($class,$name) = $AUTOLOAD =~ /^(.*)::(.*?)$/;
*{$AUTOLOAD} = sub { Gimp->$name(@_) };
goto &$AUTOLOAD;
@ -329,6 +330,7 @@ unless ($no_SIG) {
sub call_callback {
my $req = shift;
my $cb = shift;
return () if $caller eq "Gimp";
if (UNIVERSAL::can($caller,$cb)) {
&{"${caller}::$cb"};
} else {
@ -338,7 +340,6 @@ sub call_callback {
sub callback {
my $type = shift;
return () if $caller eq "Gimp";
if ($type eq "-run") {
local $function = shift;
local $in_run = 1;
@ -455,8 +456,6 @@ sub AUTOLOAD {
wantarray ? @r : $r[0];
};
goto &$AUTOLOAD;
} elsif (defined(*{"${interface_pkg}::$sub"}{CODE})) {
die "safety net $interface_pkg :: $sub (REPORT THIS!!)";#d#
}
}
# for performance reasons: supply a DESTROY method
@ -790,10 +789,9 @@ interface (L<Gimp::Net>), and not as a native plug-in. Here's an example:
Gimp::init;
<do something with the gimp>
Gimp::end;
The optional argument to init has the same format as the GIMP_HOST variable
described in L<Gimp::Net>.
described in L<Gimp::Net>. Calling C<Gimp::end> is optional.
=item Gimp::lock(), Gimp::unlock()

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

@ -62,6 +62,13 @@ _gimp_prefix()
OUTPUT:
RETVAL
char *
_gimp_path()
CODE:
RETVAL = GIMP_PATH;
OUTPUT:
RETVAL
BOOT:
{
HV *stash = gv_stashpvn("Gimp", 4, TRUE);

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

@ -1,8 +1,7 @@
package Gimp::Data;
use strict;
use Carp;
use Gimp qw();
use Gimp ();
sub TIEHASH {
my $pkg = shift;

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

@ -47,21 +47,6 @@ sub import {
}
}
sub missing {
my ($msg,$function)=@_;
require Gimp;
Gimp::logger(message => "$_[0] is required but not found", function => $function);
Gimp::initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit Gimp::quiet_main();
}
sub need {
my ($feature,$function)=@_;
unless (present($feature)) {
missing($description{$feature},$function);
Gimp::initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit Gimp::quiet_main();
}
}
sub describe {
$description{$_[0]};
}
@ -111,6 +96,17 @@ sub present {
}
}
sub missing {
my ($msg,$function)=@_;
require Gimp;
Gimp::logger(message => "$_[0] is required but not found", function => $function);
Gimp::initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit Gimp::quiet_main();
}
sub need {
my ($feature,$function)=@_;
missing($description{$feature},$function) unless present $feature;
}
1;
__END__

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

@ -1,7 +1,7 @@
package Gimp::Fu;
use Carp;
use Gimp qw();
use Gimp ();
use Gimp::Data;
require Exporter;
@ -158,6 +158,7 @@ sub help_window(\$$$) {
$b = new Gtk::Text;
$b->set_editable (0);
$b->set_word_wrap (1);
$font = load Gtk::Gdk::Font "9x15bold";
$font = fontset_load Gtk::Gdk::Font "-*-courier-medium-r-normal--*-120-*-*-*-*-*" unless $font;
@ -281,7 +282,7 @@ sub interact($$$$@) {
my $setval = sub {
$val=$_[0];
unless (defined $val && $fs->set_font_name ($val)) {
warn "illegal default font description: $val" if defined $val;
warn "illegal default font description for $function: $val\n" if defined $val;
$val=$def;
$fs->set_font_name ($val);
}
@ -899,19 +900,20 @@ sub register($$$$$$$$$;@) {
@_==0 or die "register called with too many or wrong arguments\n";
for my $p (@$params,@$results) {
int($p->[0]) eq $p->[0] or croak "Argument/return value '$p->[1]' has illegal type '$p->[0]'";
int($p->[0]) eq $p->[0] or croak "$function: argument/return value '$p->[1]' has illegal type '$p->[0]'";
$p->[1]=~/^[0-9a-z_]+$/ or carp "$function: argument name '$p->[1]' contains illegal characters, only 0-9, a-z and _ allowed";
}
$function="perl_fu_".$function unless $function=~/^(?:perl_fu|extension|plug_in)/ || $function=~s/^\+//;
Gimp::logger message => "function name contains dashes instead of underscores",
function => $function, fatal => 0
if $function =~ y/-//;
*$function = sub {
$run_mode=shift; # global!
my(@pre,@defaults,@lastvals,$input_image);
Gimp::logger message => "function name contains dashes instead of underscores",
function => $function, fatal => 0
if $function =~ y/-//;
if ($menupath=~/^<Image>\//) {
@_ >= 2 or die "<Image> plug-in called without both image and drawable arguments!\n";
@pre = (shift,shift);

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

@ -611,7 +611,7 @@ push_gimp_sv (GParam *arg, int array_as_ref)
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;
: newSVsv (&PL_sv_undef);
break;
case PARAM_COLOR:
@ -810,6 +810,32 @@ destroy_paramdefs (GParamDef *arg, int count)
}
#endif
#ifdef GIMP_HAVE_PROCEDURAL_DB_GET_DATA_SIZE
#define get_data_size gimp_get_data_size
#else
guint32
get_data_size (gchar *id)
{
GParam *return_vals;
int nreturn_vals;
int length;
return_vals = gimp_run_procedure ("gimp_procedural_db_get_data",
&nreturn_vals,
PARAM_STRING, id,
PARAM_END);
if (return_vals[0].data.d_status == STATUS_SUCCESS)
length = return_vals[1].data.d_int32;
else
length = 0;
gimp_destroy_params (return_vals, nreturn_vals);
return length;
}
#endif
static void simple_perl_call (char *function, char *arg1)
{
char *argv[2];
@ -1363,20 +1389,7 @@ gimp_set_data(id, data)
dta = SvPV (data, dlen);
/* do not remove this comment */
#ifdef GIMP_HAVE_PROCEDURAL_DB_GET_DATA_SIZE
gimp_set_data (SvPV (id, dc), dta, dlen);
#else
{
char str[MAX_STRING]; /* hack */
SvUPGRADE (id, SVt_PV);
len = SvCUR (id);
Copy (SvPV (id, dc), str, len, char);
str[len+1] = 0;
str[len] = 'S'; gimp_set_data (str, &dlen, sizeof (STRLEN));
str[len] = 'C'; gimp_set_data (str, dta, dlen);
}
#endif
}
void
@ -1389,35 +1402,12 @@ gimp_get_data(id)
STRLEN len;
STRLEN dc;
/* do not remove this comment */
#ifdef GIMP_HAVE_PROCEDURAL_DB_GET_DATA_SIZE
dlen = gimp_get_data_size (SvPV (id, dc));
dlen = get_data_size (SvPV (id, dc));
/* I count on dlen being zero if "id" doesn't exist. */
data = newSVpv ("", 0);
gimp_get_data (SvPV (id, dc), SvGROW (data, dlen+1));
SvCUR_set (data, dlen);
*((char *)SvPV (data, dc) + dlen) = 0;
#else
{
char str[MAX_STRING]; /* hack */
SvUPGRADE (id, SVt_PV);
len = SvCUR (id);
Copy (SvPV (id, dc), str, len, char);
str[len+1] = 0;
dlen = (STRLEN) -1;
str[len] = 'S'; gimp_get_data (str, &dlen);
data = newSVpv ("", 0);
if (dlen != (STRLEN)-1)
{
str[len] = 'C'; gimp_get_data (str, SvGROW (data, dlen+1));
SvCUR_set (data, dlen);
*((char *)SvPV (data, dc) + dlen) = 0;
}
}
#endif
XPUSHs (sv_2mortal (data));
}

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

@ -140,26 +140,31 @@ sub set_trace {
sub start_server {
print "trying to start gimp\n" if $Gimp::verbose;
$server_fh=local *FH;
socketpair $server_fh,GIMP_FH,PF_UNIX,SOCK_STREAM,AF_UNIX
my $gimp_fh=local *FH;
socketpair $server_fh,$gimp_fh,PF_UNIX,SOCK_STREAM,AF_UNIX
or croak "unable to create socketpair for gimp communications: $!";
$gimp_pid = fork;
if ($gimp_pid > 0) {
Gimp::ignore_functions(@Gimp::gimp_gui_functions);
close $gimp_fh;
return $server_fh;
} elsif ($gimp_pid == 0) {
close $server_fh;
delete $ENV{GIMP_HOST};
unless ($Gimp::verbose) {
open STDIN,"</dev/null";
open STDOUT,">/dev/null";
open STDERR,">&1";
close STDIN;
}
my $args = &Gimp::RUN_NONINTERACTIVE." ".
(&Gimp::_PS_FLAG_BATCH | &Gimp::_PS_FLAG_QUIET)." ".
fileno(GIMP_FH);
fileno($gimp_fh);
{ # block to suppress warning with broken perls (e.g. 5.004)
exec "gimp","-n","-b","(extension-perl-server $args)",
"(extension_perl_server $args)"
exec &Gimp::_gimp_path,
"-n","-b","(extension-perl-server $args)",
"(extension_perl_server $args)",
"(gimp_quit 0)",
"(gimp-quit 0)";
}
exit(255);
} else {

2
plug-ins/perl/Gimp/UI.pm
View File

@ -1,7 +1,7 @@
package Gimp::UI;
use Carp;
use Gimp qw();
use Gimp ();
use Gtk;
$gtk_10 = Gtk->major_version==1 && Gtk->minor_version==0;

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

@ -23,12 +23,15 @@ you end up with them and the user cannot see them or delete them. So we
always attach our created layers to an image here, too avoid memory leaks
and debugging times.
These functions try to preserve the current settings like colors.
These functions try to preserve the current settings like colors, but not
all do.
Also: these functions are handled in exactly the same way as
PDB-Functions, i.e. the (hypothetical) function C<gimp_image_xyzzy> can be
called as $image->xyzzy, if the module is available.
The need to explicitly C<use Gimp::Util> will go away in the future.
=head1 FUNCTIONS
=over 4
@ -55,20 +58,31 @@ use Gimp;
=item C<get_state ()>, C<set_state state>
C<get_state> returns a scalar representing most of gimps global state (at the
moment foreground colour and background colour). The state can later be
restored by a call to C<set_state>. This is ideal for library functions such
as the ones used here, at least when it includes more state in the future.
C<get_state> returns a scalar representing most of gimps global state
(at the moment foreground colour, background colour, active gradient,
pattern and brush). The state can later be restored by a call to
C<set_state>. This is ideal for library functions such as the ones used
here, at least when it includes more state in the future.
=cut
sub get_state() {
[Palette->get_foreground,Palette->get_background];
[
Palette->get_foreground,
Palette->get_background,
Gradients->get_active,
scalar Patterns->get_pattern,
scalar Brushes->get_brush,
]
}
sub set_state($) {
Palette->set_foreground($_->[0]);
Palette->set_background($_->[1]);
my $s = shift;
Palette->set_foreground($s->[0]);
Palette->set_background($s->[1]);
Gradients->set_active($s->[2]);
Patterns->set_pattern($s->[3]);
Brushes->set_brush($s->[4]);
}
##############################################################################

4
plug-ins/perl/MANIFEST
View File

@ -72,3 +72,7 @@ examples/yinyang
examples/image_tile
examples/stamps
examples/font_table
examples/perlotine
examples/randomblends
examples/innerbevel

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

@ -10,6 +10,7 @@ $|=1;
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 stamps font_table
perlotine randomblends innerbevel
);
@shebang = (map("examples/$_",@examples),
qw(Perl-Server examples/example-net.pl examples/homepage-logo.pl
@ -24,7 +25,7 @@ if ($ARGV[0] ne "--writemakefile") {
do './config.pl';
if(defined $EXTENSIVE_TESTS) {
print "\nFetched some defaults from an earlier Makefile.PL run.\n";
print "Run \"make clean\" if you don't want this\n";
print "Run \"make realclean\" if you don't want this\n";
} else {
print "
This module usually does only a very short installation check.
@ -35,7 +36,7 @@ gimp-1.1 ;)
If you decide to run these tests (please!), I'd be glad to hear
success stories (and of course any bug-reports ;)
Do you want me to make these tests [y]? ";
Do you want me to run these tests [y]? ";
print "y\n";
$EXTENSIVE_TESTS = 1;
@ -59,6 +60,45 @@ Do you want me to make these tests [y]? ";
require ExtUtils::MakeMaker;
import ExtUtils::MakeMaker;
@INC = grep /^\//,@INC;
eval { $Gimp::no_SIG=1; require Gimp };
unless($@) {
$old_prefix = eval { Gimp::_gimp_prefix() };
if ($@) {
print <<EOF;
WARNING: I've detected an old version of Gimp-Perl installed
already. Since I cannot detect the prefix used to install
it I will just overwrite it. If you happen to use two
different and incompatible versions of the Gimp with differing
prefixes you should call configure with the --disable-perl
switch to disable the perl extension, or consider installing
the perl module elsewhere, using the environment variables
PERL5LIB=/my/module/dir and PERL_MM_OPTS="PREFIX=\$PERL5LIB" to
overwrite the installation directory (PERL_MM_OPTS) and run the
Gimp (PERL5LIB). See "perldoc ExtUtils::MakeMaker" for a full
discussion of your options.
EOF
} else {
if ($GIMP_PREFIX ne $old_prefix) {
print <<EOF;
WARNING: I've detected another installation of the Gimp-Perl extension.
This version uses the prefix '$GIMP_PREFIX'.
The already installed version uses the prefix '$old_prefix'.
They don't match, which indicates that installing Gimp-Perl might
overwrite an old but still used installation. Gimp-Perl will
therefore be disabled, and not be installed.
EOF
not_halt("prefix mismatch");
}
}
}
eval "use Gtk;"; $GTK = $@ eq "";
eval "use PDL;"; $PDL = $@ eq "";
eval "use Parse::RecDescent;"; $PRD = $@ eq "";
@ -129,44 +169,6 @@ WARNING: version 0.3 of Gtk is _required_ for this module to
EOF
}
eval { $Gimp::no_SIG=1; require Gimp };
unless($@) {
$old_prefix = eval { Gimp::_gimp_prefix() };
if ($@) {
print <<EOF;
WARNING: I've detected an old version of Gimp-Perl installed
already. Since I cannot detect the prefix used to install
it I will just overwrite it. If you happen to use two
different and incompatible versions of the Gimp with differing
prefixes you should call configure with the --disable-perl
switch to disable the perl extension, or consider installing
the perl module elsewhere, using the environment variables
PERL5LIB=/my/module/dir and PERL_MM_OPTS="PREFIX=\$PERL5LIB" to
overwrite the installation directory (PERL_MM_OPTS) and run the
Gimp (PERL5LIB). See "perldoc ExtUtils::MakeMaker" for a full
discussion of your options.
EOF
} else {
if ($GIMP_PREFIX ne $old_prefix) {
print <<EOF;
WARNING: I've detected another installaion of the Gimp-Perl extension.
This version uses the prefix '$GIMP_PREFIX'.
The already installed version uses the prefix '$old_prefix'.
They don't match, which indicates that installing Gimp-Perl might
overwrite an old but still used installation. Gimp-Perl will
therefore be disabled, and not be installed.
EOF
not_halt("prefix mismatch");
}
}
}
# wo do no longer do these dirty things
#for(@shebang) {
# system ($Config{perlpath},"-pi","-e","\$. == 1 and \$_ = '#!$Config{perlpath}\n'",$_);

24
plug-ins/perl/Perl-Server
View File

@ -16,9 +16,9 @@ use strict;
use vars qw($use_unix $use_tcp $trace_res $server_quit $max_pkt $unix $tcp $ps_flags
%object_dynamic $object_uid %objects $auth @authorized $exclusive
$rm $saved_rm);
# the '' might be required (i.e. no ())
use Gimp '';
use Gimp::Net qw(:server);
# the '' might be required (i.e. no ()). why??
use Gimp ();
use Gimp::Net ();
Gimp::set_trace(\$trace_res);
Gimp::ignore_functions(qw(gimp_progress_init gimp_progress_update));
@ -305,15 +305,15 @@ sub extension_perl_server {
}
sub query {
Gimp->install_procedure("extension_perl_server", "Start the Gimp-Perl Server",
"This is the server for plug-ins written using the Gimp::Net module",
"Marc Lehmann <pcg\@goof.com>", "Marc Lehmann", "1998-07-22",
"<Toolbox>/Xtns/Perl Server", "*",&Gimp::PROC_EXTENSION,
[
[&Gimp::PARAM_INT32, "run_mode", "Interactive, [non-interactive]"],
[&Gimp::PARAM_INT32, "flags", "internal flags (must be 0)"],
[&Gimp::PARAM_INT32, "extra", "multi-purpose ;)"],
],[]);
Gimp->install_procedure("extension_perl_server", "Start the Gimp-Perl Server",
"This is the server for plug-ins written using the Gimp::Net module",
"Marc Lehmann <pcg\@goof.com>", "Marc Lehmann", "1998-07-22",
"<Toolbox>/Xtns/Perl Server", "*",&Gimp::PROC_EXTENSION,
[
[&Gimp::PARAM_INT32, "run_mode", "Interactive, [non-interactive]"],
[&Gimp::PARAM_INT32, "flags", "internal flags (must be 0)"],
[&Gimp::PARAM_INT32, "extra", "multi-purpose ;)"],
],[]);
}
sub quit {

10
plug-ins/perl/etc/config.pl.in
View File

@ -7,11 +7,17 @@ $LDFLAGS = q[@LDFLAGS@];
$prefix = q[@prefix@];
$exec_prefix = q[@exec_prefix@];
$libdir = q[@libdir@];
$bindir = q[@bindir@];
$exec_prefix=~s/\${?prefix}?/$prefix/g;
$libdir=~s/\${?exec_prefix}?/$exec_prefix/g;
$bindir=~s/\${?exec_prefix}?/$exec_prefix/g;
$IN_GIMP = q[@IN_GIMP@];
$PERL = q[@PERL@];
$GIMP = q[@GIMP@];
$GIMP = $IN_GIMP ? q[@GIMP@] : "$bindir/gimp";
$GIMPTOOL = q[@GIMPTOOL@];
$GIMP_INC = q[@GIMP_CFLAGS@];
$GIMP_INC_NOUI = q[@GIMP_CFLAGS_NOUI@];
@ -34,4 +40,4 @@ if ($IN_GIMP) {
chomp $GIMP_PREFIX;
}
$DEFS = ' -DGIMP_PREFIX=\"'.$GIMP_PREFIX.'\"';
$DEFS = ' -DGIMP_PREFIX=\"'.$GIMP_PREFIX.'\" -DGIMP_PATH=\"'.$GIMP.'\"';

125
plug-ins/perl/etc/configure vendored
View File

@ -574,25 +574,31 @@ do
set dummy $ac_prog; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:577: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_GIMP'+set}'`\" = set"; then
if eval "test \"`echo '$''{'ac_cv_path_GIMP'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
if test -n "$GIMP"; then
ac_cv_prog_GIMP="$GIMP" # Let the user override the test.
else
case "$GIMP" in
/*)
ac_cv_path_GIMP="$GIMP" # Let the user override the test with a path.
;;
?:/*)
ac_cv_path_GIMP="$GIMP" # Let the user override the test with a dos path.
;;
*)
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
ac_dummy="$PATH"
for ac_dir in $ac_dummy; do
for ac_dir in $ac_dummy; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
ac_cv_prog_GIMP="$ac_prog"
ac_cv_path_GIMP="$ac_dir/$ac_word"
break
fi
done
IFS="$ac_save_ifs"
;;
esac
fi
fi
GIMP="$ac_cv_prog_GIMP"
GIMP="$ac_cv_path_GIMP"
if test -n "$GIMP"; then
echo "$ac_t""$GIMP" 1>&6
else
@ -601,7 +607,6 @@ fi
test -n "$GIMP" && break
done
test -n "$GIMP" || GIMP="gimp"
# Check whether --with-gimp-prefix or --without-gimp-prefix was given.
@ -645,7 +650,7 @@ fi
# Extract the first word of "gimptool", so it can be a program name with args.
set dummy gimptool; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:649: checking for $ac_word" >&5
echo "configure:654: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_path_GIMPTOOL'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -680,7 +685,7 @@ fi
min_gimp_version=1.0.2
echo $ac_n "checking for GIMP - version >= $min_gimp_version""... $ac_c" 1>&6
echo "configure:684: checking for GIMP - version >= $min_gimp_version" >&5
echo "configure:689: checking for GIMP - version >= $min_gimp_version" >&5
no_gimp=""
if test "$GIMPTOOL" = "no" ; then
no_gimp=yes
@ -713,7 +718,7 @@ echo "configure:684: checking for GIMP - version >= $min_gimp_version" >&5
echo $ac_n "cross compiling; assumed OK... $ac_c"
else
cat > conftest.$ac_ext <<EOF
#line 717 "configure"
#line 722 "configure"
#include "confdefs.h"
#include <stdio.h>
@ -762,7 +767,7 @@ int main ()
EOF
if { (eval echo configure:766: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
if { (eval echo configure:771: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
:
else
@ -796,7 +801,7 @@ fi
CFLAGS="$CFLAGS $GIMP_CFLAGS"
LIBS="$LIBS $GIMP_LIBS"
cat > conftest.$ac_ext <<EOF
#line 800 "configure"
#line 805 "configure"
#include "confdefs.h"
#include <stdio.h>
@ -806,7 +811,7 @@ int main() {
return 0;
; return 0; }
EOF
if { (eval echo configure:810: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
if { (eval echo configure:815: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
echo "*** The test program compiled, but did not run. This usually means"
echo "*** that the run-time linker is not finding GIMP or finding the wrong"
@ -847,7 +852,7 @@ rm -f conftest*
ac_gimp_save_CPPFLAGS="$CPPFLAGS"
CPPFLAGS="$CPPFLAGS $GIMP_CFLAGS"
echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
echo "configure:851: checking how to run the C preprocessor" >&5
echo "configure:856: checking how to run the C preprocessor" >&5
# On Suns, sometimes $CPP names a directory.
if test -n "$CPP" && test -d "$CPP"; then
CPP=
@ -862,13 +867,13 @@ else
# On the NeXT, cc -E runs the code through the compiler's parser,
# not just through cpp.
cat > conftest.$ac_ext <<EOF
#line 866 "configure"
#line 871 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:872: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
{ (eval echo configure:877: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
:
@ -879,13 +884,13 @@ else
rm -rf conftest*
CPP="${CC-cc} -E -traditional-cpp"
cat > conftest.$ac_ext <<EOF
#line 883 "configure"
#line 888 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:889: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
{ (eval echo configure:894: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
:
@ -896,13 +901,13 @@ else
rm -rf conftest*
CPP="${CC-cc} -nologo -E"
cat > conftest.$ac_ext <<EOF
#line 900 "configure"
#line 905 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:906: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
{ (eval echo configure:911: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
:
@ -927,7 +932,7 @@ fi
echo "$ac_t""$CPP" 1>&6
cat > conftest.$ac_ext <<EOF
#line 931 "configure"
#line 936 "configure"
#include "confdefs.h"
#include <libgimp/gimp.h>
EOF
@ -947,17 +952,17 @@ for ac_hdr in unistd.h
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
echo "configure:951: checking for $ac_hdr" >&5
echo "configure:956: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 956 "configure"
#line 961 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:961: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
{ (eval echo configure:966: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@ -983,73 +988,18 @@ else
fi
done
for ac_func in _exit
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
echo "configure:990: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 995 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
#include <assert.h>
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char $ac_func();
int main() {
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
choke me
#else
$ac_func();
#endif
; return 0; }
EOF
if { (eval echo configure:1018: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
eval "ac_cv_func_$ac_func=no"
fi
rm -f conftest*
fi
if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
echo "$ac_t""yes" 1>&6
ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
cat >> confdefs.h <<EOF
#define $ac_tr_func 1
EOF
else
echo "$ac_t""no" 1>&6
fi
done
CONFIG_H="config.h"
for ac_func in vsnprintf
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
echo "configure:1048: checking for $ac_func" >&5
echo "configure:998: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 1053 "configure"
#line 1003 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
@ -1072,7 +1022,7 @@ $ac_func();
; return 0; }
EOF
if { (eval echo configure:1076: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
if { (eval echo configure:1026: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
@ -1128,12 +1078,12 @@ fi
for ac_func in _exit
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
echo "configure:1132: checking for $ac_func" >&5
echo "configure:1082: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 1137 "configure"
#line 1087 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
@ -1156,7 +1106,7 @@ $ac_func();
; return 0; }
EOF
if { (eval echo configure:1160: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
if { (eval echo configure:1110: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
@ -1543,3 +1493,4 @@ test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
echo "now invoking perl to complete the configuration..."
exec $PERL $MAKEFILE_PL --writemakefile PREFIX="$prefix"

3
plug-ins/perl/etc/configure.in
View File

@ -16,7 +16,7 @@ AC_ARG_WITH(includes,[ --with-includes=DIR Additionally search for includes
AC_ARG_WITH(libs, [ --with-libs=DIR Additionally search for libraries in dir in DIR (optional)],
LIBS="$LIBS -L$with_libs")
AC_CHECK_PROGS(GIMP,gimp,gimp)
AC_PATH_PROGS(GIMP,gimp)
AM_PATH_GIMP(1.0.2,, AC_MSG_ERROR(
** unable to find gimp, make sure it's in your path (version 1.0.2+ required!)
@ -29,7 +29,6 @@ AC_EGREP_CPP(DIVIDE_MODE,[#include <libgimp/gimp.h>],AC_DEFINE(HAVE_DIVIDE_MODE)
CPPFLAGS="$ac_gimp_save_CPPFLAGS"
AC_CHECK_HEADERS(unistd.h)
AC_CHECK_FUNCS(_exit)
CONFIG_H="config.h"

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

@ -106,7 +106,7 @@ register
"<Image>/Image/Colors/Alpha2Color",
"RGBA",
[
[PF_COLOR, "Color", "Color for current alpha", [127,127,127]]
[PF_COLOR, "color", "Color for current alpha", [127,127,127]]
],
\&alpha2col;

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

@ -85,7 +85,7 @@ register
"<Image>/Filters/Animation/Animate Cells",
"*",
[
[PF_TOGGLE, "Work on a copy?", "", 1]
[PF_TOGGLE, "work_on_copy", "", 1]
],
\&perl_fu_animate_cells;

22
plug-ins/perl/examples/font_table
View File

@ -179,17 +179,17 @@ register
"<Toolbox>/Xtns/Render/Font Table",
"*",
[
[PF_STRING, "Foundery (perl regex or \"*\")", "Foundery", "*"],
[PF_STRING, "Family (perl regex or \"*\")", "Family", "*"],
[PF_STRING, "Weight (perl regex or \"*\")", "Weight", "*"],
[PF_STRING, "Slant (perl regex or \"*\")", "Slant", "*"],
[PF_INT32, "Point Size", "Size", 18],
[PF_COLOR, "Text Color", "FG", 'black'],
[PF_COLOR, "Background Color", "BG", 'white'],
[PF_FONT, "Label Font", "Font", '-*-courier-medium-r-normal--18-*-*-*-*-*-*-*'],
[PF_STRING, "Test String", "String", 'FOUR (4) SCORE and seven (7) years @%$*&'],
[PF_INT32, "Text Padding", "Padding", 10],
[PF_INT32, "Maximum page height", "Height", 1000]
[PF_STRING, "foundery", "Foundery (perl regex or \"*\")", "*"],
[PF_STRING, "family", "Family (perl regex or \"*\")", "*"],
[PF_STRING, "weight", "Weight (perl regex or \"*\")", "*"],
[PF_STRING, "slant", "Slant (perl regex or \"*\")", "*"],
[PF_INT32, "point_size", "Point Size", 18],
[PF_COLOR, "text_color", "Text Color", 'black'],
[PF_COLOR, "bg_color", "Background Color", 'white'],
[PF_FONT, "label_font", "Label Font", '-*-courier-medium-r-normal--18-*-*-*-*-*-*-*'],
[PF_STRING, "test_string", "Test String", 'FOUR (4) SCORE and seven (7) years @%$*&'],
[PF_INT32, "padding", "Text Padding", 10],
[PF_INT32, "height", "Maximum page height", 1000]
],
\&font_table;

14
plug-ins/perl/examples/image_tile
View File

@ -442,13 +442,13 @@ register
# Image and drawable are given for free...
# [PF_IMAGE, "Input image", undef],
# [PF_DRAWABLE, "Input drawable", undef],
[PF_INT32, "Number of tiles (X)", "X tiles", 10],
[PF_INT32, "Number of tiles (Y)", "Y tiles", 10],
[PF_INT32, "Number of sample cells per tile (X)", "X cells", 4],
[PF_INT32, "Number of sample cells per tile (Y)", "Y cells", 4],
[PF_INT32, "Duplicates (0[lots] - 100[none])", "Duplicates", 5],
[PF_STRING, "Sub-image directories (space speparated)", "Directories"],
[PF_TOGGLE, "Delete cached image samples?", "", 0]
[PF_INT32, "tiles_x", "Number of tiles (X)", 10],
[PF_INT32, "tiles_y", "Number of tiles (Y)", 10],
[PF_INT32, "samples_x", "Number of sample cells per tile (X)", 4],
[PF_INT32, "samples_y", "Number of sample cells per tile (Y)", 4],
[PF_INT32, "duplicates", "Duplicates (0[lots] - 100[none])", 5],
[PF_STRING, "image_dirs", "Sub-image directories (space speparated)"],
[PF_TOGGLE, "delete_cached", "Delete cached image samples?", 0]
],
\&perl_fu_image_tile;

95
plug-ins/perl/examples/innerbevel Executable file
View File

@ -0,0 +1,95 @@
#!/usr/bin/perl
# Effect taken from http://tigert.gimp.org/gimp/tutorials/beveled_text/
# perl-ified by Seth Burgess <sjburges@gimp.org>
# Programatically, this script is about as dull as they come. The only
# exceptions are those of the neat util functions (that aren't all quite
# working btw). You can follow step by step with the website at
# http://tigert.gimp.org/gimp/tutorials/beveled_text/
use Gimp;
use Gimp::Fu;
use Gimp::Util;
$defaultcolor1 = [124,10,18];
$defaultcolor2 = [200,19,27];
$path = "<Toolbox>/Xtns/Render/Logos/Inner Bevel";
$shortdesc = "Perform an inner bevel on text";
$longdesc = "This uses tigert's inner bevel method on text, which can be found with his other excellent tutorials at http://tigert.gimp.org/";
$date = "1999-03-23";
$imgtypes = "*";
$author = "Seth Burgess <sjburges\@gimp.org>";
$path =~ m,/([^/]+)$,;
$regname = $1;
$regname =~ s/ /_/g;
$regname =~ tr/A-Z/a-z/;
$author =~ m/^(.*) </;
$authorname = $1;
register $regname, $shortdesc, $longdesc, $authorname, $author, $date, $path, $imgtypes,
[
[PF_FONT, "font", "Font Name"],
[PF_STRING, "text", "Enter your text to be beveled", "INNERBEVEL"],
[PF_COLOR, "top_color", "Blend to this color", $defaultcolor2],
[PF_COLOR, "bot_color", "Blend from this color", $defaultcolor1],
[PF_SLIDER, "azimuth", "Direction of the shine", 132, [0,255,5]],
[PF_SLIDER, "shinyness", "How shiny the final image will be",30, [0,90,5]],
[PF_SLIDER, "depth_shape", "Determines the final shape", 34 , [0,64,32]],
[PF_RADIO, "map", "The type of Map to use", 2, [Linear => 0, Spherical => 1, Sinusoidal => 2] ],
], sub {
my ($font, $text, $color1, $color2, $azimuth, $elevation, $depth, $maptype) = @_;
# -- step 1 --
$oldst = get_state();
gimp_palette_set_background($color1);
gimp_palette_set_foreground($color2);
@dims = gimp_text_wh($text, $font);
$img = gimp_image_new($dims[0]+10, $dims[1]+10, RGB);
# none of the macro's did quite what I was looking for here.
# i.e. create a text layer on transparent only...
# -- step 2 --
$layertmp = $img->add_new_layer(0,TRANS_IMAGE_FILL);
$txtlayer = $img->text_fontname(-1, 10, 10, $text, 0, 1, xlfd_size($font), $font);
$dsp = gimp_display_new($img); # display the image early
$layer = $img->merge_visible_layers(EXPAND_AS_NECESSARY);
@pt1 = ($layer->width * 0.5 -1, 0);
@pt2 = ($layer->width * 0.5 +1, $layer->height);
# -- step 3 --
$layer->set_preserve_trans(1);
$layer->blend(FG_BG_RGB, 0, LINEAR, 100, 0, REPEAT_NONE, 0, 3, 0.20, @pt1, @pt2); # NORMAL isn't recognized
# -- step 4 --
$layer2 = $layer->copy(0); # Can you override these to have a default? (would be nice)
$img->add_layer($layer2, 0);
# -- step 5 --
$layer2->set_preserve_trans(1);
$img->selection_all;
gimp_palette_set_background([255,255,255]);
$layer2->edit_fill;
# -- step 6 --
$layer2->set_preserve_trans(0);
$layer2->gauss_rle(6,1,1); # Defaults would be cool here too :)
# -- step 7 --
$layer->plug_in_bump_map($layer2, $azimuth, $elevation, $depth, 0,0,0,0,1,0,$maptype);
# -- step 8 --
$layer2->invert;
$img->lower_layer($layer2);
# -- step 9 --
$layer2->translate(2, 3);
# extra stuff
$img->add_new_layer(2);
$img->gimp_selection_none();
set_state($oldst); # Doesn't seem to work - says it can't grok color
return();
};
exit main; # <-- This lil' bugger caused me much grief. I suppose its very much required?

166
plug-ins/perl/examples/perlotine Executable file
View File

@ -0,0 +1,166 @@
#!/usr/bin/perl
# <sjburges@gimp.org>
# This is tigert's request. I suppose it'll be useful to those that do
# this sort of thing. Personally I'll probably only run it to test and
# put up a demo image.
use Gimp;
use Gimp::Fu;
use Gimp::Util;
# Gimp::set_trace(TRACE_ALL);
sub get_vguides { # get back an ordered set of vertical guides
my ($img)=@_;
$i=0;
my @vguides;
while ($i=$img->findnext_guide($i)) {
if (!$img->get_guide_orientation($i)){
$keyval = sprintf("%4d", $img->get_guide_position($i));
$vkeys{$keyval} = $i;
}
}
foreach $key(sort (keys %vkeys)) {
# print "Unshifting ", $key, "\n";
push @vguides, $vkeys{$key};
}
return @vguides;
}
sub get_hguides { # get back an ordered set of horizontal guides
my ($img)=@_;
$i=0;
my @hguides;
while ($i=$img->findnext_guide($i)) {
if ($img->get_guide_orientation($i)){
$keyval = sprintf("%4d", $img->get_guide_position($i));
$hkeys{$keyval} = $i;
}
}
# need to sort them in order of their occurance in the image
foreach $key(sort keys %hkeys) {
push @hguides, $hkeys{$key};
}
return @hguides;
}
sub dosel { # do the selection
($img, $savepath, $imgpath, $imgbasename, $l,$r,$t,$b, $i,$j) = @_;
$filename =~ m/^(.*)\.[^\.]*$/ ;
$imgname = "$imgbasename-$i-$j.gif";
$tmpimg = $img->channel_ops_duplicate;
# print "Cropping from $l to $r, $t to $b\n";
$tmpimg->crop($r-$l, $b-$t, $l, $t);
$tmplay = $tmpimg->active_drawable;
if (! $tmplay->indexed) {
$tmpimg->convert_indexed(1,256);
}
$tmpimg->gimp_file_save(-1,"$savepath$imgpath$imgname","$savepath$imgpath$imgname");
$tmpimg->delete;
return "$imgpath$imgname"; # what I want printed in html
}
sub html_table_start {
($fn,$cellpadding,$cellspacing,$border,$capatalize) = @_;
$str = $capatalize ? "<TABLE CELLSPACING=$cellspacing CELLPADDING=$cellpadding BORDER=$border>\n" :
"<table cellspacing=$cellspacing cellpadding=$cellpadding border=$border>\n" ;
print $fn $str;
}
sub html_table_row_start {
($fn, $capatalize) = @_;
$str = $capatalize ? "\t<TR>\n" : "\t<tr>\n";
print $fn $str;
}
sub html_table_entry {
($fn, $imgname, $width, $height, $capatalize) = @_;
$str = $capatalize ? "\t\t<TD><IMG SRC=\"$imgname\" WIDTH=\"$width\"HEIGHT=\"$height\"></TD>\n" :
"\t\t<td><img src=\"$imgname\" width=\"$width\"height=\"$height\"></td>\n";
print $fn $str;
}
sub html_table_row_end {
($fn, $capatalize) = @_;
$str = $capatalize ? "\t</TR>\n" : "\t</tr>\n";
print $fn $str;
}
sub html_table_end {
($fn, $capatalize) = @_;
$str = $capatalize ? "</TABLE>\n":"</table>\n";
print $fn $str;
}
# <tigert> Save-path: [_____________________][browse]
# <tigert> html-file name: [_________________]
# <tigert> image-basename [__________________]
# <tigert> [x] use separate dir for images
# <tigert> image directory: [___________________]
# later, decided to have UPPER/lower case HTML toggle
# cellspacing: ___^
register "perlotine",
"Guilotine implemented ala perl, with html output",
"Add guides to an image. Then run this. It will cut along the guides, and give you the html to reassemble the resulting images.",
"Seth Burgess",
"Seth Burgess <sjburges\@gimp.org>",
"1999-03-19",
"<Image>/Image/Transforms/Perl-o-tine",
"*",
[
[PF_STRING, "save_path", "The path to export the HTML to",$ENV{HOME}],
[PF_STRING, "html_file_name", "Filename to export","perlotine.html"],
[PF_STRING, "image_basename", "What to call the images","perlotine"],
[PF_TOGGLE, "separate_image_dir", "Use a separate directory for images?",0],
[PF_STRING, "relative_image_path", "The path to export the images to, relative to the Save Path", "images/"],
[PF_TOGGLE, "capitalize_tags", "Capatalize HTML tags?", 0],
[PF_SPINNER, "cellspacing", "Add space between the table elements", 0, [0,15,1]],
], sub {
my($img,$layer,$savepath, $htmlname, $imgbasename, $separate, $imgpath, $capatalize, $cellspacing) =@_;
@vert = get_vguides($img);
@horz = get_hguides($img);
if (!(scalar(@vert) || scalar(@horz))) {
die ("No horizontal or vertical guides found. Aborted.");
}
# print @vert, " LEN = ", scalar(@vert), "\n";
# print @horz, " LEN = ", scalar(@horz), "\n";
# foreach $guide (@vert) {
# print $img->get_guide_position($guide), "\n";
# }
if (!($savepath=~ m,/$,)) { # add a trailing slash if its not on there
$savepath = $savepath . "/";
}
if (!($imgpath=~ m,/$,)) { # add a trailing slash if its not on there
$imgpath= $imgpath . "/";
}
if (!$separate) { $imgpath = ""; }
open FILE, ">$savepath$htmlname" or die "Couldn't open $savepath$filename: $!\n";
$top=0;
html_table_start(\*FILE,0,$cellspacing,0,$capatalize);
for ($i=0; $i<=scalar(@horz); $i++) {
$bot = ($i>$#horz) ? $img->height : $img->get_guide_position($horz[$i]);
html_table_row_start(\*FILE, $capatalize);
$left=0;
for ($j=0; $j<=scalar(@vert); $j++) {
$right = ($j>$#vert) ? $img->width : $img->get_guide_position($vert[$j]);
$imgname = dosel($img, $savepath, $imgpath, $imgbasename, $left, $right, $top, $bot, $i, $j);
html_table_entry(\*FILE, $imgname, $right-$left, $bot-$top, $capatalize);
$left = $right + $cellspacing;
}
html_table_row_end(\*FILE, $capatalize);
$top = $bot + $cellspacing;
}
html_table_end(\*FILE, $capatalize);
return();
};
exit main;

10
plug-ins/perl/examples/prep4gif.pl
View File

@ -98,11 +98,11 @@ register
"<Image>/Filters/Misc/Prepare for GIF",
"RGB*",
[
[PF_INT32, "Lower Threshold", "Lower Alpha Threshold", 64],
[PF_INT32, "Growth", "How Much growth for safety ",1],
[PF_TOGGLE, "Convert To Indexed", "Convert Image to indexed", 0],
[PF_TOGGLE, "Dither", "Floyd-Steinberg Dithering?", 1],
[PF_INT32, "Colors", "Colors to quantize to", "255"],
[PF_INT32, "lower_threshold", "Lower Alpha Threshold", 64],
[PF_INT32, "growth", "How Much growth for safety ",1],
[PF_TOGGLE, "convert_to_indexed", "Convert Image to indexed", 0],
[PF_TOGGLE, "dither", "Floyd-Steinberg Dithering?", 1],
[PF_INT32, "colors", "Colors to quantize to", "255"],
],
\&prep;

57
plug-ins/perl/examples/randomblends Executable file
View File

@ -0,0 +1,57 @@
#!/usr/bin/perl
# <sjburges@gimp.org>
# This is adrian's idea - take random blends and difference them. You're
# bound to come up w/ something cool eventually.
use Gimp;
use Gimp::Fu;
use Gimp::Util;
# Gimp::set_trace(TRACE_ALL);
sub randint {
my ($int) = @_;
return int(rand()*$int +0.5);
}
register "random_blends",
"Random Blends - take a guess.",
"A random approach to art. Just try it. It might be good.",
"Seth Burgess",
"Seth Burgess <sjburges\@gimp.org>",
"1999-03-18",
"<Image>/Filters/Render/Random Blends",
"RGB*, GRAY*",
[
[PF_SPINNER, "number", "How many gradients to apply", 7, [1,255,1]],
], sub {
my($img,$layer,$numgradients) =@_;
eval { $img->undo_push_group_start }; # undo is broked for this one.
# add this to the get_state (after its working?)
$oldgradient = gimp_gradients_get_active();
($sel,$x1,$y1,$x2,$y2) = $img->gimp_selection_bounds;
srand();
@gradientlist = gimp_gradients_get_list();
for ($i=0; $i<=$numgradients; $i++) {
gimp_gradients_set_active(@gradientlist[randint($#gradientlist)]);
$layer->gimp_blend(CUSTOM,
6, # DIFFERENCE
# I'd really like to alternate how many arguments in gradient type depending
# on what version of gimp is being run.. Hints anyone? -sjb
randint(10), # gradient type
randint(100), # opacity
0, # offset
randint(2), # repeat
0,3,0.2, # disabled supersampling
randint($x2-$x1)+$x1, # x1
randint($y2-$y1)+$y1, # y1
randint($x2-$x1)+$x1, # x2
randint($y2-$y1)+$y1, # y2
);
}
eval { $img->undo_push_group_end };
gimp_gradients_set_active($oldgradient);
return();
};
exit main;

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

@ -85,13 +85,13 @@ register "seth_spin",
"<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?", 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],
[PF_DRAWABLE, "source", "What drawable to spin from?"],
[PF_DRAWABLE, "destination","What drawable to spin to?"],
[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'],

1
plug-ins/perl/examples/stamps
View File

@ -8,7 +8,6 @@ sub stamps {
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);

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

@ -45,8 +45,8 @@ register
[
[ PF_RADIO, "solid_noise", "The Texture Type", 0, ["solid noise" => 1, "current picture" => 0]],
[ PF_FONT, "helvetica", "Font Name", "-*-helvetica-medium-r-normal-*-*-240-*-*-p-*-iso8859-1" ],
[ PF_STRING, "Text", "Enter your Text to be Terral-ified", "TerralText"],
[ PF_SLIDER, "Blur Amount", "Blur Amount", 10, [0,26,1]],
[ PF_STRING, "text", "Enter your Text to be Terral-ified", "TerralText"],
[ PF_SLIDER, "blur_amount", "Blur Amount", 10, [0,26,1]],
],
[],
sub {

10
plug-ins/perl/examples/tex-to-float
View File

@ -166,11 +166,11 @@ register "tex_string_to_float", "Turn a TeX-string into floating layer", "Takes
"<Image>/Filters/Render/TeX String",
"*",
[
[PF_STRING, "Input file", "TeX macro file to input"],
[PF_STRING, "TeX String", "Enter TeX String"],
[PF_VALUE, "DPI", "Resolution to render the text in", "72"],
[PF_VALUE, "Magstep", "TeX magstep", "2"],
[PF_VALUE, "Anti-aliasing", "Anti-aliasing factor", "4"],
[PF_STRING, "input_file", "TeX macro file to input"],
[PF_STRING, "tex_string", "Enter TeX String"],
[PF_VALUE, "dpi", "Resolution to render the text in", "72"],
[PF_VALUE, "magstep", "TeX magstep", "2"],
[PF_VALUE, "anti_aliasing", "Anti-aliasing factor", "4"],
],
\&tex_string_to_float;

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

@ -19,9 +19,9 @@ register
'Tom Rathborne', 'GPLv2', '1999-03-11',
'<Image>/View/3D Surface',
'GRAY', [
[ PF_BOOL, 'Polar', 'Radial view', 0],
[ PF_BOOL, 'Lines', 'Draw grid lines', 0],
[ PF_BOOL, 'Smooth', 'Smooth surface normals', 1]
[ PF_BOOL, 'polar', 'Radial view', 0],
[ PF_BOOL, 'lines', 'Draw grid lines', 0],
[ PF_BOOL, 'smooth', 'Smooth surface normals', 1]
], [],
sub {
my ($img, $dwb, $polar, $lines, $smooth) = @_;

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

@ -16,9 +16,9 @@ register "webify",
[
[PF_BOOL, "new", "create a new image?", 1],
[PF_BOOL, "transparent", "make transparent?", 1],
[PF_COLOUR, "bg colour", "the background colour to use for transparency", "white"],
[PF_COLOUR, "bg_color", "the background colour to use for transparency", "white"],
[PF_SLIDER, "threshold", "the threshold to use for background detection", 3, [0, 255, 1]],
[PF_INT32, "colours", "how many colours to use (0 = don't convert to indexed)", 32],
[PF_INT32, "colors", "how many colours to use (0 = don't convert to indexed)", 32],
[PF_BOOL, "autocrop", "autocrop at end?", 1],
],
sub {

8
plug-ins/perl/examples/windy.pl
View File

@ -54,10 +54,10 @@ register
"<Image>/Filters/Distorts/Windify",
"*",
[
[PF_INT32, "Angle", "Wind Angle, 0 is left", 120],
[PF_INT32, "Density", "How Much Is Blown",80],
[PF_VALUE, "Distance", "How Far Its Blown",30],
[PF_TOGGLE, "Smear?", "Smear on Edges (or Wrap)",0]
[PF_INT32, "angle", "Wind Angle, 0 is left", 120],
[PF_INT32, "density", "How Much Is Blown",80],
[PF_VALUE, "distance", "How Far Its Blown",30],
[PF_TOGGLE, "smear", "Smear on Edges (or Wrap)",0]
],
\&windify;

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

@ -42,8 +42,8 @@ register "xach_blocks",
"<Image>/Filters/Map/Xach Blocks",
"*",
[
[PF_SLIDER, "Block size", "The size of the blocks...", 10, [0, 255, 1]],
[PF_SLIDER, "Knob factor", "The size of your knob...", 67, [0, 100, 5]],
[PF_SLIDER, "block_size", "The size of the blocks...", 10, [0, 255, 1]],
[PF_SLIDER, "knob_factor", "The size of your knob...", 67, [0, 100, 5]],
],
sub {
my($img,$drawable,$blocksize, $knobfactor)=@_;

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

@ -34,7 +34,7 @@ register "xach_shadows",
"<Image>/Filters/Map/Xach Shadows",
"RGB*, GRAY*",
[
[PF_SLIDER, "Block size", "The size of the blocks...", 10, [0, 255, 1]],
[PF_SLIDER, "block_size", "The size of the blocks...", 10, [0, 255, 1]],
],
sub {
my($img,$drawable,$blocksize) =@_;

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

@ -15,8 +15,8 @@ register "xachvision",
"<Image>/Filters/Noise/Xach Vision",
"RGB*, GRAY*",
[
[PF_COLOR, "Color", "What Color to see the world in", [0, 255, 0]],
[PF_SLIDER, "Added Noise", "How much noise to add", 25, [0,255,5]]
[PF_COLOR, "color", "What Color to see the world in", [0, 255, 0]],
[PF_SLIDER, "added_noise", "How much noise to add", 25, [0,255,5]]
],
sub {
my($img,$drawable,$color,$amt) =@_;

14
plug-ins/perl/examples/yinyang
View File

@ -108,13 +108,13 @@ register("yinyang", "Render a stand-alone Yin/Yang image",
"Aaron Sherman", "(c) 1998, Aaron Sherman",
"1999a", "<Toolbox>/Xtns/Render/Yin-Yang", "*",
[
[PF_INT32, "Width", "Width", 256],
[PF_INT32, "Height", "Height", 256],
[PF_TOGGLE, "Insert eyes?", "", 1],
[PF_TOGGLE, "Eyes are images?", "", 0],
[PF_STRING, "Top eye filename", "eye 1", ""],
[PF_STRING, "Bottom eye filename", "eye 2", ""],
[PF_TOGGLE, "Anti-aliasing?", "", 1]
[PF_INT32, "width", "Width", 256],
[PF_INT32, "height", "Height", 256],
[PF_TOGGLE, "insert_eyes", "", 1],
[PF_TOGGLE, "eyes_are_images", "", 0],
[PF_STRING, "top_eye_filename", "eye 1", ""],
[PF_STRING, "aobttom_eye_filename", "eye 2", ""],
[PF_TOGGLE, "anti_aliasing", "", 1]
],
\&yinyang);

12
plug-ins/perl/scm2perl
View File

@ -36,12 +36,12 @@ Parse::RecDescent module from CPAN.
=head2 PDB functions returning arrays
Perls knows the length of arrays, Script-Fu doesn't. Functions returning
single arrays return them as a normal perl array, Functions returning more
then one array return it as an array-ref. Script-Fu (and the converted
script) expect to get a length argument and then the arguments. Each
occurence (common ones are C<gimp_list_images> or C<gimp_image_get_layers>)
must be fixed by hand.
Perl knows the length of arrays, Script-Fu doesn't. Functions returning
single arrays return them as a normal perl array, Functions returning
more then one array return it as an array-ref. Script-Fu (and the
converted script) expect to get a length argument and then the
arguments. Each occurence (common ones are C<gimp_list_images> or
C<gimp_image_get_layers>) must be fixed by hand.
=head1 AUTHOR

16
plug-ins/perl/t/load.t
View File

@ -1,18 +1,10 @@
use Test;
BEGIN {
plan tests => 2;
}
END {
ok(0) unless $loaded;
}
$|=1;
print "1..2\n";
use Gimp qw(:consts);
$loaded = 1;
ok(1);
print "ok 1\n";
ok(SHARPEN,1);
print "ok 2\n" if SHARPEN;

18
plug-ins/perl/t/loadlib.t
View File

@ -1,19 +1,11 @@
use Test;
$|=1;
print "1..1\n";
BEGIN {
plan tests => 2;
}
END {
ok(0) unless $loaded;
}
# trick Gimp into using the Gimp::Lib-interface.
BEGIN { @ARGV = '-gimp' }
use Gimp qw(:consts);
use Gimp::Lib;
$loaded = 1;
ok(1);
ok(SHARPEN,1);
print "ok 1\n";

84
plug-ins/perl/t/run.t
View File

@ -1,19 +1,27 @@
use Test;
use Config;
use vars qw($EXTENSIVE_TESTS $GIMPTOOL);
# the most complicated thing is to set up a working gimp environment. its
# difficult at best...
BEGIN {
plan tests => 25;
$|=1;
print "1..26\n";
$count=0;
$Gimp::host = "spawn/";
}
sub ok($;$) {
print((@_==1 ? shift : $_[0] eq &{$_[1]}) ?
"ok " : "not ok ", ++$count, "\n");
}
sub skip($$;$) {
shift() ? print "ok ",++$count," # skip\n" : &ok;
}
END {
if($loaded and $dir) {
system("rm","-rf",$dir); #d#FIXME
} else {
ok(0);
}
# system("rm","-rf",$dir);#d##FIXME#
}
use Cwd;
@ -25,59 +33,71 @@ ok(1);
$n=!$EXTENSIVE_TESTS;
skip($n,sub {($plugins = `$GIMPTOOL -n --install-admin-bin /bin/sh`) =~ s{^.*\s(.*?)(?:/+bin/sh)\r?\n?$}{$1}});
skip($n,sub {-d $plugins});
skip($n,sub {-x "$plugins/script-fu"});
skip($n,1,sub {($plugins = `$GIMPTOOL -n --install-admin-bin /bin/sh`) =~ s{^.*\s(.*?)(?:/+bin/sh)\r?\n?$}{$1}});
skip($n,1,sub {-d $plugins});
skip($n,1,sub {-x "$plugins/script-fu"});
use Gimp;
$loaded = 1;
ok(1);
ok(RGBA_IMAGE || RGB_IMAGE);
ok(RGB_IMAGE ? 1 : 1); # this shouldn't be a pattern match(!)
ok(RGB_IMAGE ? 1 : 1); # check for correct prototype
sub net {
sub tests {
my($i,$l);
skip($n,sub{$i=new Image(10,10,RGB)});
skip($n,ref $i);
skip($n,sub{$l=$i->layer_new(10,10,RGBA_IMAGE,"new layer",100,VALUE_MODE)});
skip($n,ref $l);
skip($n,1,sub{0 != ($i=new Image(10,10,RGB))});
skip($n,1,sub {!!ref $i});
skip($n,1,sub{0 != ($l=$i->layer_new(10,10,RGBA_IMAGE,"new layer",100,VALUE_MODE))});
skip($n,1,sub {!!ref $l});
skip($n,sub{gimp_image_add_layer($l,0) || 1});
skip($n,sub{$l->get_name()},"new layer");
skip($n,1,sub{gimp_image_add_layer($l,0) || 1});
skip($n,"new layer",sub{$l->get_name()});
skip($n,sub{$l->paintbrush(50,[1,1,2,2,5,3,7,4,2,8]) || 1});
skip($n,sub{$l->paintbrush(30,4,[5,5,8,1]) || 1});
skip($n,1,sub{$l->paintbrush(50,[1,1,2,2,5,3,7,4,2,8]) || 1});
skip($n,1,sub{$l->paintbrush(30,4,[5,5,8,1]) || 1});
skip($n,sub{Plugin->sharpen(RUN_NONINTERACTIVE,$i,$l,10) || 1});
skip($n,sub{$l->sharpen(10) || 1});
skip($n,sub{plug_in_sharpen($i,$l,10) || 1});
skip($n,1,sub{Plugin->sharpen(RUN_NONINTERACTIVE,$i,$l,10) || 1});
skip($n,1,sub{$l->sharpen(10) || 1});
skip($n,1,sub{plug_in_sharpen($i,$l,10) || 1});
skip($n,sub{$i->delete || 1});
skip($n,1,sub{$i->delete || 1});
}
system("rm","-rf",$dir); #d#FIXME
ok(sub {mkdir $dir,0700});
ok(sub {symlink "../Perl-Server","$dir/Perl-Server"});
skip($n,sub {symlink "$plugins/script-fu","$dir/script-fu"});
skip($n,sub {symlink "$plugins/sharpen","$dir/sharpen"});
ok(1,sub {mkdir $dir,0700});
# copy the Perl-Server
{
local(*X,*Y,$/);
open X,"<Perl-Server" or die "unable to read the Perl-Server";
my $s = <X>;
open Y,">$dir/Perl-Server.pl" or die "unable to write the Perl-Server";
print Y $Config{startperl},"\n",$s,<X>;
ok(1);
}
ok(1,sub { chmod 0700,"$dir/Perl-Server.pl" });
skip($n,1,sub {symlink "$plugins/script-fu","$dir/script-fu"});
skip($n,1,sub {symlink "$plugins/sharpen","$dir/sharpen"});
ok (
open RC,">$dir/gimprc" and
print RC "(show-tips no)\n" and
print RC "(gimp_data_dir \"\")\n" and
print RC "(script-fu-path \"\")\n" and
print RC "(plug-in-path \"$dir\")\n" and
close RC
);
$ENV{'GIMP_DIRECTORY'}=$dir;
$Gimp::host = "spawn/";
if(!$n) {
skip($n,1);
main;
Gimp::init;
tests;
} else {
skip($n,0);
net();
tests;
}