gimp/plug-ins/perl/examples/PDB

490 lines
15 KiB
Perl
Executable File

#!/usr/bin/perl
#BEGIN {$^W=1};
use Gimp::Feature qw(perl-5.005 gtk-1.2);
use Gimp (':consts');
use Gimp::Fu;
use Gtk;
use Gtk::Gdk;
Gtk->init;
#Gimp::set_trace(TRACE_ALL);
my $ex; # average font width for default font
my $ey; # average font height for default font
my $window; # the main window
my $clist; # the list of completions
my $rlist; # the results list
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
my %function; # the same as hash
my %completion; # a hash that maps completion names to values
sub refresh {
undef %function;
@function = Gimp->procedural_db_query("","","","","","","");
@function{@function}=(1) x @function;
}
sub get_words {
my $text = $inputline->get_text;
my $i = 0;
my($p,$idx,$pos);
my $word;
my @words;
substr($text,$inputline->get('text_position'),0,"\0");
while ($text =~ /("(?:[^"\\]*(?:\\.[^"\\]*)*)")[ ,]*|([^ ,]+)[ ,]*|[ ,]+/g) {
$word = defined $1 ? $1 : $2;
if (($p = index($word, "\0")) >= 0) {
$idx=$i; $pos=$p;
substr ($word, $p, 1, "");
}
$i++;
push(@words,$word);
}
($idx,$pos,@words);
}
sub set_words {
my $text=shift;
$text.=" ".join(",",@_) if scalar@_;
my $pos=index($text,"\0");
if ($pos) {
substr($text,$pos,1,"");
$inputline->set_text($text);
$inputline->set_position($pos);
} else {
$inputline->set_text($text);
}
}
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 new_cinfo {
$cinfo->freeze;
$cinfo->clear;
my $add_split = sub {
my($t,$n,$d)=@_;
$d=~s/^(.{40,60})[ \t]*([\{[:\(])/$1\n$2/mg;
for(split/\n/,Gimp::wrap_text($d,60)) {
$cinfo->append("",$t,$n,$_);
$t=$n="";
}
};
if($args) {
$cinfo->append("In:","","","");
for(@args) {
$add_split->($type2str{$_->[0]},$_->[1],$_->[2]);
}
}
if($results) {
$cinfo->append("Out:","","","");
for(0..$results-1) {
my($type,$name,$desc)=Gimp->procedural_db_proc_val ($last_func, $_);
$add_split->($type2str{$type},$name,$desc);
}
}
$cinfo->thaw;
}
sub set_current_function {
my $fun = shift;
return if $last_func eq $fun || !$function{$fun};
$last_func = $fun;
$last_arg = 0;
@args=();
eval {
$function{$fun} or die;
($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,$_)]);
}
new_cinfo;
};
}
my $block_sel_changed; # gtk is braindamaged
my $block_changed; # gtk is broken
sub set_clist {
$block_sel_changed++;
$clist->clear_items(0,99999);
%completion=@_;
while(@_) {
$clist->add(new Gtk::ListItem(shift));
shift;
}
$clist->unselect_item(0);
$clist->show_all;
$block_sel_changed--;
}
sub complete_function {
my $name = shift;
$name=~s/[-_]/[-_]/g;
my @matches = eval { sort grep /$name/i,@function };
if(@matches>70) {
set_clist map(($_,$_),@matches[0..69]);
$synopsis->set("showing only the first 70 matches (of ".(scalar@matches).")");
} elsif(@matches>1) {
set_clist map(($_,$_),@matches);
$synopsis->set(scalar@matches." matching functions");
} else {
set_clist @matches,@matches;
$synopsis->set($matches[0]." (press Tab to complete)");
}
}
sub complete_type {
my($type,$name,$desc)=@_;
if($type==PARAM_IMAGE) {
set_clist(map(("$$_: ".$_->get_filename,$$_),Gimp->list_images));
} elsif($type==PARAM_LAYER) {
set_clist(map { my $i = $_; map(("$$_: ".$i->get_filename."/".$_->get_name,$$_),$i->get_layers)} Gimp->list_images);
} elsif($type==PARAM_CHANNEL) {
set_clist(map { my $i = $_; map(("$$_: ".$i->get_filename."/".$_->get_name,$$_),$i->get_channels)} Gimp->list_images);
} elsif($type==PARAM_DRAWABLE) {
set_clist(map { my $i = $_; map(("$$_: ".$i->get_filename."/".$_->get_name,$$_),($i->get_layers,$i->get_channels))} Gimp->list_images);
} elsif ($type==PARAM_INT32) {
if ($name eq "run_mode") {
set_clist("RUN_NONINTERACTIVE","RUN_NONINTERACTIVE",
"RUN_INTERACTIVE","RUN_INTERACTIVE",
"RUN_WITH_LAST_VALS","RUN_WITH_LAST_VALS");
} elsif ($desc=~s/(?::\s*)?{(.*)}.*?$//) {
$_=$1;
my @args;
while(s/^.*?([A-Za-z_-]+)\s*\(\s*(\d+)\s*\)//) {
push(@args,"$2: $1",$2);
}
set_clist(@args);
} else {
set_clist;
}
} else {
set_clist;
}
$synopsis->set($desc);
}
sub update_completion {
my($idx,$pos,@words)=get_words;
return unless $idx ne $last_arg;
$last_arg=$idx;
set_current_function $words[0];
if ($idx == 0) {
complete_function($words[0]);
} elsif ($idx>@args) {
$synopsis->set('too many arguments');
set_clist;
} else {
complete_type(@{$args[$idx-1]});
}
}
sub do_completion {
update_completion;
my($idx,$pos,@words)=get_words;
my($word)=$words[$idx];
$word=~s/[-_]/[-_]/g;
my(@matches)=grep /$word/i,keys %completion;
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];
} else {
$words[$idx].="\0";
}
set_words @words;
}
undef $last_arg;
}
sub execute_command {
my($idx,$pos,$fun,@args)=get_words;
$res=eval { Gimp->$fun(@args) };
if ($@) {
$statusbar->set($@);
$result->set_text("");
Gtk::Gdk->beep;
} else {
$statusbar->set('');
$result->set_text($res);
$rlist->prepend_items(new Gtk::ListItem $res);
}
}
sub idle {
Gtk->idle_remove($idle) if $idle;
undef $idle;
update_completion;
}
sub do_idle {
$idle=Gtk->idle_add(\&idle) unless $idle;
}
sub inputline {
my $e = new Gtk::Entry;
$e->set_text("");
$e->signal_connect("changed",sub {
return if $block_changed;
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 {
undef $last_arg;
do_idle;
# GDK_Tab = 0xFF09
if ($_[1]->{keyval} == 0xFF09) {
$_[0]->signal_emit_stop_by_name('key_press_event');
do_completion;
1;
} else {
();
}
});
$e->signal_connect("activate",\&execute_command);
$e->set_usize($ex*40,0);
$inputline=$e;
my $c = new Gtk::List;
$clist = $c;
$c->set_selection_mode(-single);
$c->set_selection_mode(-browse);
$c->signal_connect("selection_changed", sub {
return if $block_sel_changed;
eval {
my($idx,$pos,@words)=get_words;
$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;
});
my $r = new Gtk::List;
$rlist = $r;
$r->set_selection_mode(-single);
$r->set_selection_mode(-browse);
}
sub create_main {
my $b;
my $t;
parse Gtk::Rc Gimp->gtkrc;
$t = new Gtk::Tooltips;
my $w = new Gtk::Dialog;
$window = $w;
$w->realize;
$ex = $w->style->font->string_width ('Mn')*0.5;
$ey = $w->style->font->string_width ('My');
$w->set_title('PDB Explorer - the alpha version');
$w->signal_connect("destroy",sub {main_quit Gtk});
$b = new Gtk::Button "Close";
$w->action_area->add($b);
$b->signal_connect("clicked",sub {main_quit Gtk});
my $h = new Gtk::HBox (0,5);
$w->vbox->pack_start ($h,0,0,0);
inputline;
$synopsis = new Gtk::Label "";
$synopsis->set_justify(-left);
my $table = new Gtk::Table 3,4,0;
$w->vbox->pack_start($table,0,0,0);
my $cs = new Gtk::ScrolledWindow undef,undef;
$cs->set_policy(-automatic,-automatic);
$cs->add_with_viewport ($clist);
my $rs = new Gtk::ScrolledWindow undef,undef;
$rs->set_policy(-automatic,-automatic);
$rs->add_with_viewport ($rlist);
$rs->set_usize(0,200);
$result = new Gtk::Entry;
$result->set_editable(0);
$result->set_usize($ex*30,0);
$statusbar = new Gtk::Label;
$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(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);
$table->attach(new Gtk::Label("Shortcuts"),0,1,2,3,{},{},0,0);
$table->attach($cs ,1,2,2,3,['expand','fill'],['expand','fill'],0,0);
$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);
my $ci = new Gtk::Frame "Command Info";
$ci->border_width(10);
my $sw = new Gtk::ScrolledWindow;
$sw->set_policy(-automatic, -automatic);
$cinfo = new_with_titles Gtk::CList '','TYPE','NAME','DESCRIPTION';
$cinfo->set_column_auto_resize (0,1);
$cinfo->set_column_auto_resize (1,1);
$cinfo->set_column_auto_resize (2,1);
$cinfo->set_selection_mode('single');
$sw->add ($cinfo);
$ci->add ($sw);
$w->vbox->pack_start ($ci,1,1,0);
idle;
$w->realize;
$w->window->resize($ex*60,$ey*25);
show_all $w;
$w->window->resize($ex*60,$ey*25);
}
register "extension_pdb_explorer",
"Procedural Database Explorer",
"This is a more interactive version of the DB Browser",
"Marc Lehmann",
"Marc Lehmann",
"0.3alpha",
"<Toolbox>/Xtns/PDB Explorer",
"",
[],
sub {
Gimp::init_gtk;
refresh;
create_main;
main Gtk;
();
};
exit main;
sub logo {
new Gtk::Pixmap(Gtk::Gdk::Pixmap->create_from_xpm_d($window->window,$window->style->black,
#%XPM:logo%
'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',
' ',
' ]&@;% ',
' ;]_ ]];{_,&( ^{__{^ #);^ ',
' ]);;+;) ,//,@;@@)_ #_......_^ (..; ',
' ;-\'\'@];@ /$=$/@_@;& #]........]\' ^..{ ',
' @@_+%-,,] ,/$///_^)&@; -...{^>+./( \'*^! {{ ##( ##\' {{ ##( ',
' ;))@/; //]);/$]_(\');] %,..+ ^*! #/,{ #,/%&..@*&..,^ >,,(;..,^ ',
' /,)];]] ,/],+%;_%-#!#()_ \'...> >)_)_))\'\'.._ (..=~...=.~..; ^..=....=> ',
' ,]]&;;] /@;->>+-+{(\'\'-+] #...# #.....=\'\'..) \'..]*\'..$>>../-^..$##,..- ',
' @_{@/, @$@_^*>(_;_&;{);\'] \'~..> ^,,/../-\'.._ (..{ ^..; \'=./-^..% #..& ',
' ,&);,& ,])-^:>#%#%+;)>->] ;..) >(..; \'..) \'..- #.._ -=./-^..( ^..& ',
' ,&&%]-&/]]_::^\'#--(#!:#:]& ^...)^#-~..# \'.._ (..% #.._ %=./-^..,>*;..+ ',
' ,/&%;{%;//_#^#+%+{%#!:-#%]] -........{ \'..) \'..% #.._ %=./-^..~....~* ',
' ;$@%+)#)@$/-\')%-+-)+^#@;)@, #@..../\' #~~) \'~~% #~=_ -/~,-^..)/..=\' ',
' ,@+(\'#);,={)]%^);@;&@=]] , %#\'#^( (%( (% %%( (%% ^..{>### ',
' ,@)^#;,/={)_\'-;///$$=;@ ,, ^..{ ',
' ],&)_=$==/])\'+),],,/$)@ @, %(\'((\'((\' ^..{ ',
' @@]/=====@-)-]$$, ]_/ , %=~~=~==& >%%^ ',
' =$@/@,@]/]$=/ ])$ & {{{{ %=====~=_ \'-{% ',
' ,$// /$/@ /$, $,, %;@,,,;{> (\'\'\'\'\'\'\'\' #~.$- ',
' //=/ $,/; $,, @@ ($......,> #~.${ ',
' /$, /,,, @@ ,, %$..],...{ ^~.$- ',
' ], ]@] )& , ($..>({..; #\'+)\'^ ^#\'*>(-!~.${ ',
' @, -- (; @ %$..^({..] *,..../* ^.._,.$!~.$- ',
' _, @\' ;\' ) %$..@@...)!@.$#(=.; ^..~.~,!~.${ ',
' ]/ ]) - ] ($......=>^..;--@.~^>...(^#:~.$- ',
' ; ;-__ ; ($../,])> %........#>..@( #~.${ ',
' _ )* ] %$..>{ \'..->^*>>\'>..; #~.$- ',
' ) &&+ _ %$..\' >=.]>>)&^ ^..; #~.${ ',
' ;- @;];] &- ($..\' \'~.....+ ^..; #~.$- ',
' \') ]_& @ __ %{))# >_@,;\' >)+( #+){ ',
' &% @; ',
' ,{_ '
#%XPM%
));
}