see plug-ins/perl/Changes

plug-ins/perl/Changes

@@ -4,6 +4,7 @@ Revision history for Gimp-Perl extension.
 	- removed sethspin.pl & billboard, they are no longer maintained :(
         - *sigh* removed some debugging code.
         - new save-filter "dataurl" (more a joke, but it does work).
+        - implemented gimp_pixel_rgn_get_row2 (others still unimplemented).
 
 1.15  Fri Nov 19 19:12:16 CET 1999
 	- added italian translations by Daniele Medri (madrid@kjws.com).

plug-ins/perl/Gimp/Lib.xs

@@ -1952,6 +1952,18 @@ gimp_tile_drawable(tile)
 	OUTPUT:
 	RETVAL
 
+SV *
+gimp_pixel_rgn_get_row2(pr, x, y, width)
+	GPixelRgn *	pr
+	int	x
+	int	y
+	int	width
+	CODE:
+        RETVAL = newSVn (width * pr->bpp);
+	gimp_pixel_rgn_get_row (pr, SvPV_nolen(RETVAL), x, y, width);
+	OUTPUT:
+	RETVAL
+
 SV *
 gimp_pixel_rgn_get_rect2(pr, x, y, width, height)
 	GPixelRgn *	pr

plug-ins/perl/MANIFEST

@@ -119,6 +119,7 @@ examples/avi
 examples/layerfuncs
 examples/bricks
 examples/dataurl
+examples/colorhtml
 pxgettext
 po/gimp-perl.pot
 po/de.po

plug-ins/perl/Makefile.PL

@@ -35,7 +35,7 @@ if ($ARGV[0] ne "--writemakefile") {
       repdup centerguide stampify goldenmean triangle mirrorsplit
       layerfuncs randomart1 glowing_steel frame_reshuffle frame_filter
       logulator miff gimpmagick guide_remove guides_to_selection burst
-      fire povray avi layerfuncs bricks dataurl
+      fire povray avi layerfuncs bricks dataurl colorhtml
    );
 @pdl_pins =
    qw(

plug-ins/perl/TODO

@@ -33,6 +33,8 @@ olof
 
 bugs
 
+  * rate-limiting for gimp_message BEFORE 1.2
+  * on-query => remove gimp::fu parasite(?)
   * bricks requires disable for pattern(?)
   * better default argument-handlign via a "massage_args" callback from Gimp/UI/interact?
   * update frosty-logo.scm  t-o-p-logo.scm starscape-logo.scm starburst-logo.scm

plug-ins/perl/examples/colorhtml

@@ -0,0 +1,135 @@
+#!/usr/bin/perl
+# pcg@goof.com
+
+use Gimp;
+use Gimp::Fu;
+use Gimp::UI;
+use Fcntl;
+
+# Gimp::set_trace(TRACE_ALL);
+
+my %replace = (
+   "&" => "&",
+   "<" => "&lt;",
+   ">" => "&gt;",
+);
+
+# read some file, make text out of it
+sub read_text {
+   my $fh = shift;
+   local $/;
+   my $data = <$fh>;
+   $data;
+}
+
+register "file_colorhtml_save",
+         __"Saves the image as coloured html text",
+         "=pod",
+         "Marc Lehmann",
+         "Marc Lehmann <pcg\@goof.com>",
+         "1999-11-21",
+         "<Save>/COLORHTML",
+         "*",
+         [
+          [PF_RADIO,	"character_source", "where to take the characters from", 0,
+          		[sourcecode => 0, textfile => 1, filename => 2]],
+          [PF_FILE,	"characters",     "the filename to read or the characters to use", ""],
+          [PF_STRING,   "font_size",      "the html font size (1..7 or -7 .. +7)", 2],
+          [PF_BOOL,	"compatible",     "html-4.0 compliancy?", 1],
+          [PF_BOOL,	"closetag",       "add closing tag?", 1],
+         ],
+         sub {
+   my($img,$drawable,$filename,$filename2,$source,$text,$size,$html40,$closetag) = @_;
+   print " @_\n";
+   my($new_img,$new_drawable);
+   my $max;
+   my $export = Gimp::UI::export_image ($new_img=$img, $new_drawable=$drawable, "COLORHTML",
+                                        CAN_HANDLE_RGB);
+   die __"export failed" if $export == EXPORT_CANCEL;
+
+   my ($w,$h) = ($new_drawable->width, $new_drawable->height);
+   Gimp->tile_cache_ntiles($w / Gimp->tile_width + 1);
+
+   sysopen FILE,$filename,O_CREAT|O_TRUNC|O_WRONLY or die __"Unable to open '$filename' for writing: $!\n";
+
+   my $data;
+   if ($source == 0) {
+      seek DATA, 0, 0;
+      $data = read_text *DATA;
+   } elsif ($source == 1) {
+      local *FILE;
+      open FILE, "<$text" or die "$text: $!\n";
+      $data = read_text *FILE;
+   } elsif ($source == 2) {
+      $data = $text;
+   }
+
+   my @data;
+   $data =~ y/\x21-\x7f//cd;
+   @data = split //, $data;
+   for (@data) {
+      s/([&<>])/$replace{$1}/e;
+   }
+   @data = ("X") x 80 unless @data;
+   my @chars;
+
+   my $region = $new_drawable->pixel_rgn (0, 0, $w, $h, 0, 0);
+
+   init Progress __"Saving '$filename' as COLORHTML...";
+
+   $closetag = $closetag ? "<font>" : "";
+
+   print FILE "<html><body bgcolor=black>\n<font size=\"$size\"><pre>\n";
+   for (my $y = 0; $y < $h; $y++) {
+      my $pel = $region->get_row2 (0, $y, $w);
+      push @chars,@data while @chars < $w;
+      if ($html40) {
+         $pel =~ s{(...)}{
+            "<font color=\"#".unpack("H*",$1)."\">".shift(@chars).$clostag;
+         }ges;
+      } else {
+         $pel =~ s{(...)}{
+            "<font color=".unpack("H*",$1).">".shift(@chars).$closetag;
+         }ges;
+      }
+      
+      print FILE $pel,"\n";
+
+      update Progress $y/$h;
+   }
+   print FILE "</pre>\n</html>\n";
+
+   $new_img->delete if $export == EXPORT_EXPORT;
+   ();
+};
+
+Gimp::on_query {
+   Gimp->register_save_handler("file_colorhtml_save", "colorhtml", "");
+};
+
+exit main;
+
+=head1 COLORHTML FILE FORMAT
+
+This file save filter writes a large regular grid filled with coloured
+characters. The characters can be stored in file and don't have anything to do
+with the image. The colour of each character, though, is taken from the image
+to save.
+
+This creates some kind of mosaic effect with characters.
+
+The pictures should be limited to about 120x120 pixels, since most
+browsers do not view larger images. The aspect ratio depends on the
+fixed-width font the browser is using, and is usually around 10:6 (so you
+should squash your image accordingly).
+
+The FONT tags can be saved either HTML-4.0 compliant (C<font color="#rrggbb">)
+or in a proprietary format most browsers support (C<font color=rrggbb>).
+To save even more space you can leave out the closing tag (C</font>),
+but this will potentially leave thousands of font elements open in the browser,
+and will disturb the current font colour.
+
+=cut
+
+__END__
+

plug-ins/perl/examples/dataurl

@@ -11,55 +11,53 @@ use Fcntl;
 
 sub encode_base64 ($;$)
 {
-    my $res = "";
+    my $res = substr pack ("u", $_[0]), 1;
-    my $eol = $_[1];
+    $res =~ s/\n.//mg;
-    $eol = "\n" unless defined $eol;
+    $res =~ tr|` -_|AA-Za-z0-9+/|; #` # syntax-hiliting in emacs kanns nicht
-    pos($_[0]) = 0;                          # ensure start at the beginning
-    while ($_[0] =~ /(.{1,45})/gs) {
-        $res .= substr(pack('u', $1), 1);
-        chop($res);
-    }
-    $res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs
-    # fix padding at the end
     my $padding = (3 - length($_[0]) % 3) % 3;
     $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
-    # break encoded string into lines of no more than 76 characters each
-    if (length $eol) {
-        $res =~ s/(.{1,76})/$1$eol/g;
-    }
     $res;
 }
 
-
+register "file_dataurl_save",
-register "file_dataurl",
+         __"saves the image as many small tiles using data:-urls",
-         "saves the image as many small tiles using data:-urls",
+         "=pod",
-         "Uses data:-urls to save a html table with embedded image data",
          "Marc Lehmann",
          "Marc Lehmann <pcg\@goof.com>",
          "1999-11-20",
          "<Save>/DATAURL",
          "*",
          [
-          [PF_SPINNER,	"tile_x",	"tile width",	32, [0, 128, 1, 1]],
+          [PF_SPINNER,	"tile_x",	"tile width",	32, [0, 8192, 1, 10]],
-          [PF_SPINNER,	"tile_y",	"tile height",	32, [0, 128, 1, 1]],
+          [PF_SPINNER,	"tile_y",	"tile height",	32, [0, 8192, 1, 10]],
+          [PF_RADIO,	"filetype",	"underlying file type", 0,
+                        [GIF => 0, JFIF => 1, PNG => 2]],
          ],
          sub {
-   my($img,$drawable,$filename,$filename2,$tx,$ty) = @_;
+   my($img,$drawable,$filename,$filename2,$tx,$ty,$type) = @_;
    my($new_img,$new_drawable);
    my $max;
    my $export = Gimp::UI::export_image ($new_img=$img, $new_drawable=$drawable, "DATAURL",
-                                        CAN_HANDLE_INDEXED|CAN_HANDLE_ALPHA);
+                                        $type==0 ? CAN_HANDLE_INDEXED|CAN_HANDLE_ALPHA
-   die "export failed" if $export == EXPORT_CANCEL;
+                                      : $type==1 ? CAN_HANDLE_RGB|CAN_HANDLE_GRAY
+                                      : $type==2 ? CAN_HANDLE_RGB|CAN_HANDLE_GRAY|CAN_HANDLE_INDEXED
+                                      :            0 );
+   die __"export failed" if $export == EXPORT_CANCEL;
 
    my ($w,$h) = ($new_drawable->width, $new_drawable->height);
 
-   my $tmp = Gimp->temp_name(".gif");
+   my $tmp = Gimp->temp_name(".img~");
 
-   sysopen FILE,$filename,O_CREAT|O_TRUNC|O_WRONLY or die "Unable to open '$filename' for writing: $!\n";
+   sysopen FILE,$filename,O_CREAT|O_TRUNC|O_WRONLY or die __"Unable to open '$filename' for writing: $!\n";
 
    print FILE "<html><body>\n";
 
-   init Progress "Saving '$filename' as DATAURL...";
+   init Progress __"Saving '$filename' as DATAURL...";
+
+   my $media = $type==0 ? "gif"
+             : $type==1 ? "jpeg"
+             : $type==2 ? "png"
+             :            "";
 
    print FILE "<table width=$w cellspacing=0 cellpadding=0 border=0>";
    for(my $y=0; $y<$h; $y+=$ty) {
@@ -70,19 +68,19 @@ register "file_dataurl",
 
          my $img = $new_img->channel_ops_duplicate;
          $img->crop($wx,$wy,$x,$y);
-         ($img->get_layers)[0]->file_gif_save(($tmp)x2, 0, 0, 0, 0);
+         ($img->get_layers)[0]->file_gif_save  (($tmp)x2, 0, 0, 0, 0)                   if $type==0;
-         #($img->get_layers)[0]->file_png_save(($tmp)x2, 0, 1, 9);
+         ($img->get_layers)[0]->file_jpeg_save (($tmp)x2, 0.7, 0, 1, 0, "", 0, 1, 0, 0) if $type==1;
-         #($img->get_layers)[0]->file_jpeg_save(($tmp)x2, 0.5, 0, 1, 0, "", 0, 1, 0, 0);
+         ($img->get_layers)[0]->file_png_save  (($tmp)x2, 0, 1, 9)                      if $type==2;
          $img->delete;
 
          my $data = do {
             local(*TEMP,$/);
-            open TEMP, "<$tmp" or die "Unable to read temporary image tile $tmp: $!";
+            open TEMP, "<$tmp" or die __"Unable to read temporary image tile $tmp: $!";
             <TEMP>;
          };
          unlink $tmp;
 
-         $url = "data:image/gif;base64,".(encode_base64 $data, "");
+         $url = "data:image/$media;base64,".(encode_base64 $data);
          $max = length($url) if length($url) > $max;
 
          print FILE "<td><img src=\"", $url, "\">";
@@ -95,7 +93,7 @@ register "file_dataurl",
    print FILE "</html>\n";
    close FILE;
 
-   warn "url size is too large ($max > 1024)\n" if $max > 1024;
+   warn __"url size is too large ($max > 1024)\n" if $max > 1024;
 
    $new_img->delete if $export == EXPORT_EXPORT;
    ();
@@ -107,3 +105,18 @@ Gimp::on_query {
 
 exit main;
 
+=head1 DATAURL FILE FORMAT
+
+After reading rfc2397, which describes the C<data:> url scheme, I got the
+idea of embedding a normal image into a html document, without resorting
+to external files.
+
+This is acomplished by embedding small tiles of the image directly
+into data:-urls. Since attribute values are by default limited to 1024
+bytes this limits the size of a tile to approximately 34x34 pixels (gif
+compression).
+
+However, since the only browser I know of that supports this (rfc2397 is only a
+proposed standard), you might want to use much larger tile sizes (upto the image
+size), since netscape obviously does not have problems with it large urls.
+

plug-ins/perl/examples/innerbevel

@@ -7,6 +7,8 @@
 # working btw).  You can follow step by step with the website at 
 # http://tigert.gimp.org/gimp/tutorials/beveled_text/
 
+BEGIN { <STDIN>; print "HO\n"; }
+
 use Gimp;
 use Gimp::Fu;
 use Gimp::Util;