gimp/plug-ins/perl/examples/parasite-editor

#!/usr/bin/perl

#BEGIN {$^W=1};

use Gimp::Feature qw(perl-5.005 gtk-1.2);
use Gimp ('__');
use Gimp::Fu;
use Gtk;

$VERSION=0.91;

#Gimp::set_trace(TRACE_ALL);

my $window;	# the main window
my $current;
my $list_func, $find_func, $attach_func, $detach_func;
my $clist;
my $name, $flags, $data;

sub deserialize {
   local $_ = shift;
   my $res;
   eval {
      while (length ($_)) {
         my $type = unpack ("C", substr $_,0,1,"");
         if ($type == 0) {
            $res.="END";
            last;
         } elsif ($type == 1) {
            $res.="INT8 ".(unpack ("C", substr $_,0,1,""));
         } elsif ($type == 2) {
            $res.="INT16 ".(unpack ("n", substr $_,0,2,""));
         } elsif ($type == 3) {
            $res.="INT32 ".(unpack ("N", substr $_,0,4,""));
         } elsif ($type == 101) {
            $res.="INT32 ".(unpack ("N", substr $_,0,4,""));
         } else {
            die "unknown serialize type\n";
         }
         print "RES: $res\n";
         print "Type = $type\n";
      }
   };
   $@ ? $@ : $res;
}

sub is_binary {
   $_[0] =~ y/\x00-\x09\x0b-\x1f//;
}

sub is_gserialize {
   0;
}

sub format_flags {
   sprintf "0x%08x",$_[0];
}

sub unformat_flags {
   eval shift;
}

sub format_plain {
   my $x=shift;
   $x=~s/\r/\\r/g;
   $x=~s/\n/\\n/g;
   $x=~s/\t/\\t/g;
   $x=~s/([\x00-\x1f])/sprintf "\\x%02x",ord($1)/eg;
   $x=~s/\\n/\n/g;
   $x;
}

