From 2ac00ed4329f22f846d46337981ffb10d7c72cbc Mon Sep 17 00:00:00 2001 From: Marc Lehmann Date: Fri, 12 Mar 1999 20:37:06 +0000 Subject: [PATCH] see plug-ins/perl/Changes --- plug-ins/perl/Changes | 32 +++--- plug-ins/perl/Gimp.pm | 29 ++++- plug-ins/perl/Gimp/Feature.pm | 24 +++- plug-ins/perl/Gimp/Fu.pm | 29 +++-- plug-ins/perl/Gimp/Net.pm | 43 ++++--- plug-ins/perl/MANIFEST | 2 + plug-ins/perl/Makefile.PL | 17 +-- plug-ins/perl/examples/PDB | 2 +- plug-ins/perl/examples/README | 17 ++- plug-ins/perl/examples/animate_cells | 114 +++++++++++++++++++ plug-ins/perl/examples/border.pl | 2 +- plug-ins/perl/examples/parasite-editor | 2 +- plug-ins/perl/examples/perlcc | 2 +- plug-ins/perl/examples/sethspin.pl | 150 +++++++++++++++++++++++++ plug-ins/perl/examples/view3d.pl | 4 +- plug-ins/perl/examples/webify.pl | 2 +- 16 files changed, 399 insertions(+), 72 deletions(-) create mode 100755 plug-ins/perl/examples/animate_cells create mode 100755 plug-ins/perl/examples/sethspin.pl diff --git a/plug-ins/perl/Changes b/plug-ins/perl/Changes index 10efc28aa4..22f8481042 100644 --- a/plug-ins/perl/Changes +++ b/plug-ins/perl/Changes @@ -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 diff --git a/plug-ins/perl/Gimp.pm b/plug-ins/perl/Gimp.pm index f9614bd5f3..145a281eef 100644 --- a/plug-ins/perl/Gimp.pm +++ b/plug-ins/perl/Gimp.pm @@ -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) { diff --git a/plug-ins/perl/Gimp/Feature.pm b/plug-ins/perl/Gimp/Feature.pm index b9f30a285f..358595a20e 100644 --- a/plug-ins/perl/Gimp/Feature.pm +++ b/plug-ins/perl/Gimp/Feature.pm @@ -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; } } diff --git a/plug-ins/perl/Gimp/Fu.pm b/plug-ins/perl/Gimp/Fu.pm index 6cb0e12f32..fea9f20b20 100644 --- a/plug-ins/perl/Gimp/Fu.pm +++ b/plug-ins/perl/Gimp/Fu.pm @@ -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=~/^\//) { diff --git a/plug-ins/perl/Gimp/Net.pm b/plug-ins/perl/Gimp/Net.pm index 7e9ef61154..bbd808da72 100644 --- a/plug-ins/perl/Gimp/Net.pm +++ b/plug-ins/perl/Gimp/Net.pm @@ -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; } diff --git a/plug-ins/perl/MANIFEST b/plug-ins/perl/MANIFEST index f468d1d8f3..158544eb53 100644 --- a/plug-ins/perl/MANIFEST +++ b/plug-ins/perl/MANIFEST @@ -64,3 +64,5 @@ examples/terral_text examples/xachvision.pl examples/gimpmagick examples/perlcc +examples/sethspin.pl +examples/animate_cells diff --git a/plug-ins/perl/Makefile.PL b/plug-ins/perl/Makefile.PL index 0b7463daa2..33f861c277 100644 --- a/plug-ins/perl/Makefile.PL +++ b/plug-ins/perl/Makefile.PL @@ -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'",$_); } diff --git a/plug-ins/perl/examples/PDB b/plug-ins/perl/examples/PDB index afdfea5e3b..32104a1d20 100755 --- a/plug-ins/perl/examples/PDB +++ b/plug-ins/perl/examples/PDB @@ -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; diff --git a/plug-ins/perl/examples/README b/plug-ins/perl/examples/README index d864bd2652..1239aa9951 100644 --- a/plug-ins/perl/examples/README +++ b/plug-ins/perl/examples/README @@ -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 +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 . + +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 diff --git a/plug-ins/perl/examples/animate_cells b/plug-ins/perl/examples/animate_cells new file mode 100755 index 0000000000..a0ff0d01e2 --- /dev/null +++ b/plug-ins/perl/examples/animate_cells @@ -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 . +# 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", + "/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 Eajs@ajs.comE + +=head1 BUGS + +TBD + +=head1 SEE ALSO + +L, L, L: the Gimp module for perl. + +=cut diff --git a/plug-ins/perl/examples/border.pl b/plug-ins/perl/examples/border.pl index fe184028f9..cf51f4571f 100755 --- a/plug-ins/perl/examples/border.pl +++ b/plug-ins/perl/examples/border.pl @@ -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; diff --git a/plug-ins/perl/examples/parasite-editor b/plug-ins/perl/examples/parasite-editor index 1ecad15517..9ca8c966c4 100755 --- a/plug-ins/perl/examples/parasite-editor +++ b/plug-ins/perl/examples/parasite-editor @@ -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; diff --git a/plug-ins/perl/examples/perlcc b/plug-ins/perl/examples/perlcc index 13ca2a5cd5..55e483c5fe 100755 --- a/plug-ins/perl/examples/perlcc +++ b/plug-ins/perl/examples/perlcc @@ -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); diff --git a/plug-ins/perl/examples/sethspin.pl b/plug-ins/perl/examples/sethspin.pl new file mode 100755 index 0000000000..49a8851cc8 --- /dev/null +++ b/plug-ins/perl/examples/sethspin.pl @@ -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 +# + +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 ", + "1.0", + "/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; + diff --git a/plug-ins/perl/examples/view3d.pl b/plug-ins/perl/examples/view3d.pl index a4dd617319..77dbab9cb0 100644 --- a/plug-ins/perl/examples/view3d.pl +++ b/plug-ins/perl/examples/view3d.pl @@ -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; diff --git a/plug-ins/perl/examples/webify.pl b/plug-ins/perl/examples/webify.pl index 10e1c49d2b..f2756f9745 100755 --- a/plug-ins/perl/examples/webify.pl +++ b/plug-ins/perl/examples/webify.pl @@ -27,7 +27,7 @@ register "webify", $img = $img->channel_ops_duplicate if $new; eval { $img->undo_group_start }; - + $drawable = $img->flatten; if ($alpha) {