mirror of
https://gitlab.gnome.org/GNOME/gimp
synced 2024-10-21 03:52:33 +00:00
see plug-ins/perl/Changes
This commit is contained in:
Marc Lehmann
parent
60c9e73db5
commit
65c34b3fd1
|
|
@ -1,6 +1,12 @@
|
|||
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;
|
||||
|
|
|
|||
89
plug-ins/perl/examples/fit-text
Executable file
89
plug-ins/perl/examples/fit-text
Executable file
|
|
@ -0,0 +1,89 @@
|
|||
#!/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;
|
||||
45
plug-ins/perl/examples/guidegrid
Executable file
45
plug-ins/perl/examples/guidegrid
Executable file
|
|
@ -0,0 +1,45 @@
|
|||
#!/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?)
|
||||
|
|
|
|||
47
plug-ins/perl/examples/roundrectsel
Executable file
47
plug-ins/perl/examples/roundrectsel
Executable file
|
|
@ -0,0 +1,47 @@
|
|||
#!/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;
|
||||
|
|
|
|||
Loading…
Reference in a new issue