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-03-10 21:10:25 +00:00
parent 9f6de5f3bf
commit cef394a9aa
10 changed files with 799 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
plug-ins/perl/Changes
View File

@ -5,7 +5,15 @@ Revision history for Gimp-Perl extension.
if it can't be found.
- Uh, ah, debugging code in the repository, again!
- PF_FONT should now display a string widget in gtk+ 1.0.
- PixelRgn/Tile data sould now be accessible again-
- PixelRgn/Tile data sould now be accessible again.
- updated PDB.
- extensive tests is now always on.
- added examples/gimpmagick.
- closed big, BIG security hole on password authenticitation
(basically one could do anything includung killing your
system without authorization. argh). This required a
protocol change, so old clients are unable to connect using
password-authenticitation.
1.06 Sat Mar 6 19:36:12 CET 1999
- Gimp::Fu does no longer display the returned image when it

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

@ -12,7 +12,7 @@ use base qw(DynaLoader);
require DynaLoader;
$VERSION = 1.06;
$VERSION = 1.061;
@_param = qw(
PARAM_BOUNDARY PARAM_CHANNEL PARAM_COLOR PARAM_DISPLAY PARAM_DRAWABLE
@ -145,7 +145,7 @@ sub VERTICAL (){ 1 };
sub _PS_FLAG_QUIET { 0000000001 }; # do not output messages
sub _PS_FLAG_BATCH { 0000000002 }; # started via Gimp::Net, extra = filehandle
$_PROT_VERSION = "1"; # protocol version
$_PROT_VERSION = "2"; # protocol version
# we really abuse the import facility..
sub import($;@) {
@ -412,12 +412,6 @@ sub new($$$$$$$$) {
init Gimp::PixelRgn(@_);
}
sub DESTROY {
my $self = shift;
$self->{_drawable}->{_id}->update($self->{_x},$self->{_y},$self->{_w},$self->{_h})
if $self->{_dirty};
};
package Gimp::Parasite;
sub is_type($$) { $_[0]->[0] eq $_[1] }

8
plug-ins/perl/Gimp/Lib.pm
View File

@ -62,7 +62,6 @@ sub gimp_pixel_rgn_w { $_[0]->{_w} }
sub gimp_pixel_rgn_h { $_[0]->{_h} }
sub gimp_pixel_rgn_rowstride { $_[0]->{_rowstride} }
sub gimp_pixel_rgn_bpp { $_[0]->{_bpp} }
sub gimp_pixel_rgn_dirty { $_[0]->{_dirty} }
sub gimp_pixel_rgn_shadow { $_[0]->{_shadow} }
sub gimp_pixel_rgn_drawable { $_[0]->{_drawable} }
@ -72,6 +71,13 @@ sub gimp_tile_bpp { $_[0]->{_bpp} }
sub gimp_tile_shadow { $_[0]->{_shadow} }
sub gimp_tile_gdrawable { $_[0]->{_gdrawable} }
sub Gimp::PixelRgn::DESTROY {
my $self = shift;
return unless $self =~ /=HASH/;
$self->{_drawable}->{_id}->update($self->{_x},$self->{_y},$self->{_w},$self->{_h})
if $self->dirty;
};
1;
__END__

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

@ -145,7 +145,7 @@ GPixelRgn *old_pixelrgn (SV *sv)
STRLEN dc;
dTHR;
if (!sv_derived_from (sv, PKG_PIXELRGN))
if (!sv_derived_from (sv, PKG_PIXELRGN) && !SvTYPE (sv) != SVt_PVHV)
croak ("argument is not of type " PKG_PIXELRGN);
/* the next line lacks any type of checking. */
@ -1503,7 +1503,6 @@ gimp_pixel_rgn_init(gdrawable, x, y, width, height, dirty, shadow)
hv_store (hv, "_h" , 2, newSViv (pr->h) , 0);
hv_store (hv, "_rowstride",10, newSViv (pr->rowstride) , 0);
hv_store (hv, "_bpp" , 4, newSViv (pr->bpp) , 0);
hv_store (hv, "_dirty" , 6, newSViv (pr->dirty) , 0);
hv_store (hv, "_shadow" , 7, newSViv (pr->shadow) , 0);
hv_store (hv, "_drawable",9, newSVsv (gdrawable) , 0);
@ -1515,6 +1514,14 @@ gimp_pixel_rgn_init(gdrawable, x, y, width, height, dirty, shadow)
OUTPUT:
RETVAL
guint
gimp_pixel_rgn_dirty(pr)
GPixelRgn * pr
CODE:
RETVAL = pr->dirty;
OUTPUT:
RETVAL
void
gimp_pixel_rgn_resize(sv, x, y, width, height)
SV * sv

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

@ -23,7 +23,7 @@ $trace_res = *STDERR;
$trace_level = 0;
sub import {
return if @_;
return if @_>1;
*Gimp::Tile::DESTROY=
*Gimp::PixelRgn::DESTROY=
*Gimp::GDrawable::DESTROY=sub {
@ -52,7 +52,7 @@ sub args2net {
$res.="undef,";
}
}
$res;
substr($res,0,-1); # may not be worth the effort
}
sub _gimp_procedure_available {
@ -147,8 +147,10 @@ sub start_server {
my $args = &Gimp::RUN_NONINTERACTIVE." ".
(&Gimp::_PS_FLAG_BATCH | &Gimp::_PS_FLAG_QUIET)." ".
fileno(GIMP_FH);
exec "gimp","-n","-b","(extension-perl-server $args)",
"(extension_perl_server $args)";
{ # block to suppress warning with broken perls (e.g. 5.004)
exec "gimp","-n","-b","(extension-perl-server $args)",
"(extension_perl_server $args)"
}
exit(255);
} else {
croak "unable to fork: $!";
@ -204,7 +206,8 @@ sub gimp_init {
if($_ eq "AUTH") {
die "server requests authorization, but no authorization available\n"
unless $auth;
command "AUTH",$auth;
my $req = "AUTH".$auth;
print $server_fh pack("N",length($req)).$req;
my @r = response;
die "authorization failed: $r[1]\n" unless $r[0];
print "authorization ok, but: $r[1]\n" if $Gimp::verbose and $r[1];

1
plug-ins/perl/MANIFEST
View File

@ -60,3 +60,4 @@ examples/scratches.pl
examples/blowinout.pl
examples/terral_text
examples/xachvision.pl
examples/gimpmagick

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

@ -27,7 +27,9 @@ success stories (and of course any bug-reports ;)
Do you want me to make these tests [y]? ";
$EXTENSIVE_TESTS = (<STDIN> !~ /^[nN]/) ? 1 : 0;
print "y\n";
$EXTENSIVE_TESTS = 1;
#$EXTENSIVE_TESTS = (<STDIN> !~ /^[nN]/) ? 1 : 0;
}
print "\n";
@ -117,7 +119,7 @@ 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 parasite-editor
scratches.pl blowinout.pl terral_text xachvision.pl);
scratches.pl blowinout.pl terral_text xachvision.pl gimpmagick);
@shebang = (map("examples/$_",@examples),
qw(Perl-Server scm2perl scm2scm examples/example-net.pl examples/homepage-logo.pl
examples/example-fu.pl));

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

@ -163,15 +163,14 @@ sub handle_request($) {
} else {
if($req eq "AUTH") {
my($ok,$msg);
($req)=Gimp::Net::net2args($data);
if($req eq $auth) {
if($data eq $auth) {
$ok=1;
$authorized[fileno($fh)]=1;
} else {
$ok=0;
$msg="wrong authorization, aborting connection";
slog $msg;
sleep 10; # safety measure
sleep 5; # safety measure
}
$data=Gimp::Net::args2net($ok,$msg);
print $fh pack("N",length($data)).$data;

165
plug-ins/perl/examples/PDB
View File

@ -2,7 +2,7 @@
#BEGIN {$^W=1};
use Gimp;
use Gimp (':consts');
use Gimp::Fu;
BEGIN { $] >= 5.005 or exit main }
use Gtk;
@ -14,6 +14,8 @@ $gtk_10 = Gtk->major_version==1 && Gtk->minor_version==0;
#Gimp::set_trace(TRACE_ALL);
my $ex; # average font width for default font
my $window; # the main window
my $clist; # the list of completions
my $rlist; # the results list
@ -21,9 +23,11 @@ my $inputline; # the input entry
my $result; # the result entry
my $synopsis; # the synopsis label
my $statusbar; # the statusbar
my $cinfo; # command info
my $idle; # the idle function id
my($blurb,$help,$author,$copyright,$date,$type,$args,$results);
my @args; # the arguments of the current function
my @function; # the names of all functions
@ -32,7 +36,7 @@ my %completion; # a hash that maps completion names to values
sub refresh {
undef %function;
@function = gimp_procedural_db_query("","","","","","","");
@function = Gimp->procedural_db_query("","","","","","","");
@function{@function}=(1) x @function;
}
@ -69,19 +73,97 @@ sub set_words {
}
my $last_func;
my $last_arg;
my %type2str = (
&PARAM_BOUNDARY => 'BOUNDARY',
&PARAM_CHANNEL => 'CHANNEL',
&PARAM_COLOR => 'COLOR',
&PARAM_DISPLAY => 'DISPLAY',
&PARAM_DRAWABLE => 'DRAWABLE',
&PARAM_FLOAT => 'FLOAT',
&PARAM_IMAGE => 'IMAGE',
&PARAM_INT32 => 'INT32',
&PARAM_FLOATARRAY => 'FLOATARRAY',
&PARAM_INT16 => 'INT16',
&PARAM_PARASITE => 'PARASITE',
&PARAM_STRING => 'STRING',
&PARAM_PATH => 'PATH',
&PARAM_INT16ARRAY => 'INT16ARRAY',
&PARAM_INT8 => 'INT8',
&PARAM_INT8ARRAY => 'INT8ARRAY',
&PARAM_LAYER => 'LAYER',
&PARAM_REGION => 'REGION',
&PARAM_STRINGARRAY => 'STRINGARRAY',
&PARAM_SELECTION => 'SELECTION',
&PARAM_STATUS => 'STATUS',
&PARAM_INT32ARRAY => 'INT32ARRAY',
);
sub leftlabel {
my $label = new Gtk::Label shift;
$label->set_alignment (0, 0.5);
$label;
}
sub new_cinfo {
my $table = new Gtk::Table 5,$args+$results+3,0;
$table->set_col_spacings($ex);
$table->set_row_spacings($ex*0.1);
$table->attach_defaults(leftlabel("TYPE"),2,3,0,1);
$table->attach_defaults(leftlabel("NAME"),3,4,0,1);
$table->attach_defaults(leftlabel("DESCRIPTION"),4,5,0,1);
my $y=2;
if($args) {
$table->attach_defaults(new Gtk::HSeparator,0,6,$y,$y+1);
$y++;
my $in = new Gtk::Label("In:");
$in->set_alignment (1, 0.5);
$table->attach_defaults($in,0,1,$y,$y+$args);
undef @argsvalid;
for(@args) {
my $valid = new Gtk::Label "-";
push(@argsvalid,$valid);
$table->attach_defaults($valid,1,2,$y,$y+1);
$table->attach_defaults(leftlabel($type2str{$_->[0]}),2,3,$y,$y+1);
$table->attach_defaults(leftlabel($_->[1]),3,4,$y,$y+1);
$table->attach_defaults(leftlabel($_->[2]),4,5,$y,$y+1);
$y++;
}
}
if($results) {
$table->attach_defaults(new Gtk::HSeparator,0,6,$y,$y+1);
$y++;
my $out = new Gtk::Label("Out:");
$out->set_alignment (1, 0.5);
$table->attach_defaults($out,0,1,$y,$y+$results);
for(0..$results-1) {
my($type,$name,$desc)=Gimp->procedural_db_proc_val ($last_func, $_);
$table->attach_defaults(leftlabel($type2str{$type}),2,3,$y,$y+1);
$table->attach_defaults(leftlabel($name),3,4,$y,$y+1);
$table->attach_defaults(leftlabel($desc),4,5,$y,$y+1);
$y++;
}
}
$table->show_all;
$table;
}
sub set_current_function {
my $fun = shift;
return if $last_func eq $fun;
return if $last_func eq $fun || !$function{$fun};
$last_func = $fun;
$last_arg = 0;
@args=();
eval {
$function{$fun} or die;
my($blurb,$help,$author,$copyright,$date,$type,$args,$results)=
gimp_procedural_db_proc_info($fun);
($blurb,$help,$author,$copyright,$date,$type,$args,$results)=
Gimp->procedural_db_proc_info($fun);
for(0..$args-1) {
push(@args,[gimp_procedural_db_proc_arg($fun,$_)]);
push(@args,[Gimp->procedural_db_proc_arg($fun,$_)]);
}
my $ci = new_cinfo;
$cinfo->remove($cinfo->children); $cinfo->add ($ci);
};
}
@ -90,7 +172,6 @@ my $block_changed; # gtk is broken
sub set_clist {
$block_sel_changed++;
# $clist->signal_handler_block($sel_changed); # yes virginia, this is broken
$clist->clear_items(0,99999);
%completion=@_;
while(@_) {
@ -99,7 +180,6 @@ sub set_clist {
}
$clist->unselect_item(0);
$clist->show_all;
# $clist->signal_handler_unblock($sel_changed);
$block_sel_changed--;
}
@ -115,7 +195,7 @@ sub complete_function {
$synopsis->set(scalar@matches." matching functions");
} else {
set_clist @matches,@matches;
$synopsis->set($matches[0]." (press F2 to complete)");
$synopsis->set($matches[0]." (press Tab to complete)");
}
}
@ -151,14 +231,13 @@ sub complete_type {
$synopsis->set($desc);
}
my $last_arg;
sub update_completion {
my($idx,$pos,@words)=get_words;
return unless $idx ne $last_arg;
eval { $argsvalid[$last_arg-1]->set('+') };
$last_arg=$idx;
$statusbar->set_percentage($idx/@args) if @args;
eval { $argsvalid[$last_arg-1]->set('>') };
set_current_function $words[0];
@ -180,8 +259,18 @@ sub do_completion {
$word=~s/[-_]/[-_]/g;
my(@matches)=grep /$word/i,keys %completion;
if(@matches==1) {
$words[$idx]=$completion{$matches[0]};
my $new;
if (@matches>1) {
if (join("\n",@matches) =~ ("^(".$words[$idx].".*).*?".("\n\\1.*" x scalar@matches-1))) {
$new=$1;
}
} elsif(@matches==1) {
$new=$completion{$matches[0]};
} else {
Gtk::Gdk->beep;
}
if (defined $new) {
$words[$idx]=$new;
set_current_function $words[0] if $idx==0;
if($idx<@args) {
$words[$idx+1]="\0".$words[$idx+1];
@ -189,9 +278,8 @@ sub do_completion {
$words[$idx].="\0";
}
set_words @words;
} else {
Gtk::Gdk->beep;
}
eval { $argsvalid[$last_arg-1]->set('-') };
undef $last_arg;
}
@ -199,9 +287,11 @@ sub execute_command {
my($idx,$pos,$fun,@args)=get_words;
$res=eval { Gimp->$fun(@args) };
if ($@) {
$result->set_text($@);
$statusbar->set($@);
$result->set_text("");
Gtk::Gdk->beep;
} else {
$statusbar->set('');
$result->set_text($res);
$rlist->prepend_items(new Gtk::ListItem $res);
}
@ -219,30 +309,30 @@ sub do_idle {
sub inputline {
my $e = new Gtk::Entry;
$e->set_text("gimp_blend 0,2,3,6,6,100,10,1,1,1,0,10,20,30,40");
$e->set_text("");
$e->signal_connect("changed",sub {
return if $block_changed;
eval { $argsvalid[$last_arg-1]->set('-') };
undef $last_arg;
do_idle;
});
$e->signal_connect("focus_in_event",\&do_idle);
$e->signal_connect("button_press_event",\&do_idle);
$e->signal_connect("key_press_event",sub {
eval { $argsvalid[$last_arg-1]->set('-') };
undef $last_arg;
do_idle;
# GDK_Tab = 0xFF09
if ($_[1]->{keyval} == 0xFF09) {
# do_completion;
print "ztab\n";
return 1;
} elsif ($_[1]->{keyval} == 0xFFBF) {
$_[0]->signal_emit_stop_by_name('key_press_event');
do_completion;
();
1;
} else {
();
}
});
$e->signal_connect("activate",\&execute_command);
$e->set_usize(300,0);
$e->set_usize($ex*40,0);
$inputline=$e;
my $c = new Gtk::List;
@ -256,6 +346,7 @@ print "ztab\n";
$words[$idx]=$completion{$c->selection->children->get}."\0";
$block_changed++;
set_words (@words);
set_current_function (substr($words[0],0,-1)) unless $idx;
$block_changed--;
};
do_idle;
@ -276,8 +367,10 @@ sub create_main {
$t = new Gtk::Tooltips;
my $w = new Gtk::Dialog;
$window = $w;
$w->realize;
$ex = $w->style->font->string_width ('Mn')*0.5;
$w->set_title('PDB Browser - the early alpha version');
$w->set_title('PDB Explorer - the alpha version');
$w->signal_connect("destroy",sub {main_quit Gtk});
$b = new Gtk::Button "Close";
@ -306,16 +399,17 @@ sub create_main {
$result = new Gtk::Entry;
$result->set_editable(0);
$result->set_usize(200,0);
$result->set_usize($ex*30,0);
# $statusbar = new Gtk::Statusbar;
$statusbar = new Gtk::ProgressBar;
$statusbar = new Gtk::Label;
realize $window;
$table->border_width(10);
$table->attach(new Gtk::Label("Synopsis") ,0,1,0,1,{},{},0,0);
$table->attach($synopsis ,1,2,0,1,{},{},0,0);
$table->attach(logo(),2,3,0,1,{},{},0,0);
#$table->attach(logo(),2,3,0,1,{},{},0,0);
$table->attach(new Gtk::Label("Command") ,0,1,1,2,{},{},0,0);
$table->attach($inputline,1,2,1,2,['expand','fill'],{},0,0);
$table->attach($result,2,3,1,2,['expand','fill'],{},0,0);
@ -324,19 +418,24 @@ sub create_main {
$table->attach($rs,2,3,2,3,['expand','fill'],['expand','fill'],0,0);
$table->attach(new Gtk::Label("Status"),0,1,3,4,{},{},0,0);
$table->attach($statusbar,1,3,3,4,['expand','fill'],['expand','fill'],0,0);
$cinfo = new Gtk::Frame "Command Info";
$cinfo->border_width(10);
$cinfo->add (new_cinfo);
$w->vbox->add ($cinfo);
idle;
show_all $w;
}
register "extension_pdb_browser",
"Procedural Database Browser",
register "extension_pdb_explorer",
"Procedural Database Explorer",
"This is a more interactive version of the DB Browser",
"Marc Lehmann",
"Marc Lehmann",
"0.0",
"<Toolbox>/Xtns/PDB Browser",
"0.1",
"<Toolbox>/Xtns/PDB Explorer",
"",
[],
sub {

625
plug-ins/perl/examples/gimpmagick Normal file
View File

@ -0,0 +1,625 @@
#!/usr/bin/perl
BEGIN { $] >= 5.005 or exit main }
use Gimp 1.06;
use Gimp::Fu;
use POSIX;
BEGIN { eval "use Gtk; use Image::Magick 1.45"; $@ and exit main };
$VERSION = '0.1';
$preview_size = 160; # max. size for image preview
# this funny little function parses the Magick.xs file
sub reparse {
my $res;
$res.="%MagickTypes = (\n";
$xs = do { local(*XS,$/); open XS,"<$_[0]" or die; <XS> };
while($xs =~ /(\w+Types)\[\]\s=\s+\{([^}]+)\}/g) {
my $name=$1;
my @vals=$2=~/"([^"]+)"/g;
shift @vals if $vals[0] eq "Undefined";
$res.=" $name => sub {\n my \$m = new Gtk::Menu;\n".
join("",map " \$m->append(new Gtk::MenuItem '$_');\n",@vals).
" my \$o = new Gtk::OptionMenu;\n".
" \$o->set_menu(\$m);\n".
" optionmenu_settext(\$o,\@_);\n".
" \$o;\n".
" },\n";
}
$res.=");\n\n";
$res.="%MagickMethods = (\n";
$xs =~ /Methods\[\]\s=\s+\{\n(.+?)\s*\};/s or die;
$methods=$1;
while($methods =~ /(?:^|\n)(\s+)\{ "([^"]+)",(?: \{ (.*?))?\s*\},(?=\n\1\{|$)/gs) {
my $method=$2;
my @args=$3=~/\{"([^"]+)", (\w+)},?/gs;
$res.=" $method => [".join(",",map "'$_'",@args)."],\n";
}
$res.=");\n";
require IO::AtomicFile;
{
local $/;
open X,"<$0" or die;
$data=<X>;
$data=~s/(?<=\n#MAGICK#\n).*/sub magick {\n$res\n}\n/s;
my $file=IO::AtomicFile->open($0,"w");
$file->print($data);
$file->close;
}
}
sub optionmenu_settext {
my ($o,$ref) = @_;
$o->signal_connect (clicked => sub {
$arg{$ref} = $_[0]->get_menu->get_active->get;
});
}
sub new_entry {
my ($re,$ref)=@_;
my $e = new Gtk::Entry;
$e->signal_connect(changed => sub {
$arg{$ref}=$e->get_text;
});
$e;
}
if ($ARGV[0] eq "--reparse") {
reparse("/root/cvt/ImageMagick-4.2.0/PerlMagick/Magick.xs");
exit;
}
&magick;
%MagickTypes = (%MagickTypes,
'StringReference' => sub { new_entry "",@_ },
'DoubleReference' => sub { new_entry '^[0-9.E+-]+$',@_ },
'IntegerReference' => sub { new_entry '^[0-9+-]+$',@_ },
'ImageReference' => sub { new Gtk::Label "not yet supported" },
);
%MagickMethods = (%MagickMethods,
);
sub check {
for(values(%MagickMethods)) {
my @a=@$_;
while(@a) {
shift @a;
my $x = shift @a;
print($x," <- does not exist\n") unless $MagickTypes{$x};
}
}
}
#check;
# read the image pixels into an imagemagick-image
sub read_pixels {
my($drawable,$im)=@_;
my $th = Gimp->tile_height;
Gimp->tile_cache_ntiles (1 + $drawable->width / Gimp->tile_width);
my $type = $drawable->type;
my $format;
$format = "RGB" if $type == RGB_IMAGE;
$format = "RGBA" if $type == RGBA_IMAGE;
$format = "GRAY" if $type == GRAY_IMAGE;
die "Indexed format and GRAYA not yet supported in GimpMagick!\n" unless $format;
my $temp = Gimp->temp_name('raw');
open TEMP,">$temp\0" or die "unable to open temporary file '$temp' for writing\n";
my ($empty,$x1,$y1,$x2,$y2) = $drawable->mask_bounds;
$x2-=$x1; $y2-=$y1;
my $region = $drawable->get->pixel_rgn ($x1, $y1, $x2, $y2, 0, 0);
Gimp->progress_init ("transferring image data");
for(my $y=0; $y<$y2; $y+=$th) {
# calling internal function, sorry folks!
Gimp->progress_update ($y/$y2*100);
print TEMP Gimp::PixelRgn::_get_rect($region,0,$y,$x2,$y2-$y > $th ? $th : $y2-$y);
}
close TEMP;
$im->Set(size => $x2.'x'.$y2);
$im->Read("$format:$temp");
unlink $temp;
$format;
}
# read the image pixels back
sub write_pixels {
my($drawable,$im,$format)=@_;
my $th = Gimp->tile_height;
my $buf;
my $temp = Gimp->temp_name('raw');
$im->Write("$format:$temp");
open TEMP,"<$temp\0" or die "unable to open temporary file '$temp' for writing\n";
unlink $temp;
my ($empty,$x1,$y1,$x2,$y2) = $drawable->mask_bounds;
$x2-=$x1; $y2-=$y1;
if ($x2 ne $im->get('width') or $y2 ne $im->get('height')) {
$drawable->resize ($im->get('width','height'),0,0);
$drawable->image->selection_none;
($x1,$y1,$x2,$y2)=(0,0,$im->get('width','height'));
}
my $region = $drawable->get->pixel_rgn ($x1, $y1, $x2, $y2, 1, 1);
Gimp->progress_init ("transferring image data");
my $stride = $x2*$region->bpp;
for(my $y=0; $y<$y2; $y+=$th) {
# calling internal function, sorry folks!
Gimp->progress_update ($y/$y2*100);
read TEMP,$buf,$stride*$th;
Gimp::PixelRgn::_set_rect($region,$buf,0,$y,$x2);
}
close TEMP;
undef $region;
$drawable->merge_shadow (1);
Gimp->displays_flush;
}
sub update_preview {
my ($im,$pre)=@_;
$im=$im->clone;
while($im->get('width') > $preview_size or $im->get('height') > $preview_size) {
$im->Minify;
}
if(0==open BLOB,"-|") {
$im->Write('RGB:-');
POSIX::_exit(0);
}
my($w,$h)=$im->get('width','height');
$pre->size($w,$h);
for (0..$h-1) {
read BLOB,$im,$w*3;
$pre->draw_row($im,0,$_,$w);
}
close BLOB;
$pre->draw(undef);
}
# Interactively apply Image::Magick
sub gimp_magick {
my ($drawable)=@_;
# generate main window
my $im = new Image::Magick;
my $format = read_pixels ($drawable, $im);
my $w = new Gtk::Dialog;
$w->set_title ("GimpMagick! $VERSION");
my $b = new Gtk::Button "Apply";
$b->signal_connect (clicked => sub { write_pixels ($drawable, $im, $format); main_quit Gtk });
$w->action_area->add ($b);
$b = new Gtk::Button "Cancel";
$b->signal_connect (clicked => sub { main_quit Gtk });
$w->action_area->add ($b);
$preview = new Gtk::Preview "color";
$w->vbox->add ($preview);
my $frame = new Gtk::Frame "Arguments";
my $cbox = new Gtk::VBox 0,0;
$frame->add($cbox);
my $command = new Gtk::Combo;
my %args;
$command->set_popdown_strings (sort keys %MagickMethods);
$command->set_case_sensitive (0);
my $changed_command = sub {
$method = $command->entry->get_text;
return unless $MagickMethods{$method};
$frame->remove ($cbox);
$cbox = new Gtk::VBox 0,5;
my @args = @{$MagickMethods{$method}};
while(@args) {
%arg=();
my($name,$type)=(shift @args,shift @args);
my($hbox)=new Gtk::HBox 0,5;
$hbox->add(new Gtk::Label "$name: ");
my $widget = $MagickTypes{$type}->($name);
$hbox->add($widget);
$cbox->add($hbox);
}
$cbox->show_all;
$frame->add($cbox);
};
$command->entry->signal_connect(changed => $changed_command);
my $execute = new Gtk::Button "Execute!";
$execute->signal_connect(clicked => sub {
$im->$method(%arg);
update_preview ($im, $preview);
});
$w->vbox->add($command);
$w->vbox->add($frame);
$w->vbox->add($execute);
update_preview ($im, $preview);
$w->show_all;
&$changed_command;
main Gtk;
();
}
register "gimp_magick",
"access to the Image::Magick-package",
"Gimp::Magick gives you access to all methods in the Image::Magick-package. These methods often offer ".
"higher quality than equivalent Gimp methods, as well as offering more methods than Gimp itself",
"Marc Lehmann",
"Marc Lehmann",
$VERSION,
"<Image>/Filters/Misc/Magick",
"*",
[
],
sub {
my($image,$drawable)=@_;
gimp_magick ($drawable);
$image;
};
exit main;
#MAGICK#
sub magick {
%MagickTypes = (
BooleanTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'False');
$m->append(new Gtk::MenuItem 'True');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
ClassTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'DirectClass');
$m->append(new Gtk::MenuItem 'PseudoClass');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
ColorspaceTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'RGB');
$m->append(new Gtk::MenuItem 'Gray');
$m->append(new Gtk::MenuItem 'Transparent');
$m->append(new Gtk::MenuItem 'OHTA');
$m->append(new Gtk::MenuItem 'XYZ');
$m->append(new Gtk::MenuItem 'YCbCr');
$m->append(new Gtk::MenuItem 'YCC');
$m->append(new Gtk::MenuItem 'YIQ');
$m->append(new Gtk::MenuItem 'YPbPr');
$m->append(new Gtk::MenuItem 'YUV');
$m->append(new Gtk::MenuItem 'CMYK');
$m->append(new Gtk::MenuItem 'sRGB');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
CompositeTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'Over');
$m->append(new Gtk::MenuItem 'In');
$m->append(new Gtk::MenuItem 'Out');
$m->append(new Gtk::MenuItem 'Atop');
$m->append(new Gtk::MenuItem 'Xor');
$m->append(new Gtk::MenuItem 'Plus');
$m->append(new Gtk::MenuItem 'Minus');
$m->append(new Gtk::MenuItem 'Add');
$m->append(new Gtk::MenuItem 'Subtract');
$m->append(new Gtk::MenuItem 'Difference');
$m->append(new Gtk::MenuItem 'Bumpmap');
$m->append(new Gtk::MenuItem 'Replace');
$m->append(new Gtk::MenuItem 'ReplaceRed');
$m->append(new Gtk::MenuItem 'ReplaceGreen');
$m->append(new Gtk::MenuItem 'ReplaceBlue');
$m->append(new Gtk::MenuItem 'ReplaceMatte');
$m->append(new Gtk::MenuItem 'Blend');
$m->append(new Gtk::MenuItem 'Displace');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
CompressionTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'None');
$m->append(new Gtk::MenuItem 'BZip');
$m->append(new Gtk::MenuItem 'Fax');
$m->append(new Gtk::MenuItem 'Group4');
$m->append(new Gtk::MenuItem 'JPEG');
$m->append(new Gtk::MenuItem 'LZW');
$m->append(new Gtk::MenuItem 'Runlength');
$m->append(new Gtk::MenuItem 'Zip');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
FilterTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'Point');
$m->append(new Gtk::MenuItem 'Box');
$m->append(new Gtk::MenuItem 'Triangle');
$m->append(new Gtk::MenuItem 'Hermite');
$m->append(new Gtk::MenuItem 'Hanning');
$m->append(new Gtk::MenuItem 'Hamming');
$m->append(new Gtk::MenuItem 'Blackman');
$m->append(new Gtk::MenuItem 'Gaussian');
$m->append(new Gtk::MenuItem 'Quadratic');
$m->append(new Gtk::MenuItem 'Cubic');
$m->append(new Gtk::MenuItem 'Catrom');
$m->append(new Gtk::MenuItem 'Mitchell');
$m->append(new Gtk::MenuItem 'Lanczos');
$m->append(new Gtk::MenuItem 'Bessel');
$m->append(new Gtk::MenuItem 'Sinc');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
GravityTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'Forget');
$m->append(new Gtk::MenuItem 'NorthWest');
$m->append(new Gtk::MenuItem 'North');
$m->append(new Gtk::MenuItem 'NorthEast');
$m->append(new Gtk::MenuItem 'West');
$m->append(new Gtk::MenuItem 'Center');
$m->append(new Gtk::MenuItem 'East');
$m->append(new Gtk::MenuItem 'SouthWest');
$m->append(new Gtk::MenuItem 'South');
$m->append(new Gtk::MenuItem 'SouthEast');
$m->append(new Gtk::MenuItem 'Static');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
ImageTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'Bilevel');
$m->append(new Gtk::MenuItem 'Grayscale');
$m->append(new Gtk::MenuItem 'Palette');
$m->append(new Gtk::MenuItem 'TrueColor');
$m->append(new Gtk::MenuItem 'Matte');
$m->append(new Gtk::MenuItem 'ColorSeparation');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
IntentTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'Saturation');
$m->append(new Gtk::MenuItem 'Perceptual');
$m->append(new Gtk::MenuItem 'Absolute');
$m->append(new Gtk::MenuItem 'Relative');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
InterlaceTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'None');
$m->append(new Gtk::MenuItem 'Line');
$m->append(new Gtk::MenuItem 'Plane');
$m->append(new Gtk::MenuItem 'Partition');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
LayerTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'Red');
$m->append(new Gtk::MenuItem 'Green');
$m->append(new Gtk::MenuItem 'Blue');
$m->append(new Gtk::MenuItem 'Matte');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
MethodTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'Point');
$m->append(new Gtk::MenuItem 'Replace');
$m->append(new Gtk::MenuItem 'Floodfill');
$m->append(new Gtk::MenuItem 'FillToBorder');
$m->append(new Gtk::MenuItem 'Reset');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
ModeTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'Frame');
$m->append(new Gtk::MenuItem 'Unframe');
$m->append(new Gtk::MenuItem 'Concatenate');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
NoiseTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'Uniform');
$m->append(new Gtk::MenuItem 'Gaussian');
$m->append(new Gtk::MenuItem 'Multiplicative');
$m->append(new Gtk::MenuItem 'Impulse');
$m->append(new Gtk::MenuItem 'Laplacian');
$m->append(new Gtk::MenuItem 'Poisson');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
PreviewTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'Rotate');
$m->append(new Gtk::MenuItem 'Shear');
$m->append(new Gtk::MenuItem 'Roll');
$m->append(new Gtk::MenuItem 'Hue');
$m->append(new Gtk::MenuItem 'Saturation');
$m->append(new Gtk::MenuItem 'Brightness');
$m->append(new Gtk::MenuItem 'Gamma');
$m->append(new Gtk::MenuItem 'Spiff');
$m->append(new Gtk::MenuItem 'Dull');
$m->append(new Gtk::MenuItem 'Grayscale');
$m->append(new Gtk::MenuItem 'Quantize');
$m->append(new Gtk::MenuItem 'Despeckle');
$m->append(new Gtk::MenuItem 'ReduceNoise');
$m->append(new Gtk::MenuItem 'AddNoise');
$m->append(new Gtk::MenuItem 'Sharpen');
$m->append(new Gtk::MenuItem 'Blur');
$m->append(new Gtk::MenuItem 'Threshold');
$m->append(new Gtk::MenuItem 'EdgeDetect');
$m->append(new Gtk::MenuItem 'Spread');
$m->append(new Gtk::MenuItem 'Solarize');
$m->append(new Gtk::MenuItem 'Shade');
$m->append(new Gtk::MenuItem 'Raise');
$m->append(new Gtk::MenuItem 'Segment');
$m->append(new Gtk::MenuItem 'Swirl');
$m->append(new Gtk::MenuItem 'Implode');
$m->append(new Gtk::MenuItem 'Wave');
$m->append(new Gtk::MenuItem 'OilPaint');
$m->append(new Gtk::MenuItem 'Charcoal');
$m->append(new Gtk::MenuItem 'JPEG');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
PrimitiveTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'Point');
$m->append(new Gtk::MenuItem 'Line');
$m->append(new Gtk::MenuItem 'Rectangle');
$m->append(new Gtk::MenuItem 'FillRectangle');
$m->append(new Gtk::MenuItem 'Circle');
$m->append(new Gtk::MenuItem 'FillCircle');
$m->append(new Gtk::MenuItem 'Ellipse');
$m->append(new Gtk::MenuItem 'FillEllipse');
$m->append(new Gtk::MenuItem 'Polygon');
$m->append(new Gtk::MenuItem 'FillPolygon');
$m->append(new Gtk::MenuItem 'Color');
$m->append(new Gtk::MenuItem 'Matte');
$m->append(new Gtk::MenuItem 'Text');
$m->append(new Gtk::MenuItem 'Image');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
ResolutionTypes => sub {
my $m = new Gtk::Menu;
$m->append(new Gtk::MenuItem 'PixelsPerInch');
$m->append(new Gtk::MenuItem 'PixelsPerCentimeter');
my $o = new Gtk::OptionMenu;
$o->set_menu($m);
optionmenu_settext($o,@_);
$o;
},
);
%MagickMethods = (
Comment => ['comment','StringReference'],
Label => ['label','StringReference'],
AddNoise => ['noise','NoiseTypes'],
Colorize => ['color','StringReference','pen','StringReference'],
Border => ['geom','StringReference','width','IntegerReference','height','IntegerReference','color','StringReference'],
Blur => ['factor','DoubleReference'],
Chop => ['geom','StringReference','width','IntegerReference','height','IntegerReference','x','IntegerReference','y','IntegerReference'],
Crop => ['geom','StringReference','width','IntegerReference','height','IntegerReference','x','IntegerReference','y','IntegerReference'],
Despeckle => [],
Edge => ['factor','DoubleReference'],
Emboss => [],
Enhance => [],
Flip => [],
Flop => [],
Frame => ['geom','StringReference','width','IntegerReference','height','IntegerReference','inner','IntegerReference','outer','IntegerReference','color','StringReference'],
Implode => ['factor','DoubleReference'],
Magnify => [],
MedianFilter => [],
Minify => [],
OilPaint => ['radius','IntegerReference'],
ReduceNoise => [],
Roll => ['geom','StringReference','x','IntegerReference','y','IntegerReference'],
Rotate => ['degree','DoubleReference','crop','BooleanTypes','sharpen','BooleanTypes'],
Sample => ['geom','StringReference','width','IntegerReference','height','IntegerReference'],
Scale => ['geom','StringReference','width','IntegerReference','height','IntegerReference'],
Shade => ['geom','StringReference','azimuth','DoubleReference','elevat','DoubleReference','color','BooleanTypes'],
Sharpen => ['factor','DoubleReference'],
Shear => ['geom','StringReference','x','DoubleReference','y','DoubleReference','crop','BooleanTypes'],
Spread => ['amount','IntegerReference'],
Swirl => ['degree','DoubleReference'],
Zoom => ['geom','StringReference','width','IntegerReference','height','IntegerReference','filter','FilterTypes'],
IsGrayImage => [],
Annotate => ['text','StringReference','font','StringReference','point','IntegerReference','density','StringReference','box','StringReference','pen','StringReference','geom','StringReference','server','StringReference','x','IntegerReference','y','IntegerReference','grav','GravityTypes'],
ColorFloodfill => ['geom','StringReference','x','IntegerReference','y','IntegerReference','pen','StringReference','bordercolor','StringReference'],
Composite => ['compos','CompositeTypes','image','ImageReference','geom','StringReference','x','IntegerReference','y','IntegerReference','grav','GravityTypes'],
Contrast => ['sharp','BooleanTypes'],
CycleColormap => ['amount','IntegerReference'],
Draw => ['prim','PrimitiveTypes','points','StringReference','meth','MethodTypes','pen','StringReference','linew','IntegerReference','server','StringReference','borderc','StringReference'],
Equalize => [],
Gamma => ['gamma','StringReference','red','DoubleReference','green','DoubleReference','blue','DoubleReference'],
Map => ['image','ImageReference','dither','BooleanTypes'],
MatteFloodfill => ['geom','StringReference','x','IntegerReference','y','IntegerReference','matte','IntegerReference','bordercolor','StringReference'],
Modulate => ['factor','StringReference','bright','DoubleReference','satur','DoubleReference','hue','DoubleReference'],
Negate => ['gray','BooleanTypes'],
Normalize => [],
NumberColors => [],
Opaque => ['color','StringReference','pen','StringReference'],
Quantize => ['colors','IntegerReference','tree','IntegerReference','colorsp','ColorspaceTypes','dither','BooleanTypes','measure','BooleanTypes','global','BooleanTypes'],
Raise => ['geom','StringReference','width','IntegerReference','height','IntegerReference','x','IntegerReference','y','IntegerReference','raise','BooleanTypes'],
Segment => ['colorsp','ColorspaceTypes','verbose','BooleanTypes','clust','DoubleReference','smooth','DoubleReference'],
Signature => [],
Solarize => ['factor','DoubleReference'],
Sync => [],
Texture => ['texture','ImageReference'],
Transform => ['crop','StringReference','geom','StringReference','filter','FilterTypes'],
Transparent => ['color','StringReference'],
Threshold => ['threshold','DoubleReference'],
Charcoal => ['factor','StringReference'],
Trim => [],
Wave => ['geom','StringReference','ampli','DoubleReference','wave','DoubleReference'],
Layer => ['layer','LayerTypes'],
Condense => [],
Stereo => ['image','ImageReference'],
Stegano => ['image','ImageReference','offset','IntegerReference'],
Coalesce => [],
);
}