mirror of
https://gitlab.gnome.org/GNOME/gimp
synced 2024-10-21 20:12:30 +00:00
see plug-ins/perl/Changes
This commit is contained in:
Marc Lehmann
parent
5267f6014f
commit
84352d4079
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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";
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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..
|
||||
|
|
|
|||
|
|
@ -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],
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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 ();
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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) {
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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",
|
||||
"*",
|
||||
[
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue