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-06-24 15:44:30 +00:00
parent bfbf64d412
commit e52d0192fb
10 changed files with 304 additions and 126 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
plug-ins/perl/Changes
View File

@ -1,7 +1,12 @@
Revision history for Gimp-Perl extension.
1.094
- finally(?) fixed the runmode confusion by making these constants
magic. Also hopefully fixed the error message.
- enable embedded pod sections in standard register arguments.
- improved scm2perl ever so slightly.
- fixed xpm off-by-one bug in embedxpm (and added embedxpm).
- fixed off-by-one error in Gimp::Fu and exmaples/PDB.
1.093 Tue Jun 15 21:48:48 CEST 1999
- possible workaround for Gimp::Util::gimp_layer_get_position.

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

@ -13,7 +13,7 @@ use subs qw(init end lock unlock canonicalize_color);
require DynaLoader;
@ISA=qw(DynaLoader);
$VERSION = 1.093;
$VERSION = 1.094;
@_param = qw(
PARAM_BOUNDARY PARAM_CHANNEL PARAM_COLOR PARAM_DISPLAY PARAM_DRAWABLE
@ -81,7 +81,7 @@ sub RADIAL (){ 2} sub CONICAL_SYMMETRIC (){ 4} sub SHAPEBURST_DIM
sub SPIRAL_ANTICLOCKWISE(){10} sub SHAPEBURST_ANGULAR (){ 6} sub SHAPEBURST_SPHERICAL(){ 7} sub ALPHA_LUT (){ 4} sub GREEN_LUT (){ 2}
sub BLUE_LUT (){ 3} sub VALUE_LUT (){ 0} sub RED_LUT (){ 1} sub HORIZONTAL_GUIDE (){ 1} sub VERTICAL_GUIDE (){ 2}
sub OFFSET_BACKGROUND (){ 0} sub OFFSET_TRANSPARENT (){ 1} sub MESSAGE_BOX (){ 0} sub ERROR_CONSOLE (){ 2} sub CONSOLE (){ 1}
sub RUN_INTERACTIVE (){ 0} sub RUN_WITH_LAST_VALS (){ 2} sub RUN_NONINTERACTIVE (){ 1} sub EXPAND_AS_NECESSARY (){ 0} sub CLIP_TO_BOTTOM_LAYER(){ 2}
sub RUN_INTERACTIVE (){bless \(my $x=0),'Gimp::run_mode'} sub RUN_WITH_LAST_VALS (){bless \(my $x=2),'Gimp::run_mode'} sub RUN_NONINTERACTIVE (){bless \(my $x=1),'Gimp::run_mode'} sub EXPAND_AS_NECESSARY (){ 0} sub CLIP_TO_BOTTOM_LAYER(){ 2}
sub CLIP_TO_IMAGE (){ 1} sub FLATTEN_IMAGE (){ 3} sub REPEAT_NONE (){ 0} sub REPEAT_SAWTOOTH (){ 1} sub REPEAT_TRIANGULAR (){ 2}
sub BG_BUCKET_FILL (){ 1} sub FG_BUCKET_FILL (){ 0} sub PATTERN_BUCKET_FILL (){ 2}
#ENUM_DEFS#
@ -534,6 +534,13 @@ sub compare($$) { $_[0]->[0] eq $_[1]->[0] and
$_[0]->[1] eq $_[1]->[1] and
$_[0]->[2] eq $_[1]->[2] }
package Gimp::run_mode;
# I guess I now use almost every perl feature available ;)
use overload fallback => 1,
'0+' => sub { ${$_[0]} };
package Gimp; # for __DATA__
1;

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

@ -1159,7 +1159,7 @@ sub print_switches {
}
sub main {
$old_trace = Gimp::set_trace (0);
$old_trace = Gimp::set_trace (0);#d#
if ($Gimp::help) {
my $this=this_script;
print <<EOF;
@ -1184,7 +1184,7 @@ sub logo {
sub logo_xpm {
my $window=shift;
new Gtk::Pixmap(Gtk::Gdk::Pixmap->create_from_xpm_d($window->window,$window->style->black,
new Gtk::Pixmap(Gtk::Gdk::Pixmap->create_from_xpm_d($window->window,undef,
#%XPM:logo%
'79 33 25 1', ' c None', '. c #020204', '+ c #848484', '@ c #444444',
'# c #C3C3C4', '$ c #252524', '% c #A5A5A4', '& c #646464', '* c #E4E4E4',
@ -1223,7 +1223,8 @@ sub logo_xpm {
' ) &&+ _ %$..\' >=.]>>)&^ ^..; #~.${ ',
' ;- @;];] &- ($..\' \'~.....+ ^..; #~.$- ',
' \') ]_& @ __ %{))# >_@,;\' >)+( #+){ ',
' &% @; '
' &% @; ',
' ,{_ '
#%XPM%
))
}

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

@ -1496,9 +1496,9 @@ gimp_call_procedure (proc_name, ...)
&proc_copyright, &proc_date, &proc_type, &nparams, &nreturn_vals,
&params, &return_vals) == TRUE)
{
int no_runmode = !nparams
|| params[0].type != PARAM_INT32
|| strcmp (params[0].name, "run_mode");
int runmode = nparams
&& params[0].type == PARAM_INT32
&& !strcmp (params[0].name, "run_mode");
g_free (proc_blurb);
g_free (proc_help);
@ -1506,121 +1506,109 @@ gimp_call_procedure (proc_name, ...)
g_free (proc_copyright);
g_free (proc_date);
if (nparams)
args = (GParam *) g_new0 (GParam, nparams);
for(;items;)
{
j = 0;
if (no_runmode || !SvROK (ST(0)))
for (i = 0; i < nparams && j < items-1; i++)
{
args[i].type = params[i].type;
if (i == 0 && no_runmode == 2)
args->data.d_int32 = RUN_NONINTERACTIVE;
else if ((!SvROK(ST(j+1)) || i >= nparams-1 || !is_array (params[i+1].type))
&& convert_sv2gimp (croak_str, &args[i], ST(j+1)))
j++;
if (croak_str [0])
{
if (!no_runmode)
{
croak_str [0] = 0;
break;
}
if (trace & TRACE_CALL)
{
dump_params (i, args, params);
trace_printf (" = [argument error]\n");
}
goto error;
}
}
if (no_runmode || i == nparams)
break;
/* very costly, do better! */
no_runmode = 2;
destroy_params (args, nparams);
args = (GParam *) g_new0 (GParam, nparams);
}
if (trace & TRACE_CALL)
{
dump_params (i, args, params);
trace_printf (" = ");
}
if (j != items-1 || i < nparams)
{
if (trace & TRACE_CALL)
trace_printf ("[unfinished]\n");
sprintf (croak_str, "%s arguments (%d) for function '%s'",
(j == items || i < nparams) ? "not enough" : "too many", (int)items-1, proc_name);
if (nparams)
destroy_params (args, nparams);
}
else
{
values = gimp_run_procedure2 (proc_name, &nvalues, nparams, args);
if (nparams)
destroy_params (args, nparams);
if (trace & TRACE_CALL)
{
dump_params (nvalues-1, values+1, return_vals);
trace_printf ("\n");
}
if (values && values[0].type == PARAM_STATUS)
{
if (values[0].data.d_status == STATUS_EXECUTION_ERROR)
sprintf (croak_str, "%s: procedural database execution failed", proc_name);
else if (values[0].data.d_status == STATUS_CALLING_ERROR)
sprintf (croak_str, "%s: procedural database execution failed on invalid input arguments", proc_name);
else if (values[0].data.d_status == STATUS_SUCCESS)
{
EXTEND(SP, perl_paramdef_count (return_vals, nvalues-1));
PUTBACK;
for (i = 0; i < nvalues-1; i++)
{
if (i < nvalues-2 && is_array (values[i+2].type))
i++;
push_gimp_sv (values+i+1, nvalues > 2+1);
}
SPAGAIN;
}
else
sprintf (croak_str, "unsupported status code: %d\n", values[0].data.d_status);
}
else
sprintf (croak_str, "gimp returned, well.. dunno how to interpret that...");
}
error:
if (values)
gimp_destroy_params (values, nreturn_vals);
destroy_paramdefs (params, nparams);
destroy_paramdefs (return_vals, nreturn_vals);
if (croak_str[0])
croak (croak_str);
}
else
croak ("gimp procedure '%s' not found", proc_name);
if (nparams)
args = (GParam *) g_new0 (GParam, nparams);
for (i = 0, j = 1; i < nparams && j < items; i++)
{
args[i].type = params[i].type;
if (i == 0 && runmode)
{
if (sv_isa (ST(j), "Gimp::run_mode"))
{
args->data.d_int32 = SvIV(SvRV(ST(j)));
j++;
}
else
args->data.d_int32 = RUN_NONINTERACTIVE;
}
else if ((!SvROK(ST(j)) || i >= nparams-1 || !is_array (params[i+1].type))
&& convert_sv2gimp (croak_str, &args[i], ST(j)))
j++;
if (croak_str [0])
{
if (trace & TRACE_CALL)
{
dump_params (i, args, params);
trace_printf (" = [argument error]\n");
}
goto error;
}
}
if (trace & TRACE_CALL)
{
dump_params (i, args, params);
trace_printf (" = ");
}
if (i < nparams || j < items)
{
if (trace & TRACE_CALL)
trace_printf ("[unfinished]\n");
sprintf (croak_str, "%s arguments for function '%s'",
i < nparams ? "not enough" : "too many", proc_name);
if (nparams)
destroy_params (args, nparams);
}
else
{
values = gimp_run_procedure2 (proc_name, &nvalues, nparams, args);
if (nparams)
destroy_params (args, nparams);
if (trace & TRACE_CALL)
{
dump_params (nvalues-1, values+1, return_vals);
trace_printf ("\n");
}
if (values && values[0].type == PARAM_STATUS)
{
if (values[0].data.d_status == STATUS_EXECUTION_ERROR)
sprintf (croak_str, "%s: procedural database execution failed", proc_name);
else if (values[0].data.d_status == STATUS_CALLING_ERROR)
sprintf (croak_str, "%s: procedural database execution failed on invalid input arguments", proc_name);
else if (values[0].data.d_status == STATUS_SUCCESS)
{
EXTEND(SP, perl_paramdef_count (return_vals, nvalues-1));
PUTBACK;
for (i = 0; i < nvalues-1; i++)
{
if (i < nvalues-2 && is_array (values[i+2].type))
i++;
push_gimp_sv (values+i+1, nvalues > 2+1);
}
SPAGAIN;
}
else
sprintf (croak_str, "unsupported status code: %d, fatal error\n", values[0].data.d_status);
}
else
sprintf (croak_str, "gimp didn't return an execution status, fatal error");
}
error:
if (values)
gimp_destroy_params (values, nreturn_vals);
destroy_paramdefs (params, nparams);
destroy_paramdefs (return_vals, nreturn_vals);
if (croak_str[0])
croak (croak_str);
}
else
croak ("gimp procedure '%s' not found", proc_name);
}
void

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

@ -170,7 +170,6 @@ sub start_server {
"--no-splash",
@args,
"-b",
"(extension-perl-server $args)",
"(extension_perl_server $args)",
"(gimp_quit 0)",
"(gimp-quit 0)";

3
plug-ins/perl/MANIFEST
View File

@ -100,4 +100,5 @@ examples/oneliners
examples/randomart1
examples/colourtoalpha
examples/pixelmap
embedxpm
logo.xpm

1
plug-ins/perl/TODO
View File

@ -10,6 +10,7 @@ make test TEST_VERBOSE=1
bugs
* Christian Soeller told me its easy: apply the affine transformation from C
* podestions are not expanded in dialog help strings etc..
* Document spawn_options in Gimp::Net.
* Selection => To Brush.

114
plug-ins/perl/embedxpm Executable file
View File

@ -0,0 +1,114 @@
#!/usr/bin/perl
=cut
=head1 NAME
embedxpm - embed xpm pictures into perl source
=head1 SYNOPSIS
embedxpm picture.xpm perl_source picture_name
=head1 DESCRIPTION
embedxpm can be used to embed xpm pictures directly into a perl program. To
do this, your program source has to contain some markers (in the form of
ocmments) that describe the position where the picture should be inserted.
To only insert the xpm data, use this form:
#%XPM:<name of xpm>%
<your xpm data goes here>
#%XPM%<what to attach to the end of the data>
Here is an example (taken from the Gimp/PDB program):
# create the logo pixmap for the given widget
sub create_logo($) {
new Gtk::Pixmap(Gtk::Gdk::Pixmap->create_from_xpm_d(
$_[0]->window,
$_[0]->style->black,
#%XPM:logo%
'xpm data', 'xpm data...',...
#%XPM%
))
}
To insert the xpm with the name example.xpm into this source you would have
to use the following commandline:
embedxpm example.xpm source.pl logo
I<WARNING:> embedxpm happily overwrites your source, without leaving a
backup-copy around(!). If anything goes wrong (for example when you left out
the end comment) your source may be lost, so better make a backup before. I
am not responsible for your data-loss!
=head1 SWITCHES
None ;)
=back
=head1 AUTHOR
Marc Lehmann <pcg@goof.com>
=cut
use File::Slurp;
$VERSION=1.0002;
if (@ARGV != 3) {
die "Usage: $0 xpm_file perl_source picture_name\n";
}
$xpm=$ARGV[0];
$file=$ARGV[1];
$id=$ARGV[2];
$verbose=1;
$columns=80;
sub stringify {
my $s=shift;
my $r=$s.shift;
my @r;
while(@_) {
if (length($r)+length($_[0])>=$columns) {
push(@r,$r); $r="$s".shift;
} else {
$r.=", ".shift;
}
}
join(",\n",@r,$r);
}
open XPM,"<$xpm\0" or die "$xpm: $!\n";
<XPM>=~/^\/\*\s+XPM\s+\*\/$/ or die "$xpm: not a valid xpm file\n";
<XPM>=~/^static\s+char\s+\*\s+(\S+?)(?:_xpm)?\[\]\s+=\s+{$/ or die "$xpm: not a valid xpm file\n";
$xpm_name=$1;
print STDERR "found xpm $xpm_name\n" if $verbose;
while(<XPM>) {
y/\t/ /;
s/'/\\\'/g;
last unless /\"([^"]*)\"/;
push(@xpm,"'$1'");
}
close XPM;
$patch=read_file($file);
$patch=~s/^(\s*)(#%XPM:$id%\n).*?(^\s*#%XPM%)(.*?)$/"$1$2".stringify($1,@xpm)."$4\n$3$4"/esmg;
write_file("$file~",$patch);
chmod((stat($file))[2],"$file~") or die;
rename "$file~",$file or die;

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

@ -474,7 +474,8 @@ sub logo {
' ) &&+ _ %$..\' >=.]>>)&^ ^..; #~.${ ',
' ;- @;];] &- ($..\' \'~.....+ ^..; #~.$- ',
' \') ]_& @ __ %{))# >_@,;\' >)+( #+){ ',
' &% @; '
' &% @; ',
' ,{_ '
#%XPM%
));
}

61
plug-ins/perl/logo.xpm Normal file
View File

@ -0,0 +1,61 @@
/* XPM */
static char * logo_xpm[] = {
"79 33 25 1",
" c None",
". c #020204",
"+ c #848484",
"@ c #444444",
"# c #C3C3C4",
"$ c #252524",
"% c #A5A5A4",
"& c #646464",
"* c #E4E4E4",
"= c #171718",
"- c #989898",
"; c #585858",
"> c #D7D7D7",
", c #383838",
"' c #B8B8B8",
") c #787878",
"! c #F7F7F8",
"~ c #0B0B0C",
"{ c #8C8C8C",
"] c #4C4C4C",
"^ c #CCCCCC",
"/ c #2C2C2C",
"( c #ABABAC",
"_ c #6C6C6C",
": c #EBEBEC",
" ",
" ]&@;% ",
" ;]_ ]];{_,&( ^{__{^ #);^ ",
" ]);;+;) ,//,@;@@)_ #_......_^ (..; ",
" ;-''@];@ /$=$/@_@;& #]........]' ^..{ ",
" @@_+%-,,] ,/$///_^)&@; -...{^>+./( '*^! {{ ##( ##' {{ ##( ",
" ;))@/; //]);/$]_(');] %,..+ ^*! #/,{ #,/%&..@*&..,^ >,,(;..,^ ",
" /,)];]] ,/],+%;_%-#!#()_ '...> >)_)_))''.._ (..=~...=.~..; ^..=....=> ",
" ,]]&;;] /@;->>+-+{(''-+] #...# #.....=''..) '..]*'..$>>../-^..$##,..- ",
" @_{@/, @$@_^*>(_;_&;{);'] '~..> ^,,/../-'.._ (..{ ^..; '=./-^..% #..& ",
" ,&);,& ,])-^:>#%#%+;)>->] ;..) >(..; '..) '..- #.._ -=./-^..( ^..& ",
" ,&&%]-&/]]_::^'#--(#!:#:]& ^...)^#-~..# '.._ (..% #.._ %=./-^..,>*;..+ ",
" ,/&%;{%;//_#^#+%+{%#!:-#%]] -........{ '..) '..% #.._ %=./-^..~....~* ",
" ;$@%+)#)@$/-')%-+-)+^#@;)@, #@..../' #~~) '~~% #~=_ -/~,-^..)/..=' ",
" ,@+('#);,={)]%^);@;&@=]] , %#'#^( (%( (% %%( (%% ^..{>### ",
" ,@)^#;,/={)_'-;///$$=;@ ,, ^..{ ",
" ],&)_=$==/])'+),],,/$)@ @, %('(('((' ^..{ ",
" @@]/=====@-)-]$$, ]_/ , %=~~=~==& >%%^ ",
" =$@/@,@]/]$=/ ])$ & {{{{ %=====~=_ '-{% ",
" ,$// /$/@ /$, $,, %;@,,,;{> ('''''''' #~.$- ",
" //=/ $,/; $,, @@ ($......,> #~.${ ",
" /$, /,,, @@ ,, %$..],...{ ^~.$- ",
" ], ]@] )& , ($..>({..; #'+)'^ ^#'*>(-!~.${ ",
" @, -- (; @ %$..^({..] *,..../* ^.._,.$!~.$- ",
" _, @' ;' ) %$..@@...)!@.$#(=.; ^..~.~,!~.${ ",
" ]/ ]) - ] ($......=>^..;--@.~^>...(^#:~.$- ",
" ; ;-__ ; ($../,])> %........#>..@( #~.${ ",
" _ )* ] %$..>{ '..->^*>>'>..; #~.$- ",
" ) &&+ _ %$..' >=.]>>)&^ ^..; #~.${ ",
" ;- @;];] &- ($..' '~.....+ ^..; #~.$- ",
" ') ]_& @ __ %{))# >_@,;' >)+( #+){ ",
" &% @; ",
" ,{_ "};