callisto-debian/gimp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

see plug-ins/perl/Changes

Browse Source
This commit is contained in:
Marc Lehmann
1999-08-03 16:20:05 +00:00
parent 823817cc52
commit 13a08f7230
15 changed files with 292 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
plug-ins/perl/Changes
View File

@ -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.

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

@ -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"});
}

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

@ -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 }
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<Storable> 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

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

@ -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<persistency>
checks wether the C<Gimp::Data> module (L<Gimp::Data>) can handle complex
persistent data structures, i.e. perl references in addition to plain
strings.
=back
The following features can only be checked B<after> C<Gimp->main> has been

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

@ -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<PF_IMAGE>) instead of a full
specification (C<[PF_IMAGE, ...]>), Gimp::Fu might supply some default
values. This is only implemented for C<PF_IMAGE> 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;

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

@ -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);
}

1
plug-ins/perl/MANIFEST
View File

@ -114,3 +114,4 @@ examples/guides_to_selection
examples/burst
examples/map_to_gradient
examples/fire
examples/povray

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

@ -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

6
plug-ins/perl/TODO
View File

@ -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.

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

@ -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) = @_;

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

@ -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;

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

@ -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);

186
plug-ins/perl/examples/povray Executable file
View File

@ -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 <pcg\@goof.com>",
"Marc Lehmann",
"19990803",
"<Toolbox>/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 = <<I;
#include "colors.inc"
#include "textures.inc"
#include "woods.inc"
#include "skies.inc"
#include "stars.inc"
#include "stones.inc"
#include "stoneold.inc"
#include "golds.inc"
/*#include "glass.inc"*/
I
my @unlink;
sub cleanup {
unlink @unlink;
undef @unlink;
}
END { cleanup }
sub run_povray {
my($w,$h,$script)=@_;
my($scr_path) = Gimp->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 (<POV>) {
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 $/; <ERR> };
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 $/; <MSG> };
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 <pcg\@goof.com>",
"Marc Lehmann",
"19990803",
"<Toolbox>/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,<<I . gen_camera @cam;
#declare TileTexture = texture { $texturename scale <$xscale,$yscale,1> 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 ;)

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

@ -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" <20>bergeben:
my ($w,$h,$num_poly,$edges,$revolutions,$feather,$super)=@_;

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

@ -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;