gimp/plug-ins/perl/examples/miff

#!/usr/bin/perl
# pcg@goof.com
# a fairly complete miff save filter

use Gimp;
use Gimp::Fu;
use Gimp::UI;
use Fcntl;

# Gimp::set_trace(TRACE_ALL);

sub write_layer {
   my($fh,$l)=@_;
   my($w,$h)=($l->width,$l->height);
   my $r = new PixelRgn $l,0,0,$w,$h,0,0;
   print $fh "rows=$h columns=$w\n",
         "matte=", $r->bpp&1 ? "False" : "True", "\n",
         ":\012";
   # inefficient as hell, but "what shells?" ;*>
   for my $y (0..$h-1) {
      print $fh $r->get_rect2(0,$y,$w,1);
   }
}

register "file_miff_save",
         "save images as miff (Magick Interchange File Format)",
         "Saves images in the miff (Magick Interchange File Format) format used by the ImageMagick package",
         "Marc Lehmann",
         "Marc Lehmann <pcg\@goof.com>",
         "1999-10-26",
         "<Save>/MIFF",
         "RGB, RGBA, GRAY",	# weird, but no matte for !DirectColour
         [],
         sub {
   my($img,$drawable,$filename) = @_;
   my($new_img,$new_drawable);
   my $export = Gimp::UI::export_image ($new_img=$img, $new_drawable=$drawable, "MIFF",
                                        CAN_HANDLE_GRAY|CAN_HANDLE_RGB|CAN_HANDLE_ALPHA|CAN_HANDLE_LAYERS|CAN_HANDLE_LAYERS_AS_ANIMATION);
   die "export failed" if $export == EXPORT_CANCEL;
   my @layers = $new_img->get_layers;

   sysopen FILE,$filename,O_CREAT|O_TRUNC|O_WRONLY or die "Unable to open '$filename' for writing: $!\n";
   my $hdr = eval { $img->parasite_find("gimp-comment")->data };
   $hdr = "   COMMENT: $hdr\n" if $hdr;
   $hdr = <<EOF;
id=ImageMagick
{
   CREATOR: file_miff_save gimp plug-in, see http://www.gimp.org/
$hdr}
EOF

   Gimp->tile_cache_ntiles($img->width / Gimp->tile_width + 1);

   init Progress "Saving '$filename' as MIFF...";
   my $scene = 0;
   for (@layers) {
      print FILE $hdr,
            "scene=$scene\n",
            "class=", $_->is_rgb ? "DirectClass" : "PseudoClass", "\n";
            #"gamma=", Gimp->gamma, "\n";
      # resolution etc..
      write_layer(*FILE,$_);
      $scene++;
      update Progress $scene/@layers;
   }
   close FILE;
   $new_img->delete if $export == EXPORT_EXPORT;
   ();
};

sub read_layer {
   my($img)=shift;
   local $_=shift;
   my($w,$h,$d)=($_->{columns},$_->{rows},$_->{_bpp});

   my $l = new Layer $img, $w, $h,
                     (
                        $d == 1 ? GRAY_IMAGE
                      : $d == 2 ? GRAYA_IMAGE
                      : $d == 3 ? RGB_IMAGE
                      : $d == 4 ? RGBA_IMAGE
                      : die "Unsupported image depth ($d channels)\n"
                     ),
                     $_->{scene}, 100, NORMAL_MODE;

   $l->add_layer($_->{scene});

   my $r = new PixelRgn $l,0,0,$w,$h,1,0;
   seek FILE, $_->{_offset}, 0;

   for my $y (0..$h-1) {
      read FILE, $_, $w * $d;
      $r->set_rect2($_,0,$y);
   }
   undef $r;
   $l;
}

register "file_miff_load",
         "load miff images (Magick Interchange File Format)",
         "Loads images that were saved in the miff (Magick Interchange File Format) format used by the ImageMagick package",
         "Marc Lehmann",
         "Marc Lehmann <pcg\@goof.com>",
         "1999-09-14",
         "<Load>/MIFF",
         undef,
         [],
         sub {
   my($filename) = @_;
   sysopen FILE,$filename,O_RDONLY or die "Unable to open '$filename' for reading: $!\n";
   my(@scenes);
   my $comment;
   seek FILE, 0, 2; my $filesize = tell FILE; seek FILE, 0, 0;
   local $/ = "\012";
   init Progress "Loading MIFF image from '$filename'...";
   do {
      my %h;
      header:
      while (<FILE>) {
         die "Unexpected end of file while reading from '$filename'\n" if eof;
         while($_ =~ /\S/) {
            if (/:\012$/) {
               last header;
            } elsif (s/^\s*(\w+)=(\S+|"(?:[^\\"]+|\\"|\\)*")//) {
               $h{$1}=$2;
            } elsif (s/\s*\{//) {
               while(!s/([^}]*)}//) {
                  $comment .= $_;
                  $_ = <FILE>;
                  die "Unexpected end of file while reading comment block from '$filename'\n" if eof;
               }
               $comment .= $1;
            } else {
               die "Unparseable header line ($_) while reading '$filename'\n";
            }
         }
      }

      die "No ImageMagick header found in '$filename'\n" unless $h{id} eq "ImageMagick";
   
      $h{_bpp} = ($h{class} =~ /PseudoClass/ ? 1 : 3)
              + ($h{matte} =~ /True/i ? 1 : 0);
      $h{_size} = $h{rows} * $h{columns} * $h{_bpp};
      $h{_offset} = tell;
      push @scenes, \%h;
      
      seek FILE, $h{_size}, 1;
      update Progress tell()/$filesize*0.2;
   } while !eof;

   my ($w,$h,$d);
   for (@scenes) {
      $w = $_->{columns} if $_->{columns} > $w;
      $h = $_->{rows}    if $_->{rows}    > $h;
      $d = $_->{_bpp}    if $_->{_bpp}    > $d;
   }

   my $img = new Image $w, $h, $d >= 3 ? RGB : GRAY;
   $img->set_filename($filename);
   $img->undo_disable;

   if ($comment) {
      $comment =~ s/^\s+//s;
      $comment =~ s/\s+$//s;
      $img->parasite_attach (new Parasite "gimp-comment", PARASITE_PERSISTENT, $comment);
   }
   # resolution etc..

   Gimp->tile_cache_ntiles($w / Gimp->tile_width + 1);

   # horrors, reverse, and line-by-line (!!)
   for (@scenes) {
      my $layer = read_layer $img,$_;
      update Progress tell()/$filesize*0.8 + 0.2;
   }

   $img->undo_enable;
   $img;
};

Gimp::on_query {
   Gimp->register_magic_load_handler("file_miff_load", "miff", "", "0,string,id=ImageMagick");
   Gimp->register_save_handler("file_miff_save", "miff", "");
};

exit main;