--- /dev/null
+#!/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 <imageobjectco> tags in docbook.xml. For each
+# one that it finds, it processes each of the <imageobject>s that it
+# contains. If you specify the base image with a processing instruction,
+# for example, <?base-image somegraphic.png?>, 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 (/<!ENTITY\s+$entref\s+SYSTEM\s+([\'\"])(.*?)\1/s) {
+ $fileref = $2;
+ } else {
+ warn "Can't handle entityref in XML::XPath (skipping $entref)\n";
+ next;
+ }
+ }
+ my @coords = ();
+
+ my $areas = $img->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);
+}
--- /dev/null
+#!/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 ("<area xml:id=\"\" linkends=\"\" units=\"calspair\" coords=\"%d,%d %d,%d\"/>\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";
+ }
+}
--- /dev/null
+<!DOCTYPE article [
+<!ENTITY duck SYSTEM "figures/duckl-co.png" NDATA PNG>
+]>
+<article xmlns="http://docbook.org/ns/docbook">
+<info>
+<title>Callout Test</title>
+</info>
+
+<para>Two ducks with callouts</para>
+
+<mediaobject>
+ <imageobjectco>
+ <areaspec>
+ <area xml:id="p1" coords="240,9049 497,8786" linkends="c1"/>
+ <area xml:id="p2" coords="2905,1360 3162,1098" linkends="c2"/>
+ <area xml:id="p3" coords="8796,1491 9052,1229" linkends="c3"/>
+ </areaspec>
+ <imageobject>
+ <?base-image figures/duckl.png?>
+ <imagedata
+ entityref="duck"/>
+ </imageobject>
+ </imageobjectco>
+</mediaobject>
+
+<calloutlist>
+ <callout arearefs="p1" xml:id="c1"><para>The bill.</para></callout>
+ <callout arearefs="p2" xml:id="c2"><para>The feet.</para></callout>
+ <callout arearefs="p3" xml:id="c3"><para>The tail.</para></callout>
+</calloutlist>
+
+<mediaobject>
+ <imageobjectco>
+ <areaspec>
+ <area xml:id="p4" coords="9333,9455 9633,9149" linkends="c4"/>
+ <area xml:id="p5" coords="5000,5170 5633,4523" linkends="c5"/>
+ <area xml:id="p6" coords="300,3027 600,2721" linkends="c6"/>
+ <areaset xml:id="p7" linkends="c7">
+ <area coords="5500,1666 5800,1360"/>
+ <area coords="5866,1054 6166,748"/>
+ </areaset>
+ </areaspec>
+ <imageobject>
+ <?base-image figures/duckr.png?>
+ <imagedata
+ fileref="figures/duckr-co.png"/>
+ </imageobject>
+ </imageobjectco>
+</mediaobject>
+
+<calloutlist>
+ <callout arearefs="p4" xml:id="c4"><para>The bill.</para></callout>
+ <callout arearefs="p5" xml:id="c5"><para>The body.</para></callout>
+ <callout arearefs="p6" xml:id="c6"><para>The tail.</para></callout>
+ <callout arearefs="p7" xml:id="c7"><para>The feet.</para></callout>
+</calloutlist>
+
+</article>
projects / docbook-dsssl / commitdiff
