see plug-ins/perl/Changes
This commit is contained in:
Marc Lehmann
@ -1,5 +1,9 @@
|
||||
This is distributed under the same license as perl itself, i.e. either the
|
||||
Artistic License (COPYING.Artistic) or the GPL (COPYING.GNU).
|
||||
This package is distributed under the same license as perl itself, i.e.
|
||||
either the Artistic License (COPYING.Artistic) or the GPL (COPYING.GNU).
|
||||
|
||||
Please note that this does _NOT_ include the scripts in the examples/
|
||||
directory. Most of them have their own distribution license (see their
|
||||
source for details, and read the file examples/README).
|
||||
|
||||
If you make modifications, please consider sending them to me,
|
||||
Marc Lehmann <pcg@goof.com>
|
||||
|
||||
@ -1,102 +1,111 @@
|
||||
Revision history for Gimp-Perl extension.
|
||||
|
||||
- added examples/yinyang, examples/image_tile.
|
||||
- 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.
|
||||
- fixed error handling bugs in Gimp::Lib, streamlined and improved
|
||||
error handling.
|
||||
- reworked callback handling, should be more flexible in the future.
|
||||
- changed implementation of PF_CUSTOM (still untested).
|
||||
|
||||
1.061 Fri Mar 12 21:27:26 CET 1999
|
||||
- closed big, BIG security hole on password authenticitation
|
||||
(basically one could do anything includung killing your
|
||||
system without authorization. argh). This required a
|
||||
protocol change, so old clients are unable to connect using
|
||||
password-authenticitation.
|
||||
- sped up Gimp::Net considerably, by getting rid of the IO::Socket
|
||||
module, which required half a second(!!) to load.
|
||||
- closed big, BIG security hole on password authenticitation
|
||||
(basically one could do anything includung killing your
|
||||
system without authorization. argh). This required a
|
||||
protocol change, so old clients are unable to connect using
|
||||
password-authenticitation.
|
||||
- sped up Gimp::Net considerably, by getting rid of the IO::Socket
|
||||
module, which required half a second(!!) to load.
|
||||
- fixed Gimp::Util::gimp_image_layertype.
|
||||
- make install checks for install directory writability
|
||||
and refuses to install if it isn't.
|
||||
- fixed a longstanding bug that caused (some) set_trace calls
|
||||
to be ignored when running under Gimp::Net.
|
||||
- make install checks for install directory writability and refuses to
|
||||
install if it isn't.
|
||||
- fixed a longstanding bug that caused (some) set_trace calls
|
||||
to be ignored when running under Gimp::Net.
|
||||
- added new convinience functions to Gimp::Util.
|
||||
- Gimp::Fu checks for the presence of Gtk and dies
|
||||
if it can't be found.
|
||||
- PF_FONT should now display a string widget in gtk+ 1.0.
|
||||
- PixelRgn/Tile data sould now be accessible again.
|
||||
- updated PDB.
|
||||
- extensive tests is now always on.
|
||||
- added examples/gimpmagick, examples/sethspin.pl, animate_cells.
|
||||
- new function Gimp::initialized that returns true whenever its
|
||||
safe to call gimp functins.
|
||||
- added the Gimp::Feature module, allowing for easy feature checks.
|
||||
See examples/gimpmagick or examples/parasite-editor for example
|
||||
usage.
|
||||
- added perlcc, the perl control center. Only displays log messages
|
||||
at the moment.
|
||||
- error and warning logging through the Perl Control Center.
|
||||
- Data::Dumper is now longer required to run the scripts, some
|
||||
buttons and RUN_WITH_LAST_VALS won't work, though.
|
||||
- removed POSIX dependency in examples/gimpmagick.
|
||||
- Uh, ah, debugging code in the repository, again!
|
||||
- Gimp::Fu checks for the presence of Gtk and dies if it can't be
|
||||
found.
|
||||
- PF_FONT should now display a string widget in gtk+ 1.0.
|
||||
- PixelRgn/Tile data sould now be accessible again.
|
||||
- updated PDB.
|
||||
- extensive tests is now always on.
|
||||
- added examples/gimpmagick, examples/sethspin.pl, animate_cells.
|
||||
- new function Gimp::initialized that returns true whenever its
|
||||
safe to call gimp functins.
|
||||
- added the Gimp::Feature module, allowing for easy feature checks.
|
||||
See examples/gimpmagick or examples/parasite-editor for example
|
||||
usage.
|
||||
- added perlcc, the perl control center. Only displays log messages
|
||||
at the moment.
|
||||
- error and warning logging through the Perl Control Center.
|
||||
- Data::Dumper is now longer required to run the scripts, some
|
||||
buttons and RUN_WITH_LAST_VALS won't work, though.
|
||||
- removed POSIX dependency in examples/gimpmagick.
|
||||
- Uh, ah, debugging code in the repository, again!
|
||||
|
||||
1.06 Sat Mar 6 19:36:12 CET 1999
|
||||
- Gimp::Fu does no longer display the returned image when it
|
||||
is the same as the one passed in.
|
||||
- append imagenumber to "Untitled"-images in widget.
|
||||
- removed publicly-visible non-PDB pixelfunctions.
|
||||
"uuuuuse peedee-ell or dieieie".
|
||||
- implemented Gimp::Fu::PF_RADIO.
|
||||
- added blowinout.pl, terral_text and xachvision.pl.
|
||||
- the use of Gimp::PDL to access the region/tile functions is
|
||||
now mandatory. The old string interface does not exist anymore.
|
||||
- the path to the server-socket now includes the UID, to avoid
|
||||
collisions. CGI-scripts should use either tcp or specify the path
|
||||
directly using GIMP_HOST (see Gimp::Net for details).
|
||||
- use _much_ saner defaults for the Scale types in Gimp::Fu.
|
||||
- Gimp::Fu's optionmenus didn't work in net()-mode.
|
||||
- implemented PF_CUSTOM (untested).
|
||||
- added Gimp::UI::ColorSelectbutton, I was utterly fed up with
|
||||
GtkColorSelectbutton never working.
|
||||
|
||||
is the same as the one passed in.
|
||||
- append imagenumber to "Untitled"-images in widget.
|
||||
- removed publicly-visible non-PDB pixelfunctions.
|
||||
"uuuuuse peedee-ell or dieieie".
|
||||
- implemented Gimp::Fu::PF_RADIO.
|
||||
- added blowinout.pl, terral_text and xachvision.pl.
|
||||
- the use of Gimp::PDL to access the region/tile functions is
|
||||
now mandatory. The old string interface does not exist anymore.
|
||||
- the path to the server-socket now includes the UID, to avoid
|
||||
collisions. CGI-scripts should use either tcp or specify the path
|
||||
directly using GIMP_HOST (see Gimp::Net for details).
|
||||
- use _much_ saner defaults for the Scale types in Gimp::Fu.
|
||||
- Gimp::Fu's optionmenus didn't work in net()-mode.
|
||||
- implemented PF_CUSTOM (untested).
|
||||
- added Gimp::UI::ColorSelectbutton, I was utterly fed up with
|
||||
GtkColorSelectbutton never working.
|
||||
|
||||
1.055 Mon Feb 22 22:38:44 CET 1999
|
||||
- applied seth's script changes.
|
||||
- gimp11ified some plug-ins.
|
||||
- removed debugging code in Gimp/Lib.xs.
|
||||
- got rid of a perl5.004 warning.
|
||||
- removed gimp_{main,init,end}.
|
||||
- gimp11ified some plug-ins.
|
||||
- removed debugging code in Gimp/Lib.xs.
|
||||
- got rid of a perl5.004 warning.
|
||||
- removed gimp_{main,init,end}.
|
||||
|
||||
1.054 Mon Feb 22 15:23:41 CET 1999
|
||||
- scm2scm and scm2perl will now be installed in INST_SCRIPT
|
||||
- fixed a bug in interact/PF_FONT.
|
||||
- made save_image more 1.1 compatible and automatically index
|
||||
when saving to gif.
|
||||
- many, Many, MANY 5.004 compatibility fixes.
|
||||
- fixed a bug in interact/PF_FONT.
|
||||
- made save_image more 1.1 compatible and automatically index
|
||||
when saving to gif.
|
||||
- many, Many, MANY 5.004 compatibility fixes.
|
||||
|
||||
1.053 Mon Feb 15 01:35:04 CET 1999
|
||||
- more errornous argument types are detected now, without
|
||||
just calling abort().
|
||||
- fixed a MAJOR namespace-leak: for example, if one used
|
||||
gimp_parasite_list once, Gimp::Image->parasite_list would call
|
||||
gimp_parasite_list and NOT gimp_image_parasite_list, as would be
|
||||
correct.
|
||||
- Gimp::Net now works correctly with parasites.
|
||||
- added examples/parasite_editor
|
||||
- added gimp_ prefix to Parasite-class
|
||||
- use $Config{perlpath} for bangpath, not $PERL
|
||||
just calling abort().
|
||||
- fixed a MAJOR namespace-leak: for example, if one used
|
||||
gimp_parasite_list once, Gimp::Image->parasite_list would call
|
||||
gimp_parasite_list and NOT gimp_image_parasite_list, as would be
|
||||
correct.
|
||||
- Gimp::Net now works correctly with parasites.
|
||||
- added examples/parasite_editor
|
||||
- added gimp_ prefix to Parasite-class
|
||||
- use $Config{perlpath} for bangpath, not $PERL
|
||||
|
||||
1.052 Tue Feb 9 18:16:15 CET 1999
|
||||
- moved the xlfd_size function from Gimp::Fu into Gimp
|
||||
(and maybe later into Gimp::Util?)
|
||||
(and maybe later into Gimp::Util?)
|
||||
- functions in Gimp::Util are now treated in the same way
|
||||
as PDB functions (when the module is loaded)
|
||||
- improved handling of "make clean" to make it less perl-ish
|
||||
and more gnu-ish
|
||||
- enabled full testsuite (keep your fingers crossed)
|
||||
as PDB functions (when the module is loaded)
|
||||
- improved handling of "make clean" to make it less perl-ish
|
||||
and more gnu-ish
|
||||
- enabled full testsuite (keep your fingers crossed)
|
||||
- PDL examples no longer cause errors at startup
|
||||
- more compatibility fixes for 5.005_54
|
||||
- bangpaths are now replaced by $PERL at configuration time
|
||||
- fixed a few quirks in scm2scm and added it to the package
|
||||
- more compatibility fixes for 5.005_54
|
||||
- bangpaths are now replaced by $PERL at configuration time
|
||||
- fixed a few quirks in scm2scm and added it to the package
|
||||
|
||||
1.051 Tue Jan 19 21:10:20 CET 1999
|
||||
- corrected a minor typoe found by Stefan Traby <stefan@sime.com>
|
||||
- added SPIRAL* constants for gimp_blend
|
||||
- moved constants from Gimp.xs and extradefs.h to Gimp.pm, where
|
||||
they belong (either there or into Gimp.xs)
|
||||
- added SPIRAL* constants for gimp_blend
|
||||
- moved constants from Gimp.xs and extradefs.h to Gimp.pm, where
|
||||
they belong (either there or into Gimp.xs)
|
||||
- added view3d.pl to examples (untested)
|
||||
- Gimp::Util is reborn (give it a try and contribute!)
|
||||
- more Gtk changes (tested with Gtk-0.5 and gtk-1.1.x, uh-oh)
|
||||
@ -104,11 +113,11 @@ Revision history for Gimp-Perl extension.
|
||||
|
||||
1.05 Fri Dec 18 22:05:25 CET 1998
|
||||
- some 5.006 compatibility fixes
|
||||
- disabled some functionality for poor gtk-1.0 which
|
||||
is borken to no end
|
||||
- fixed PARASITE_PERSISTENT typoe
|
||||
- new functions: gimp_{major,minor,micro}_version
|
||||
- PF_BRUSH, PATTERN and GRADIENT widgets are "emulated" in gimp-1.0
|
||||
- disabled some functionality for poor gtk-1.0 which
|
||||
is borken to no end
|
||||
- fixed PARASITE_PERSISTENT typoe
|
||||
- new functions: gimp_{major,minor,micro}_version
|
||||
- PF_BRUSH, PATTERN and GRADIENT widgets are "emulated" in gimp-1.0
|
||||
|
||||
1.049 Mon Nov 23 20:54:41 CET 1998
|
||||
- updated configure to require 1.0.2
|
||||
@ -493,9 +502,9 @@ Revision history for Gimp-Perl extension.
|
||||
0.80 Fri Feb 13 17:15:48 CET 1998
|
||||
- version 1.0 is the first one generally usable.. we're getting
|
||||
close!
|
||||
- Gimp::Net and Gimp::Lib are only internal modules, there is not
|
||||
much of a distinction between networked modules and modules
|
||||
using libgimp!
|
||||
- Gimp::Net and Gimp::Lib are only internal modules, there is not
|
||||
much of a distinction between networked modules and modules
|
||||
using libgimp!
|
||||
- Gimp::OO usable over the network.
|
||||
|
||||
0.07 Thu Feb 12 06:51:56 CET 1998
|
||||
|
||||
@ -5,13 +5,13 @@ 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
|
||||
@gimp_gui_functions $function $ignore_die
|
||||
$help $verbose $host);
|
||||
|
||||
require DynaLoader;
|
||||
|
||||
@ISA=qw(DynaLoader);
|
||||
$VERSION = 1.061;
|
||||
$VERSION = 1.07;
|
||||
|
||||
@_param = qw(
|
||||
PARAM_BOUNDARY PARAM_CHANNEL PARAM_COLOR PARAM_DISPLAY PARAM_DRAWABLE
|
||||
@ -268,9 +268,18 @@ EOF
|
||||
}
|
||||
|
||||
my @log;
|
||||
my $caller;
|
||||
|
||||
sub format_msg {
|
||||
$_=shift;
|
||||
"$_->[0]: $_->[2] ".($_->[1] ? "($_->[1])":"");
|
||||
}
|
||||
|
||||
sub _initialized_callback {
|
||||
if (@log) {
|
||||
for(@log) {
|
||||
Gimp->message(format_msg($_)) if $_->[3] && $interface_type eq "lib";
|
||||
}
|
||||
Gimp->_gimp_append_data ('gimp-perl-log', map join("\1",@$_)."\0",@log);
|
||||
@log=();
|
||||
}
|
||||
@ -284,37 +293,75 @@ sub logger {
|
||||
my $file=$0;
|
||||
$file=~s/^.*[\\\/]//;
|
||||
$args{message} = "unknown message" unless defined $args{message};
|
||||
$args{function} = $function unless defined $args{function};
|
||||
$args{function} = "" unless defined $args{function};
|
||||
$args{fatal} = 1 unless defined $args{fatal};
|
||||
print STDERR "$file: $args{message} ",($args{function} ? "(for function $args{function})":""),"\n" if $verbose || $interface_type eq 'net';
|
||||
push(@log,[$file,@args{'function','message','fatal'}]);
|
||||
print STDERR format_msg($log[-1]),"\n" if $verbose || $interface_type eq 'net';
|
||||
_initialized_callback if initialized();
|
||||
}
|
||||
|
||||
# calm down the gimp module
|
||||
sub net {}
|
||||
sub query {}
|
||||
sub die_msg {
|
||||
logger(message => substr($_[0],0,-1), fatal => 1, function => 'DIE');
|
||||
}
|
||||
|
||||
sub normal_context {
|
||||
!$^S && defined $^S;
|
||||
sub call_callback {
|
||||
my $req = shift;
|
||||
my $cb = shift;
|
||||
if (UNIVERSAL::can($caller,$cb)) {
|
||||
&{"${caller}::$cb"};
|
||||
} else {
|
||||
die_msg "required callback '$cb' not found\n" if $req;
|
||||
}
|
||||
}
|
||||
|
||||
sub callback {
|
||||
my $type = shift;
|
||||
confess unless initialized();
|
||||
_initialized_callback;
|
||||
return () if $caller eq "Gimp";
|
||||
if ($type eq "-run") {
|
||||
local $function = shift;
|
||||
call_callback 1,$function,@_;
|
||||
} elsif ($type eq "-net") {
|
||||
call_callback 1,"net";
|
||||
} elsif ($type eq "-query") {
|
||||
call_callback 1,"query";
|
||||
} elsif ($type eq "-quit") {
|
||||
local $ignore_die = 0;
|
||||
call_callback 0,"quit";
|
||||
}
|
||||
}
|
||||
|
||||
sub main {
|
||||
$caller=caller;
|
||||
&{"${interface_pkg}::gimp_main"};
|
||||
}
|
||||
|
||||
# same as main, but callbacks are ignored
|
||||
sub quiet_main {
|
||||
main;
|
||||
}
|
||||
|
||||
$SIG{__DIE__} = sub {
|
||||
if (normal_context) {
|
||||
logger(message => substr($_[0],0,-1), fatal => 1, function => 'DIE');
|
||||
if (!$^S && $ignore_die) {
|
||||
die_msg $_[0];
|
||||
initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit main();
|
||||
} else {
|
||||
die $_[0];
|
||||
}
|
||||
die $_[0];
|
||||
};
|
||||
|
||||
$SIG{__WARN__} = sub {
|
||||
if (normal_context) {
|
||||
logger(message => substr($_[0],0,-1), fatal => 0, function => 'WARN');
|
||||
if ($ignore_die) {
|
||||
warn $_[0];
|
||||
} else {
|
||||
warn $_[0];
|
||||
logger(message => substr($_[0],0,-1), fatal => 0, function => 'WARN');
|
||||
}
|
||||
};
|
||||
|
||||
##############################################################################
|
||||
|
||||
if ($interface_type=~/^lib$/i) {
|
||||
$interface_pkg="Gimp::Lib";
|
||||
} elsif ($interface_type=~/^net$/i) {
|
||||
@ -331,10 +378,8 @@ for(qw(_gimp_procedure_available gimp_call_procedure set_trace initialized)) {
|
||||
*$_ = \&{"${interface_pkg}::$_"};
|
||||
}
|
||||
|
||||
*main = \&{"${interface_pkg}::gimp_main"};
|
||||
*init = \&{"${interface_pkg}::gimp_init"};
|
||||
*end = \&{"${interface_pkg}::gimp_end" };
|
||||
|
||||
*init = \&{"${interface_pkg}::gimp_init"};
|
||||
*end = \&{"${interface_pkg}::gimp_end" };
|
||||
*lock = \&{"${interface_pkg}::lock" };
|
||||
*unlock= \&{"${interface_pkg}::unlock" };
|
||||
|
||||
|
||||
@ -35,10 +35,6 @@ my %description = (
|
||||
'never' => '(for testing, will never be present)',
|
||||
);
|
||||
|
||||
# calm down the gimp module
|
||||
sub net {}
|
||||
sub query {}
|
||||
|
||||
sub import {
|
||||
my $pkg = shift;
|
||||
my $feature;
|
||||
@ -59,7 +55,7 @@ sub need {
|
||||
my ($feature,$function)=@_;
|
||||
unless (present($feature)) {
|
||||
missing($description{$feature},$function);
|
||||
Gimp::initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit Gimp::main();
|
||||
Gimp::initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit Gimp::quiet_main();
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -388,9 +388,10 @@ sub interact($$$@) {
|
||||
}
|
||||
|
||||
} elsif($type == PF_CUSTOM) {
|
||||
$a=$extra->[0];
|
||||
push(@setvals,$extra->[1]);
|
||||
push(@getvals,$extra->[2]);
|
||||
my (@widget)=&$extra;
|
||||
$a=$widget[0];
|
||||
push(@setvals,$widget[1]);
|
||||
push(@getvals,$widget[2]);
|
||||
|
||||
} else {
|
||||
$label="Unsupported argumenttype $type";
|
||||
@ -814,10 +815,10 @@ string. The default brush/pattern/gradient-name can be preset.
|
||||
|
||||
=item PF_CUSTOM
|
||||
|
||||
PF_CUSTOM is for those of you requiring some non-standard-widget. Just supply an array reference
|
||||
with three elements as extra argument:
|
||||
PF_CUSTOM is for those of you requiring some non-standard-widget. You have
|
||||
to supply a code reference returning three values as the extra argument:
|
||||
|
||||
[widget, settor, gettor]
|
||||
(widget, settor, gettor)
|
||||
|
||||
C<widget> is Gtk widget that should be used.
|
||||
|
||||
@ -828,7 +829,7 @@ C<gettor> is a function that should return the current value of the widget.
|
||||
|
||||
While the values can be of any type (as long as it fits into a scalar),
|
||||
you should be prepared to get a string when the script is started from the
|
||||
commandline.
|
||||
commandline or via the PDB.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
@ -18,6 +18,9 @@
|
||||
#undef MIN
|
||||
#undef MAX
|
||||
|
||||
/* various functions allocate static buffers, STILL. */
|
||||
#define MAX_STRING 4096
|
||||
|
||||
/* dunno where this comes from */
|
||||
#undef VOIDUSED
|
||||
|
||||
@ -187,7 +190,7 @@ trace_init ()
|
||||
void trace_printf (char *frmt, ...)
|
||||
{
|
||||
va_list args;
|
||||
char buffer[4096]; /* sorry... */
|
||||
char buffer[MAX_STRING]; /* sorry... */
|
||||
|
||||
va_start (args, frmt);
|
||||
#ifdef HAVE_VSNPRINTF
|
||||
@ -200,10 +203,33 @@ void trace_printf (char *frmt, ...)
|
||||
}
|
||||
|
||||
#else
|
||||
#error need ansi compiler, maybe try c89?
|
||||
error need_ansi_compiler__maybe_try_c89
|
||||
#endif
|
||||
|
||||
/* in case g_strdup_printf is missing. */
|
||||
#if (GLIB_MAJOR_VERSION>1) || (GLIB_MAJOR_VERSION==1 && GLIB_MINOR_VERSION>1)
|
||||
#define strdup_printf g_strdup_printf
|
||||
#elif __STDC__
|
||||
#include <stdarg.h>
|
||||
static char *
|
||||
strdup_printf (char *frmt, ...)
|
||||
{
|
||||
va_list args;
|
||||
char buffer[MAX_STRING]; /* sorry... */
|
||||
|
||||
va_start (args, frmt);
|
||||
#ifdef HAVE_VSNPRINTF
|
||||
vsnprintf (buffer, sizeof buffer, frmt, args);
|
||||
#else
|
||||
vsprintf (buffer, frmt, args);
|
||||
#endif
|
||||
return g_strdup (buffer);
|
||||
}
|
||||
#else
|
||||
error need_ansi_compiler__maybe_try_c89
|
||||
#endif
|
||||
|
||||
|
||||
static int
|
||||
is_array (GParamType typ)
|
||||
{
|
||||
@ -482,7 +508,7 @@ unbless (SV *sv, char *type, char *croak_str)
|
||||
static gint32
|
||||
unbless_croak (SV *sv, char *type)
|
||||
{
|
||||
char croak_str[320];
|
||||
char croak_str[MAX_STRING];
|
||||
gint32 r;
|
||||
croak_str[0] = 0;
|
||||
|
||||
@ -777,25 +803,30 @@ destroy_paramdefs (GParamDef *arg, int count)
|
||||
}
|
||||
#endif
|
||||
|
||||
/* first check wether the procedure exists at all. */
|
||||
static void try_call (char *name, int req)
|
||||
/* calls Gimp::die_msg. */
|
||||
static void gimp_die_msg (char *msg)
|
||||
{
|
||||
dSP;
|
||||
CV *cv = perl_get_cv (name, 0);
|
||||
char *argv[2];
|
||||
argv[0] = msg;
|
||||
argv[1] = 0;
|
||||
|
||||
PUSHMARK(sp); perl_call_pv ("Gimp::_initialized_callback", G_DISCARD | G_NOARGS);
|
||||
|
||||
/* it's not an error if the callback doesn't exist. */
|
||||
if (cv) {
|
||||
PUSHMARK(sp);
|
||||
perl_call_sv ((SV *)cv, G_DISCARD | G_NOARGS);
|
||||
} else if (req)
|
||||
croak ("required callback '%s' not found", name);
|
||||
perl_call_argv ("Gimp::die_msg", G_DISCARD, argv);
|
||||
}
|
||||
|
||||
static void pii_init (void) { try_call ("init" ,0); }
|
||||
static void pii_query(void) { try_call ("query",1); }
|
||||
static void pii_quit (void) { try_call ("quit" ,0); }
|
||||
/* 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);
|
||||
}
|
||||
|
||||
static void pii_init (void) { try_call ("-init" ); }
|
||||
static void pii_query(void) { try_call ("-query"); }
|
||||
static void pii_quit (void) { try_call ("-quit" ); }
|
||||
|
||||
static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals, GParam **xreturn_vals)
|
||||
{
|
||||
@ -805,7 +836,6 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
|
||||
dSP;
|
||||
STRLEN dc;
|
||||
int i, count;
|
||||
GParamDef *return_defs;
|
||||
char *err_msg = 0;
|
||||
|
||||
char *proc_blurb;
|
||||
@ -816,15 +846,8 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
|
||||
int proc_type;
|
||||
int _nparams;
|
||||
GParamDef *params;
|
||||
|
||||
PUSHMARK(sp); perl_call_pv ("Gimp::_initialized_callback", G_DISCARD | G_NOARGS);
|
||||
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,
|
||||
¶ms, &return_defs) == TRUE)
|
||||
@ -840,6 +863,9 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
|
||||
SAVETMPS;
|
||||
|
||||
PUSHMARK(sp);
|
||||
|
||||
XPUSHs (newSVpv ("-run", 4));
|
||||
XPUSHs (newSVpv (name, 0));
|
||||
|
||||
if (nparams)
|
||||
{
|
||||
@ -856,7 +882,7 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
|
||||
SPAGAIN;
|
||||
}
|
||||
|
||||
count = perl_call_pv (name, G_EVAL
|
||||
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));
|
||||
|
||||
@ -885,51 +911,54 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
|
||||
else
|
||||
{
|
||||
int i;
|
||||
char err_msg [1024];
|
||||
err_msg [0] = 0;
|
||||
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++;
|
||||
|
||||
|
||||
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 (err_msg, &return_vals[i], TOPs))
|
||||
&& convert_sv2gimp (errmsg, &return_vals[i], TOPs))
|
||||
{
|
||||
--count;
|
||||
POPs;
|
||||
}
|
||||
|
||||
if (err_msg [0])
|
||||
croak (err_msg);
|
||||
if (errmsg [0])
|
||||
{
|
||||
err_msg = g_strdup (errmsg);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
if (count)
|
||||
croak ("callback returned %s more values than expected", count);
|
||||
if (count && !err_msg)
|
||||
err_msg = strdup_printf ("plug-in returned %d more values than expected", count);
|
||||
}
|
||||
|
||||
while (count--)
|
||||
POPs;
|
||||
|
||||
g_free (return_defs);
|
||||
destroy_paramdefs (return_defs, nreturn_vals);
|
||||
|
||||
FREETMPS;
|
||||
LEAVE;
|
||||
}
|
||||
else
|
||||
croak ("being called as '%s', but '%s' not registered in the pdb", name, name);
|
||||
err_msg = strdup_printf ("being called as '%s', but '%s' not registered in the pdb", name, name);
|
||||
|
||||
if (err_msg)
|
||||
{
|
||||
gimp_message (err_msg);
|
||||
gimp_die_msg (err_msg);
|
||||
g_free (err_msg);
|
||||
|
||||
if (return_vals)
|
||||
destroy_params (return_vals, nreturn_vals);
|
||||
destroy_params (*xreturn_vals, nreturn_vals+1);
|
||||
|
||||
nreturn_vals = 1;
|
||||
return_vals = g_new (GParam, 1);
|
||||
@ -938,7 +967,6 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
|
||||
*xnreturn_vals = nreturn_vals;
|
||||
*xreturn_vals = return_vals;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
GPlugInInfo PLUG_IN_INFO = { pii_init, pii_quit, pii_query, pii_run };
|
||||
@ -1113,7 +1141,7 @@ gimp_call_procedure (proc_name, ...)
|
||||
char * proc_name
|
||||
PPCODE:
|
||||
{
|
||||
char croak_str[320] = "";
|
||||
char croak_str[MAX_STRING] = "";
|
||||
char *proc_blurb;
|
||||
char *proc_help;
|
||||
char *proc_author;
|
||||
@ -1333,7 +1361,7 @@ gimp_set_data(id, data)
|
||||
gimp_set_data (SvPV (id, dc), dta, dlen);
|
||||
#else
|
||||
{
|
||||
char str[1024]; /* hack */
|
||||
char str[MAX_STRING]; /* hack */
|
||||
SvUPGRADE (id, SVt_PV);
|
||||
len = SvCUR (id);
|
||||
Copy (SvPV (id, dc), str, len, char);
|
||||
@ -1364,7 +1392,7 @@ gimp_get_data(id)
|
||||
*((char *)SvPV (data, dc) + dlen) = 0;
|
||||
#else
|
||||
{
|
||||
char str[1024]; /* hack */
|
||||
char str[MAX_STRING]; /* hack */
|
||||
SvUPGRADE (id, SVt_PV);
|
||||
len = SvCUR (id);
|
||||
Copy (SvPV (id, dc), str, len, char);
|
||||
|
||||
@ -236,7 +236,7 @@ sub gimp_init {
|
||||
sub gimp_end {
|
||||
$initialized = 0;
|
||||
|
||||
undef $server_fh;
|
||||
close $server_fh;
|
||||
kill 'KILL',$gimp_pid if $gimp_pid;
|
||||
undef $gimp_pid;
|
||||
}
|
||||
@ -244,10 +244,15 @@ sub gimp_end {
|
||||
sub gimp_main {
|
||||
gimp_init;
|
||||
no strict 'refs';
|
||||
eval { &{caller(1)."::net"} };
|
||||
die $@ if $@ && $@ ne "BE QUIET ABOUT THIS DIE\n";
|
||||
gimp_end;
|
||||
return 0;
|
||||
eval { Gimp::callback("-net") };
|
||||
if($@ && $@ ne "BE QUIET ABOUT THIS DIE\n") {
|
||||
Gimp::logger(message => substr($@,0,-1), fatal => 1, function => 'DIE');
|
||||
gimp_end;
|
||||
-1;
|
||||
} else {
|
||||
gimp_end;
|
||||
0;
|
||||
}
|
||||
}
|
||||
|
||||
sub get_connection() {
|
||||
|
||||
@ -66,3 +66,5 @@ examples/gimpmagick
|
||||
examples/perlcc
|
||||
examples/sethspin.pl
|
||||
examples/animate_cells
|
||||
examples/yinyang
|
||||
examples/image_tile
|
||||
|
||||
@ -1,6 +1,5 @@
|
||||
require 5.004;
|
||||
|
||||
use ExtUtils::MakeMaker;
|
||||
use Config;
|
||||
|
||||
$topdir=".";
|
||||
@ -10,10 +9,12 @@ $|=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);
|
||||
sethspin.pl animate_cells image_tile yinyang
|
||||
);
|
||||
@shebang = (map("examples/$_",@examples),
|
||||
qw(Perl-Server scm2perl scm2scm examples/example-net.pl examples/homepage-logo.pl
|
||||
examples/example-fu.pl examples/example-oo.pl));
|
||||
qw(Perl-Server examples/example-net.pl examples/homepage-logo.pl
|
||||
examples/example-fu.pl examples/example-oo.pl
|
||||
));
|
||||
|
||||
if ($ARGV[0] ne "--writemakefile") {
|
||||
for(@ARGV) {
|
||||
@ -55,6 +56,9 @@ Do you want me to make these tests [y]? ";
|
||||
do './config.pl';
|
||||
}
|
||||
|
||||
require ExtUtils::MakeMaker;
|
||||
import ExtUtils::MakeMaker;
|
||||
|
||||
eval { require Gimp };
|
||||
unless($@) {
|
||||
$old_prefix = eval { Gimp::_gimp_prefix() };
|
||||
@ -163,9 +167,10 @@ WARNING: version 0.3 of Gtk is _required_ for this module to
|
||||
EOF
|
||||
}
|
||||
|
||||
for(@shebang) {
|
||||
system ($Config{perlpath},"-pi","-e","\$. == 1 and \$_ = '#!$Config{perlpath}\n'",$_);
|
||||
}
|
||||
# wo do no longer do these dirty things
|
||||
#for(@shebang) {
|
||||
# system ($Config{perlpath},"-pi","-e","\$. == 1 and \$_ = '#!$Config{perlpath}\n'",$_);
|
||||
#}
|
||||
|
||||
sub MY::install {
|
||||
package MY;
|
||||
@ -190,14 +195,20 @@ install ::
|
||||
exit ; \
|
||||
fi \
|
||||
done ; \
|
||||
$(MAKE) really-install
|
||||
$(MAKE) really-install install-plugins
|
||||
|
||||
'.$install;
|
||||
}
|
||||
|
||||
sub fixinstall {
|
||||
my($src,$dst)=@_;
|
||||
" cp '$src' '\$(INST_SCRIPT)/$dst' && \$(FIXIN) '\$(INST_SCRIPT)/$dst' && \\\n".
|
||||
" cd '\$(INST_SCRIPT)' && $GIMPTOOL --install-admin-bin '$dst' && \\\n".
|
||||
" rm '$dst'\n";
|
||||
}
|
||||
|
||||
sub MY::postamble {
|
||||
(my $GIMPTOOL2 = $GIMPTOOL) =~ s/^\.\./..\/../;
|
||||
my $postamble=<<"EOF";
|
||||
my $postamble="
|
||||
|
||||
objclean :: clean
|
||||
maintainer-clean :: realclean
|
||||
@ -207,13 +218,9 @@ check :: test
|
||||
clean ::
|
||||
test -f Makefile || mv -f Makefile.old Makefile
|
||||
|
||||
really-install :: install-plugins
|
||||
$GIMPTOOL --install-admin-bin Perl-Server
|
||||
|
||||
install-plugins:
|
||||
EOF
|
||||
|
||||
$postamble.join("",map " -cd examples && $GIMPTOOL2 --install-admin-bin $_\n", @examples);
|
||||
install-plugins :: \$(INST_SCRIPT)/.exists\n"
|
||||
.fixinstall('Perl-Server','Perl-Server')
|
||||
.join("",map fixinstall("examples/$_",$_),@examples);
|
||||
}
|
||||
|
||||
WriteMakefile(
|
||||
|
||||
@ -17,25 +17,27 @@ bugs
|
||||
|
||||
important issues
|
||||
|
||||
* Gimp::IO (?)
|
||||
* Gimp->server_eval()
|
||||
* install scripts in share/
|
||||
* fix auto-edit shebang for check-ins
|
||||
* gimp-tiles are not accessible in any way..
|
||||
[DONE] * fix auto-edit shebang for check-ins
|
||||
[DONE] * gimp-tiles are not accessible in any way..
|
||||
* register dummy function to calm gimp down
|
||||
* paths in module(!)
|
||||
* config options & paths in module(!)
|
||||
* Gimp::Module for modules (!)
|
||||
* gimp->object_id, drawable_object_id remove!
|
||||
* PF_CUSTOM
|
||||
* gimp_display_image
|
||||
* vamp up homepage
|
||||
* --ui and --noui for Gimp::Fu
|
||||
* [PF_CUSTOM]
|
||||
[DONE] * [PF_CUSTOM]
|
||||
* Gimp::ping
|
||||
* clean up PKG_ANY vs. PKG_REAL_DRAWABLE
|
||||
* allow plug-ins to register with only a drawable argument(!)
|
||||
(fix this in Gimp)
|
||||
* provide propper overwriting in Gimp::Net::pixel-_rgn ;(
|
||||
[DONE] * provide propper overwriting in Gimp::Net::pixel-_rgn ;(
|
||||
* gradient button
|
||||
* implement Perl-Server RSET and shared lock(!)
|
||||
* substr 4th argument form for Net:: -> require 5.005!!!! DO IT! PLEASE!!!!
|
||||
[KILL] * substr 4th argument form for Net:: -> require 5.005!!!! DO IT! PLEASE!!!!
|
||||
* use Gimp qw(GIMP_HOST=jfjf)???
|
||||
* zero-copy PDL support
|
||||
* weighted movement in drawing tools
|
||||
|
||||
@ -16,34 +16,43 @@ use Gimp qw(:auto);
|
||||
use Gimp::Fu;
|
||||
use Gimp::Util;
|
||||
|
||||
$animate_cells_version = "1.1.1";
|
||||
$animate_cells_version = "1.2";
|
||||
$animate_cells_released = "3/12/1999";
|
||||
|
||||
# use strict;
|
||||
|
||||
sub perl_fu_animate_cells {
|
||||
my $image = shift;
|
||||
# my $drawable = shift; # Unused
|
||||
my $drawable = shift; # Unused
|
||||
my $makecopy = shift;
|
||||
$image = gimp_channel_ops_duplicate($image) if $makecopy;
|
||||
gimp_image_disable_undo($image);
|
||||
gimp_progress_init("Animating cell layers...",MESSAGE_BOX);
|
||||
|
||||
my @ids = reverse gimp_image_get_layers($image);
|
||||
my $back = shift @ids;
|
||||
|
||||
if (@ids < 2) {
|
||||
gimp_message("animate_cells: Too few cells (layers) in image.");
|
||||
gimp_image_delete($image) if $makecopy;
|
||||
return;
|
||||
}
|
||||
|
||||
gimp_selection_layer_alpha($ids[0]);
|
||||
for($i=1;$i<@ids;$i++) {
|
||||
gimp_progress_update(1/(@ids-1)/2*$i);
|
||||
$lnum = $#ids+1-$i;
|
||||
fix_cell_layer($image, $ids[$i], $ids[$i-1], $back, $lnum);
|
||||
}
|
||||
|
||||
for($i=$#ids;$i>=0;$i--) {
|
||||
gimp_progress_update(0.5+1/@ids*(@ids-$i));
|
||||
gimp_image_merge_down($image, $ids[$i], EXPAND_AS_NECESSARY);
|
||||
}
|
||||
|
||||
gimp_progress_update(1.0);
|
||||
|
||||
gimp_display_new($image) if $makecopy;
|
||||
gimp_selection_none($image);
|
||||
gimp_image_enable_undo($image);
|
||||
gimp_displays_flush();
|
||||
@ -68,7 +77,7 @@ sub fix_cell_layer {
|
||||
|
||||
# Gimp::Fu registration routine for placing this function into gimp's PDB
|
||||
register
|
||||
"animate_cells",
|
||||
"animate-cells",
|
||||
"Perform cell animation from a single, layered image",
|
||||
"Use this plugin to animate a series of layers in the same way that\
|
||||
a physical animation process would use cells.",
|
||||
@ -76,6 +85,7 @@ register
|
||||
"<Image>/Filters/Animation/Animate Cells",
|
||||
"*",
|
||||
[
|
||||
[PF_TOGGLE, "Work on a copy?", "", 1]
|
||||
],
|
||||
\&perl_fu_animate_cells;
|
||||
|
||||
@ -90,14 +100,27 @@ animate_cells - Animate an image
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Called from the Gimp. Use Gimp's user interface to call this function.
|
||||
By default "C<E<lt>ImageE<gt>/Perl Fu/Animate Cells>".
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
TBD
|
||||
This Gimp plugin makes animation of images much simpler. The idea is that
|
||||
(as was the case with physical "cell" animation) you simply create a
|
||||
background and as many cell layers as you like. Each layer represents a
|
||||
frame to be animated on top of the background, but unlike normal Gimp
|
||||
animation, you don't have to worry about covering up previous frames.
|
||||
|
||||
The effect is like taking the bottom layer, and flipping through
|
||||
the rest of the layers on top of it, one at a time. This greatly reduces
|
||||
the time involved in creating new animations, especially where a single
|
||||
object is moving over a static background (more complex animation may
|
||||
still require just as much work as before).
|
||||
|
||||
=head1 PARAMETERS
|
||||
|
||||
None.
|
||||
The script only asks if you want to work on a copy of the image. Otherwise,
|
||||
you just need an image with a background layer and two or more layers
|
||||
on top of it which represent your "cells".
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
|
||||
595
plug-ins/perl/examples/image_tile
Executable file
595
plug-ins/perl/examples/image_tile
Executable file
@ -0,0 +1,595 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# A photo-tiling pluggin. Take an image, and tile it (much like the
|
||||
# mosaic operation, only using other images).
|
||||
#
|
||||
# Written in 1998 (c) by Aaron Sherman <ajs@ajs.com>.
|
||||
# This plugin may be distributed under the same terms as The Gimp itself.
|
||||
# See http://www.gimp.org/ for more information on The Gimp.
|
||||
#
|
||||
# TODO:
|
||||
#
|
||||
# o Fix undo
|
||||
# o Handle input drawable correctly (for working on selections)
|
||||
# o Find faster ways to sample sub-images.
|
||||
# o More control over cropping
|
||||
# o Scaling vs cropping of sub-images
|
||||
# o Better color matching algorithms
|
||||
# o Test (fix?) non-interactive use...
|
||||
# o Allow tile aspect selection independant of base image
|
||||
|
||||
use Gimp qw(:auto);
|
||||
use Gimp::Fu;
|
||||
use Fcntl qw(O_RDWR O_CREAT O_TRUNC);
|
||||
use Gimp::Feature;
|
||||
BEGIN { eval "use DB_File";
|
||||
$@ and Gimp::Feature::missing('Berkeley DB interface module') }
|
||||
# use strict;
|
||||
# use vars qw($DO_HSV $debug);
|
||||
|
||||
$DO_HSV = 0;
|
||||
$debug = 0;
|
||||
|
||||
# This function takes:
|
||||
# Gimp-provided:
|
||||
# Image -- The gimp image to be operated on.
|
||||
# Drawable -- Its drawable
|
||||
# User-provided:
|
||||
# X Tiles -- Number of images to be tiled across.
|
||||
# Y Tiles -- Number of images to be tiled down.
|
||||
# X Cells -- Number of color samples across for each image.
|
||||
# Y Cells -- Number of color samples down for each image.
|
||||
# Duplicates Weight -- Amount of weight to apply against images that
|
||||
# have already been used.
|
||||
# Directories -- Space separated list of directories.
|
||||
#
|
||||
# It will tile the images from the given directories over the given
|
||||
# image to form a mosaic of the original.
|
||||
sub perl_fu_image_tile {
|
||||
my $image = shift;
|
||||
my $drawable = shift;
|
||||
my $xtiles = shift;
|
||||
my $ytiles = shift;
|
||||
my $xcells = shift;
|
||||
my $ycells = shift;
|
||||
my $dupweight = shift;
|
||||
my $dirs = shift;
|
||||
my $cleanup = shift;
|
||||
my $subimages = 0;
|
||||
my $TOP = "$ENV{HOME}/.gimp";
|
||||
if (! -d $TOP) {
|
||||
$TOP = "/tmp";
|
||||
if (! -d $TOP) {
|
||||
gimp_message("Don't know where to put temporary files!");
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
# Use C-Shell style file globbing to expand given directories, and
|
||||
# allow them to be space-separated.
|
||||
my @dirs = map {glob $_} split /\s+/, $dirs;
|
||||
print "DEBUG: Dir list is ", join(", ", @dirs), "\n" if $debug;
|
||||
my $dir;
|
||||
my $imgwidth = gimp_drawable_width($drawable);
|
||||
my $imgheight = gimp_drawable_height($drawable);
|
||||
my $xtilewidth = int($imgwidth/$xtiles);
|
||||
my $ytileheight = int($imgheight/$ytiles);
|
||||
my $aspect = $xtilewidth/$ytileheight;
|
||||
my $s_aspect = sprintf("%0.3f",$aspect);
|
||||
my $type = gimp_image_base_type($image);
|
||||
my $ndone=0;
|
||||
gimp_image_disable_undo($image);
|
||||
gimp_progress_init("Image Tiling...",-1);
|
||||
|
||||
my %tile_cache; # Tied to image tile database
|
||||
my %wt_cache;
|
||||
my $stored_keys = 0; # Number of keys stored to date.
|
||||
my $db; # DB_File database reference
|
||||
my $wdb;
|
||||
|
||||
# One cache file holds the image color samples, which may get re-used
|
||||
# between runs.
|
||||
my $cache_file = "$TOP/image_tile.${s_aspect}.${xcells}X${ycells}";
|
||||
if (!defined($db = tie(%tile_cache, 'DB_File',
|
||||
$cache_file, O_RDWR|O_CREAT,
|
||||
0644, $DB_HASH))) {
|
||||
gimp_message("Failed to create tile sample database: $!");
|
||||
exit(0);
|
||||
}
|
||||
|
||||
# The other cache file contains image re-use weights, which only get
|
||||
# used once.
|
||||
my $wt_file = "$TOP/image_tile.$$";
|
||||
if (!defined($wdb=tie(%wt_cache,'DB_File',$wt_file,
|
||||
O_RDWR|O_CREAT|O_TRUNC,0644,$DB_HASH))) {
|
||||
gimp_message("Failed to create weight database: $!");
|
||||
exit(0);
|
||||
}
|
||||
|
||||
# Loop over directories, looking for images
|
||||
foreach $dir (@dirs) {
|
||||
print "DEBUG: **** load images from $dir\n" if $debug;
|
||||
gimp_progress_update((40/@dirs)*($ndone++)/100);
|
||||
local *DIR;
|
||||
if (opendir(DIR,$dir)) {
|
||||
my $file;
|
||||
# Only take files with an extension, as Gimp won't be able to
|
||||
# open others.
|
||||
my @files = sort grep {/\.\w+$/} readdir DIR;
|
||||
closedir(DIR);
|
||||
my $filesdone=0;
|
||||
foreach $file (@files) {
|
||||
print "DEBUG: Load file: $file\n" if $debug;
|
||||
gimp_progress_update((40/@dirs)*($ndone-1+($filesdone/@files))/100);
|
||||
$filesdone++;
|
||||
next unless -f "$dir/$file" && -s "$dir/$file";
|
||||
if (defined $tile_cache{"$dir/$file"}) {
|
||||
$wt_cache{"$dir/$file"} = 0;
|
||||
$subimages++;
|
||||
} else {
|
||||
my $short = $file;
|
||||
my $img;
|
||||
$file = "$dir/$file";
|
||||
# Open the sub-image, record info about it and close it.
|
||||
eval {
|
||||
# 1 == NON_INTERACTIVE, but symbol does not work.... ?
|
||||
$img = gimp_file_load(1,$file,$file);
|
||||
};
|
||||
next if $@ || !defined($img) || !$img;
|
||||
my $subtype = gimp_image_base_type($img);
|
||||
if ($subtype != $type) {
|
||||
if ($type == RGB_IMAGE) {
|
||||
gimp_convert_rgb($img);
|
||||
} elsif ($type == GRAY_IMAGE) {
|
||||
gimp_convert_grayscale($img);
|
||||
} elsif ($type == INDEXED_IMAGE) {
|
||||
gimp_convert_indexed($img,1,256);
|
||||
}
|
||||
}
|
||||
my $cells = get_image_cells($img,$xcells,$ycells,
|
||||
$xtilewidth/$ytileheight);
|
||||
$wt_cache{$file} = 0;
|
||||
$tile_cache{$file} = $$cells;
|
||||
$subimages++;
|
||||
$db->sync(0) if ++$stored_keys % 16 == 0;
|
||||
gimp_image_delete($img);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
gimp_message("Cannot open $dir: $!");
|
||||
}
|
||||
}
|
||||
|
||||
if ($subimages == 0) {
|
||||
gimp_message("$0: No subimages loaded.");
|
||||
exit(0);
|
||||
}
|
||||
|
||||
$db->sync(0);
|
||||
$wdb->sync(0);
|
||||
|
||||
# Now store color info for target image
|
||||
my $dup = gimp_image_new($imgwidth,$imgheight,RGB_IMAGE);
|
||||
gimp_edit_copy($drawable); # gimp 1.1 -deleted $image
|
||||
my $back =
|
||||
gimp_layer_new($dup,$imgwidth,$imgheight,RGB_IMAGE,"Target",100,NORMAL);
|
||||
gimp_image_add_layer($dup,$back,0);
|
||||
my $sel = gimp_edit_paste($back,0); # gimp 1.1 -deleted $dup
|
||||
gimp_floating_sel_anchor($sel);
|
||||
my $oimage = get_image_cells($dup,$xtiles*$xcells,$ytiles*$ycells,
|
||||
$imgwidth/$imgheight,40,60);
|
||||
gimp_image_delete($dup);
|
||||
undef $sel;
|
||||
undef $back;
|
||||
undef $dup;
|
||||
gimp_progress_update(60/100);
|
||||
|
||||
# Now we have the image data, so it's time to start mapping
|
||||
# in the sub-images.
|
||||
$ndone=0;
|
||||
# Randomize the order in which tiles will be mapped (this reduces the
|
||||
# impact from weighting image re-use)
|
||||
my @todo;
|
||||
for(my $x=0;$x<$xtiles;$x++) {
|
||||
for(my $y=0;$y<$ytiles;$y++) {
|
||||
push(@todo, "$x,$y");
|
||||
}
|
||||
}
|
||||
for(my $i=0;$i<@todo;$i++) {
|
||||
# Don't need srand(), because we don't need to do it differently every
|
||||
# time.
|
||||
my $target = int(rand(@todo));
|
||||
my $tmp = $todo[$i];
|
||||
$todo[$i] = $todo[$target];
|
||||
$todo[$target] = $tmp;
|
||||
}
|
||||
my @ocells;
|
||||
# Now, map in the sub-images according to the random order determined, above
|
||||
foreach my $coord (@todo) {
|
||||
my($x,$y) = split /,/,$coord,2;
|
||||
gimp_progress_update((60+40/($xtiles*$ytiles)*($ndone++))/100);
|
||||
my $minmatch = undef;
|
||||
my $matchid;
|
||||
# Create a cache of all of the cell samples from the original image for
|
||||
# this tile only.
|
||||
for(my $xcell=0;$xcell<$xcells;$xcell++) {
|
||||
for(my $ycell=0;$ycell<$ycells;$ycell++) {
|
||||
$ocells[$xcell][$ycell] =
|
||||
substr($$oimage,
|
||||
(($x*$xcells + $xcell)*$ytiles*$ycells+
|
||||
$y*$ycells +
|
||||
$ycell) * 3, 3);
|
||||
}
|
||||
}
|
||||
my $subimg;
|
||||
my $weight;
|
||||
# Loop through all available sub-images and find best fit for this
|
||||
# tile.
|
||||
while(($subimg,$weight)=each %wt_cache) {
|
||||
my $match = 0;
|
||||
for(my $xcell=0;$xcell<$xcells;$xcell++) {
|
||||
my $subfile = $subimg;
|
||||
for(my $ycell=0;$ycell<$ycells;$ycell++) {
|
||||
# Cell samples are stored as packed 3-byte values
|
||||
my($o1,$o2,$o3) = unpack 'CCC', $ocells[$xcell][$ycell];
|
||||
my($n1,$n2,$n3) = unpack 'CCC',
|
||||
substr($tile_cache{$subfile},($xcell*$ycells+$ycell)*3,3);
|
||||
# 2 methods of comparing: by RGB and by HSV. HSV seems to
|
||||
# give a more accurate map, as it stresses the matching of light
|
||||
# and darkness. We do some weighting of the HSV match so that
|
||||
# we don't care about hue as much if saturation or value is
|
||||
# low, and we don't care about saturation as much if value is low
|
||||
# The net effect is that for a black pixel, you don't care
|
||||
# what color hue tells you it is, because it's always black
|
||||
my $c3_delta = abs($o3 - $n3);
|
||||
my $c2_delta;
|
||||
my $c1_delta;
|
||||
if ($DO_HSV) {
|
||||
# c1 == H, c2 == S, c3 == V
|
||||
$c2_delta = abs($o2 - $n2) * $o3 / 255;
|
||||
$c1_delta = hue_dist($o1,$n1)* 2 * ($o3*$o2/(255**2));
|
||||
} else {
|
||||
# c1 == R, c2 == G, c3 == B
|
||||
$c2_delta = abs($o2 - $n2);
|
||||
$c1_delta = abs($o1 - $n1);
|
||||
}
|
||||
# Keep a running score of the differences between samples for this
|
||||
# sub-image vs. this tile from the orginal
|
||||
$match += $c1_delta + $c2_delta + $c3_delta;
|
||||
}
|
||||
}
|
||||
# Weight for image duplicates.
|
||||
$match += $wt_cache{$subimg};
|
||||
|
||||
if (!defined($minmatch) || $match < $minmatch) {
|
||||
$minmatch = $match;
|
||||
$matchid = $subimg;
|
||||
}
|
||||
}
|
||||
if (!defined($matchid)) {
|
||||
die("image_tile: No subimages selected!");
|
||||
}
|
||||
# Actually insert the selected image.
|
||||
overlay_image($drawable, $matchid,
|
||||
$xtilewidth*$x, $ytileheight*$y,
|
||||
$xtilewidth, $ytileheight);
|
||||
$wt_cache{$matchid} += $dupweight;
|
||||
}
|
||||
# Finish up.
|
||||
undef $db;
|
||||
untie %tile_cache;
|
||||
undef $wdb;
|
||||
untie %wt_cache;
|
||||
unlink($wt_file);
|
||||
unlink($cache_file) if $cleanup;
|
||||
gimp_progress_update(1);
|
||||
gimp_image_enable_undo($image);
|
||||
gimp_displays_flush();
|
||||
}
|
||||
|
||||
# Take IMAGE, XCELLS, YCELLS, TARGET_ASPECT.
|
||||
# Works destructively on IMAGE, and returns a list of anon-lists which
|
||||
# contain the color samples for the given IMAGE.
|
||||
sub get_image_cells {
|
||||
my $img = shift;
|
||||
my $xcells = shift;
|
||||
my $ycells = shift;
|
||||
my $target_aspect = shift;
|
||||
my $start_complete = shift;
|
||||
my $end_complete = shift;
|
||||
# print "Target aspect: $target_aspect\n";
|
||||
my $file = gimp_image_get_filename($img);
|
||||
# print "$file: ";
|
||||
my $width = gimp_image_width($img)+0;
|
||||
# print "width: $width ";
|
||||
my $height = gimp_image_height($img)+0;
|
||||
# print "height: $height\n";
|
||||
my $cells = "\0\0\0" x ($xcells * $ycells);
|
||||
return () if $width < 1 || $height < 1;
|
||||
|
||||
# First crop to fit tiles
|
||||
match_aspect($img,$target_aspect,$width,$height);
|
||||
|
||||
# Now, scale down to xcells by ycells for color sampling
|
||||
# NOTE: We will re-open this image later if it is chosen.
|
||||
# This scaling is just to get color samples.
|
||||
gimp_image_scale($img,$xcells,$ycells);
|
||||
my $draw = gimp_image_active_drawable($img);
|
||||
for(my $x=0;$x<$xcells;$x++) {
|
||||
if (defined($start_complete)) {
|
||||
gimp_progress_update(($start_complete+
|
||||
($end_complete-$start_complete)*$x/$xcells)/100);
|
||||
}
|
||||
for(my $y=0;$y<$ycells;$y++) {
|
||||
# Why is this setting FG? PDB docs seem to indicate that I can shut
|
||||
# that off...
|
||||
my $color = gimp_color_picker($draw,$x,$y,0,1); # Gimp 1.1 -deleted $img
|
||||
my @c;
|
||||
if ($DO_HSV) {
|
||||
@c = rgb2hsv(@$color);
|
||||
} else {
|
||||
@c = @$color;
|
||||
}
|
||||
substr($cells,($x*$ycells+$y)*3,3) = pack('CCC',@c);
|
||||
}
|
||||
}
|
||||
return \$cells;
|
||||
}
|
||||
|
||||
# Take IMAGE, TARGET_ASPECT, WIDTH (of image), HEIGHT (of image)
|
||||
# Crops IMAGE to match aspect ratio of TARGET_ASPECT.
|
||||
sub match_aspect {
|
||||
my $img = shift;
|
||||
my $target_aspect = shift;
|
||||
my $width = shift;
|
||||
my $height = shift;
|
||||
my $aspect = $width/$height;
|
||||
|
||||
if ($aspect < $target_aspect) {
|
||||
my $oldheight=$height;
|
||||
$height = int($width/$target_aspect);
|
||||
# print "Image was $width X $oldheight, cropping to $width X $height\n";
|
||||
gimp_crop($img,$width,$height,0,int(($oldheight-$height)/2));
|
||||
} elsif ($aspect > $target_aspect) {
|
||||
my $oldwidth=$width;
|
||||
$width = int($target_aspect*$height);
|
||||
# print "Image was $oldwidth X $height, cropping to $width X $height\n";
|
||||
gimp_crop($img,$width,$height,int(($oldwidth-$width)/2),0);
|
||||
}
|
||||
}
|
||||
|
||||
# Take DRAWABLE, INFO, X, Y, WIDTH, HEIGHT
|
||||
# Opens image referenced by INFO->{name} and scale/crop to fit in rectagnle
|
||||
# described by X,Y,WIDTH,HEIGHT
|
||||
sub overlay_image {
|
||||
my $draw = shift;
|
||||
my $file = shift;
|
||||
my $x = shift;
|
||||
my $y = shift;
|
||||
my $width = shift;
|
||||
my $height = shift;
|
||||
# 1 == NON_INTERACTIVE, but symbol does not seem to work.... ?
|
||||
my $img = gimp_file_load(1,$file,$file);
|
||||
my $subwidth = gimp_image_width($img);
|
||||
my $subheight = gimp_image_height($img);
|
||||
match_aspect($img,$width/$height,$subwidth,$subheight);
|
||||
gimp_image_scale($img,$width,$height);
|
||||
gimp_edit_copy(gimp_image_active_drawable($img)); #gimp 1.1 -deleted $img
|
||||
my $baseimg = gimp_drawable_image($draw);
|
||||
gimp_rect_select($baseimg,$x,$y,$width,$height,REPLACE,0,0);
|
||||
my $sel = gimp_edit_paste($draw,0); # gimp 1.1 -deleted $baseimg
|
||||
gimp_floating_sel_anchor($sel);
|
||||
gimp_image_delete($img);
|
||||
}
|
||||
|
||||
# Take a Red, Green, Blue color value and return Hue, Saturation and Value
|
||||
# RGB and HSV data should be in the range 0-255 (note Hue is usually
|
||||
# represented as 0-360, but here is scaled to be 0-255).
|
||||
sub rgb2hsv {
|
||||
my $r = shift;
|
||||
my $g = shift;
|
||||
my $b = shift;
|
||||
my($h,$s,$v);
|
||||
my $min = undef;
|
||||
my $max = 0;
|
||||
foreach my $color ($r, $g, $b) {
|
||||
$min = $color if !defined($min) || $min>$color;
|
||||
$max = $color if $color > $max;
|
||||
}
|
||||
$v = $max;
|
||||
$s = $max?int(($max-$min)/$max*255+0.5):0;
|
||||
if ($s == 0) {
|
||||
$h = 0;
|
||||
} else {
|
||||
my $d = $max - $min;
|
||||
if ($r == $max) {
|
||||
$h = ($g-$b)/$d;
|
||||
} elsif ($g == $max) {
|
||||
$h = 2+($b-$r)/$d;
|
||||
} else {
|
||||
$h = 4+($r-$g)/$d;
|
||||
}
|
||||
# This:
|
||||
# $h *= 60;
|
||||
# $h += 360 if $h < 0;
|
||||
# $h *= (256/360);
|
||||
# , simplified is this:
|
||||
$h= int(($h+($h<0?6:0)) * 128 / 3 + 0.5);
|
||||
}
|
||||
return ($h,$s,$v);
|
||||
}
|
||||
|
||||
# Caclulate the "distance" between to HSV hue values in the range 0-255.
|
||||
sub hue_dist {
|
||||
my $h1 = shift;
|
||||
my $h2 = shift;
|
||||
my $d = abs($h1-$h2);
|
||||
return($d>128?(256-$d):$d);
|
||||
}
|
||||
|
||||
# Gimp::Fu registration routine for placing this function into gimp's PDB
|
||||
register
|
||||
"image-tile",
|
||||
"Tile images to form a larger Image",
|
||||
"Use Image Tile to take a directory of images and use it to
|
||||
construct a single, existing image, sort of like the
|
||||
Filters/Artistic/Mosaic plugin, but with images as the
|
||||
tiles.",
|
||||
"Aaron Sherman", "Aaron Sherman (c)", "1999-03-13",
|
||||
"<Image>/Filters/Map/Image Tile",
|
||||
"*",
|
||||
[
|
||||
# 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]
|
||||
],
|
||||
\&perl_fu_image_tile;
|
||||
|
||||
exit main;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
image_tile - An image tiling plug-in for The Gimp
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
B<image_tile> is called from The Gimp under the Perl-Fu image menu.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
B<image_tile> is a plug-in for The Gimp that re-creates an image by tiling many
|
||||
sub-images which are in turn chosen for their likeness to a part of the original.
|
||||
|
||||
In other words, you give image_tile a base image (the one you open in The
|
||||
Gimp, and call image_tile on) and a list of directories to find other images
|
||||
in. It then tiles small versions of the images over the original image in
|
||||
such a way that you can still make out the original if you squint hard
|
||||
enough.
|
||||
|
||||
=head1 LIMITATIONS
|
||||
|
||||
B<image_tile> requires a large number of image to work from. This is because
|
||||
it needs to divide up your original image and for each tile, find another
|
||||
image which looks like that tile. This can require anywhere from 2000 to tens
|
||||
of thousands of component images.
|
||||
|
||||
image_tile will use as much disk space as is required to store the sampling
|
||||
information that it creates for each of the sub images. However, its use of
|
||||
memory is much more conservative. The assumption being that a lot more people
|
||||
have a Gig of disk free than a Gig of RAM. So, expect a large file to be
|
||||
created in your .gimp directory (you can select automatic cleanup of this
|
||||
file if you wish).
|
||||
|
||||
Note that this plug-in now works only with version 1.1 of the GIMP. If you
|
||||
wish to make it work with previous versions, you will have to search for
|
||||
"1.1" in the code, and put back the first argument to a lot of functions
|
||||
(each deletion has been noted).
|
||||
|
||||
=head1 PARAMETERS
|
||||
|
||||
When you bring up the image tiler, you are given several options. Each of these
|
||||
is detailed below:
|
||||
|
||||
=over 5
|
||||
|
||||
=item Number of tiles
|
||||
|
||||
The number of tiles in the X and Y directions must be given. This is the
|
||||
number of sub-images that will be tiled across and down your original image.
|
||||
|
||||
=item Number of cells
|
||||
|
||||
In each tile, the image tiler will sample color areas to determine a match.
|
||||
The more color areas you sample, the more accurate the match, but this also
|
||||
increases memory, disk and time usage. The default of 4 cells in each direction
|
||||
is good for most tiling which is meant to be viewed on-line. Print-quality
|
||||
tiling will have to use more samples to get even finer details right.
|
||||
|
||||
=item Duplicate weight
|
||||
|
||||
This is a number from 0 to 100 (actually, there is no real upper bound, but
|
||||
100 is a practical upper limit). This is a weight applied to each sub-image
|
||||
each time it has been selected. Thus, if you use a hight weight, images
|
||||
will tend to be chosen only once. If you use a low weight, images will be
|
||||
chosen as many times as they happen to be the best fit. A weight of 0 will lead
|
||||
to the most accurate match, but due to the repetition of some images, you
|
||||
may find the resulting image to be difficult to make out.
|
||||
|
||||
=item Sub-Image directories
|
||||
|
||||
This is a space-separated list of the directories in which The Gimp will
|
||||
be able to load sub-images. You may use B<csh>-style file "globing" such
|
||||
as C</tmp/images/image_dir_*> or C</mnt/cdrom/images_[1234]>.
|
||||
|
||||
=item Delete cached image samples
|
||||
|
||||
This toggle button will tell the image tiler whether or not to delete the
|
||||
cached image samples that it creates while reading the sub-images. If you
|
||||
are planning to attempt matching these sub-images against this base image
|
||||
again (say, adding a few new files, or brightening the base image first),
|
||||
you will probably want to keep them around, as the time savings is
|
||||
huge. However, since these samples are based on aspect ratio and number
|
||||
of cells, you cannot re-use the samples if you change the number of tiles
|
||||
or number of cells. Sorry.
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Written in 1998 (c) by Aaron Sherman <ajs@ajs.com>
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
Most of the I<bugs> in the image tiler are actually just design limitations.
|
||||
For example:
|
||||
|
||||
=over 5
|
||||
|
||||
=item *
|
||||
|
||||
The images must all be the same aspect ratio, so B<image_tile> will crop them
|
||||
to match the target aspect ratio. Because of the large number of images
|
||||
involved, it is impractical to specify a crop area for each one, so the
|
||||
center of the image is chosen.
|
||||
|
||||
=item *
|
||||
|
||||
If The Gimp library were multi-threaded the image tiler would read more than
|
||||
one sub-image at a time.
|
||||
|
||||
=item *
|
||||
|
||||
Directory selection is crude. Gimp needs a file/directory selection model for
|
||||
plug-ins similar to the color selection model.
|
||||
|
||||
=item *
|
||||
|
||||
If some of your sub-images are bad, the image tiler will display an error
|
||||
message when trying to load them. This can result in a I<lot> of messages
|
||||
for a multi-thousand image database.
|
||||
|
||||
=item *
|
||||
|
||||
URLs should be handled as image directories.
|
||||
|
||||
=item *
|
||||
|
||||
Some text describing what image directory is being searched would be nice, but
|
||||
this would require more code than I want to write right now.
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<gimp>, L<perl>, L<Gimp>: the Gimp module for perl.
|
||||
|
||||
=cut
|
||||
@ -10,6 +10,7 @@ $gtk = Gimp::Feature::present 'gtk';
|
||||
if($gtk) {
|
||||
# make a relatively extensive check for gtk capabilities
|
||||
# this must be done before initializing Gtk in the main program (thus here)
|
||||
# imagine!! it might even FLICKER!!!
|
||||
unless(open GTK,"-|") {
|
||||
close STDERR;
|
||||
require Gtk;
|
||||
@ -54,37 +55,44 @@ sub generate_log {
|
||||
}
|
||||
|
||||
sub gtkview_log {
|
||||
my($title,$log)=@_;
|
||||
my($w,$b,$font,$lines);
|
||||
$w = new Gtk::Dialog;
|
||||
$w->set_title ($title);
|
||||
if ($_[0]) {
|
||||
destroy $_[0];
|
||||
undef $_[0];
|
||||
} else {
|
||||
my($title,$log)=@_[1,2];
|
||||
my($w,$b,$font,$lines);
|
||||
$w = new Gtk::Dialog;
|
||||
$w->set_title ($title);
|
||||
|
||||
$b = new Gtk::Text;
|
||||
$b->set_editable(0);
|
||||
$b = new Gtk::Text;
|
||||
$b->set_editable(0);
|
||||
|
||||
$lines=$log=~y/\n//;
|
||||
$lines=25 if $lines>25;
|
||||
$lines=$log=~y/\n//;
|
||||
$lines=25 if $lines>25;
|
||||
|
||||
$font = load Gtk::Gdk::Font "9x15bold";
|
||||
$font = fontset_load Gtk::Gdk::Font "-*-courier-medium-r-normal--*-120-*-*-*-*-*" unless $font;
|
||||
$font = $b->style->font unless $font;
|
||||
$b->insert($font,$b->style->fg(-normal),undef,$log);
|
||||
$b->set_usize($font->string_width('M')*80,($font->ascent+$font->descent)*($lines+1));
|
||||
$w->vbox->add($b);
|
||||
$font = load Gtk::Gdk::Font "9x15bold";
|
||||
$font = fontset_load Gtk::Gdk::Font "-*-courier-medium-r-normal--*-120-*-*-*-*-*" unless $font;
|
||||
$font = $b->style->font unless $font;
|
||||
$b->insert($font,$b->style->fg(-normal),undef,$log);
|
||||
$b->set_usize($font->string_width('M')*80,($font->ascent+$font->descent)*($lines+1));
|
||||
$w->vbox->add($b);
|
||||
|
||||
$b = new Gtk::Button "OK";
|
||||
$b->can_default(1);
|
||||
$b->grab_default;
|
||||
$b->signal_connect(clicked => sub { destroy $w });
|
||||
$w->action_area->add($b);
|
||||
$b = new Gtk::Button "OK";
|
||||
$b->can_default(1);
|
||||
$b->grab_default;
|
||||
$b->signal_connect(clicked => sub { destroy $w; undef $_[0] });
|
||||
$w->action_area->add($b);
|
||||
|
||||
show_all $w;
|
||||
show_all $w;
|
||||
$_[0]=$w;
|
||||
}
|
||||
}
|
||||
|
||||
# the extension that's called.
|
||||
sub extension_perl_control_center {
|
||||
if ($gtk) {
|
||||
my($w,$b);
|
||||
my($l,$s);
|
||||
|
||||
init Gtk;
|
||||
parse Gtk::Rc Gimp->gtkrc;
|
||||
@ -93,11 +101,11 @@ sub extension_perl_control_center {
|
||||
$w->set_title ('Perl Control Center');
|
||||
|
||||
$b = new Gtk::Button "View Perl Feature Status";
|
||||
$b->signal_connect(clicked => sub { gtkview_log 'Perl Feature Status',generate_status});
|
||||
$b->signal_connect(clicked => sub { gtkview_log $s,'Perl Feature Status',generate_status});
|
||||
$w->vbox->add($b);
|
||||
|
||||
$b = new Gtk::Button "View Perl Error/Warning Log";
|
||||
$b->signal_connect(clicked => sub { gtkview_log 'Perl Error/Warning Log',generate_log });
|
||||
$b->signal_connect(clicked => sub { gtkview_log $l,'Perl Error/Warning Log',generate_log });
|
||||
$w->vbox->add($b);
|
||||
|
||||
$b = new Gtk::Button "Clear Perl Error/Warning Log";
|
||||
@ -135,7 +143,6 @@ sub extension_perl_control_center {
|
||||
|
||||
sub net {
|
||||
extension_perl_control_center;
|
||||
# print "\n",generate_log,"\n";
|
||||
}
|
||||
|
||||
sub query {
|
||||
|
||||
181
plug-ins/perl/examples/yinyang
Executable file
181
plug-ins/perl/examples/yinyang
Executable file
@ -0,0 +1,181 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# Gimp yin/yang symbol plugin for The Gimp. Extract documentation by running
|
||||
# "perldoc" on this plugin, or by using the pod utilities (pod2man, pod2html,
|
||||
# etc.)
|
||||
#
|
||||
# Written by Aaron Sherman, (c) 1998
|
||||
|
||||
use Gimp qw(:auto);
|
||||
use Gimp::Fu;
|
||||
|
||||
# Main function. Takes width, height, do_eyes (toggle), eye_images (toggle),
|
||||
# white_eye_image (filename) and black_eye_image (filename).
|
||||
# Creates a stand-alone image with a yin-yang symbol in black and white.
|
||||
sub yinyang {
|
||||
my $width = shift;
|
||||
my $height = shift;
|
||||
my $do_eyes = shift;
|
||||
my $eye_images = shift;
|
||||
my $white_eye_image = shift;
|
||||
my $black_eye_image = shift;
|
||||
my $aa = shift;
|
||||
|
||||
# Create new image
|
||||
my $img = gimp_image_new($width,$height,0);
|
||||
my $layer = gimp_layer_new($img,$width,$height,1,"Yin/Yang",100,0);
|
||||
gimp_image_add_layer($img,$layer,0);
|
||||
gimp_image_set_active_layer($img,$layer);
|
||||
my $draw = gimp_image_active_drawable($img);
|
||||
my $oldcolor = gimp_palette_get_foreground();
|
||||
gimp_palette_set_foreground([0,0,0]);
|
||||
gimp_selection_all($img);
|
||||
gimp_bucket_fill($draw,0,0,100,0,0,0,0);
|
||||
|
||||
# Create the yin-yang shape
|
||||
#gimp_selection_invert($img);
|
||||
gimp_selection_none($img);
|
||||
gimp_rect_select($img,0,0,$width/2,$height,0,0,0);
|
||||
gimp_ellipse_select($img,$width/2-$width/4,0,$width/2,
|
||||
int($height/2),0,$aa,0,0);
|
||||
gimp_ellipse_select($img,$width/2-$width/4,$height/2,
|
||||
$width/2, $height/2, 1, $aa, 0, 0);
|
||||
gimp_palette_set_foreground([255,255,255]);
|
||||
gimp_bucket_fill($draw,0,0,100,0,0,0,0);
|
||||
|
||||
# Cut away all but the central circle
|
||||
gimp_ellipse_select($img,0,0,$width,$height,2,$aa,0,0);
|
||||
gimp_selection_invert($img);
|
||||
gimp_edit_clear($draw);
|
||||
|
||||
# Create the "eyes"
|
||||
if ($do_eyes) {
|
||||
my $x1 = $width/2-$width/16;
|
||||
my $y1 = $height/2-$height/4-$height/16;
|
||||
my $x2 = $x1;
|
||||
my $y2 = $height/2+$height/4-$height/16;
|
||||
my $eyewidth = $width/8;
|
||||
my $eyeheight = $height/8;
|
||||
insert_eye($img,$eye_images,$white_eye_image,[0,0,0],$x1,$y1,$eyewidth,
|
||||
$eyeheight,$draw,$aa);
|
||||
insert_eye($img,$eye_images,$black_eye_image,[255,255,255],$x2,$y2,
|
||||
$eyewidth,$eyeheight,$draw,$aa);
|
||||
}
|
||||
|
||||
# Finish up
|
||||
gimp_palette_set_foreground($oldcolor);
|
||||
gimp_selection_none($img);
|
||||
gimp_display_new($img);
|
||||
gimp_displays_flush();
|
||||
}
|
||||
|
||||
# This subroutine inserts an "eye" (a dot in the center of the cicular
|
||||
# part of each of the halves of the yin-yang). The eye is either
|
||||
# a solid dot of the opposite color from that half of the yin-yang or
|
||||
# an image, which is loaded and scaled to fit.
|
||||
sub insert_eye {
|
||||
my $img = shift;
|
||||
my $do_image = shift;
|
||||
my $file = shift;
|
||||
my $color = shift;
|
||||
my $x = shift;
|
||||
my $y = shift;
|
||||
my $width = shift;
|
||||
my $height = shift;
|
||||
my $draw = shift;
|
||||
my $aa = shift;
|
||||
|
||||
gimp_ellipse_select($img,$x,$y,$width,$height,2,$aa,0,0);
|
||||
gimp_palette_set_foreground($color);
|
||||
if ($do_image) {
|
||||
my $eye = gimp_file_load(NON_INTERACTIVE,$file,$file);
|
||||
gimp_image_scale($eye,$width,$height);
|
||||
gimp_selection_all($eye);
|
||||
my $eyedraw = gimp_image_active_drawable($eye);
|
||||
gimp_edit_copy($eye,$eyedraw);
|
||||
my $float = gimp_edit_paste($img,$draw,1);
|
||||
gimp_floating_sel_anchor($float);
|
||||
gimp_image_delete($eye);
|
||||
} else {
|
||||
gimp_bucket_fill($draw,0,0,100,0,0,0,0);
|
||||
}
|
||||
}
|
||||
|
||||
# Register with The Gimp
|
||||
register("yinyang", "Render a stand-alone Yin/Yang image",
|
||||
"Renders a black-and-white Yin/Yang symbol optionally
|
||||
with \"eyes\" that may optionally be images.",
|
||||
"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]
|
||||
],
|
||||
\&yinyang);
|
||||
|
||||
exit main;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
yinyang
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
yinyang
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
B<yinyang> is a B<Gimp> plugin. It generates a Yin/Yang symbol, which
|
||||
is a Chinese symbol of duality. It takes as parameters (provided by the
|
||||
Gimp user interface) the width and height of the resulting image;
|
||||
a toggle to indicate if "eyes" should be inserted (see I<EYES>);
|
||||
a toggle to indicate if the eyes should be images that are
|
||||
loaded separately; the two filenames for the eyes and a toggle to
|
||||
indicate if anti-aliasing should be used.
|
||||
|
||||
=head1 EYES
|
||||
|
||||
The "eyes" are normally either black or white dots in the middle of the
|
||||
circular regions of the two halves of the Yin and Yang. If you like
|
||||
you can load these eyes from another image.
|
||||
|
||||
=head1 IDEAS
|
||||
|
||||
Here are some thoughts on how the plugin could be used:
|
||||
|
||||
=over 5
|
||||
|
||||
=item *
|
||||
|
||||
Use as a low-opacity layer over an image to indicate duality or harmony.
|
||||
|
||||
=item *
|
||||
|
||||
Use to replace circular objects in an image (e.g. eyes, street signs,
|
||||
the sun, etc.)
|
||||
|
||||
=item *
|
||||
|
||||
Map two opposed or dualistic images. One into the black region, one
|
||||
into the white. For a really cool look, make the eyes show a peice of
|
||||
the other image.
|
||||
|
||||
=item *
|
||||
|
||||
Dip in 1 tbsp chunky peanut butter, 1 tbsp rice vinegar, 1 tbsp
|
||||
lime juice, 1 dash black pepper. Eat to taste.
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Written by Aaron Sherman <ajs@ajs.com>, (c) 1998.
|
||||
|
||||
=cut
|
||||
@ -23,14 +23,10 @@ newer gimp API's.
|
||||
|
||||
=head1 EXAMPLES
|
||||
|
||||
Convert all script-fu scripts in the current directory from the
|
||||
1.0 to the current API:
|
||||
Convert all script-fu scripts in the current directory from the 1.0 to the
|
||||
1.2 API (creating new files with the extension .sc2):
|
||||
|
||||
scm2scm *.scm
|
||||
|
||||
Convert C<weird.scm> from the 1.0 api to the 1.2 api:
|
||||
|
||||
scm2scm -t 1.2 weird.scm
|
||||
scm2scm -t 1.2 *.scm
|
||||
|
||||
Generate a diff containing the required changes from the 1.0
|
||||
to the 1.1-API:
|
||||
|
||||
Reference in New Issue
Block a user