#############################################################################
# output the a Graph::Easy as SVG (Scalable Vector Graphics)
#
#############################################################################
package Graph::Easy::As_svg;
use vars qw/$VERSION/;
$VERSION = '0.23';
use strict;
use utf8;
sub _text_length
{
# Take a string, and return it's length, based on the font-size and the
# contents ("iii" is shorter than "WWW")
my ($em, $text) = @_;
# For each len entry, count how often it matches the string
# if it matches 2 times "[Ww]", and 3 times "[i]" then we have
# (X - (2+3)) * EM + 2*$W*EM + 3*$I*EM where X is length($text), and
# $W and $I are sizes of "[Ww]" and "[i]", respectively.
my $count = length($text);
my $len = 0; my $match;
$match = $text =~ tr/'`//;
$len += $match * 0.25 * $em; $count -= $match;
$match = $text =~ tr/Iijl!.,;:\|//;
$len += $match * 0.33 * $em; $count -= $match;
$match = $text =~ tr/"Jft\(\)\[\]\{\}//;
$len += $match * 0.4 * $em; $count -= $match;
$match = $text =~ tr/?//;
$len += $match * 0.5 * $em; $count -= $match;
$match = $text =~ tr/crs_//;
$len += $match * 0.55 * $em; $count -= $match;
$match = $text =~ tr/ELPaäevyz\\\/-//;
$len += $match * 0.6 * $em; $count -= $match;
$match = $text =~ tr/1BZFbdghknopqux~üö//;
$len += $match * 0.65 * $em; $count -= $match;
$match = $text =~ tr/KCVXY%023456789//;
$len += $match * 0.7 * $em; $count -= $match;
$match = $text =~ tr/§€//;
$len += $match * 0.75 * $em; $count -= $match;
$match = $text =~ tr/ÜÖÄßHGDSNQU$&//;
$len += $match * 0.8 * $em; $count -= $match;
$match = $text =~ tr/AwO=+<>//;
$len += $match * 0.85 * $em; $count -= $match;
$match = $text =~ tr/W//;
$len += $match * 0.90 * $em; $count -= $match;
$match = $text =~ tr/M//;
$len += $match * 0.95 * $em; $count -= $match;
$match = $text =~ tr/m//;
$len += $match * 1.03 * $em; $count -= $match;
$match = $text =~ tr/@//;
$len += $match * 1.15 * $em; $count -= $match;
$match = $text =~ tr/æ//;
$len += $match * 1.25 * $em; $count -= $match;
$len += $count * $em; # anything else is 1.0
# return length in "characters"
$len / $em;
}
sub _quote_name
{
my $name = shift;
my $out_name = $name;
# "--" is not allowed inside comments:
$out_name =~ s/--/- - /g;
# "&", "<" and ">" will not work in comments, so quote them
$out_name =~ s/&/&/g;
$out_name =~ s/</g;
$out_name =~ s/>/>/g;
$out_name;
}
sub _quote
{
my ($txt) = @_;
# "&", ,'"', "<" and ">" will not work in hrefs or texts
$txt =~ s/&/&/g;
$txt =~ s/</g;
$txt =~ s/>/>/g;
$txt =~ s/"/"/g;
# remove "\n"
$txt =~ s/(^|[^\\])\\[lcnr]/$1 /g;
$txt;
}
sub _sprintf
{
my $form = '%0.2f';
my @rc;
for my $x (@_)
{
push @rc, undef and next unless defined $x;
my $y = sprintf($form, $x);
# convert "10.00" to "10"
$y =~ s/\.0+\z//;
# strip tailing zeros on "0.10", but not from "100"
$y =~ s/(\.[0-9]+?)0+\z/$1/;
push @rc, $y;
}
wantarray ? @rc : $rc[0];
}
#############################################################################
#############################################################################
package Graph::Easy;
use strict;
BEGIN
{
*_quote = \&Graph::Easy::As_svg::_quote;
*_svg_attributes_as_txt = \&Graph::Easy::Node::_svg_attributes_as_txt;
}
sub EM
{
# return the height of one line in pixels, taking the font-size into account
my $self = shift;
# default is 16 pixels (and 0.5 of that is a nice round number, like, oh, 8)
$self->_font_size_in_pixels( 16 );
}
sub LINE_HEIGHT
{
# return the height of one line in pixels, taking the font-size into account
my $self = shift;
# default is 20% bigger than EM (to make a bit more space on multi-line
# labels for underlines etc)
$self->_font_size_in_pixels( 16 ) * 18 / 16;
}
my $devs = {
'ah' =>
" \n ' . "\n"
. ' '. "\n"
. ' '. "\n"
. " \n",
'ahb' =>
" \n ' . "\n"
. ' '. "\n"
. ' '. "\n"
. ' '. "\n"
. " \n",
'ahc' =>
" \n ' . "\n"
. ' '. "\n"
. " \n",
'ahf' =>
" \n ' . "\n"
. ' '. "\n"
. " \n",
# point-shapes
'diamond' =>
" ' . "\n"
. ' '. "\n"
. " \n",
'circle' =>
" ' . "\n"
. ' '. "\n"
. " \n",
'star' =>
" ' . "\n"
. ' '. "\n"
. " \n",
'square' =>
" ' . "\n"
. ' '. "\n"
. " \n",
'dot' =>
" ' . "\n"
. ' '. "\n"
. " \n",
'cross' =>
" ' . "\n"
. ' '. "\n"
. ' '. "\n"
. " \n",
# point-shapes with double border
'd-diamond' =>
" ' . "\n"
. ' '. "\n"
. ' '. "\n"
. " \n",
'd-circle' =>
" ' . "\n"
. ' '. "\n"
. ' '. "\n"
. " \n",
'd-square' =>
" ' . "\n"
. ' '. "\n"
. ' '. "\n"
. " \n",
'd-star' =>
" ' . "\n"
. ' '. "\n"
. ' '. "\n"
. " \n",
};
my $strokes = {
'dashed' => '3, 1',
'dotted' => '1, 1',
'dot-dash' => '1, 1, 3, 1',
'dot-dot-dash' => '1, 1, 1, 1, 3, 1',
'double-dash' => '3, 1',
'bold-dash' => '3, 1',
};
sub _svg_use_def
{
# mark a certain def as used (to output it's definition later)
my ($self, $def_name) = @_;
$self->{_svg_defs}->{$def_name} = 1;
}
sub text_styles_as_svg
{
my $self = shift;
my $style = '';
my $ts = $self->text_styles();
$style .= ' font-style="italic"' if $ts->{italic};
$style .= ' font-weight="bold"' if $ts->{bold};
if ($ts->{underline} || $ts->{none} || $ts->{overline} || $ts->{'line-through'})
{
# XXX TODO: HTML does seem to allow only one of them
my @s;
foreach my $k (qw/underline overline line-through none/)
{
push @s, $k if $ts->{$k};
}
my $s = join(' ', @s);
$style .= " text-decoration=\"$s\"" if $s;
}
my @styles;
# XXX TODO: this will needless include the font-family if set via
# "node { font: X }:
my $ff = $self->attribute('font');
push @styles, "font-family:$ff" if $ff;
# XXX TODO: this will needless include the font-size if set via
# "node { font-size: X }:
my $fs = $self->_font_size_in_pixels( 16 ); $fs = '' if $fs eq '16';
# XXX TODO:
# the 'style="font-size:XXpx"' is nec. for Batik 1.5 (Firefox and Opera also
# handle 'font-size="XXpx"'):
push @styles, "font-size:${fs}px" if $fs;
$style .= ' style="' . (join(";", @styles)) . '"' if @styles > 0;
$style;
}
my $al_map = {
'c' => 'middle',
'l' => 'start',
'r' => 'end',
};
sub _svg_text
{
# create a text via at pos x,y, indented by "$indent"
my ($self, $color, $indent, $x, $y, $style, $xl, $xr) = @_;
my $align = $self->attribute('align');
my $text_wrap = $self->attribute('textwrap');
my ($lines, $aligns) = $self->_aligned_label($align, $text_wrap);
# We can't just join them togeter with 'x=".." dy="1em"' because Firefox 1.5
# doesn't support this (Batik does, tho). So calculate x and y on each tspan:
#print STDERR "# xl $xl xr $xr\n";
my $label = '';
if (@$lines > 1)
{
my $lh = $self->LINE_HEIGHT(); my $em = $self->EM();
my $in = $indent . $indent;
my $dy = $y - $lh + $em;
$label = "\n$in"; $dy += $lh;
my $i = 0;
for my $line (@$lines)
{
# quote "<" and ">", "&" and also '"'
$line = _quote($line);
my $all = $aligns->[$i+1] || substr($align,0,1);
my $al = ' text-anchor="' . $al_map->{$all} . '"';
#print STDERR "$line $al $all $align\n";
$al = '' if $all eq substr($align,0,1);
my $xc = $x;
$xc = $xl if ($all eq 'l');
$xc = $xr if ($all eq 'r');
my $join = ""; $join .= "\n$in" if $i < @$lines - 1;
$dy += $lh;
$label .= $line . $join;
$i++;
}
$label .= "\n ";
}
else
{
$label = _quote($lines->[0]) if @$lines;
}
my $fs; $fs = $self->text_styles_as_svg() if $label ne '';
$fs = '' unless defined $fs;
# For an edge, the default stroke is black, but this will render a black
# outline around colored text. So disable the stroke with "none".
my $stroke = ''; $stroke = ' stroke="none"' if ref($self) =~ /Edge/;
if (!defined $style)
{
$x = $xl if $align eq 'left';
$x = $xr if $align eq 'right';
$style = '';
my $def_align = $self->default_attribute('align');
$style = ' text-anchor="' . $al_map->{substr($align,0,1)} . '"';
}
my $svg = "$indent$label\n";
$svg . "\n"
}
sub _remap_align
{
my ($self, $att, $val) = @_;
# align: center; => text-anchor: middle; => supress as it is the default?
# return (undef,undef)if $val eq 'center';
$val = 'middle' if $val eq 'center';
# align: center; => text-anchor: middle;
('text-anchor', $val);
}
sub _remap_font_size
{
my ($self, $att, $val) = @_;
# "16" to "16px"
$val .= 'px' if $val =~ /^\d+\z/;
if ($val =~ /em\z/)
{
$val = $self->_font_size_in_pixels( 16, $val ) . 'px';
}
('font-size', $val);
}
sub _adjust_dasharray
{
# If the border is bigger than 1px, we need to adjust the dasharray to
# match it.
my ($self,$att) = @_;
# convert "20px" to "20"
# convert "2em" to "xx"
my $s = $att->{'stroke-width'} || 1;
$s =~ s/px//;
if ($s =~ /(\d+)em/)
{
my $em = $self->EM();
$s = $1 * $em;
}
$att->{'stroke-width'} = $s;
delete $att->{'stroke-width'} if $s eq '1';
return $att unless exists $att->{'stroke-dasharray'};
# for very thin line, make it a bit bigger as to be actually visible
$s = 2 if $s < 2;
my @dashes = split /\s*,\s*/, $att->{'stroke-dasharray'};
for my $d (@dashes)
{
$d *= $s; # modify in place
}
$att->{'stroke-dasharray'} = join (',', @dashes);
$att;
}
sub _as_svg
{
# convert the graph to SVG
my ($self, $options) = @_;
# set the info fields to defaults
$self->{svg_info} = { width => 0, height => 0 };
$self->layout() unless defined $self->{score};
my ($rows,$cols,$max_x,$max_y) = $self->_prepare_layout('svg');
my $cells = $self->{cells};
my $txt;
if ($options->{standalone})
{
$txt .= <
EOSVG
;
}
my $em = $self->EM();
my $LINE_HEIGHT = $self->LINE_HEIGHT();
# XXX TODO: that should use the padding/margin attribute from the graph
my $xl = int($em / 2); my $yl = int($em / 2);
my $xr = int($em / 2); my $yr = int($em / 2);
my $mx = $max_x + $xl + $xr;
my $my = $max_y + $yl + $yr;
# we need both xmlns= and xmlns:xlink to make Firefix 1.5 happy :-(
$txt .=
# '