mirror of https://github.com/GNOME/gimp.git
see plug-ins/perl/Changes
This commit is contained in:
Marc Lehmann
parent
5be7e1d3e8
commit
365d68b850
|
|
@ -1,5 +1,6 @@
|
|||
Revision history for Gimp-Perl extension.
|
||||
|
||||
1.052 Tue Feb 9 18:16:15 CET 1999
|
||||
- moved the xlfd_size function from Gimp::Fu into Gimp
|
||||
(and maybe later into Gimp::Util?)
|
||||
- functions in Gimp::Util are now treated in the same way
|
||||
|
|
@ -9,6 +10,8 @@ Revision history for Gimp-Perl extension.
|
|||
- enabled full testsuite (keep your fingers crossed)
|
||||
- PDL examples no longer cause errors at startup
|
||||
- more compatibility fixes for 5.005_54
|
||||
- bangpaths are now replaced by $PERL at configuration time
|
||||
- fixed a few quirks in scm2scm and added it to the package
|
||||
|
||||
1.051 Tue Jan 19 21:10:20 CET 1999
|
||||
- corrected a minor typoe found by Stefan Traby <stefan@sime.com>
|
||||
|
|
|
|||
|
|
@ -174,7 +174,7 @@ sub import($;@) {
|
|||
} elsif ($_ ne "") {
|
||||
push(@export,$_);
|
||||
} elsif ($_ eq "") {
|
||||
#nop #d#FIXME
|
||||
#nop #d#FIXME, Perl-Server requires this!
|
||||
} else {
|
||||
croak "$_ is not a valid import tag for package $pkg";
|
||||
}
|
||||
|
|
@ -798,6 +798,8 @@ invocation.
|
|||
|
||||
write trace to FILEHANDLE instead of STDERR.
|
||||
|
||||
=back
|
||||
|
||||
=head1 SUPPORTED GIMP DATA TYPES
|
||||
|
||||
Gimp supports different data types like colors, regions, strings. In
|
||||
|
|
|
|||
|
|
@ -116,8 +116,9 @@ Some exmaples:
|
|||
|
||||
$region = $drawable->pixel_rgn (0,0, 100,100, 1,0);
|
||||
$pixel = $region->get_pixel (5,7); # fetches the pixel from (5|7)
|
||||
print $pixel;
|
||||
-> [255, 127, 0] # RGB format ;)
|
||||
print $pixel; # outputs something like
|
||||
# [255, 127, 0], i.e. in
|
||||
# RGB format ;)
|
||||
$region->set_pixel ($pixel * 0.5, 5, 7);# darken the pixel
|
||||
$rect = $region->get_rect (3,3,70,20); # get a horizontal stripe
|
||||
$rect = $rect->hclip(255/5)*5; # clip and multiply by 5
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
=head1 NAME
|
||||
|
||||
Gimp::Util - some handy routines for Gimp.Perl users
|
||||
Gimp::Util - some handy routines for Gimp-Perl users
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
|
|
@ -23,7 +23,7 @@ you end up with them and the user cannot see them or delete them. So we
|
|||
always attach our created layers to an image here, too avoid memory leaks
|
||||
and debugging times.
|
||||
|
||||
These functions preserve the current settings like colors.
|
||||
These functions try to preserve the current settings like colors.
|
||||
|
||||
Also: these functions are handled in exactly the same way as
|
||||
PDB-Functions, i.e. the (hypothetical) function C<gimp_image_xyzzy> can be
|
||||
|
|
@ -236,6 +236,8 @@ sub gimp_text_wh {
|
|||
|
||||
=pod
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Various, version 1.000 written mainly by Tels (http://bloodgate.com/). The author
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
scm2perl
|
||||
README
|
||||
NEWS
|
||||
Changes
|
||||
|
|
@ -12,6 +11,8 @@ Makefile.PL
|
|||
typemap
|
||||
Gimp.pm
|
||||
Gimp.xs
|
||||
scm2perl
|
||||
scm2scm
|
||||
t/load.t
|
||||
t/loadlib.t
|
||||
t/run.t
|
||||
|
|
|
|||
|
|
@ -4,13 +4,13 @@ use ExtUtils::MakeMaker;
|
|||
use Config;
|
||||
|
||||
$topdir=".";
|
||||
$|=1;
|
||||
|
||||
if ($ARGV[0] ne "--writemakefile") {
|
||||
for(@ARGV) {
|
||||
s/^prefix=/--prefix=/i;
|
||||
}
|
||||
|
||||
$|=1;
|
||||
do './config.pl';
|
||||
if(defined $EXTENSIVE_TESTS) {
|
||||
print "\nFetched some defaults from an earlier Makefile.PL run.\n";
|
||||
|
|
@ -53,28 +53,30 @@ $] >= 5.005 or print <<EOF;
|
|||
WARNING: you are using a version of perl older than 5.005. While this
|
||||
extension should run on older versions (and I try to keep source
|
||||
compatibility), some people get spurious errors that go away
|
||||
after upgrading to 5.005. Since 5.005 is much better and has many
|
||||
many bugs fixed, an upgrade wpuld come in handy...
|
||||
after upgrading to 5.005 (or to gimp-1.1). Therefore, some
|
||||
features of Gimp DO NOT WORK WITH 5.004 or gimp-1.0. Since 5.005
|
||||
is much better and has many many bugs fixed, an upgrade would
|
||||
come in handy...
|
||||
|
||||
EOF
|
||||
|
||||
$GTK or print <<EOF;
|
||||
|
||||
WARNING: unable to use the Perl-Gtk interface. Some features (like
|
||||
Gimp::Fu) rely on this extension. You can try to build without
|
||||
it, but it's better to install it (version 0.3 or higher is
|
||||
required, you can get it from ftp://ftp.gimp.org/pub/gtk/perl/ or
|
||||
any CPAN mirror.
|
||||
WARNING: unable to use the Perl-Gtk interface. Most features (like
|
||||
Gimp::Fu) rely on this extension. You can try to build without
|
||||
it (and many scripts won't work), but it's better to install
|
||||
it (version 0.3 or higher is required, you can get it from
|
||||
ftp://ftp.gimp.org/pub/gtk/perl/ or any CPAN mirror.
|
||||
|
||||
EOF
|
||||
|
||||
$PDL or print <<EOF;
|
||||
|
||||
WARNING: unable to use PDL (the perl data language). This means that
|
||||
Gimp::PDL is non-functional. Unless you plan to use Tile/PixelRgn
|
||||
functions together with PDL, this is harmless. Gimp::PDL will be
|
||||
installed, just in case you later install PDL. The plug-ins using
|
||||
PDL, however, will NOT BE INSTALLED. You can get PDL from any CPAN
|
||||
WARNING: unable to use PDL (the perl data language). This means that
|
||||
Gimp::PDL is non-functional. Unless you plan to use Tile/PixelRgn
|
||||
functions together with PDL, this is harmless. Gimp::PDL will
|
||||
be installed, just in case you later install PDL. The plug-ins
|
||||
using PDL, however, will NOT WORK. You can get PDL from any CPAN
|
||||
mirror.
|
||||
|
||||
EOF
|
||||
|
|
@ -112,6 +114,17 @@ 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);
|
||||
@shebang = (map("examples/$_",@examples),
|
||||
qw(Perl-Server scm2perl scm2scm examples/example-net.pl));
|
||||
|
||||
for(@shebang) {
|
||||
print "updating bangpath in $_\n";
|
||||
system ($PERL,"-pi","-e","\$. == 1 and \$_ = '#!$PERL\n'",$_);
|
||||
}
|
||||
|
||||
sub MY::postamble {
|
||||
(my $GIMPTOOL2 = $GIMPTOOL) =~ s/^\.\./..\/../;
|
||||
my $postamble=<<"EOF";
|
||||
|
|
@ -130,9 +143,7 @@ install :: install-plugins
|
|||
install-plugins:
|
||||
EOF
|
||||
|
||||
$postamble.join("",map " -cd examples && $GIMPTOOL2 --install-admin-bin $_\n",
|
||||
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));
|
||||
$postamble.join("",map " -cd examples && $GIMPTOOL2 --install-admin-bin $_\n", @examples);
|
||||
}
|
||||
|
||||
WriteMakefile(
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/perl
|
||||
#!/usr/app/bin/perl
|
||||
|
||||
#
|
||||
# you can enable unix sockets, tcp sockets, or both (or neither...)
|
||||
|
|
|
|||
|
|
@ -10,14 +10,15 @@ make test TEST_VERBOSE=1
|
|||
|
||||
bugs
|
||||
|
||||
* auto-edit shebang
|
||||
* only install plug-ins that really work
|
||||
[DONE] * auto-edit shebang
|
||||
[XXXX] * only install plug-ins that really work
|
||||
* perl_fu_webify in homepage-logo.pl
|
||||
* wait for working gimp_file_load (or do it myself?)
|
||||
* Gimp::import should croak on importing "garbage".
|
||||
[DONE] * Gimp::import should croak on importing "garbage".
|
||||
|
||||
important issues
|
||||
|
||||
* register dummy function to calm gimp down
|
||||
* gimp->object_id, drawable_object_id remove!
|
||||
* PF_CUSTOM
|
||||
* gimp_display_image
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/perl
|
||||
#!/usr/app/bin/perl
|
||||
|
||||
#BEGIN {$^W=1};
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/perl
|
||||
#!/usr/app/bin/perl
|
||||
|
||||
use Gimp qw( :auto );
|
||||
use Gimp::Fu;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/perl -w
|
||||
#!/usr/app/bin/perl
|
||||
|
||||
#BEGIN {$^W=1};
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/perl
|
||||
#!/usr/app/bin/perl
|
||||
|
||||
use strict 'subs';
|
||||
use Gimp;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/perl
|
||||
#!/usr/app/bin/perl
|
||||
|
||||
# example for the gimp-perl-server (also called Net-Server)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/perl
|
||||
#!/usr/app/bin/perl
|
||||
|
||||
use Gimp;
|
||||
use Gimp::Fu;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/local/bin/perl
|
||||
#!/usr/app/bin/perl
|
||||
######################################################################
|
||||
# A Perl::Fu plugin for converting TeX strings to floating layers.
|
||||
#
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/perl -w
|
||||
#!/usr/app/bin/perl
|
||||
|
||||
BEGIN { $^W=1 }
|
||||
use strict;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/perl -w
|
||||
#!/usr/app/bin/perl
|
||||
|
||||
use Gimp;
|
||||
use Gimp::Fu;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/perl
|
||||
#!/usr/app/bin/perl
|
||||
|
||||
# sent to me by Seth Burgess <sjburges@ou.edu>
|
||||
# small changes my Marc Lehmann <pcg@goof.com>
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/perl
|
||||
#!/usr/app/bin/perl
|
||||
|
||||
#require 5.005;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,280 @@
|
|||
#!/usr/app/bin/perl
|
||||
|
||||
#require 5.005;
|
||||
|
||||
# Copyright Marc Lehmann <pcg@goof.com>
|
||||
#
|
||||
# This is distributed under the GPL.
|
||||
|
||||
=cut
|
||||
|
||||
=head1 NAME
|
||||
|
||||
scm2scm - convert script-fu to script-fu
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
scm2scm [-d] [-t translation]... filename.scm...
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This perl-script can be used to upgrade existing script-fu-scripts to
|
||||
newer gimp API's.
|
||||
|
||||
=head1 EXAMPLES
|
||||
|
||||
Convert all script-fu scripts in the current directory from the
|
||||
1.0 to the current API:
|
||||
|
||||
scm2scm *.scm
|
||||
|
||||
Convert C<weird.scm> from the 1.0 api to the 1.2 api:
|
||||
|
||||
scm2scm -t 1.2 weird.scm
|
||||
|
||||
Generate a diff containing the required changes from the 1.0
|
||||
to the 1.1-API:
|
||||
|
||||
scm2scm -d -t 1.1 test.scm
|
||||
|
||||
=head1 SWITCHES
|
||||
|
||||
=over 4
|
||||
|
||||
=item -d
|
||||
|
||||
generate a unified diff on stdout
|
||||
|
||||
=item -t translation id
|
||||
|
||||
specify a translation id, can be one of (run scm2scm without arguments
|
||||
to see the full list)
|
||||
|
||||
I<api1> api-mega-break-patch #1
|
||||
|
||||
I<1.1> 1.0 -> 1.1 (not fully implemented)
|
||||
|
||||
I<1.2> 1.0 -> 1.2 (not fully implemented)
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Marc Lehmann <pcg@goof.com>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
gimp(1), L<Gimp>.
|
||||
|
||||
=cut
|
||||
|
||||
# drop the first argument, while preserving correct whitespace(!)
|
||||
sub drop_1st {
|
||||
my($a,$f,$t1,$t2,@t)=@_;
|
||||
($a,$f,new token($t1->[0],$t2->[1],$t2->[2]),@t);
|
||||
}
|
||||
|
||||
# every hash value consists of an array of specifications, each
|
||||
# one has the form ["regexp", codref_to_call], or a string (another translation
|
||||
# name)
|
||||
%translation = (
|
||||
'api1' =>
|
||||
[[
|
||||
"^(gimp-airbrush|gimp-blend|gimp-brightness-contrast|gimp-bucket-fill|".
|
||||
"gimp-by-color-select|gimp-channel-ops-offset|gimp-clone|gimp-color-balance|".
|
||||
"gimp-color-picker|gimp-convolve|gimp-curves-explicit|gimp-curves-spline|".
|
||||
"gimp-desaturate|gimp-edit-clear|gimp-edit-copy|gimp-edit-cut|gimp-edit-fill|".
|
||||
"gimp-edit-paste|gimp-edit-stroke|gimp-equalize|gimp-eraser|".
|
||||
"gimp-eraser-extended|gimp-flip|gimp-fuzzy-select|gimp-histogram|".
|
||||
"gimp-hue-saturation|gimp-invert|gimp-levels|gimp-paintbrush|".
|
||||
"gimp-paintbrush-extended|gimp-pencil|gimp-perspective|gimp-posterize|".
|
||||
"gimp-rotate|gimp-scale|gimp-selection-float|gimp-selection-layer-alpha|".
|
||||
"gimp-selection-load|gimp-shear|gimp-threshold)\$",
|
||||
\&drop_1st
|
||||
]],
|
||||
'1.1' => ['api1'],
|
||||
'1.2' => ['api1'],
|
||||
);
|
||||
|
||||
$gen_diff=0;
|
||||
@trans = ();
|
||||
|
||||
package token;
|
||||
|
||||
sub new {
|
||||
my $type = shift;
|
||||
bless [@_],$type;
|
||||
}
|
||||
|
||||
package main;
|
||||
|
||||
my $stream; # the stream to tokenize from
|
||||
my $word; # the current token-word
|
||||
my $tok; # current token
|
||||
|
||||
# parses a new token [ws, tok, ws]
|
||||
sub get() {
|
||||
my $ws1,$ws1,$ctok;
|
||||
# could be wrapped into one regex
|
||||
$ws1 = $stream=~s/^((?:\s*(?:(;[^\n]*\n))?)*)// ? $1 : die;
|
||||
$ctk = $stream=~s/^(\(
|
||||
|\)
|
||||
|"(?:[^"]+|\\")*"
|
||||
|'(?:[^()]+)
|
||||
|[^ \t\r\n()]+
|
||||
)
|
||||
(?:[ \t]*(?=\n))?//x ? $1 : undef;
|
||||
$ws2 = $stream=~s/^([ \t]*;[^\n]*\n)// ? $1 : "";
|
||||
$word=$ctk;
|
||||
|
||||
# print "TOKEN:$ws1:$ctk:$ws2\n";
|
||||
$tok=new token($ws1,$ctk,$ws2);
|
||||
}
|
||||
|
||||
# returns a parse tree, which is an array
|
||||
# of [token, token...] refs.
|
||||
sub parse() {
|
||||
my @toks;
|
||||
$depth++;
|
||||
for(;;) {
|
||||
# print "$depth: $word\n";
|
||||
if ($word eq "(") {
|
||||
my $t = $tok; get;
|
||||
my @t = &parse;
|
||||
$word eq ")" or die "missing right paranthese (got $word)\n";
|
||||
push(@toks,[$t,@t,$tok]); get;
|
||||
} elsif ($word eq ")") {
|
||||
$depth--;
|
||||
return @toks;
|
||||
} elsif (!defined $word) {
|
||||
$depth--;
|
||||
return @toks;
|
||||
} else {
|
||||
push(@toks,$tok);
|
||||
get;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub parse_scheme {
|
||||
get;
|
||||
my @t = parse;
|
||||
(@t,$tok);
|
||||
}
|
||||
|
||||
# dumb dump of the tree structure
|
||||
sub dump_tree {
|
||||
my $d=shift;
|
||||
print "$d",scalar@_;
|
||||
for(@_) {
|
||||
if (isa($_,token)) {
|
||||
print " [$_->[1]]";
|
||||
} else {
|
||||
print " *";
|
||||
}
|
||||
}
|
||||
print "\n";
|
||||
for(@_) {
|
||||
if(!isa($_,token)) {
|
||||
dump_tree ("$d ",@$_);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub toks2scheme {
|
||||
my $func = shift;
|
||||
if ($func->[1] eq "(") {
|
||||
my $close = shift;
|
||||
# func2scheme @_;
|
||||
} else {
|
||||
}
|
||||
while(@_) {
|
||||
my @toks = shift;
|
||||
my ($ws1,$t,$ws1)=$toks[0]
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub tree2scheme {
|
||||
join ("",map isa($_,token) ? @$_ : tree2scheme(@$_),@_);
|
||||
}
|
||||
|
||||
# translate functions, sorry folks, this function is write-only!
|
||||
sub translate {
|
||||
my $v=shift;
|
||||
my @t=@_;
|
||||
if (isa($t[0],token)) {
|
||||
for(@$v) {
|
||||
if ($t[1][1] =~ $_->[0]) {
|
||||
@t=$_->[1]->(@t);
|
||||
}
|
||||
}
|
||||
}
|
||||
for(@t) {
|
||||
$_=[translate($v,@$_)] unless isa($_,token);
|
||||
}
|
||||
@t;
|
||||
}
|
||||
|
||||
sub dofile {
|
||||
my($in,$out)=@_;
|
||||
|
||||
open IN,"$in" or die "unable to open '$in' for reading: $!";
|
||||
{ local $/; $stream = <IN> }
|
||||
close IN;
|
||||
|
||||
my @prog = parse_scheme;
|
||||
|
||||
if (@trans) {
|
||||
my $changed;
|
||||
do {
|
||||
$changed=0;
|
||||
@trans = map {
|
||||
if (!ref $_) {
|
||||
$changed=1;
|
||||
@{$translation{$_}};
|
||||
} else {
|
||||
$_;
|
||||
}
|
||||
} @trans;
|
||||
} while($changed);
|
||||
@prog = translate ([@trans],@prog);
|
||||
}
|
||||
|
||||
open OUT,"$out" or die "unable to open '$out' for writing: $!";
|
||||
print OUT tree2scheme(@prog);
|
||||
close OUT;
|
||||
}
|
||||
|
||||
*isa = \&UNIVERSAL::isa;
|
||||
|
||||
sub usage {
|
||||
print STDERR "Script-Fu to Script-Fu Translater 1.1\n";
|
||||
print STDERR "Usage: $0 [-d] [-t translation] file.scm ...\n";
|
||||
print STDERR "available translations are: @{[keys %translation]}\n";
|
||||
exit(1);
|
||||
}
|
||||
|
||||
while($ARGV[0]=~/^-(.)$/) {
|
||||
shift;
|
||||
if ($1 eq "d") {
|
||||
$gen_diff=1;
|
||||
} elsif ($1 eq "t") {
|
||||
push(@trans,shift);
|
||||
} else {
|
||||
print STDERR "unknown switch '$1'\n";
|
||||
}
|
||||
}
|
||||
@ARGV or usage;
|
||||
|
||||
for $x (@ARGV) {
|
||||
my $y;
|
||||
if ($gen_diff) {
|
||||
$y="| echo Index: '$x' && diff -u '$x' -";
|
||||
} else {
|
||||
($y=$x)=~s/\.scm/.sc2/i or die "source file '$x' has no .scm extension";
|
||||
$y=">$y\0";
|
||||
}
|
||||
dofile("<$x\0",$y);
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue