dnrops
/
gimp
mirror of https://github.com/GNOME/gimp.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

see plug-ins/perl/Changes

This commit is contained in:
Marc Lehmann 1998-11-13 20:07:45 +00:00
parent 5267f6014f
commit 84352d4079
12 changed files with 131 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
plug-ins/perl/Changes
View File

@ -1,5 +1,16 @@
Revision history for Gimp-Perl extension.
1.048 Fri Nov 13 20:39:52 CET 1998
- Gimp::Fu::save_image now correctly respects the quality setting
- allow layers/channels as drawables in typemap
- allow usage of Gimp::PDL via Gimp::Net (this is a hack!)
- added optional argument to gimp_init
- fixed some of the example scripts for the "mega-api-break-it-all-
patch"
- added Gimp::Net::get_connection and set_connection functions
- the Perl-Server now respects GIMP_HOST and opens a socket
according to its content.
1.047 Wed Nov 11 02:47:12 CET 1998
- passing arguments on the commandline works again
(formerly all arguments were treated as integers)

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

@ -12,7 +12,7 @@ use base qw(DynaLoader);
require DynaLoader;
$VERSION = 1.047;
$VERSION = 1.048;
@_param = qw(
PARAM_BOUNDARY PARAM_CHANNEL PARAM_COLOR PARAM_DISPLAY PARAM_DRAWABLE
@ -583,7 +583,7 @@ speak for you), or just plain interesting functions.
Should be called immediately when perl is initialized. Arguments are not yet
supported. Initializations can later be done in the init function.
=item init(), end (), gimp_init(), gimp_end()
=item Gimp::init([connection-argument]), Gimp::end()
These is an alternative and experimental interface that replaces the call to
gimp_main and the net callback. At the moment it only works for the Net
@ -595,6 +595,9 @@ interface (L<Gimp::Net>), and not as a native plug-in. Here's an example:
<do something with the gimp>
Gimp::end;
The optional argument to init has the same format as the GIMP_HOST variable
described in L<Gimp::Net>.
=item Gimp::lock(), Gimp::unlock()
These functions can be used to gain exclusive access to the Gimp. After

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

@ -865,7 +865,7 @@ sub save_image($$) {
$interlace=$1 eq "+", next if s/^([-+])[iI]//;
$flatten=$1 eq "+", next if s/^([-+])[fF]//;
$smooth=$1 eq "+", next if s/^([-+])[sS]//;
$quality=$1, next if s/^-[qQ](\d+)//;
$quality=$1*0.01, next if s/^-[qQ](\d+)//;
$compress=$1, next if s/^-[cC](\d+)//;
croak "$_: unknown/illegal file-save option";
}

59
plug-ins/perl/Gimp/Net.pm
View File

@ -138,6 +138,7 @@ sub start_server {
return $server_fh;
} elsif ($gimp_pid == 0) {
close $server_fh;
delete $ENV{GIMP_HOST};
unless ($Gimp::verbose) {
open STDOUT,">/dev/null";
open STDERR,">&1";
@ -148,6 +149,7 @@ sub start_server {
fileno(GIMP_FH);
exec "gimp","-n","-b","(extension-perl-server $args)",
"(extension_perl_server $args)";
exit(255);
} else {
croak "unable to fork: $!";
}
@ -177,7 +179,9 @@ sub try_connect {
}
sub gimp_init {
if (defined($Gimp::host)) {
if (@_) {
$server_fh = try_connect ($_[0]);
} elsif (defined($Gimp::host)) {
$server_fh = try_connect ($Gimp::host);
} elsif (defined($ENV{GIMP_HOST})) {
$server_fh = try_connect ($ENV{GIMP_HOST});
@ -222,10 +226,28 @@ sub gimp_main {
return 0;
}
sub get_connection() {
[$server_fh,$gimp_pid];
}
sub set_connection($) {
($server_fh,$gimp_pid)=@$_;
}
END {
gimp_end;
}
# provide some functions for the Gimp::PDL module to override
# this is yet another hack (YAH)
for my $f (qw(gimp_pixel_rgn_get_pixel gimp_pixel_rgn_get_row gimp_pixel_rgn_get_col gimp_pixel_rgn_get_rect
gimp_pixel_rgn_set_pixel gimp_pixel_rgn_set_row gimp_pixel_rgn_set_col gimp_pixel_rgn_set_rect)) {
no strict;
*{$f} = sub {
gimp_call_procedure $f,@_;
};
}
1;
__END__
@ -248,11 +270,13 @@ then it is probably installed.
The Perl-Server can either be started from the C<<Xtns>> menu in Gimp, or automatically
when a perl script can't find a running Perl-Server.
When started from within The Gimp, the Perl-Server will create a
unix domain socket to which local clients can connect. If an authorization
password is given to the Perl-Server (by defining the environment variable
C<GIMP_HOST> before starting The Gimp), it will also listen on a tcp port
(default 10009).
When started from within The Gimp, the Perl-Server will create a unix domain
socket to which local clients can connect. If an authorization password is
given to the Perl-Server (by defining the environment variable C<GIMP_HOST>
before starting The Gimp), it will also listen on a tcp port (default
10009). Since the password is transmitted in cleartext, using the Perl-Server
over tcp effectively B<lowers the security of your network to the level of
telnet>.
=head1 ENVIRONMENT
@ -275,20 +299,37 @@ and spawn/ for a private gimp instance. Examples are:
=head1 CALLBACKS
net()
=over 4
=item net()
is called after we have succesfully connected to the server. Do your dirty
work in this function, or see L<Gimp::Fu> for a better solution.
=back
=head1 FUNCTIONS
server_quit()
=over 4
=item server_quit()
sends the perl server a quit command.
=item get_connection()
return a connection id which uniquely identifies the current connection.
=item set_connection(conn_id)
set the connection to use on subsequent commands. C<conn_id> is the
connection id as returned by get_connection().
=back
=head1 BUGS
(Ver 0.04..) This module is much faster than it ought to be... Silly that I wondered
(Ver 0.04) This module is much faster than it ought to be... Silly that I wondered
wether I should implement it in perl or C, since perl is soo fast.
=head1 AUTHOR

48
plug-ins/perl/Perl-Server
View File

@ -209,7 +209,8 @@ sub extension_perl_server {
$ps_flags=0;
}
$auth = $ENV{'GIMP_HOST'}=~s/^(.*)\@// ? $1 : undef; # get authorization
my $host = $ENV{'GIMP_HOST'};
$auth = $host=~s/^(.*)\@// ? $1 : undef; # get authorization
slog "server version $Gimp::VERSION started".($auth ? ", authorization required" : "");
@ -217,21 +218,40 @@ sub extension_perl_server {
my($unix_path)=$Gimp::Net::default_unix_dir.$Gimp::Net::default_unix_sock;
my(%handles,$r,$fh,$f);
if ($use_unix) {
unlink $unix_path;
rmdir $Gimp::Net::default_unix_dir;
mkdir $Gimp::Net::default_unix_dir,0700 or die "$!";
$unix = new IO::Socket::UNIX (Local => $unix_path, Listen => 5) or die "$!";
slog "accepting connections on $unix_path";
vec($rm,$unix->fileno,1)=1;
}
if ($use_tcp && $auth) {
$tcp = new IO::Socket::INET (LocalPort => $Gimp::Net::default_tcp_port, Listen => 5,
Reuse => 1) or die "$!";
slog "accepting connections on port $Gimp::Net::default_tcp_port";
vec($rm,$tcp->fileno,1)=1;
if ($host ne "") {
if ($host=~s{^spawn/}{}) {
die "invalid GIMP_HOST: 'spawn' is not a valid connection method for the server";
} elsif ($host=~s{^unix/}{/}) {
$unix = new IO::Socket::UNIX (Local => $host, Listen => 5) or die "$!";
slog "accepting connections in $host";
vec($rm,$unix->fileno,1)=1;
} else {
$host=~s{^tcp/}{};
my($host,$port)=split /:/,$host;
$port=$Gimp::Net::default_tcp_port unless $port;
$tcp = new IO::Socket::INET (LocalPort => $port, Listen => 5, Reuse => 1) or die "$!";
slog "accepting connections on port $port";
vec($rm,$tcp->fileno,1)=1;
};
} else {
if ($use_unix) {
unlink $unix_path;
rmdir $Gimp::Net::default_unix_dir;
mkdir $Gimp::Net::default_unix_dir,0700 or die "$!";
$unix = new IO::Socket::UNIX (Local => $unix_path, Listen => 5) or die "$!";
slog "accepting connections on $unix_path";
vec($rm,$unix->fileno,1)=1;
}
if ($use_tcp && $auth) {
$tcp = new IO::Socket::INET (LocalPort => $Gimp::Net::default_tcp_port, Listen => 5,
Reuse => 1) or die "$!";
slog "accepting connections on port $Gimp::Net::default_tcp_port";
vec($rm,$tcp->fileno,1)=1;
}
}
!$tcp || $auth or die "authorization required for tcp connections";
sub new_connection {
my $fh = shift;
$fh->autoflush (1); # for compatibility with old perls..

4
plug-ins/perl/examples/border.pl
View File

@ -14,8 +14,8 @@ register "border_average",
"calulcates the average border colour",
"Marc Lehmann",
"Marc Lehmann",
"0.1",
"<Image>/Filter/Misc/Border Average",
"0.2",
"<Image>/Filters/Misc/Border Average",
"RGB",
[
[PF_INT32, "thickness", "Border size to take in count", 10],

2
plug-ins/perl/examples/example-fu.pl
View File

@ -34,7 +34,7 @@ register "my_first_gimp_fu", # fill in name
my $img=new Image($width,$height,RGB);
my $l=new Layer($img,$width,$height,RGB,"Background",100,NORMAL_MODE);
$img->add_layer($l,-1);
$l->add_layer(-1);
Palette->set_foreground($fg) unless $ignore;
Palette->set_background($bg) unless $ignore;

4
plug-ins/perl/examples/example-net.pl
View File

@ -12,13 +12,13 @@ sub net {
$bg=$img->layer_new(30,20,RGB_IMAGE,"Background",100,NORMAL_MODE);
$img->add_layer($bg,1);
$bg->add_layer(1);
new Gimp::Display($img);
for $i (0..255) {
Palette->set_background([$i,255-$i,$i]);
$img->edit_fill ($bg);
$bg->edit_fill;
Display->displays_flush ();
}

16
plug-ins/perl/examples/homepage-logo.pl
View File

@ -4,6 +4,8 @@
# save it as an indexed gif in /tmp/x.gif
# it works as plug-in as well as standalone!
# this script is old (its the first script ever written for gimp-perl)
# and I had no time to fix it yet.
use Gimp;
@ -59,11 +61,11 @@ sub write_logo {
set_bg($blend2);
# blend the background
gimp_blend($img,$bg,FG_BG_HSV,NORMAL_MODE,LINEAR,100,0,
gimp_blend($bg,FG_BG_HSV,NORMAL_MODE,LINEAR,100,0,
REPEAT_NONE,0,0,0,
0,0,$w*0.9,$h);
gimp_rect_select ($img,$w*0.92,0,$w,$h,REPLACE, 0, 0);
gimp_blend($img,$bg,FG_BG_HSV,NORMAL_MODE,LINEAR,100,0,
gimp_blend($bg,FG_BG_HSV,NORMAL_MODE,LINEAR,100,0,
REPEAT_NONE,0,0,0,
$w,0,$w*0.92,0);
gimp_selection_all($img);
@ -76,19 +78,19 @@ sub write_logo {
my ($shadow) = gimp_layer_copy ($text, 0);
plug_in_gauss_rle (RUN_NONINTERACTIVE, $img, $text, 1, 1, 1) unless $active;
plug_in_gauss_rle ($text, 1, 1, 1) unless $active;
gimp_image_add_layer ($img,$shadow,1);
gimp_shear ($img,$shadow,1,HORIZONTAL,-$th);
gimp_shear ($shadow,1,HORIZONTAL,-$th);
gimp_layer_scale ($shadow, $tw, $th*0.3, 1);
gimp_layer_translate ($shadow, $th*0.1, $th*0.3);
plug_in_gauss_rle (RUN_NONINTERACTIVE, $img, $shadow, 1, 1, 1);
plug_in_gauss_rle ($shadow, 1, 1, 1);
gimp_hue_saturation($img, $bg, ALL_HUES, 0, 0, $active ? 10 : -40);
plug_in_nova (RUN_NONINTERACTIVE, $img, $bg, $h*0.4, $h*0.5, '#f0a020', 5, 50) if $active;
plug_in_nova (RUN_NONINTERACTIVE, $img, $bg, $w-$h*0.4, $h*0.5, '#f0a020', 5, 50) if $active;
plug_in_nova ($bg, $h*0.4, $h*0.5, '#f0a020', 5, 50) if $active;
plug_in_nova ($bg, $w-$h*0.4, $h*0.5, '#f0a020', 5, 50) if $active;
# add an under construction sign
if ($uc) {

6
plug-ins/perl/examples/prep4gif.pl
View File

@ -61,17 +61,17 @@ sub prep {
my $layer_mask = gimp_layer_create_mask($foreground,2);
gimp_image_add_layer_mask ($out, $foreground, $layer_mask);
gimp_threshold($out,$layer_mask,$threshold,255);
gimp_threshold($layer_mask,$threshold,255);
# Transfer layer mask to selection, and grow the selection
gimp_selection_layer_alpha($out, $foreground);
gimp_selection_layer_alpha($foreground);
gimp_selection_grow($out,$growth);
# Apply this selection to the background
gimp_layer_set_visible($bottomlayer, 1);
gimp_image_set_active_layer($out, $bottomlayer);
gimp_selection_invert($out);
gimp_edit_cut($out, $bottomlayer);
gimp_edit_cut($bottomlayer);
# Clean up after yourself
gimp_image_remove_layer_mask($out, $foreground, 1);

18
plug-ins/perl/examples/tex-to-float
View File

@ -3,7 +3,7 @@
# A Perl::Fu plugin for converting TeX strings to floating layers.
#
# Author: Dov Grobgeld
# Version: 0.11
# Version: 0.12
######################################################################
use Gimp;
@ -109,20 +109,20 @@ sub grey_file_to_float {
# Create an alpha layer and copy image to alpha layer
gimp_layer_add_alpha($grey_layer);
$grey_img->selection_all();
gimp_edit_copy($grey_img,$grey_layer);
gimp_edit_copy($grey_layer);
$mask = gimp_layer_create_mask($grey_layer, 0);
gimp_image_add_layer_mask($grey_img, $grey_layer, $mask);
my $floating_layer = gimp_edit_paste($grey_img, $mask, 0);
my $floating_layer = gimp_edit_paste($mask, 0);
gimp_floating_sel_anchor($floating_layer);
gimp_invert($grey_img, $mask);
gimp_invert($mask);
gimp_palette_set_background(gimp_palette_get_foreground());
gimp_edit_fill($grey_img, $grey_layer);
gimp_edit_fill($grey_layer);
gimp_image_remove_layer_mask($grey_img, $grey_layer, 0);
# Now copy this layer to $img 1
gimp_edit_copy($grey_img, $grey_layer);
$floating_layer = gimp_edit_paste($img1, $drw1, 0);
gimp_edit_fill($img1, $floating_layer);
gimp_edit_copy($grey_layer);
$floating_layer = gimp_edit_paste($drw1, 0);
gimp_edit_fill($floating_layer);
print STDERR "Yohoo!\n";
cleanup();
@ -162,7 +162,7 @@ sub tex_string_to_float {
# register the script
register "tex_string_to_float", "Turn a TeX-string into floating layer", "Takes a TeX string as input and creates a floating layer of the rendered string in the current layer in the foreground color.",
"Dov Grobgeld <dov\@imagic.weizmann.ac.il>", "Dov Grobgeld",
"1998-11-02",
"1998-11-03",
"<Image>/Perl-Fu/TeX String",
"*",
[

5
plug-ins/perl/typemap
View File

@ -24,7 +24,7 @@ IMAGE T_PREF
LAYER T_PREF
COLOR T_PREF
CHANNEL T_PREF
DRAWABLE T_PREF
DRAWABLE T_PREF_ANY
DISPLAY T_PREF
REGION T_PREF
@ -33,6 +33,9 @@ INPUT
T_PREF
$var = unbless ($arg, PKG_$ntype, 0)
T_PREF_ANY
$var = unbless ($arg, PKG_ANY, 0)
T_GDRAWABLE
$var = old_gdrawable ($arg)