Commit 65c34b3f authored by Marc Lehmann's avatar Marc Lehmann

see plug-ins/perl/Changes

parent 60c9e73d
Revision history for Gimp-Perl extension.
- added guidegrid, git-text, roundrectsel.
1.072 Sat Mar 27 21:04:39 CET 1999
- scripts will now be correctly installed when IN_GIMP.
- test-dir was not removed by make distclean etc.
- messages now only show up in the Perl Control Center.
this is not correct, however ;)
1.071 Tue Mar 23 13:47:10 CET 1999
- changed the definition of PF_RADIO, simplifying it (it ain't no C).
......
......@@ -8,11 +8,12 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD %EXPORT_TAGS @EXPORT_FAIL
@gimp_gui_functions $function $basename
$in_quit $in_run $in_net $in_init $in_query $no_SIG
$help $verbose $host);
use subs qw(init end lock unlock canonicalize_color);
require DynaLoader;
@ISA=qw(DynaLoader);
$VERSION = 1.071;
$VERSION = 1.072;
@_param = qw(
PARAM_BOUNDARY PARAM_CHANNEL PARAM_COLOR PARAM_DISPLAY PARAM_DRAWABLE
......@@ -161,7 +162,7 @@ sub import($;@) {
for(@_) {
if ($_ eq ":auto") {
push(@export,@_consts,@_procs);
*{"${up}::AUTOLOAD"} = sub {
*{"$up\::AUTOLOAD"} = sub {
croak "cannot autoload '$AUTOLOAD' at this time" unless initialized();
my ($class,$name) = $AUTOLOAD =~ /^(.*)::(.*?)$/;
*{$AUTOLOAD} = sub { Gimp->$name(@_) };
......@@ -183,7 +184,7 @@ sub import($;@) {
}
for(@export) {
*{"${up}::$_"} = \&$_;
*{"$up\::$_"} = \&$_;
}
}
......@@ -308,11 +309,16 @@ sub die_msg {
logger(message => substr($_[0],0,-1), fatal => 1, function => 'ERROR');
}
# this needs to be improved
sub quiet_die {
die "BE QUIET ABOUT THIS DIE\n";
}
unless ($no_SIG) {
$SIG{__DIE__} = sub {
unless ($^S || !defined $^S || $in_quit) {
die_msg $_[0];
initialized() ? die "BE QUIET ABOUT THIS DIE\n" : xs_exit(main());
initialized() ? &quiet_die : exit quiet_main();
} else {
die $_[0];
}
......@@ -332,7 +338,7 @@ sub call_callback {
my $cb = shift;
return () if $caller eq "Gimp";
if (UNIVERSAL::can($caller,$cb)) {
&{"${caller}::$cb"};
&{"$caller\::$cb"};
} else {
die_msg "required callback '$cb' not found\n" if $req;
}
......@@ -363,7 +369,7 @@ sub main {
$caller=caller;
#d# #D# # BIG BUG LURKING SOMEWHERE
# just calling exit() will be too much for bigexitbug.pl
xs_exit(&{"${interface_pkg}::gimp_main"});
xs_exit(&{"$interface_pkg\::gimp_main"});
}
# same as main, but callbacks are ignored
......@@ -386,18 +392,20 @@ $interface_pkg->import;
# create some common aliases
for(qw(_gimp_procedure_available gimp_call_procedure set_trace initialized)) {
*$_ = \&{"${interface_pkg}::$_"};
*$_ = \&{"$interface_pkg\::$_"};
}
*init = \&{"${interface_pkg}::gimp_init"};
*end = \&{"${interface_pkg}::gimp_end" };
*lock = \&{"${interface_pkg}::lock" };
*unlock= \&{"${interface_pkg}::unlock" };
*init = \&{"$interface_pkg\::gimp_init"};
*end = \&{"$interface_pkg\::gimp_end" };
*lock = \&{"$interface_pkg\::lock" };
*unlock= \&{"$interface_pkg\::unlock" };
($basename = $0) =~ s/^.*[\\\/]//;
# extra check for Gimp::Feature::import
$in_query=0 unless defined $in_query; # perl -w is SOOO braindamaged
$verbose=
$in_quit=$in_run=$in_net=$in_init=$in_query=0; # perl -w is braindamaged
$in_quit=$in_run=$in_net=$in_init; # perl -w is braindamaged
my %ignore_function = ();
......@@ -422,7 +430,7 @@ sub _croak($) {
sub AUTOLOAD {
my ($class,$name) = $AUTOLOAD =~ /^(.*)::(.*?)$/;
for(@{"${class}::PREFIXES"}) {
for(@{"$class\::PREFIXES"}) {
my $sub = $_.$name;
if (exists $ignore_function{$sub}) {
*{$AUTOLOAD} = sub { () };
......@@ -438,7 +446,7 @@ sub AUTOLOAD {
};
goto &$AUTOLOAD;
} elsif (UNIVERSAL::can($interface_pkg,$sub)) {
my $ref = \&{"${interface_pkg}::$sub"};
my $ref = \&{"$interface_pkg\::$sub"};
*{$AUTOLOAD} = sub {
shift unless ref $_[0];
# goto &$ref; # does not always work, PERLBUG! #FIXME
......@@ -469,10 +477,10 @@ sub AUTOLOAD {
sub _pseudoclass {
my ($class, @prefixes)= @_;
unshift(@prefixes,"");
*{"Gimp::${class}::AUTOLOAD"} = \&AUTOLOAD;
push(@{"${class}::ISA"} , "Gimp::${class}");
push(@{"Gimp::${class}::PREFIXES"} , @prefixes); @prefixes=@{"Gimp::${class}::PREFIXES"};
push(@{"${class}::PREFIXES"} , @prefixes); @prefixes=@{"${class}::PREFIXES"};
*{"Gimp::$class\::AUTOLOAD"} = \&AUTOLOAD;
push(@{"$class\::ISA"} , "Gimp::$class");
push(@{"Gimp::$class\::PREFIXES"} , @prefixes); @prefixes=@{"Gimp::$class\::PREFIXES"};
push(@{"$class\::PREFIXES"} , @prefixes); @prefixes=@{"$class\::PREFIXES"};
}
_pseudoclass qw(Layer gimp_layer_ gimp_drawable_ gimp_floating_sel_ gimp_image_ gimp_ plug_in_);
......
......@@ -40,6 +40,7 @@ sub import {
my $pkg = shift;
my $feature;
local $Gimp::in_query=1;
while(@_) {
$_=shift;
s/^://;
......@@ -91,21 +92,26 @@ sub present {
0;
} else {
require Gimp;
Gimp::logger(message => "unimplemented requirement '$_' (failed)", fatal => 1);
Gimp::logger(message => "unimplemented requirement '$_' (failed)");
0;
}
}
sub missing {
sub _missing {
my ($msg,$function)=@_;
require Gimp;
Gimp::logger(message => "$_[0] is required but not found", function => $function);
Gimp::initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit Gimp::quiet_main();
Gimp::initialized() ? &Gimp::quiet_die() : exit Gimp::quiet_main();
}
sub missing {
local $Gimp::in_query=1;
&_missing;
}
sub need {
my ($feature,$function)=@_;
missing($description{$feature},$function) unless present $feature;
_missing($description{$feature},$function) unless present $feature;
}
1;
......
......@@ -73,9 +73,9 @@ sub _gimp_procedure_available {
# this is hardcoded into gimp_call_procedure!
sub response {
my($len,$req);
read($server_fh,$len,4) == 4 or die "protocol error";
read($server_fh,$len,4) == 4 or die "protocol error (1)";
$len=unpack("N",$len);
read($server_fh,$req,$len) == $len or die "protocol error";
read($server_fh,$req,$len) == $len or die "protocol error (2)";
net2args($req);
}
......
......@@ -75,4 +75,7 @@ examples/font_table
examples/perlotine
examples/randomblends
examples/innerbevel
examples/fit-text
examples/guidegrid
examples/roundrectsel
......@@ -10,7 +10,7 @@ $|=1;
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 image_tile yinyang stamps font_table
perlotine randomblends innerbevel
perlotine randomblends innerbevel fit-text guidegrid roundrectsel
);
@shebang = (map("examples/$_",@examples),
qw(Perl-Server examples/example-net.pl examples/homepage-logo.pl
......@@ -288,6 +288,7 @@ clean mostlyclean objclean:
distclean maintainer-clean: clean
rm -f Makefile config.cache config.pl config.log config.h config.status stamp-h Makefile.old
rm -rf test-dir inst-temp
EOF
close MAKEFILE;
exit;
......
#!/usr/bin/perl
# <sjburges@gimp.org>
# This is adrian and xachs idea - take a rectangluar selection, and select
# font type and string. Then fill it with whatever size is needed.
use Gimp;
use Gimp::Fu;
use Gimp::Util;
# Gimp::set_trace(TRACE_ALL);
$defaultfont = "-*-blippo-heavy-r-normal-*-*-360-*-*-p-*-iso8859-1";
undef $defaultfont;
sub growfont {
($fontname, $plussize) = @_;
@fontdesc = split /-/, $fontname;
$fontdesc[8] += $plussize;
$outname = join "-", @fontdesc;
return $outname;
}
register "fit_text",
"Fit Text - fit text to a selection",
"Have a rectangular selection, and select the font type and spacing. It will fill the selection with text as closely as possible. If no selection is made prior to running, it will fill the entire image.",
"Seth Burgess",
"Seth Burgess <sjburges\@gimp.org>",
"1999-03-21",
"<Image>/Filters/Render/Fit Text",
"*",
[
[PF_FONT, "font", "What font type to use - size will be ignored", $defaultfont],
[PF_STRING, "string", "Text String to fill with", "Fit Text"],
],
[],
['gimp-1.1'],
sub {
my($img,$layer,$xlfd,$string) =@_;
($sel,$x1,$y1,$x2,$y2) = $img->gimp_selection_bounds;
$width = $x2-$x1;
$height = $y2-$y1;
@extents=gimp_text_get_extents_fontname($string,xlfd_size($xlfd),$xlfd);
$growsize = ($extents[0]<$width && $extents[1]<$height) ? 80 : -80;
if ($growsize > 0 ) {
while ($extents[0]<$width && $extents[1]<$height) {
$xlfd = growfont($xlfd,$growsize);
@extents=gimp_text_get_extents_fontname($string,xlfd_size($xlfd),$xlfd);
}
$xlfd = growfont($xlfd, -$growsize);
}
else {
while ($extents[0]>$width || $extents[1]>$height) {
$xlfd = growfont($xlfd,$growsize);
@extents=gimp_text_get_extents_fontname($string,xlfd_size($xlfd),$xlfd);
}
}
while ($extents[0]<$width && $extents[1]<$height) {
$xlfd = growfont($xlfd,10); # precision for the last bit
@extents=gimp_text_get_extents_fontname($string,xlfd_size($xlfd),$xlfd);
}
while ($extents[0]>$width || $extents[1]>$height) {
$xlfd = growfont($xlfd,-4);
@extents=gimp_text_get_extents_fontname($string,xlfd_size($xlfd),$xlfd);
}
# print $xlfd, "\n";
$tmplay = $layer->text_fontname($x1,$y1,$string,0,1,xlfd_size($xlfd), $xlfd);
$width2=$tmplay->width;
$height2=$tmplay->height;
# X returns crap, so fine tune it here.
# print "$width2, $height2:$width, $height\n";
while ($width2<$width && $height2<$height) {
$tmplay->remove;
$xlfd = growfont($xlfd,4);
$tmplay=$layer->text_fontname($x1,$y1,$string,0,1,xlfd_size($xlfd), $xlfd);
$width2=$tmplay->width;
$height2=$tmplay->height;
}
$tmplay->remove;
$xlfd = growfont($xlfd,-2);
$tmplay=$layer->text_fontname($x1,$y1,$string,0,1,xlfd_size($xlfd), $xlfd);
return();
};
exit main;
#!/usr/bin/perl
# <sjburges@gimp.org>
# This is adrian's idea - take random blends and difference them. You're
# bound to come up w/ something cool eventually.
use Gimp;
use Gimp::Fu;
use Gimp::Util;
# Gimp::set_trace(TRACE_ALL);
register "guide_grid",
"GuideGrid - creates a grid of guides\n",
"You specify the X spacing, the Y spacing, and initial offsets. It creates a grid of guides\n",
"Seth Burgess",
"Seth Burgess <sjburges\@gimp.org>",
"1999-03-20",
"<Image>/GuideGrid",
"*",
[
[PF_SPINNER, "x_spacing", "How far to space grid horizontally", 24, [1,1000,1]],
[PF_SPINNER, "y_spacing", "How far to space grid vertically", 24, [1,1000,1]],
[PF_SPINNER, "x_offset", "How much to initially offset it horizontally", 0, [0,1000,1]],
[PF_SPINNER, "y_offset", "How much to initially offset it vertically", 0, [0,1000,1]],
],
[],
['gimp-1.1'],
sub {
my($img,$layer,$xspace, $yspace, $xoffset, $yoffset) =@_;
for ($i=$xoffset; $i<$img->width; $i+=$xspace) {
if ($i) {
$img->add_vguide($i);
}
}
for ($i=$yoffset; $i<$img->height; $i+=$yspace) {
if ($i) {
$img->add_hguide($i);
}
}
return();
};
exit main;
......@@ -39,6 +39,9 @@ register $regname, $shortdesc, $longdesc, $authorname, $author, $date, $path, $i
[PF_SLIDER, "shinyness", "How shiny the final image will be",30, [0,90,5]],
[PF_SLIDER, "depth_shape", "Determines the final shape", 34 , [0,64,32]],
[PF_RADIO, "map", "The type of Map to use", 2, [Linear => 0, Spherical => 1, Sinusoidal => 2] ],
],[],
[
'gimp-1.1',
], sub {
my ($font, $text, $color1, $color2, $azimuth, $elevation, $depth, $maptype) = @_;
......
......@@ -24,7 +24,10 @@ register "random_blends",
"RGB*, GRAY*",
[
[PF_SPINNER, "number", "How many gradients to apply", 7, [1,255,1]],
], sub {
],
[],
['gimp-1.1'],
sub {
my($img,$layer,$numgradients) =@_;
eval { $img->undo_push_group_start }; # undo is broked for this one.
# add this to the get_state (after its working?)
......
#!/usr/bin/perl
# <sjburges@gimp.org>
# This is adrian's idea - take random blends and difference them. You're
# bound to come up w/ something cool eventually.
use Gimp;
use Gimp::Fu;
use Gimp::Util;
# Gimp::set_trace(TRACE_ALL);
register "round_rect_sel",
"Rounds a rectangular selection.",
"Rounds a rectangular selection. If no selection exists, it selects all first, then rounds that selection. If there exists a selection, but its non-rectangluar, it will be replaced by a rectangluar one.",
"Seth Burgess",
"Seth Burgess <sjburges\@gimp.org>",
"1999-03-25",
"<Image>/Select/Generate/Rounded Rectangluar Selection",
"*",
[
[PF_SPINNER, "x_rounding", "How much to round in the horizontal, in pixels", 16, [1,1000,1]],
[PF_SPINNER, "y_rounding", "How far to round the in vertical, in pixels", 16, [1,1000,1]],
], sub {
my($img,$layer,$x_round, $y_round) =@_;
eval { $img->undo_push_group_start };
@bounds = $img->selection_bounds;
# recreate the selection
$img->rect_select($bounds[1], $bounds[2], $bounds[3]-$bounds[1], $bounds[4]-$bounds[2], 0, 0, 0.5);
# cut out the corners
$img->rect_select($bounds[1], $bounds[2], $x_round/2, $y_round/2, 1, 0, 0.5);
$img->rect_select($bounds[3]-$x_round/2, $bounds[2], $x_round/2, $y_round/2, 1, 0, 0.5);
$img->rect_select($bounds[3]-$x_round/2, $bounds[4]-$y_round/2, $x_round/2, $y_round/2, 1, 0, 0.5);
$img->rect_select($bounds[1], $bounds[4]-$y_round/2, $x_round/2, $y_round/2, 1, 0, 0.5);
# add them back as elipses
$img->ellipse_select($bounds[1], $bounds[2], $x_round, $y_round, 0, 1, 0, 0.5);
$img->ellipse_select($bounds[3]-$x_round, $bounds[2], $x_round, $y_round, 0, 1, 0, 0.5);
$img->ellipse_select($bounds[3]-$x_round, $bounds[4]-$y_round, $x_round, $y_round, 0, 1, 0, 0.5);
$img->ellipse_select($bounds[1], $bounds[4]-$y_round, $x_round, $y_round, 0, 1, 0, 0.5);
eval { $img->undo_push_group_end };
return();
};
exit main;
......@@ -49,6 +49,7 @@ register
[ PF_SLIDER, "blur_amount", "Blur Amount", 10, [0,26,1]],
],
[],
['gimp-1.1'],
sub {
($img, $pattern, $solidnoise, $font, $text, $blur) = @_;
$oldbg = gimp_palette_get_background();
......
......@@ -40,7 +40,7 @@ Perl knows the length of arrays, Script-Fu doesn't. Functions returning
single arrays return them as a normal perl array, Functions returning
more then one array return it as an array-ref. Script-Fu (and the
converted script) expect to get a length argument and then the
arguments. Each occurence (common ones are C<gimp_list_images> or
arguments. Each occurrence (common ones are C<gimp_list_images> or
C<gimp_image_get_layers>) must be fixed by hand.
=head1 AUTHOR
......
......@@ -21,7 +21,7 @@ sub skip($$;$) {
}
END {
# system("rm","-rf",$dir);#d##FIXME#
system("rm","-rf",$dir);#d##FIXME#
}
use Cwd;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment