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 1999-05-11 16:47:02 +00:00
parent 101de6b47b
commit 487b581039
9 changed files with 166 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
plug-ins/perl/Changes
View File

@ -8,6 +8,10 @@ Revision history for Gimp-Perl extension.
- gimp_text_fontname etc.. are now available in gimp-1.0 as well,
re-enabled the scripts using it (and depending on 1.1 before).
- allow negative "INT32's".
- added examples/randomart1, the plug-in used in my iX article.
- commandline switch printing improved a bit.
- removed IO::Socket::* dependency from Perl-Server. Was tooo slow.
- fixed uninitialized memory error.
1.081 Thu May 6 19:33:37 CEST 1999
- added "oneliners".

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

@ -266,6 +266,14 @@ sub canonicalize_colour {
*canonicalize_color = \&canonicalize_colour;
($basename = $0) =~ s/^.*[\\\/]//;
# extra check for Gimp::Feature::import
$in_query=0 unless defined $in_query; # perl -w is SOOO braindamaged
$in_quit=$in_run=$in_net=$in_init=0; # perl -w is braindamaged
$verbose=0;
$interface_type = "net";
if (@ARGV) {
if ($ARGV[0] eq "-gimp") {
@ -439,13 +447,6 @@ for(qw(_gimp_procedure_available gimp_call_procedure set_trace initialized)) {
*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; # perl -w is braindamaged
my %ignore_function = ();
@PREFIXES=("gimp_", "");

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

@ -1098,7 +1098,7 @@ sub print_switches {
for(@{$this->[8]}) {
my $type=$pf_type2string{$_->[0]};
my $key=mangle_key($_->[1]);
printf " -%-25s %s\n","$key $type",$_->[2];
printf " -%-25s %s%s\n","$key $type",$_->[2],defined $_->[3] ? " [$_->[3]]" : "";
}
}
@ -1108,13 +1108,14 @@ sub main {
my $this=this_script;
print <<EOF;
interface-arguments are
-o | --output <filespec> write image to disk, then delete
-o | --output <filespec> write image to disk, don't display
-i | --interact let the user edit the values first
script-arguments are
EOF
print_switches ($this);
} else {
Gimp::main;
}
Gimp::main;
};
sub logo {

4
plug-ins/perl/Gimp/Lib.xs
View File

@ -1253,7 +1253,7 @@ gimp_call_procedure (proc_name, ...)
g_free (proc_date);
if (nparams)
args = (GParam *) g_new (GParam, nparams);
args = (GParam *) g_new0 (GParam, nparams);
for(;items;)
{
@ -1293,7 +1293,7 @@ gimp_call_procedure (proc_name, ...)
/* very costly, do better! */
no_runmode = 2;
destroy_params (args, nparams);
args = (GParam *) g_new (GParam, nparams);
args = (GParam *) g_new0 (GParam, nparams);
}
if (trace & TRACE_CALL)

2
plug-ins/perl/MANIFEST
View File

@ -92,4 +92,4 @@ examples/triangle
examples/billboard
examples/mirrorsplit
examples/oneliners
examples/randomart1

2
plug-ins/perl/Makefile.PL
View File

@ -11,7 +11,7 @@ $|=1;
sethspin.pl animate_cells image_tile yinyang stamps font_table
perlotine randomblends innerbevel fit-text guidegrid roundrectsel
repdup centerguide stampify goldenmean triangle billboard mirrorsplit
oneliners
oneliners randomart1
);
@shebang = (map("examples/$_",@examples),
qw(Perl-Server examples/example-net.pl examples/homepage-logo.pl

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

@ -9,8 +9,7 @@
$use_unix = 1;
$use_tcp = 1; # tcp is enabled only when authorization is available
use IO::Handle;
use IO::Socket;
use Socket;
use strict;
use vars qw($use_unix $use_tcp $trace_res $server_quit $max_pkt $unix $tcp $ps_flags
@ -104,12 +103,19 @@ sub handle_request($) {
my($fh)=@_;
my($length,$req,$data,@args,$trace_level);
$fh->timeout(6) unless $ps_flags & &Gimp::_PS_FLAG_BATCH;
$fh->read($length,4) == 4 or return 0;
$length=unpack("N",$length);
$length>0 && $length<$max_pkt or return 0;
$fh->read($req,4) == 4 or return 0;
$fh->read($data,$length-4) == $length-4 or return 0;
eval {
local $SIG{ALRM}=sub { die "\n" };
#alarm(6) unless $ps_flags & &Gimp::_PS_FLAG_BATCH;
read($fh,$length,4) == 4 or die "\n";
$length=unpack("N",$length);
$length>0 && $length<$max_pkt or die "\n";
#alarm(6) unless $ps_flags & &Gimp::_PS_FLAG_BATCH;
read($fh,$req,4) == 4 or die "\n";
#alarm(20) unless $ps_flags & &Gimp::_PS_FLAG_BATCH;
read($fh,$data,$length-4) == $length-4 or die "\n";
#alarm(0);
};
return 0 if $@;
if(!$auth or $authorized[fileno($fh)]) {
if($req eq "EXEC") {
@ -191,9 +197,9 @@ sub extension_perl_server {
if ($run_mode == &Gimp::RUN_NONINTERACTIVE) {
if ($ps_flags & &Gimp::_PS_FLAG_BATCH) {
my($fh)=new_from_fd IO::Handle $extra,"r+";
$fh or die "unable to open Gimp::Net communications socket\n";
$fh->autoflush(1); # compatibility for old perls
my($fh) = local *FH;
open $fh,"+<&$extra" or die "unable to open Gimp::Net communications socket\n";
select $fh; $|=1; select STDOUT;
reply $fh,"PERL-SERVER",$Gimp::_PROT_VERSION;
while(!$server_quit and !eof($fh)) {
last unless handle_request($fh);
@ -222,31 +228,48 @@ sub extension_perl_server {
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 "$!";
$unix = local *FH;
socket($unix,AF_UNIX,SOCK_STREAM,PF_UNSPEC)
&& bind($unix,sockaddr_un $host)
&& listen($unix,5)
or die "unable to create listening unix socket: $!\n";
slog "accepting connections in $host";
vec($rm,$unix->fileno,1)=1;
vec($rm,fileno($unix),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 "$!";
$tcp = local *FH;
socket($tcp,PF_INET,SOCK_STREAM,scalar getprotobyname('tcp') || 6)
&& bind($tcp,sockaddr_in $port,INADDR_ANY)
&& setsockopt($tcp,SOL_SOCKET,SO_REUSEADDR,1)
&& listen($tcp,5)
or die "unable to create listening tcp socket: $!\n";
slog "accepting connections on port $port";
vec($rm,$tcp->fileno,1)=1;
};
vec($rm,fileno($tcp),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 "$!";
$unix = local *FH;
socket($unix,AF_UNIX,SOCK_STREAM,PF_UNSPEC)
&& bind($unix,sockaddr_un $unix_path)
&& listen($unix,5)
or die "unable to create listening unix socket: $!\n";
slog "accepting connections on $unix_path";
vec($rm,$unix->fileno,1)=1;
vec($rm,fileno($unix),1)=1;
}
if ($use_tcp && $auth) {
$tcp = new IO::Socket::INET (LocalPort => $Gimp::Net::default_tcp_port, Listen => 5,
Reuse => 1) or die "$!";
$tcp = local *FH;
socket($tcp,PF_INET,SOCK_STREAM,scalar getprotobyname('tcp') || 6)
&& bind($tcp,sockaddr_in $Gimp::Net::default_tcp_port,INADDR_ANY)
&& setsockopt($tcp,SOL_SOCKET,SO_REUSEADDR,1)
&& listen($tcp,5)
or die "unable to create listening tcp socket: $!\n";
slog "accepting connections on port $Gimp::Net::default_tcp_port";
vec($rm,$tcp->fileno,1)=1;
vec($rm,fileno($tcp),1)=1;
}
}
@ -254,23 +277,26 @@ sub extension_perl_server {
sub new_connection {
my $fh = shift;
$fh->autoflush (1); # for compatibility with old perls..
select $fh; $|=1; select STDOUT;
$handles{fileno($fh)}=$fh;
my @r = ("PERL-SERVER",$Gimp::_PROT_VERSION);
push(@r,"AUTH") if $auth;
reply $fh,@r;
vec($rm,$fh->fileno,1)=1;
vec($rm,fileno($fh),1)=1;
}
while(!$server_quit) {
if(select($r=$rm,undef,undef,undef)>0) {
if ($tcp && vec($r,$tcp->fileno,1)) {
my $h=$tcp->accept;
if ($tcp && vec($r,fileno($tcp),1)) {
my $h = local *FH;
my ($port,$host) = sockaddr_in (accept ($h,$tcp)) or die "unable to accept tcp connection: $!\n";
new_connection($h);
slog("accepted tcp connection from ",$h->peerhost);
slog "accepted tcp connection from ",inet_ntoa($host),":$port";
}
if ($unix && vec($r,$unix->fileno,1)) {
new_connection($unix->accept);
if ($unix && vec($r,fileno($unix),1)) {
my $h = local *FH;
accept ($h,$unix) or die "unable to accept unix connection: $!\n";
new_connection($h);
slog("accepted unix connection");
}
for $f (keys(%handles)) {

91
plug-ins/perl/examples/randomart1 Executable file
View File

@ -0,0 +1,91 @@
#!/usr/bin/perl
use Gimp;
use Gimp::Fu;
# Definiere die Konstante "pi mal zwei"
use constant PIx2 => 8 * atan2 1,1;
register "random_art_1", # Funktionsname
"Create a Random Tile", # Kurzhilfe
"Create a tileable image by repeatedly drawing colourful polygons",
# Hilfetext
"Marc Lehmann", # Autor
"Marc Lehmann <pcg\@goof.com", # Copyright
"0.3", # Version/Datum
"<Toolbox>/Xtns/Render/Random Art #1", # Menüpfad
"", # Bildtypen
# Eingabeparameter
# Typ Name Beschreibung Wert
[
[PF_INT32, 'width', 'Image Width', 300],
[PF_INT32, 'height', 'Image Height', 300],
[PF_SLIDER, 'num_poly', 'Number of Polygons', 20, [5,100,1]],
[PF_SLIDER, 'edges', 'Number of Edges', 10, [3, 30, 1]],
[PF_SLIDER, 'revolutions', 'Number of Revolutions',1, [1, 3, 1]],
[PF_SLIDER, 'feather', 'Feather Radius', 30, [1, 100]],
[PF_BOOL, 'supersample', 'Adaptive Supersampling?', 0],
],
[
[PF_IMAGE, 'image', 'the resulting image'],
],
sub { # Perl-Code
# Die Parameter werden ganz "normal" übergeben:
my ($w,$h,$num_poly,$edges,$revolutions,$feather,$super)=@_;
# Erzeuge ein neues Bild
my $image = new Image($w,$h,RGB);
$image->disable_undo;
# Erzeuge die erste Ebene für das Bild
my $layer = $image->layer_new($w,$h,RGB_IMAGE,
"Random Art #1",100,NORMAL_MODE);
# Füge sie in das Bild ein
$image->add_layer($layer,0);
# Setze die Hintergrundfarben
Palette->set_background('white');
# ...und lösche die Ebene damit
$layer->fill(BG_IMAGE_FILL);
# Jetzt wurde ein neues, leeres Bild erzeugt, und
# das Zeichnen kann beginnen.
# Erzeuge zufällige Polygone, fülle sie mit einem
# zufälligen Farbgradienten und verschiebe das Bild
# wiederholt.
for (1..$num_poly) {
my @ecken;
for (1..$edges*$revolutions) {
my $r = rand(0.4)+0.1;
push(@ecken, $w/2+sin($_*PIx2/$edges)*$r*$w,
$h/2+cos($_*PIx2/$edges)*$r*$h);
}
# Selektiere die Region
$image->free_select (\@ecken, SELECTION_REPLACE, 1, 1, $feather);
# Wähle zufällig zwei Farben aus
Palette->set_foreground([rand(256),rand(256),rand(256)]);
Palette->set_background([rand(256),rand(256),rand(256)]);
# Un erzeuge einen Farbverlauf über das Bild
$layer->blend (FG_BG_HSV, DIFFERENCE_MODE, LINEAR, 100,
0, REPEAT_TRIANGULAR, $super, 2, 3,
$w/2, $h/2,
rand($w), rand($h));
# Und dann verschiebe das Bild etwas
$layer->channel_ops_offset (1,0,(rand(0.8)+0.1)*$w,(rand(0.8)+0.1)*$h);
}
$image->enable_undo;
# Gib das neu erzeugte Bild zurück, damit es angezeigt wird.
$image;
};
exit main;

10
plug-ins/perl/examples/terral_text
View File

@ -49,19 +49,11 @@ register
[ PF_SLIDER, "blur_amount", "Blur Amount", 10, [0,26,1]],
],
sub {
Gimp::set_trace(TRACE_NAME);
($img, $pattern, $solidnoise, $font, $text, $blur) = @_;
$oldbg = gimp_palette_get_background();
$oldfg = gimp_palette_get_foreground();
Gimp->install_procedure("plug_in_example_oo", "a test plug-in in perl",
"try it out", "Marc Lehmann", "Marc Lehmann", "1998-04-27",
"<Toolbox>/Xtns/Perl Example Plug-in", "*", &PROC_EXTENSION,
[[0, "run_mode", "desc"]],
[]);
if ($solidnoise) {
$pattern->plug_in_solid_noise(1,1,256*rand(), 1,2.5,2.5);
}