From 13a08f723014e937b4fb2714d6a09f59155593e8 Mon Sep 17 00:00:00 2001 From: Marc Lehmann Date: Tue, 3 Aug 1999 16:20:05 +0000 Subject: [PATCH] see plug-ins/perl/Changes --- plug-ins/perl/Changes | 8 ++ plug-ins/perl/Gimp.pm | 2 + plug-ins/perl/Gimp/Data.pm | 55 +++++++- plug-ins/perl/Gimp/Feature.pm | 15 ++- plug-ins/perl/Gimp/Fu.pm | 30 +++-- plug-ins/perl/Gimp/Lib.xs | 4 +- plug-ins/perl/MANIFEST | 1 + plug-ins/perl/Makefile.PL | 2 +- plug-ins/perl/TODO | 6 +- plug-ins/perl/examples/fire | 4 +- plug-ins/perl/examples/glowing_steel | 4 +- plug-ins/perl/examples/pixelmap | 2 +- plug-ins/perl/examples/povray | 186 +++++++++++++++++++++++++++ plug-ins/perl/examples/randomart1 | 4 +- plug-ins/perl/examples/yinyang | 4 +- 15 files changed, 292 insertions(+), 35 deletions(-) create mode 100755 plug-ins/perl/examples/povray diff --git a/plug-ins/perl/Changes b/plug-ins/perl/Changes index ce9c3f0438..3131edc95e 100644 --- a/plug-ins/perl/Changes +++ b/plug-ins/perl/Changes @@ -1,5 +1,9 @@ Revision history for Gimp-Perl extension. +1.11 Tue Aug 3 03:23:23 CEST 1999 + NOTYET - EXPERIMENTALLY re-enabled the return path from main. It works + NOTYET with perl 5.005_58, but I remember problems with other versions. + NOTYET This re-enables END handlers etc. - updated seths scripts, added remove_guides... - examples/glowing_steel was missing from the MANIFEST!! - data types for RADIO, SPINNER etc.. are guessed better now. @@ -18,6 +22,10 @@ Revision history for Gimp-Perl extension. - gimpdoc can now output a html file tree. - moved the Perl-Server and Perl Control Center into the Perl submenu. - Gimp::Parasite no longer has a search path. + - Gimp::Data now handles data persistency. + - Gimp::Fu augments (some) return value specifications. + - fixed a "Attempt to free unreferenced scalar" bug that was caused + by passing undef for strings. 1.1 Fri Jul 30 07:37:30 CEST 1999 - one of the most successful releases, in terms of features & bugfixes. diff --git a/plug-ins/perl/Gimp.pm b/plug-ins/perl/Gimp.pm index 5c56c04ba3..8383452702 100644 --- a/plug-ins/perl/Gimp.pm +++ b/plug-ins/perl/Gimp.pm @@ -242,6 +242,7 @@ $spawn_opts = ""; # extra check for Gimp::Feature::import $in_query=0 unless defined $in_query; # perl -w is SOOO braindamaged $in_top=$in_quit=$in_run=$in_net=$in_init=0; # perl -w is braindamaged +($function)=$0=~/([^\/\\]+)$/; $verbose=0; @@ -402,6 +403,7 @@ sub main { $caller=caller; #d# #D# # BIG BUG LURKING SOMEWHERE # just calling exit() will be too much for bigexitbug.pl + #&{"$interface_pkg\::gimp_main"}; xs_exit(&{"$interface_pkg\::gimp_main"}); } diff --git a/plug-ins/perl/Gimp/Data.pm b/plug-ins/perl/Gimp/Data.pm index 5f377d7f2d..d50b59c327 100644 --- a/plug-ins/perl/Gimp/Data.pm +++ b/plug-ins/perl/Gimp/Data.pm @@ -1,5 +1,21 @@ package Gimp::Data; +sub freeze($) { + my $data = shift; + eval { require Data::Dumper } or return; + $data = new Data::Dumper [$data]; + $data->Purity(1)->Terse(0); + $data = $data->Dump; +} + +sub thaw { + my $data = shift; + eval { require Data::Dumper } or return; + my $VAR1; # Data::Dumper is braindamaged + local $^W=0; # perl -w is braindamaged + eval $data; +} + sub TIEHASH { my $pkg = shift; my $self; @@ -8,13 +24,22 @@ sub TIEHASH { } sub FETCH { - eval { Gimp->find_parasite ($_[1])->data } - || ($@ ? Gimp->get_data ($_[1]) : ()); + my $data = eval { Gimp->find_parasite ($_[1])->data } + || ($@ ? Gimp->get_data ($_[1]) : ()); + if ($data =~ /^\$VAR1 = \[/) { + thaw $data; + } else { + $data; + } } sub STORE { - eval { Gimp->attach_parasite ([$_[1], Gimp::PARASITE_PERSISTENT, $_[2]]) }; - Gimp->set_data ($_[1], $_[2]) if $@; + my $data = $_[2]; + if (ref $data) { + $data = freeze $data or return; + } + eval { Gimp->attach_parasite ([$_[1], Gimp::PARASITE_PERSISTENT, $data]) }; + Gimp->set_data ($_[1], $data) if $@; } sub EXISTS { @@ -59,6 +84,28 @@ like your plug-in's name. As an example, the Gimp::Fu module uses This module might use a persistant implementation, i.e. your data might survive a restart of the Gimp application, but you cannot count on this. +Gimp::Data will try to freeze your data when you pass in a reference. On +retrieval, the data is thawed again. See L for more info. This +might be implemented through either Storable or Data::Dumper, or not +implemented at all (i.e. silently fail) ;) + +=head1 PERSISTANCE + +Gimp::Data contains the following functions to ease applications where +persistence for perl data structures is required: + +=over 4 + +=item Gimp::Data::freeze(reference) + +Freeze (serialize) the reference. + +=item Gimp::Data::thaw(data) + +Thaw (unserialize) the dsata and return the original reference. + +=back + =head1 LIMITATIONS You cannot store references, and you cannot (yet) iterate through the keys diff --git a/plug-ins/perl/Gimp/Feature.pm b/plug-ins/perl/Gimp/Feature.pm index 1cae1adc95..f320f41ca5 100644 --- a/plug-ins/perl/Gimp/Feature.pm +++ b/plug-ins/perl/Gimp/Feature.pm @@ -33,6 +33,7 @@ my %description = ( 'dumper' => 'the Data::Dumper module', 'never' => '(for testing, will never be present)', 'unix' => 'a unix-like operating system', + 'persistency'=> 'Gimp::Data can handle persistency', ); sub import { @@ -85,6 +86,8 @@ sub present { eval { require Gtk::XmHTML }; $@ eq ""; } elsif ($_ eq "dumper") { eval { require Data::Dumper }; $@ eq ""; + } elsif ($_ eq "persistency") { + eval { require Data::Dumper }; $@ eq ""; } elsif ($_ eq "unix") { !{ MacOS => 1, @@ -128,15 +131,15 @@ __END__ =head1 NAME -Gimp::Features - check for specific features to be present before registering the script. +Gimp::Feature - check for specific features to be present before registering the script. =head1 SYNOPSIS - use Gimp::Features; + use Gimp::Feature; or - use Gimp::Features qw(feature1 feature2 ...); + use Gimp::Feature qw(feature1 feature2 ...); =head1 DESCRIPTION @@ -176,6 +179,12 @@ checks for the presence of the Gtk::XmHTML module. checks wether the script runs on a unix-like operating system. At the moment, this is every system except windows, macos, os2 and vms. +=item C + +checks wether the C module (L) can handle complex +persistent data structures, i.e. perl references in addition to plain +strings. + =back The following features can only be checked B Cmain> has been diff --git a/plug-ins/perl/Gimp/Fu.pm b/plug-ins/perl/Gimp/Fu.pm index 2eaeac8e2d..6d322380cd 100644 --- a/plug-ins/perl/Gimp/Fu.pm +++ b/plug-ins/perl/Gimp/Fu.pm @@ -760,6 +760,8 @@ Gimp::on_net { @load_retvals = ([&Gimp::PARAM_IMAGE , "image", "Output image"]); +$image_retval = [&Gimp::PARAM_IMAGE , "image", "The resulting image"]; + Gimp::on_query { my($type); expand_podsections; @@ -768,6 +770,13 @@ Gimp::on_query { my($perl_sub,$function,$blurb,$help,$author,$copyright,$date, $menupath,$imagetypes,$params,$results,$features,$code)=@$_; + for (@$results) { + next if ref $_; + if ($_ == &Gimp::PARAM_IMAGE) { + $_ = $image_retval; + } + } + for(@$features) { next script unless fu_feature_present($_,$function); } @@ -918,8 +927,13 @@ See the section PARAMETER TYPES for the supported types. =item the return values This is just like the parameter array, just that it describes the return -values. Of course, default values don't make much sense here. (Even if they -did, it's not implemented anyway..). This argument is optional. +values. Of course, default values and the enhanced Gimp::Fu parameter +types don't make much sense here. (Even if they did, it's not implemented +anyway..). This argument is optional. + +If you supply a parameter type (e.g. C) instead of a full +specification (C<[PF_IMAGE, ...]>), Gimp::Fu might supply some default +values. This is only implemented for C at the moment. =item the features requirements @@ -1080,6 +1094,7 @@ sub register($$$$$$$$$;@) { @_==0 or die "register called with too many or wrong arguments\n"; for my $p (@$params,@$results) { + next unless ref $p; int($p->[0]) eq $p->[0] or croak "$function: argument/return value '$p->[1]' has illegal type '$p->[0]'"; $p->[1]=~/^[0-9a-z_]+$/ or carp "$function: argument name '$p->[1]' contains illegal characters, only 0-9, a-z and _ allowed"; } @@ -1125,17 +1140,15 @@ sub register($$$$$$$$$;@) { if ($run_mode == &Gimp::RUN_INTERACTIVE || $run_mode == &Gimp::RUN_WITH_LAST_VALS) { my $fudata = $Gimp::Data{"$function/_fu_data"}; - my $VAR1; # Data::Dumper is braindamaged - local $^W=0; # perl -w is braindamaged - if ($run_mode == &Gimp::RUN_WITH_LAST_VALS && $fudata ne "") { - @_ = @{eval $fudata}; + if ($run_mode == &Gimp::RUN_WITH_LAST_VALS && $fudata) { + @_ = @{$fudata}; } else { if (@_) { my $res; local $^W=0; # perl -w is braindamaged # gimp is braindamaged, is doesn't deliver useful values!! - ($res,@_)=interact($function,$blurb,$help,$params,@{eval $fudata}); + ($res,@_)=interact($function,$blurb,$help,$params,@{$fudata}); return unless $res; } } @@ -1151,8 +1164,7 @@ sub register($$$$$$$$$;@) { $input_image = $_[0] if ref $_[0] eq "Gimp::Image"; $input_image = $pre[0] if ref $pre[0] eq "Gimp::Image"; - eval { require Data::Dumper }; - $Gimp::Data{"$function/_fu_data"}=Data::Dumper::Dumper([@_]) unless $@; + $Gimp::Data{"$function/_fu_data"}=[@_]; print $function,"(",join(",",(@pre,@_)),")\n" if $Gimp::verbose; diff --git a/plug-ins/perl/Gimp/Lib.xs b/plug-ins/perl/Gimp/Lib.xs index f59fcf19b7..a6b91c729d 100644 --- a/plug-ins/perl/Gimp/Lib.xs +++ b/plug-ins/perl/Gimp/Lib.xs @@ -834,7 +834,7 @@ push_gimp_sv (GParam *arg, int array_as_ref) case PARAM_FLOAT: sv = newSVnv(arg->data.d_float ); break; case PARAM_STRING: sv = arg->data.d_string ? neuSVpv(arg->data.d_string) - : sv_newmortal (); + : newSVsv (&PL_sv_undef); break; case PARAM_DISPLAY: @@ -864,7 +864,7 @@ push_gimp_sv (GParam *arg, int array_as_ref) } if (id == -1) - PUSHs (sv_newmortal ()); + PUSHs (newSVsv (&PL_sv_undef)); else sv = newSViv (id); } diff --git a/plug-ins/perl/MANIFEST b/plug-ins/perl/MANIFEST index f2a63ad873..3d73baf96e 100644 --- a/plug-ins/perl/MANIFEST +++ b/plug-ins/perl/MANIFEST @@ -114,3 +114,4 @@ examples/guides_to_selection examples/burst examples/map_to_gradient examples/fire +examples/povray diff --git a/plug-ins/perl/Makefile.PL b/plug-ins/perl/Makefile.PL index 699dc1b43b..36bafa1616 100644 --- a/plug-ins/perl/Makefile.PL +++ b/plug-ins/perl/Makefile.PL @@ -13,7 +13,7 @@ $|=1; repdup centerguide stampify goldenmean triangle billboard mirrorsplit oneliners randomart1 pixelmap glowing_steel frame_reshuffle frame_filter logulator miff magick guide_remove guides_to_selection burst map_to_gradient - fire + fire povray ); @shebang = (map("examples/$_",@examples), qw(Perl-Server examples/example-net.pl examples/homepage-logo.pl diff --git a/plug-ins/perl/TODO b/plug-ins/perl/TODO index d98ba7fc8d..5cd2a0d7f3 100644 --- a/plug-ins/perl/TODO +++ b/plug-ins/perl/TODO @@ -18,14 +18,12 @@ script-fu 4.9 vs. 3.3 bugs + * installation & Feature system (?) * map_to_gradient does not work on GRAYA thingies. Argh. -[DONE] * /root/gimprelease && TODO -> publish! +[DONE] * /root/gimprelease && TODO -> publish! PUSH PUSH * perl_require_pv with _59? * scroll behaviour, use clist instead of list? -[DONE] * can_Default for oter OK-buttons * document Gimp::PDL and rect2, ...2 functions! -[DONE] * MJH: glib-config(!!!) -[KILL] * empty desfiption -> no display in PDB?` * podestions are not expanded in dialog help strings etc.. * Kommandozeilenmodus(!). * don't start gimp in cmdline mode and error. diff --git a/plug-ins/perl/examples/fire b/plug-ins/perl/examples/fire index de3bc37860..1b5bff8ffe 100755 --- a/plug-ins/perl/examples/fire +++ b/plug-ins/perl/examples/fire @@ -59,11 +59,11 @@ register "firetext", [PF_TEXT, "text", "The text to render (can be multi-line)", "burn,\nBurn,\nBURN!"], [PF_FONT, "font", "The font to use"], [PF_TOGGLE, "inverse", "Invert source mask?", 1], - [PF_SLIDER, "strength", "The strength (length) of the bursts", 50, [1,300,5]], + [PF_SLIDER, "strength", "The strength (length) of the bursts", 10, [1,300,5]], [PF_GRADIENT, "gradient", "The gradient to use for the colour, e.g. 'Incandescent' or 'Burning_Paper'", 'Burning_Transparency'], [PF_TOGGLE, "displace", "Additionally displace with itself?", 0], ], - [[PF_IMAGE, "image", "The resulting image"]], + [PF_IMAGE], ['gimp-1.1'], sub { my ($text, $font, $inverse, $strength, $gradient, $displace) = @_; diff --git a/plug-ins/perl/examples/glowing_steel b/plug-ins/perl/examples/glowing_steel index 1a9e0bfbae..531874c22f 100755 --- a/plug-ins/perl/examples/glowing_steel +++ b/plug-ins/perl/examples/glowing_steel @@ -316,9 +316,7 @@ register [PF_TOGGLE, "highlight_edges", "", 1], [PF_TOGGLE, "antialias", "", 1] ], - [ - [PF_IMAGE, "image", "resulting image"] - ], + [PF_IMAGE], \&perl_fu_glowing_steel; exit main; diff --git a/plug-ins/perl/examples/pixelmap b/plug-ins/perl/examples/pixelmap index bd2a7baf3d..dcc3e91a28 100755 --- a/plug-ins/perl/examples/pixelmap +++ b/plug-ins/perl/examples/pixelmap @@ -79,7 +79,7 @@ register "pixelgen", GRAYA => GRAYA_IMAGE, INDEXED => INDEXED_IMAGE, INDEXEDA => INDEXEDA_IMAGE]], [PF_TEXT, "expression" , "The perl expression to use", "outer(\$x*0.1,\$y*0.2)\n->slice(\"*\$bpp\")"] ], - [[PF_IMAGE, "image" , "The resulting image"]], + [PF_IMAGE], sub { my($w,$h,$type,$expr)=@_; my $image = new Image $w, $h, Gimp->layer2imagetype($type); diff --git a/plug-ins/perl/examples/povray b/plug-ins/perl/examples/povray new file mode 100755 index 0000000000..3c824d2797 --- /dev/null +++ b/plug-ins/perl/examples/povray @@ -0,0 +1,186 @@ +#!/usr/bin/perl + +use Gimp; +use Gimp::Feature qw(gimp-1.1 persistency); +use Gimp::Fu; +use Gimp::Data; + +use constant DEG2RAD => 4 / 180 * atan2 1,1; + +sub set_preferences { + $Gimp::Data{povray_preferences} = \@_; + (); +} + +sub get_preferences { + my $data; + while (!ref ($data=$Gimp::Data{povray_preferences})) { + Gimp->perl_fu_povray_preferences_set(RUN_INTERACTIVE,(undef)x3); + } + ($pov_path,$pov_quality,$pov_args)=@$data; +} + +register "povray_preferences_set", + "Set povray preferences", + "=pod(DESCRIPTION)", + "Marc Lehmann ", + "Marc Lehmann", + "19990803", + "/Xtns/Render/Povray/Preferences", + "*", + [ + [PF_FILE, "povray_path", "The path to the povray executable", "x-povray"], + [PF_STRING, "quality", "The quality setting (0..9, R)", "R"], + [PF_STRING, "extra_args", "Extra arguments for povray invocation","+d"], + ], + \&set_preferences; + +my @camera = ( + [PF_SLIDER, 'cam_phi', 'The camera angle around the z axis', 0, [-180,180,1]], + [PF_SLIDER, 'cam_theta', 'The camera angle relative to the z-Axis', 0, [0,90,1]], + [PF_SLIDER, 'cam_radius', 'The camera distance', 1, [0,25,0.3]], + [PF_SLIDER, 'cam_fov', 'The camera field-of-view', 30, [0,90,1]], +); + +sub get_camera(\@) { + (shift @{$_[0]},shift @{$_[0]},shift @{$_[0]},shift @{$_[0]}); +} + +sub gen_camera { + my($p,$v,$r,$fov)=@_; + my($x,$y,$z); + $x = $r * sin ($v * DEG2RAD) * cos ($p * DEG2RAD); + $y = $r * sin ($v * DEG2RAD) * sin ($p * DEG2RAD); + $z = $r * cos ($v * DEG2RAD); + "camera { location <$x, $y, $z> angle $fov look_at <0,0,0> }"; +} + +$prelude = <temp_name("pov"); + my($ppm_path) = Gimp->temp_name("ppm"); + my($err_path) = Gimp->temp_name("err"); + my($msg_path) = Gimp->temp_name("msg"); + push @unlink, $scr_path, $ppm_path, $err_path, $msg_path; + open SCR, ">$scr_path" or die "Unable to create pov script '$scr_path': $!\n"; + print SCR $prelude; + print SCR $script; + close SCR; + get_preferences, + my $cmd ="$pov_path +V -GS -GD -GR ". + "+GF$err_path +GW$msg_path ". + "+Q$pov_quality +i$scr_path $pov_args +FP +O$ppm_path +W$w +H$h"; + open POV,"$cmd 2>&1 |" or die "Unable to run '$cmd': $!\n"; + init Progress "Rendering..."; + local $/ = "\r"; + while () { + for (split /\n/) { + if (/endering line\s+(\d+) of\s+(\d+)/) { + update Progress $1/$2; + } else { + #print "POV: $_\n"; + } + } + } + my $res = close POV >> 8; + if (open ERR, "<$err_path") { + my $err = do { local $/; }; + close ERR; + $err =~ s/^\s+//; $err =~ s/\s+$//; + die "POVRAY ERROR OUTPUT:\n$err\n" if $err; + } + if (open MSG, "<$msg_path") { + my $err = do { local $/; }; + close MSG; + $err =~ s/^\s+//; $err =~ s/\s+$//; + Gimp->message("POVRAY WARNING OUTPUT:\n$err\n") if $err; + } + die "Povray returned with non-zero exit status ($res)\n" if $res; + -f $ppm_path or die "Povray produced no output image\n"; + + $ppm_path; +} + +sub load_img { + my $img = Gimp->file_load((shift)x2); + $img->clean_all; + cleanup; # FIXME: remove when xs_exit repaired + $img; +} + +register "povray_render_texture", + "Render a povray texture into a new image", + "=pod(DESCRIPTION)", + "Marc Lehmann ", + "Marc Lehmann", + "19990803", + "/Xtns/Render/Povray/Texture", + "*", + [ + @camera, + [PF_SPINNER, "width", "The resulting image width", 200, [1, 4096, 1]], + [PF_SPINNER, "height", "The resulting image height", 200, [1, 4096, 1]], + [PF_STRING, 'texture', 'The Povray texture name', 'T_Wood1'], + [PF_SLIDER, "xscale", "Horizontal Scale Factor", 1, [0.0001, 5, 0.1]], + [PF_SLIDER, "yscale", "Vertical Scale Factor", 1, [0.0001, 5, 0.1]], + [PF_SLIDER, "rotation", "Rotate about y (deg)", 0, [0, 360]], + ], + [PF_IMAGE], + sub { + my(@cam)=get_camera(@_); + my($w,$h,$texturename,$xscale,$yscale,$rotation)=@_; + load_img run_povray $w,$h,< rotate $rotation * y } +#declare TileSize = <1, 1, 1>; + +#declare _TX_tempver = version; +#declare _TX_size = TileSize * <1, 1, 1>; +#declare TileSeam = 1; +/*camera {location <.5, .5, -1> look_at <.5, .5, 0> orthographic up y right $aspectratio * x} */ + +#declare _TX_xtexture = texture {gradient x texture_map { + [.5 - (TileSeam / 2) TileTexture scale <1 / _TX_size.x, 1, 1>] + [.5 + (TileSeam / 2) TileTexture scale <1 / _TX_size.x, 1, 1> translate x]}} +plane {z, 0 texture {gradient y texture_map { + [.5 - (TileSeam / 2) _TX_xtexture scale <1, 1 / _TX_size.y, 1>] + [.5 + (TileSeam / 2) _TX_xtexture scale <1, 1 / _TX_size.y, 1> + translate y]}}} + +light_source {z*100000 rgb <1, 1, 1>} + +I +}; + +exit main; + +=head1 DESCRIPTION + +No docs. Yet. Bug me to provide them. + +=head1 ACK! + +Thanks to Aaron Sherman who inspired me, to John Pitney who wrote some +other, similar plug-in and to Adrian Likins who knew that. Not that this +plug-in is cool enough to warrant a long list of thanks ;) + diff --git a/plug-ins/perl/examples/randomart1 b/plug-ins/perl/examples/randomart1 index 5afea92d7b..64273c2357 100755 --- a/plug-ins/perl/examples/randomart1 +++ b/plug-ins/perl/examples/randomart1 @@ -26,9 +26,7 @@ register "random_art_1", # Funktionsname [PF_SLIDER, 'feather', 'Feather Radius', 30, [1, 100]], [PF_BOOL, 'supersample', 'Adaptive Supersampling?', 0], ], - [ - [PF_IMAGE, 'image', 'the resulting image'], - ], + [PF_IMAGE], sub { # Perl-Code # Die Parameter werden ganz "normal" übergeben: my ($w,$h,$num_poly,$edges,$revolutions,$feather,$super)=@_; diff --git a/plug-ins/perl/examples/yinyang b/plug-ins/perl/examples/yinyang index 457aee4412..8e12aa2945 100755 --- a/plug-ins/perl/examples/yinyang +++ b/plug-ins/perl/examples/yinyang @@ -116,9 +116,7 @@ register("yinyang", "Render a stand-alone Yin/Yang image", [PF_STRING, "aobttom_eye_filename", "eye 2", ""], [PF_TOGGLE, "anti_aliasing", "", 1] ], - [ - [PF_IMAGE, "image", "Resulting Image"], - ], + [PF_IMAGE], \&yinyang); exit main;