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-12 20:37:06 +00:00
parent f3d1c7ef7d
commit 2ac00ed432
16 changed files with 399 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
plug-ins/perl/Changes
View File

@ -1,24 +1,26 @@
Revision history for Gimp-Perl extension.
- 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 with 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.
- Uh, ah, debugging code in the repository, again!
- 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.
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.
- 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.
- 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.
@ -26,9 +28,11 @@ Revision history for Gimp-Perl extension.
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

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

@ -8,10 +8,9 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD %EXPORT_TAGS @EXPORT_FAIL
@gimp_gui_functions
$help $verbose $host);
use base qw(DynaLoader);
require DynaLoader;
@ISA=qw(DynaLoader);
$VERSION = 1.061;
@_param = qw(
@ -287,11 +286,35 @@ sub logger {
$args{message} = "unknown message" unless defined $args{message};
$args{function} = "" unless defined $args{function};
$args{fatal} = 1 unless defined $args{fatal};
print STDERR "$file: $args{message} (for function $args{function})\n" if $verbose || $interface_type eq 'net';
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'}]);
_initialized_callback if initialized();
}
# calm down the gimp module
sub net {}
sub query {}
sub normal_context {
!$^S && defined $^S;
}
$SIG{__DIE__} = sub {
if (normal_context) {
logger(message => substr($_[0],0,-1), fatal => 1, function => 'DIE');
initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit main();
}
die $_[0];
};
$SIG{__WARN__} = sub {
if (normal_context) {
logger(message => substr($_[0],0,-1), fatal => 0, function => 'WARN');
} else {
warn $_[0];
}
};
if ($interface_type=~/^lib$/i) {
$interface_pkg="Gimp::Lib";
} elsif ($interface_type=~/^net$/i) {

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

@ -1,11 +1,8 @@
package Gimp::Feature;
use Carp;
use Gimp ();
use base qw(Exporter);
require Exporter;
@ISA=(Exporter);
@EXPORT = ();
my($gtk,$gtk_10,$gtk_11);
@ -19,6 +16,7 @@ sub _check_gtk {
$gtk_10 = (Gtk->major_version==1 && Gtk->minor_version==0);
$gtk_11 = (Gtk->major_version==1 && Gtk->minor_version>=1) || Gtk->major_version>1;
$gtk_12 = (Gtk->major_version==1 && Gtk->minor_version>=2) || Gtk->major_version>1;
$gtk_13 = (Gtk->major_version==1 && Gtk->minor_version>=3) || Gtk->major_version>1;
}
}
@ -26,12 +24,15 @@ my %description = (
'gtk' => 'the gtk perl module',
'gtk-1.1' => 'gtk+ version 1.1 or higher',
'gtk-1.2' => 'gtk+ version 1.2 or higher',
'gtk-1.3' => 'gtk+ version 1.3 or higher',
'gimp-1.1' => 'gimp version 1.1 or higher',
'gimp-1.2' => 'gimp version 1.2 or higher',
'perl-5.005' => 'perl version 5.005 or higher',
'pdl' => 'PDL (the Perl Data Language), version 1.9906 or higher',
'gnome' => 'the gnome perl module',
'gtkxmhtml' => 'the Gtk::XmHTML module',
'dumper' => 'the Data::Dumper module',
'never' => '(for testing, will never be present)',
);
# calm down the gimp module
@ -50,6 +51,7 @@ sub import {
sub missing {
my ($msg,$function)=@_;
require Gimp;
Gimp::logger(message => "$_[0] is required but not found", function => $function);
}
@ -57,7 +59,7 @@ sub need {
my ($feature,$function)=@_;
unless (present($feature)) {
missing($description{$feature},$function);
Gimp::initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit eval { Gimp::main() };
Gimp::initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit Gimp::main();
}
}
@ -77,7 +79,9 @@ sub present {
} elsif ($_ eq "gtk-1.1") {
_check_gtk; $gtk_11;
} elsif ($_ eq "gtk-1.2") {
_check_gtk; $gtk_11;
_check_gtk; $gtk_12;
} elsif ($_ eq "gtk-1.3") {
_check_gtk; $gtk_13;
} elsif ($_ eq "gimp-1.1") {
(Gimp->major_version==1 && Gimp->minor_version>=1) || Gimp->major_version>1;
} elsif ($_ eq "gimp-1.2") {
@ -90,6 +94,14 @@ sub present {
eval { require Gnome }; $@ eq "";
} elsif ($_ eq "gtkxmhtml") {
eval { require Gtk::XmHTML }; $@ eq "";
} elsif ($_ eq "dumper") {
eval { require Data::Dumper }; $@ eq "";
} elsif ($_ eq "never") {
0;
} else {
require Gimp;
Gimp::logger(message => "unimplemented requirement '$_' (failed)", fatal => 1);
0;
}
}

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

@ -10,11 +10,9 @@ use File::Basename;
use base qw(Exporter);
require Exporter;
require DynaLoader;
require AutoLoader;
eval {
require Data::Dumperx;
require Data::Dumper;
import Data::Dumper;
};
if ($@) {
@ -474,6 +472,17 @@ sub interact($$$@) {
}
}
sub fu_feature_present($$) {
my ($feature,$function)=@_;
require Gimp::Feature;
if (Gimp::Feature::present($feature)) {
1;
} else {
Gimp::Feature::missing(Gimp::Feature::describe($feature),$function);
0;
}
}
sub this_script {
return $scripts[0] unless $#scripts;
# well, not-so-easy-day today
@ -535,6 +544,10 @@ sub net {
my($interact)=1;
my $params = $this->[8];
for(@{$this->[10]}) {
return unless fu_feature_present($_,$this->[0]);
}
# %map is a hash that associates (mangled) parameter names to parameter index
@map{map mangle_key($_->[1]), @{$params}} = (0..$#{$params});
@ -586,14 +599,8 @@ sub query {
my($function,$blurb,$help,$author,$copyright,$date,
$menupath,$imagetypes,$params,$results,$features,$code)=@$_;
if(@$features) {
require Gimp::Feature;
for(@$features) {
unless (Gimp::Feature::present($_)) {
Gimp::Feature::missing(Gimp::Feature::describe($_),$function);
next script;
}
}
for(@$features) {
next script unless fu_feature_present($_,$function);
}
if ($menupath=~/^<Image>\//) {

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

@ -4,7 +4,7 @@
#
package Gimp::Net;
use strict;
use strict 'vars';
use Carp;
use vars qw(
$VERSION
@ -12,8 +12,7 @@ use vars qw(
$server_fh $trace_level $trace_res $auth $gimp_pid
);
use subs qw(gimp_call_procedure);
use IO::Socket;
use Socket; # IO::Socket is _really_ slow
$default_tcp_port = 10009;
$default_unix_dir = "/tmp/gimp-perl-serv-uid-$>/";
@ -23,6 +22,7 @@ $trace_res = *STDERR;
$trace_level = 0;
my $initialized = 0;
my $new_handle = "HANDLE0000";
sub initialized { $initialized }
@ -65,16 +65,16 @@ sub args2net {
sub _gimp_procedure_available {
my $req="TEST".$_[0];
print $server_fh pack("N",length($req)).$req;
$server_fh->read($req,1);
read($server_fh,$req,1);
return $req;
}
# this is hardcoded into gimp_call_procedure!
sub response {
my($len,$req);
$server_fh->read($len,4) == 4 or die "protocol error";
read($server_fh,$len,4) == 4 or die "protocol error";
$len=unpack("N",$len);
$server_fh->read($req,$len) == $len or die "protocol error";
read($server_fh,$req,$len) == $len or die "protocol error";
net2args($req);
}
@ -91,9 +91,9 @@ sub gimp_call_procedure {
if ($trace_level) {
$req="TRCE".args2net($trace_level,@_);
print $server_fh pack("N",length($req)).$req;
$server_fh->read($len,4) == 4 or die "protocol error";
read($server_fh,$len,4) == 4 or die "protocol error";
$len=unpack("N",$len);
$server_fh->read($req,$len) == $len or die "protocol error";
read($server_fh,$req,$len) == $len or die "protocol error";
($trace,$req,@args)=net2args($req);
if (ref $trace_res eq "SCALAR") {
$$trace_res = $trace;
@ -103,9 +103,9 @@ sub gimp_call_procedure {
} else {
$req="EXEC".args2net(@_);
print $server_fh pack("N",length($req)).$req;
$server_fh->read($len,4) == 4 or die "protocol error";
read($server_fh,$len,4) == 4 or die "protocol error";
$len=unpack("N",$len);
$server_fh->read($req,$len) == $len or die "protocol error";
read($server_fh,$req,$len) == $len or die "protocol error";
($req,@args)=net2args($req);
}
croak $req if $req;
@ -138,8 +138,8 @@ sub set_trace {
sub start_server {
print "trying to start gimp\n" if $Gimp::verbose;
$server_fh=*SERVER_SOCKET;
socketpair $server_fh,GIMP_FH,AF_UNIX,SOCK_STREAM,PF_UNIX
$server_fh=*{$new_handle++};
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) {
@ -174,16 +174,22 @@ sub try_connect {
if (s{^spawn/}{}) {
return start_server;
} elsif (s{^unix/}{/}) {
return new IO::Socket::UNIX (Peer => $_);
my $server_fh=*{$new_handle++};
return socket($server_fh,PF_UNIX,SOCK_STREAM,AF_UNIX)
&& connect($server_fh,sockaddr_un $_)
? $server_fh : ();
} else {
s{^tcp/}{};
my($host,$port)=split /:/,$_;
$port=$default_tcp_port unless $port;
return new IO::Socket::INET (PeerAddr => $host, PeerPort => $port);
};
my $server_fh=*{$new_handle++};
return socket($server_fh,PF_INET,SOCK_STREAM,scalar getprotobyname('tcp') || 6)
&& connect($server_fh,sockaddr_in $port,inet_aton $host)
? $server_fh : ();
}
} else {
return $fh if $fh = try_connect ("$auth\@unix$default_unix_dir$default_unix_sock");
return $fh if $fh = try_connect ("$auth\@tcp/localhost:$default_tcp_port");
return $fh if $fh = try_connect ("$auth\@tcp/127.1:$default_tcp_port");
return $fh if $fh = try_connect ("$auth\@spawn/");
}
undef $auth;
@ -200,7 +206,7 @@ sub gimp_init {
$server_fh = try_connect ("");
}
defined $server_fh or croak "could not connect to the gimp server server (make sure Net-Server is running)";
$server_fh->autoflush(1); # for compatibility with very old perls..
{ my $fh = select $server_fh; $|=1; select $fh }
my @r = response;
@ -238,7 +244,8 @@ sub gimp_end {
sub gimp_main {
gimp_init;
no strict 'refs';
&{caller()."::net"};
eval { &{caller(1)."::net"} };
die $@ if $@ && $@ ne "BE QUIET ABOUT THIS DIE\n";
gimp_end;
return 0;
}

2
plug-ins/perl/MANIFEST
View File

@ -64,3 +64,5 @@ examples/terral_text
examples/xachvision.pl
examples/gimpmagick
examples/perlcc
examples/sethspin.pl
examples/animate_cells

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

@ -6,6 +6,15 @@ use Config;
$topdir=".";
$|=1;
@examples =
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);
@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));
if ($ARGV[0] ne "--writemakefile") {
for(@ARGV) {
s/^prefix=/--prefix=/i;
@ -154,14 +163,6 @@ WARNING: version 0.3 of Gtk is _required_ for this module to
EOF
}
@examples =
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);
@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));
for(@shebang) {
system ($Config{perlpath},"-pi","-e","\$. == 1 and \$_ = '#!$Config{perlpath}\n'",$_);
}

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

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

17
plug-ins/perl/examples/README
View File

@ -1,10 +1,17 @@
This file describes the various files in the example/ directory. It also
contains links to applications/scripts people have written. If you
want to be added, drop me a note at <pcg@goof.com>
This file describes the various files in the examples/ directory. It also
contains links to applications/scripts people have written. If you want to
be added, drop me a note at <pcg@goof.com>.
Most of these scripts are distributed under the GPL only, not under the
Artistic License. If you need a script released under the Artistic License
please contact its author directly.
Also, most scripts in the examples directory are not described or
documented here. See their source for more info.
example-fu.pl
a very small, bare-bones Gimp::Fu script. it is useful
as a starting point for experiments.
a very small, bare-bones Gimp::Fu script. it is useful as a
starting point for experiments.
webify.pl
a small plugin that flattens an image, makes the background

114
plug-ins/perl/examples/animate_cells Executable file
View File

@ -0,0 +1,114 @@
#!/usr/bin/perl
#
# A plug-in for GIMP which animates a series of layers as if
# they were animation cells (different from the normal gimp animation,
# in that each cell REPLACES the previous, instead of adding. The
# background cell (bottom most layer) is always kept.
#
# Written in 1999 (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.
#
require 5.004;
use Gimp qw(:auto);
use Gimp::Fu;
use Gimp::Util;
$animate_cells_version = "1.1.1";
$animate_cells_released = "3/12/1999";
# use strict;
sub perl_fu_animate_cells {
my $image = shift;
# my $drawable = shift; # Unused
gimp_image_disable_undo($image);
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.");
return;
}
gimp_selection_layer_alpha($ids[0]);
for($i=1;$i<@ids;$i++) {
$lnum = $#ids+1-$i;
fix_cell_layer($image, $ids[$i], $ids[$i-1], $back, $lnum);
}
for($i=$#ids;$i>=0;$i--) {
gimp_image_merge_down($image, $ids[$i], EXPAND_AS_NECESSARY);
}
gimp_selection_none($image);
gimp_image_enable_undo($image);
gimp_displays_flush();
}
sub fix_cell_layer {
my $img = shift; # The image
my $target = shift; # The target layer
my $prev = shift; # The layer before it
my $back = shift; # The background layer
my $lnum = shift; # The new layer's number
my $dup = gimp_layer_copy($prev,0);
# Tried to do a gimp_layer_get_position($target), here, but it failed...
gimp_image_add_layer($img, $dup, $lnum);
gimp_selection_sharpen($img); # No feathered or fuzzy selection areas
gimp_selection_grow($img,1); # XXX - Gets around gimp 1-pixel bug
gimp_edit_copy($back);
my $float = gimp_edit_paste($dup,0);
gimp_floating_sel_anchor($float);
gimp_selection_layer_alpha($target);
}
# Gimp::Fu registration routine for placing this function into gimp's PDB
register
"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.",
"Aaron Sherman", "Aaron Sherman (c)", "1999-03-12",
"<Image>/Filters/Animation/Animate Cells",
"*",
[
],
\&perl_fu_animate_cells;
exit main;
__END__
=head1 NAME
animate_cells - Animate an image
=head1 SYNOPSIS
Called from the Gimp. Use Gimp's user interface to call this function.
=head1 DESCRIPTION
TBD
=head1 PARAMETERS
None.
=head1 AUTHOR
Written in 1999 (c) by Aaron Sherman E<lt>ajs@ajs.comE<gt>
=head1 BUGS
TBD
=head1 SEE ALSO
L<gimp>, L<perl>, L<Gimp>: the Gimp module for perl.
=cut

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

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

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

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

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

@ -44,7 +44,7 @@ sub generate_log {
$log.=sprintf "%-16s %-5s %s\n", 'File','Fatal', 'Message';
for (split /\x00/,Gimp->get_data ('gimp-perl-log')) {
my ($file,$function,$msg,$installed)=split /\x01/;
@msg = split /\n/,Gimp::wrap_text ($msg.($function ? " ($function)" : ""),56);
@msg = split /\n/,Gimp::wrap_text ($msg.($function ? " ($function)" : ""),55);
$log.=sprintf "%-16s %-5s %s\n",$file,$installed ? 'Yes':'No',shift(@msg);
while(@msg) {
$log.=sprintf "%-16s %-5s %s\n",'','+->',shift(@msg);

150
plug-ins/perl/examples/sethspin.pl Executable file
View File

@ -0,0 +1,150 @@
#!/usr/bin/perl
# This one's all mine. Well, its GPL but I"m the author and creator.
# I think you need gimp 1.1 or better for this - if you don't, please let
# me know
# As a fair warning, some of this code is a bit ugly. But thats perl for ya :)
# Seth Burgess
# <sjburges@gimp.org>
use Gimp;
use Gimp::Fu;
# Gimp::set_trace(TRACE_ALL);
sub hideallbut {
($img, @butlist) = @_;
@layers = $img->get_layers();
foreach $layer (@layers) {
if ($layer->get_visible()) {
$layer->set_visible(0);
}
}
foreach $but (@butlist) {
if (! $layers[$but]->get_visible()) {
$layers[$but]->set_visible(1);
}
}
};
sub saw { # a sawtooth function on PI
($val) = @_;
if ($val < 3.14159/2.0) {
return ($val/3.14159) ;
}
elsif ($val < 3.14159) {
return (-1+$val/3.14159);
}
elsif ($val < 3.14159+3.14159/2.0) {
return ($val/3.14159) ;
}
else {
return (-1+$val/3.14159);
};
};
sub spin_layer {
my ($img, $spin, $dest, $numframes) = @_;
# Now lets spin it!
$stepsize = 3.14159/$numframes; # in radians
for ($i=0; $i<=3.14159; $i+=$stepsize) {
# create a new layer for spinning
if ($i < 3.14159/2.0) {
$framelay = $spin->layer_copy(1);
}
else {
$framelay = $dest->layer_copy(1);
}
$img->add_layer($framelay, 0);
# spin it a step
$img->selection_all();
@x = $img->selection_bounds();
# x[1],x[2] x[3],x[2]
# x[1],x[4] x[3],x[4]
$psp = 0.2; # The perspective amount
$floater = $framelay->perspective(1,
$x[1]+saw($i)*$psp*$framelay->width,$x[2]+$spin->height *sin($i)/2,
$x[3]-saw($i)*$psp*$framelay->width,$x[2]+$spin->height *sin($i)/2,
$x[1]-saw($i)*$psp*$framelay->width,$x[4]-$spin->height *sin($i)/2,
$x[3]+saw($i)*$psp*$framelay->width,$x[4]-$spin->height *sin($i)/2);
$floater->floating_sel_to_layer();
# fill entire layer with background
$framelay->fill(1); # BG-IMAGE-FILL
}
for ($i=0; $i<$numframes; $i++) {
hideallbut($img, $i, $i+1);
$img->merge_visible_layers(0);
}
@all_layers = $img->get_layers();
$destfram = $all_layers[$numframes]->copy(0);
$img->add_layer($destfram,0);
# clean up my temporary layers
$img->remove_layer($all_layers[$numframes]);
$img->remove_layer($all_layers[$numframes+1]);
};
register "seth_spin",
"Seth Spin",
"Take one image. Spin it about the horizontal axis, and end up with another image. I made it for easy web buttons.",
"Seth Burgess",
"Seth Burgess <sjburges\@gimp.org>",
"1.0",
"<Image>/Filters/Animation/Seth Spin",
"RGB*, GRAY*",
[
[PF_DRAWABLE, "Destination","What drawable to spin to?"],
[PF_INT8, "Frames", "How many frames to use?", 8],
[PF_COLOR, "Background", "What color to use for background if not transparent", [0,0,0]],
[PF_SLIDER, "Perspective", "How much perspective effect to get", 40, [0,255,5]],
[PF_TOGGLE, "Spin Back", "Should it also spin back? Will double the number of frames", 1],
],
sub {
my($img,$src,$dest,$frames,$color,$psp,$spinback) =@_;
eval { $img->undo_push_group_start };
$oldbackground = gimp_palette_get_background();
gimp_palette_set_background($color);
# Create the new layer that the spin will occur on...
$src->edit_copy();
$spinlayer = $src->edit_paste(1);
$spinlayer->floating_sel_to_layer();
$dest->edit_copy();
$destlayer = $dest->edit_paste(1);
$destlayer->floating_sel_to_layer();
spin_layer($img, $spinlayer, $destlayer, $frames);
if ($spinback) {
@layerlist = $img->get_layers();
$img->add_layer($layerlist[$frames]->copy(0),0);
$img->remove_layer($layerlist[$frames]);
@layerlist = $img->get_layers();
spin_layer($img, $layerlist[1], $layerlist[0], $frames);
$realframes = 2*$frames;
}
else {
$realframes = $frames;
}
# unhide and name layers
@all_layers = $img->get_layers();
for ($i=0; $i<$realframes ; $i++) {
$all_layers[$i]->set_visible(1);
$all_layers[$i]->set_name("Spin Layer $i");
}
gimp_palette_set_background($oldbackground);
eval { $img->undo_push_group_end };
gimp_displays_flush();
return();
};
exit main;

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

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

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

@ -27,7 +27,7 @@ register "webify",
$img = $img->channel_ops_duplicate if $new;
eval { $img->undo_group_start };
$drawable = $img->flatten;
if ($alpha) {