callisto-debian/gimp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

see plug-ins/perl/Changes

Browse Source
This commit is contained in:
Marc Lehmann
1999-11-20 20:43:36 +00:00
parent 3bfe043c4d
commit 7f38315e5c
8 changed files with 199 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
plug-ins/perl/Changes
View File

@ -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).

12
plug-ins/perl/Gimp/Lib.xs
View File

@ -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

1
plug-ins/perl/MANIFEST
View File

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

2
plug-ins/perl/Makefile.PL
View File

@ -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(

2
plug-ins/perl/TODO
View File

@ -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

135
plug-ins/perl/examples/colorhtml Executable file
View File

@ -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__

77
plug-ins/perl/examples/dataurl
View File

@ -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 <pcg\@goof.com>",
"1999-11-20",
"<Save>/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 "<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_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: $!";
<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.

2
plug-ins/perl/examples/innerbevel
View File

@ -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;