From: Norman Walsh Date: Fri, 9 Jun 2006 13:13:09 +0000 (+0000) Subject: Imageobjectco helpers X-Git-Url: https://granicus.if.org/sourcecode?a=commitdiff_plain;h=95662375eda0fd9c2efcea095884edd5b94ecf1e;p=docbook-dsssl Imageobjectco helpers --- diff --git a/imageco/bin/areaoverlay b/imageco/bin/areaoverlay new file mode 100755 index 000000000..56fd9a0e5 --- /dev/null +++ b/imageco/bin/areaoverlay @@ -0,0 +1,235 @@ +#!/usr/bin/perl -- # -*- Perl -*- + +# areaoverlay -- Generates images with callouts from DocBook imageobjectco's +# +# $Id$ +# +# Copyright (C) 2006 Norman Walsh +# +# This is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2, or (at your option) +# any later version. +# +# It is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +# License for more details. +# +# Usage: +# +# areaoverlay [-d] [-p copath] [-e coext] docbook.xml +# +# The script searches for tags in docbook.xml. For each +# one that it finds, it processes each of the s that it +# contains. If you specify the base image with a processing instruction, +# for example, , then this script will use +# the base image plus the areas specified to generate the image identified +# by the fileref with callouts at the specified locations. +# +# The callouts are 1.gif, 2.gif, etc. You can (and probably must) specify +# the directory where the graphics are located with the -p option. You can +# change the extension with the -e option. If you specify -d, the script +# will add a black rectangle to the graphic showing the region that it +# thinks each coords identifies. +# +# Bugs and limitations: +# +# Only supports calspair units. +# +# Requires GD library version 2 or later. Version 1 doesn't support +# transparency so the results are usually pretty ugly. +# +# The version of GD that I have seems to mangle transparent PNGs. +# +# XML::XPath doesn't support unparsed-entity-uri() so entityref is handled +# with a hack. And it doesn't support public identifiers or catalog +# resolution. + +use strict; +use English; +use Getopt::Std; +use GD; +use XML::XPath; +use vars qw($opt_d $opt_p $opt_e); + +my $usage = "$0 [-d] [-p copath] [-e coext] docbook.xml\n"; + +die $usage if ! getopts('de:p:'); + +my $debug = $opt_d || 0; +my $path = $opt_p || "/sourceforge/docbook/xsl/images/callouts"; +my $ext = $opt_e || "gif"; + +my $docbook = shift @ARGV || die $usage; + +my $xp = XML::XPath->new(filename => $docbook); +$xp->set_namespace('db', 'http://docbook.org/ns/docbook'); + +my $cos = $xp->find("//imageobjectco|//db:imageobjectco"); +foreach my $node ($cos->get_nodelist()) { + processImage($node); +} + +sub processImage { + my $node = shift; + my $pi = "processing-instruction('base-image')"; + my $images = $node->find("imageobject[$pi]|db:imageobject[$pi]"); + + foreach my $img ($images->get_nodelist()) { + my $baseimg = ($img->find($pi . "[1]")->get_nodelist())[0]->getData(); + my $data = ($img->find("imagedata|db:imagedata")->get_nodelist())[0]; + my $fileref = $data->getAttribute('fileref'); + if (!$fileref) { + my $entref = $data->getAttribute('entityref'); + # HACK HACK HACK; this ought to be supported in XML::XPath + open (F, $docbook); + read (F, $_, 32768); # 32k far enough? + close (F); + # No support for public identifiers and catalog resolution :-( + if (/find("../areaspec/*|../db:areaspec/*"); + + my $count = 0; + foreach my $area ($areas->get_nodelist()) { + $count++; + if ($area->getLocalName() eq 'areaset') { + my $setareas = $area->find("area|db:area"); + if ($area->getAttribute('units') eq 'calspair' + || !$area->getAttribute('units')) { + foreach my $sarea ($setareas->get_nodelist()) { + processArea(\@coords, $count, $sarea); + } + } + } else { + processArea(\@coords, $count, $area); + } + } + + print "Callouts: $baseimg -> $fileref\n"; + makeOverlay($baseimg, $fileref, @coords); + } +} + +sub processArea { + my $coords = shift; + my $count = shift; + my $area = shift; + + if ($area->getAttribute('units') ne 'calspair' + && $area->getAttribute('units')) { + # only process with calspairs + return; + } + + push (@{$coords}, "$count " . $area->getAttribute('coords')); +} + +sub makeOverlay { + my $baseimage = shift; + my $overimage = shift; + my @coords = @_; + my @overlays = (); + + my $orig = load($baseimage); + my ($width, $height) = $orig->getBounds(); + + my $black = $orig->colorAllocate(0,0,0); + + while (@coords) { + while (split(/\s+/, shift @coords)) { + my $conumber = shift || die "Can't parse callout data.\n"; + my $llcorner = shift || die "Can't parse callout data.\n"; + my $urcorner = shift || die "Can't parse callout data.\n"; + + die "Can't parse callout data.\n" + if ($conumber !~ /^\d+$/ + || $llcorner !~ /^\d+,\d+$/ + || $urcorner !~ /^\d+,\d+$/); + + my $cographic = load("$path/$conumber.$ext"); + my ($cowidth,$coheight) = $cographic->getBounds(); + + my ($lx, $ly, $ux, $uy); + ($lx, $ly) = ($1, $2) if $llcorner =~ /^(\d+),(\d+)$/; + ($ux, $uy) = ($1, $2) if $urcorner =~ /^(\d+),(\d+)$/; + + $lx = int(($width * $lx) / 10000.0); + $ly = $height - int(($height * $ly) / 10000.0) - 1; + $ux = int(($width * $ux) / 10000.0); + $uy = $height - int(($height * $uy) / 10000.0) - 1; + + $orig->rectangle($lx,$ly,$ux,$uy,$black) if $debug; + + $orig->copy($cographic, $lx, $ly, 0, 0, $cowidth, $coheight); + } + } + + save($orig, $overimage); +} + +sub load { + my $file = shift; + my $ext = $file; + $ext =~ s/^.*\.([^\.]+)$/$1/; + + if (! -f $file) { + die "File not found: $file\n"; + } + + if ($ext eq 'png') { + return GD::Image->newFromPng($file); + } elsif ($ext eq 'jpeg' || $ext eq 'jpg') { + return GD::Image->newFromJpeg($file); + } elsif ($ext eq 'xbm') { + return GD::Image->newFromXbm($file); + } elsif ($ext eq 'wmp') { + return GD::Image->newFromWMP($file); + } elsif ($ext eq 'gif') { + return GD::Image->newFromGif($file); + } elsif ($ext eq 'xpm') { + return GD::Image->newFromXpm($file); + } else { + die "Don't know how to load image: $file\n"; + } +} + +sub save { + my $img = shift; + my $file = shift; + my %formats = ('png' => 1, 'jpeg' => 1, 'jpg' => 1, + 'wmp' => 1, 'gif' => 1); + my $ext = $file; + $ext =~ s/^.*\.([^\.]+)$/$1/; + + if (!exists($formats{$ext})) { + warn "Cannot save $file.\n"; + return; + } + + open (F, ">$file"); + binmode (F); + + if ($ext eq 'png') { + print F $img->png(); + } elsif ($ext eq 'jpeg' || $ext eq 'jpg') { + print F $img->jpeg(); + } elsif ($ext eq 'wmp') { + print F $img->wbmp(); + } elsif ($ext eq 'gif') { + print F $img->gif(); + } else { + # shouldn't happen! + die "Don't know how to save image: $file\n"; + } + + close (F); +} diff --git a/imageco/bin/areasearch b/imageco/bin/areasearch new file mode 100755 index 000000000..3c0f7d4bb --- /dev/null +++ b/imageco/bin/areasearch @@ -0,0 +1,163 @@ +#!/usr/bin/perl -- # -*- Perl -*- + +# areasearch -- Searches for rectangles and generates coords +# +# $Id$ +# +# Copyright (C) 2006 Norman Walsh +# +# This is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2, or (at your option) +# any later version. +# +# It is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +# License for more details. +# +# Usage: +# +# areasearch graphic +# +# The script searches for rectangular regions in the graphic and generates +# CALS calspair coords for them. +# +# Bugs and limitations: +# +# Identifies the background color by searching exhaustively for the +# predominate color. That may be slow on large graphics. +# +# Searches for rectangles, no other shapes. + +use strict; +use English; +use Getopt::Std; +use GD; +use Image::Info qw(image_info dim); + +my $usage = "$0 image\n"; +my $imagefile = shift @ARGV || die $usage; + +print STDERR "Loading $imagefile...\n"; + +my $img = load($imagefile); +my ($width, $height) = $img->getBounds(); + +print STDERR "Searching for background color...\n"; + +my %index = (); +for (my $y = 0; $y < $height; $y++) { + for (my $x = 0; $x < $width; $x++) { + my $idx = $img->getPixel($x, $y); + $index{$idx} = 0 if ! exists $index{$idx}; + $index{$idx}++; + } +} + +my $count = -1; +my $background = 0; +foreach my $idx (keys %index) { + if ($index{$idx} > $count) { + $background = $idx; + $count = $index{$idx}; + } +} + +#print STDERR "Index $background is the background color.\n"; + +print STDERR "Searching for rectangles...\n"; + +my @squares = (); +for (my $y = 0; $y < $height; $y++) { + for (my $x = 0; $x < $width; $x++) { + my $idx = $img->getPixel($x, $y); + if ($idx != $background && newSquare($x, $y)) { + my ($width, $height) = findSquare($x, $y); + print STDERR "New rectangle at $x, $y ($width x $height)\n"; + } + } +} + +foreach my $sq (@squares) { + my ($x, $y) = ($sq->{'x'}, $sq->{'y'}); + my ($w, $h) = ($sq->{'w'}, $sq->{'h'}); + + my $lx = $x; + my $ly = $height - $y; + my $ux = $x+$w-1; + my $uy = $height - ($y + $h - 1); + + printf ("\n", + int($lx/$width*10000.0), + int($ly/$height*10000.0), + int($ux/$width*10000.0), + int($uy/$height*10000.0)); +} + +exit; + +# ============================================================ + +sub findSquare { + my $x = shift; + my $y = shift; + + my $w = 0; + my $h = 0; + + while ($w < $width && $img->getPixel($x+$w, $y) != $background) { + $w++; + } + + while ($h < $height && $img->getPixel($x, $y+$h) != $background) { + $h++; + } + + my $sq = {}; + $sq->{'x'} = $x; + $sq->{'y'} = $y; + $sq->{'w'} = $w; + $sq->{'h'} = $h; + push (@squares, $sq); + + return ($w, $h); +} + +sub newSquare { + my $x = shift; + my $y = shift; + + foreach my $sq (@squares) { + if ($x >= $sq->{'x'} + && $x <= $sq->{'x'}+$sq->{'w'}-1 + && $y >= $sq->{'y'} + && $y <= $sq->{'y'}+$sq->{'h'}-1) { + return 0; + } + } + + return 1; +} + +sub load { + my $file = shift; + my $ext = $file; + $ext =~ s/^.*\.([^\.]+)$/$1/; + + if ($ext eq 'png') { + return GD::Image->newFromPng($file); + } elsif ($ext eq 'jpeg' || $ext eq 'jpg') { + return GD::Image->newFromJpeg($file); + } elsif ($ext eq 'xbm') { + return GD::Image->newFromXbm($file); + } elsif ($ext eq 'wmp') { + return GD::Image->newFromWMP($file); + } elsif ($ext eq 'gif') { + return GD::Image->newFromGif($file); + } elsif ($ext eq 'xpm') { + return GD::Image->newFromXpm($file); + } else { + die "Don't know how to load image: $file\n"; + } +} diff --git a/imageco/example/Makefile b/imageco/example/Makefile new file mode 100644 index 000000000..bc399b9bc --- /dev/null +++ b/imageco/example/Makefile @@ -0,0 +1,10 @@ +all: duck.html + +duck.html: duck.xml + ../bin/areaoverlay $< + saxon $< /sourceforge/docbook/xsl2/html/docbook.xsl $@ + tidy $@ + +clean: + rm duck.html + rm figures/duck*-co.png diff --git a/imageco/example/duck.xml b/imageco/example/duck.xml new file mode 100644 index 000000000..37b8ca157 --- /dev/null +++ b/imageco/example/duck.xml @@ -0,0 +1,58 @@ + +]> +
+ +Callout Test + + +Two ducks with callouts + + + + + + + + + + + + + + + + + The bill. + The feet. + The tail. + + + + + + + + + + + + + + + + + + + + + + The bill. + The body. + The tail. + The feet. + + +
diff --git a/imageco/example/figures/duckl.png b/imageco/example/figures/duckl.png new file mode 100644 index 000000000..0da62a579 Binary files /dev/null and b/imageco/example/figures/duckl.png differ diff --git a/imageco/example/figures/duckr.png b/imageco/example/figures/duckr.png new file mode 100644 index 000000000..e8a99beef Binary files /dev/null and b/imageco/example/figures/duckr.png differ diff --git a/imageco/example/figures/rcallouts.png b/imageco/example/figures/rcallouts.png new file mode 100644 index 000000000..da64885a5 Binary files /dev/null and b/imageco/example/figures/rcallouts.png differ