From 7f38315e5c831028647ddbd5142bb7f845d83796 Mon Sep 17 00:00:00 2001 From: Marc Lehmann Date: Sat, 20 Nov 1999 20:43:36 +0000 Subject: [PATCH] see plug-ins/perl/Changes --- plug-ins/perl/Changes | 1 + plug-ins/perl/Gimp/Lib.xs | 12 +++ plug-ins/perl/MANIFEST | 1 + plug-ins/perl/Makefile.PL | 2 +- plug-ins/perl/TODO | 2 + plug-ins/perl/examples/colorhtml | 135 ++++++++++++++++++++++++++++++ plug-ins/perl/examples/dataurl | 77 ++++++++++------- plug-ins/perl/examples/innerbevel | 2 + 8 files changed, 199 insertions(+), 33 deletions(-) create mode 100755 plug-ins/perl/examples/colorhtml diff --git a/plug-ins/perl/Changes b/plug-ins/perl/Changes index 6c3c4bb023..fafb86c8e6 100644 --- a/plug-ins/perl/Changes +++ b/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). diff --git a/plug-ins/perl/Gimp/Lib.xs b/plug-ins/perl/Gimp/Lib.xs index 7effa7042d..aa5b032883 100644 --- a/plug-ins/perl/Gimp/Lib.xs +++ b/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 diff --git a/plug-ins/perl/MANIFEST b/plug-ins/perl/MANIFEST index d1c362b90c..8f00003943 100644 --- a/plug-ins/perl/MANIFEST +++ b/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 diff --git a/plug-ins/perl/Makefile.PL b/plug-ins/perl/Makefile.PL index fb53d6d0dc..7efa094e29 100644 --- a/plug-ins/perl/Makefile.PL +++ b/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( diff --git a/plug-ins/perl/TODO b/plug-ins/perl/TODO index c4d7acb5c2..c6a2d83017 100644 --- a/plug-ins/perl/TODO +++ b/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 diff --git a/plug-ins/perl/examples/colorhtml b/plug-ins/perl/examples/colorhtml new file mode 100755 index 0000000000..cc5a24e3cd --- /dev/null +++ b/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 = ( + "&" => "&", + "<" => "<", + ">" => ">", +); + +# 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 ", + "1999-11-21", + "/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 ? "" : ""; + + print FILE "\n
\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{(...)}{
+            "".shift(@chars).$clostag;
+         }ges;
+      } else {
+         $pel =~ s{(...)}{
+            "".shift(@chars).$closetag;
+         }ges;
+      }
+      
+      print FILE $pel,"\n";
+
+      update Progress $y/$h;
+   }
+   print FILE "
\n\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) +or in a proprietary format most browsers support (C). +To save even more space you can leave out the closing tag (C), +but this will potentially leave thousands of font elements open in the browser, +and will disturb the current font colour. + +=cut + +__END__ + diff --git a/plug-ins/perl/examples/dataurl b/plug-ins/perl/examples/dataurl index e12c4f21b0..c412da3f91 100755 --- a/plug-ins/perl/examples/dataurl +++ b/plug-ins/perl/examples/dataurl @@ -11,55 +11,53 @@ use Fcntl; sub encode_base64 ($;$) { - my $res = ""; - my $eol = $_[1]; - $eol = "\n" unless defined $eol; - 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 $res = substr pack ("u", $_[0]), 1; + $res =~ s/\n.//mg; + $res =~ tr|` -_|AA-Za-z0-9+/|; #` # syntax-hiliting in emacs kanns nicht 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", - "saves the image as many small tiles using data:-urls", - "Uses data:-urls to save a html table with embedded image data", +register "file_dataurl_save", + __"saves the image as many small tiles using data:-urls", + "=pod", "Marc Lehmann", "Marc Lehmann ", "1999-11-20", "/DATAURL", "*", [ - [PF_SPINNER, "tile_x", "tile width", 32, [0, 128, 1, 1]], - [PF_SPINNER, "tile_y", "tile height", 32, [0, 128, 1, 1]], + [PF_SPINNER, "tile_x", "tile width", 32, [0, 8192, 1, 10]], + [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); - die "export failed" if $export == EXPORT_CANCEL; + $type==0 ? CAN_HANDLE_INDEXED|CAN_HANDLE_ALPHA + : $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 "\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 ""; 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_png_save(($tmp)x2, 0, 1, 9); - #($img->get_layers)[0]->file_jpeg_save(($tmp)x2, 0.5, 0, 1, 0, "", 0, 1, 0, 0); + ($img->get_layers)[0]->file_gif_save (($tmp)x2, 0, 0, 0, 0) if $type==0; + ($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_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: $!"; ; }; 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 "
"; @@ -95,7 +93,7 @@ register "file_dataurl", print FILE "\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 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. + diff --git a/plug-ins/perl/examples/innerbevel b/plug-ins/perl/examples/innerbevel index 7d38cfcea6..c079039c6e 100755 --- a/plug-ins/perl/examples/innerbevel +++ b/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 { ; print "HO\n"; } + use Gimp; use Gimp::Fu; use Gimp::Util;