sub unformat_plain {
   my $x=shift;
   $x=~s/\\r/\r/g;
   $x=~s/\\t/\t/g;
   $x=~s/\\x([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
   $x;
}

sub format_hex {
   join (" ", map { sprintf "%02x",ord($_) } split //,shift);
}

sub unformat_hex {
   my $x = shift;
   $x =~ y/0-9a-fA-F//cd;
   $x=pack("H*",$x);
   $x;
}

sub format_gserialize {
   format_hex(@_);
}

sub unformat_gserialize {
   unformat_hex(@_);
}

sub escape($) {
   my $x=shift;
   is_gserialize($x) ? format_gserialize($x)
                     : is_binary($x) ? format_hex($x)
                                     : format_plain($x);
}

sub refresh_names {
   undef $parasite;
   $name->set_text ("");
   $flags->set_text ("");
   $data->set_text ("");
   $clist->freeze;
   $clist->clear;
   my @list = sort &$list_func($current);
   for (@list) {
      $clist->append($_);
   }
   $clist->show_all;
   $clist->thaw;
}

sub new_Entry {
   my $hbox = new Gtk::HBox 0,0;
   my $label = new Gtk::Label $_[1];
   my $name = $_[2];

   $label->set_alignment (0, 0.5);

   $hbox->pack_start ($label, 0, 0, 0);
   $hbox->pack_start ($name , 1, 1, 0);

   $_[0]->add ($hbox);

   $name->set_editable (0);
   $name;
}

sub create_main {
   my $b;
   my $t;

   parse Gtk::Rc Gimp->gtkrc;

   $t = new Gtk::Tooltips;
   my $w = new Gtk::Dialog;

   $ex = $w->style->font->string_width ('Mn')*0.5;
   $eX = $w->style->font->ascent + $w->style->font->descent + 10;

   $window = $w;

   $w->set_title("Parasite Editor - version $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 $v = new Gtk::VBox (0,5);
   $w->vbox->add ($v);

   my $top = new Gtk::HBox (0,5);
   $v->pack_start($top,0,1,5);
   my $bot = new Gtk::HBox (0,5);
   $v->add($bot);
   my $cmd = new Gtk::HBox (0,5);
   $v->pack_start($cmd,0,1,5);

   $top->set_usize (-1, $eX+5);

   $clist = new Gtk::CList (1);
   $clist->set_selection_mode (-single);
   $clist->signal_connect ("select_row" => sub {
      $parasite = $_[0]->get_text($_[1],$_[2]);
      my ($par) = &$find_func($current,$parasite);
      $name->set_text ($par->[0]);
      $flags->set_text (sprintf "0x%08x", $par->[1]);
      $data->set_text (escape $par->[2]);
   });

   my $cs = new Gtk::ScrolledWindow undef,undef;
   $cs->set_policy(-automatic,-automatic);
   $cs->add ($clist);
   $bot->add ($cs);

   my $parbox = new Gtk::VBox (0,5);
   $bot->set_usize ($ex*80,$eX*4);
   $bot->add ($parbox);

   $name  = new_Entry $parbox,"Name: ",new Gtk::Entry;
   $flags = new_Entry $parbox,"Flags: ",new Gtk::Entry;
   $data  = new_Entry $parbox,"Data: ",new Gtk::Entry;

   {
      my $menu = new Gtk::Menu;
      my $item;
      my $subtype = new Gtk::OptionMenu;

      my $set_submenu = sub {
         my $submenu = new Gtk::Menu;
         for(@_) {
            my $cur = $_->[0];
            my $item = new Gtk::MenuItem $_->[1];
            $item->signal_connect ("activate" => sub { $current = $cur; refresh_names });
            $submenu->append ($item);
         }
         $subtype->set_menu($submenu);
         $submenu->show_all;
         if(@_) {
            $submenu->get_active->signal_emit("activate");
         } else {
            undef $current;
            refresh_names;
         }
      };

      $item = new Gtk::MenuItem "Global";
      my $act_global = sub {
         $list_func   = sub { Gimp->parasite_list   };
         $find_func   = sub { shift; Gimp->parasite_find   (shift) };
         $attach_func = sub { shift; Gimp->parasite_attach (shift) };
         $detach_func = sub { shift; Gimp->parasite_detach (shift) };
         &$set_submenu();
      };
      $item->signal_connect("activate", $act_global);
      $menu->append($item);

      $item = new Gtk::MenuItem "Image";
      $item->signal_connect("activate", sub {
         $list_func   = sub { $_[0] ? shift->parasite_list : () };
         $find_func   = sub { shift->parasite_find   (shift) };
         $attach_func = sub { shift->parasite_attach (shift) };
         $detach_func = sub { shift->parasite_detach (shift) };
         &$set_submenu(map [$_,"$$_: ".$_->get_filename],Gimp->image_list);
      });
      $menu->append($item);

      $item = new Gtk::MenuItem "Drawable";
      $item->signal_connect("activate", sub {
         $list_func   = sub { $_[0] ? shift->parasite_list : () };
         $find_func   = sub { shift->parasite_find   (shift) };
         $attach_func = sub { shift->parasite_attach (shift) };
         $detach_func = sub { shift->parasite_detach (shift) };
         &$set_submenu(map [$_,$_->image->get_filename." / "
                               .($_->layer ? $_->layer_get_name : $_->channel_get_name)],
                           map (($_->get_layers,$_->get_channels),Gimp->image_list));
      });
      $menu->append($item);

      my $type = new Gtk::OptionMenu;
      $type->set_menu ($menu);

      $top->add($type);
      $top->add($subtype);

      &$act_global;
   }

   local *addcmd = sub {
      my $label = new Gtk::Button shift;
      $label->signal_connect(clicked => shift);
      $cmd->add($label);
   };

   addcmd ("New", sub {Gimp->message("NYI!!")});
   addcmd ("Edit", sub {
      (new ParasiteEditor($find_func,$attach_func,$detach_func,$current,$parasite))->show_all
         if $parasite ne "";
   });
   addcmd ("Delete", sub {$detach_func->($current,$parasite) if $parasite; refresh_names});

   show_all $w;
}

register "extension_parasite_editor",
         "Parasite Editor",
         "This plug-in can be used to view (and in a future version edit) existing parasites",
         "Marc Lehmann",
         "Marc Lehmann",
         $VERSION,
         __"<Toolbox>/Xtns/Parasite Editor",
         "",
         [],
         [],
         ['gimp-1.1'],
         sub {

   Gimp::gtk_init;
   create_main;
   main Gtk;

   ();
};

package ParasiteEditor;

use Gtk;
use base Gtk::Dialog;

my $init;

init_add Gtk sub { Gtk::Dialog->register_subtype(ParasiteEditor) };

sub GTK_CLASS_INIT { };

sub unformat {
   my $self=shift;
   $self->{data_} = $self->{unformat}->($self->{-data}->get_chars(0,-1)) if $self->{unformat};
   $self->{name_} = $self->{-name}->get_text;
   $self->{flags_} = ::unformat_flags($self->{-flags}->get_text);
}

sub format {
   my $self=shift;
   $self->{format}->($self->{data_});
}

sub refresh {
   my $self=shift;
   $self->{-name}->set_text($self->{name_});
   $self->{-flags}->set_text(::format_flags $self->{flags_});
   $self->{-data}->delete_text(0,-1);
   $self->{-data}->insert_text($self->format,0);
}

sub undirty {
   my $self=shift;
}

sub GTK_OBJECT_INIT {
   my $self = shift;
   @{$self}{qw(find_func attach_func detach_func current parasite)}=@$init;
   @{$self}{qw(name  flags  data)}=
   @{$self}{qw(name_ flags_ data_)}=@{$self->{find_func}->(@{$self}{qw(current parasite)})};

   my $table = new Gtk::Table (2,3,0);
   $table->attach(new Gtk::Label("Name")	,0,1,0,1,{},{},0,0);
   $table->attach(new Gtk::Label("Flags")	,0,1,1,2,{},{},0,0);
   $table->attach(new Gtk::Label("Format")	,0,1,2,3,{},{},0,0);
   $table->attach(new Gtk::Label("Data")	,0,1,3,4,{},{},0,0);

   $self->{-name} = new Gtk::Entry;
   $self->{-flags} = new Gtk::Entry;
   $self->{-data} = new Gtk::Text;

   $self->{format} = \&::format_plain;
   $self->refresh;

   my $format = new Gtk::HBox 0,5;
   my $radio;
   local *newformat = sub {
      my ($label,$in,$out,$enable)=@_;
      my $r = new Gtk::RadioButton $label,$radio ? $radio : ();
      $format->add($r);
      $r->signal_connect(clicked => sub {
         $self->unformat;
         $self->{format}=$in;
         $self->{unformat}=$out;
         $self->refresh;
      });
      $r->signal_emit_by_name("clicked") if $enable;
      $radio = $r;
   };

   $table->attach($self->{-name}	,1,2,0,1,{},{},0,0);
   $table->attach($self->{-flags}	,1,2,1,2,{},{},0,0);
   $table->attach($format		,1,2,2,3,{},{},0,0);
   $table->attach($self->{-data}	,1,2,3,4,['fill'],{},0,0);

   $detect = ::is_gserialize($self->{data_}) ? 3
           : ::is_binary($self->{data_})     ? 2
           :                                   1;

   newformat("Text",\&::format_plain,\&::unformat_plain,$detect==1);
   newformat("Hex",\&::format_hex,\&::unformat_hex,$detect==2);
   newformat("GSerialize",\&::format_gserialize,\&::unformat_gserialize,$detect==3);

   $self->vbox->add($table);

   $self->refresh;

   $self->{-data}->set_editable(1);

   my $b = new Gtk::Button "OK";
   $b->signal_connect(clicked => sub {
      $self->unformat;
      $self->{detach_func}->(@{$self}{'current','parasite'});
      $self->{attach_func}->($self->{'current'},[@{$self}{'name_','flags_','data_'}]);
      main::refresh_names;
      destroy $self;
   });
   $self->action_area->add($b);
   my $b = new Gtk::Button "Cancel";
   $b->signal_connect(clicked => sub { destroy $self });
   $self->action_area->add($b);
}

sub new {
   $init=\@_;
   new Gtk::Widget shift;
}

package main;

exit main;