############################################################################# # 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; } sub _quote { my ($txt) = @_; # "&", ,'"', "<" and ">" will not work in hrefs or texts $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 .= # '' '' ."\n\n\n"; my $title = _quote($self->title()); $txt .= "$title\n" if $title ne ''; $txt .= "\n##devs##"; # clear used definitions $self->{_svg_defs} = {}; # which attributes must be output as what name: my $mutator = { background => 'fill', 'align' => \&_remap_align, 'color' => 'stroke', 'fontsize' => \&_remap_font_size, 'font' => 'font-family', }; my $skip = qr/^( arrow(style|shape)| (auto)?(link|title|label)| bordercolor| borderstyle| borderwidth| border| color| colorscheme| comment| columns| flow| format| gid| labelpos| labelcolor| linkbase| line-height| letter-spacing| margin.*| nodeclass| padding.*| rows| root| size| style| shape| title| type| textstyle| width| rotate| )\z/x; my $overlay = { edge => { "stroke" => 'black', "text-align" => 'center', "font-size" => '13px', }, node => { "font-size" => '16px', "text-align" => 'center', }, }; $overlay->{graph} = { "font-size" => '16px', "text-align" => 'center', "border" => '1px dashed #808080', }; # generate the class attributes first my $style = $self->_class_styles( $skip, $mutator, '', ' ', $overlay); $txt .= "\n \n" ." \n" if $style ne ''; $txt .="\n\n"; ########################################################################### # prepare graph label output my $lp = 'top'; my ($lw,$lh) = Graph::Easy::Node::_svg_dimensions($self); # some padding on the label $lw = int($em*$lw + $em + 0.5); $lh = int($LINE_HEIGHT*$lh+0.5); my $label = $self->label(); if ($label ne '') { $lp = $self->attribute('labelpos'); # handle the case where the graph label is bigger than the graph itself if ($mx < ($lw+$em)) { # move the content to the right to center it $xl += (($lw+$em) - $mx) / 2; # and then make the graph more wide $mx = $em + $lw; } $my += $lh; } ########################################################################### # output the graph's background and border my $em2 = $em / 2; { # 'inherit' only works for HTML, not for SVG my $bg = $self->color_attribute('fill'); $bg = 'white' if $bg eq 'inherit'; my $bs = $self->attribute('borderstyle'); my $cl = $self->color_attribute('bordercolor'); $cl = $bg if $bs eq 'none'; my $bw = $self->attribute('borderwidth') || 1; $bw =~ s/px//; # We always need to output a background rectangle, otherwise printing the # SVG from Firefox ends you up with a black background, which rather ruins # the day: # XXX TODO adjust dasharray my $att = { 'stroke-dasharray' => $strokes->{$bs} || '', 'stroke-width' => $bw, 'stroke' => $cl, 'fill' => $bg, }; # avoid stroke-dasharray="": delete $att->{'stroke-dasharray'} unless $att->{'stroke-dasharray'} ne ''; my $d = $self->_svg_attributes_as_txt($self->_adjust_dasharray($att)); my $xr = $mx + $em2; my $yr = $my + $em2; if ($bs ne '') { # Provide some padding around the graph to avoid that the border sticks # very close to the edge $xl += $em2 + $bw; $yl += $em2 + $bw; $xr += $em2 + 2 * $bw; $yr += $em2 + 2 * $bw; $mx += $em + 4 * $bw; $my += $em + 4 * $bw; } my $bw_2 = $bw / 2; $txt .= '' . "\n\n\n"; } # end outpuf of background ########################################################################### # adjust space for the graph label and output the label if ($label ne '') { my $y = $yl + $em2; $y = $my - $lh + $em2 if $lp eq 'bottom'; # also include a link on the label if nec. my $link = _quote($self->link()); my $l = Graph::Easy::Node::_svg_text($self, $self->color_attribute('color') || 'black', ' ', $mx / 2, $y, undef, $em2, $mx - $em2); $l =~ s/groups(), $self->edges(), $self->sorted_nodes()) { my $x = $xl; my $y = $yl; if ((ref($n) eq 'Graph::Easy::Node') || (ref($n) eq 'Graph::Easy::Node::Anon')) { # get position from cell $x += $cols->{ $n->{x} }; $y += $rows->{ $n->{y} }; } my $class = $n->class(); $class =~ s/\./_/; # node.city => node-city my $obj_txt = $n->as_svg($x,$y,' ', $rows, $cols); if ($obj_txt ne '') { $obj_txt =~ s/\n\z/<\/g>\n\n/; my $id = $n->attribute('id'); $id = $n->{id} if $id eq ''; $id =~ s/([\"\\])/\\$1/g; $txt .= "\n" . $obj_txt; } } # include the used definitions into my $d = ''; for my $key (keys %{$self->{_svg_defs}}) { $d .= $devs->{$key}; } $txt =~ s/##devs##/$d/; $txt =~ s/##MX##/$mx/; $txt =~ s/##MY##/$my/; $txt .= ""; # finish $txt .= "\n" if $options->{standalone}; # set the info fields: $self->{svg_info}->{width} = $mx; $self->{svg_info}->{height} = $my; $txt; } =pod =head1 NAME Graph::Easy::As_svg - Output a Graph::Easy as Scalable Vector Graphics (SVG) =head1 SYNOPSIS use Graph::Easy; my $graph = Graph::Easy->new(); $graph->add_edge ('Bonn', 'Berlin'); print $graph->as_svg_file(); =head1 DESCRIPTION C contains just the code for converting a L object to a SVG text. X X X X X X X =head1 EXPORT Exports nothing. =head1 SEE ALSO L. =head1 AUTHOR Copyright (C) 2004 - 2008 by Tels L See the LICENSE file for information. X =cut ############################################################################# ############################################################################# package Graph::Easy::Node::Cell; use vars qw/$VERSION/; $VERSION = '0.01'; sub as_svg { ''; } sub _correct_size_svg { my $self = shift; $self->{w} = 3; $self->{h} = 3; $self; } ############################################################################# ############################################################################# package Graph::Easy::Group::Cell; use vars qw/$VERSION/; $VERSION = '0.01'; sub as_svg { my ($self,$x, $y, $indent) = @_; my $svg = $self->_svg_background($x,$y,$indent); $svg .= $self->SUPER::as_svg($x,$y,$indent) if $self->{has_label}; $svg; } my $coords = { 'gl' => 'x1="XX0" y1="YY0" x2="XX0" y2="YY1"', 'gt' => 'x1="XX0" y1="YY0" x2="XX1" y2="YY0"', 'gb' => 'x1="XX0" y1="YY1" x2="XX1" y2="YY1"', 'gr' => 'x1="XX1" y1="YY0" x2="XX1" y2="YY1"', }; sub _svg_background { # draw the background for this node/cell, if nec. my ($self, $x, $y, $indent) = @_; my $bg = $self->background(); $bg = $self->{group}->default_attribute('fill') if $bg eq ''; my $svg = ''; if ($bg ne '') { $bg = $self->{group}->color_attribute('fill') if $bg eq 'inherit'; $bg = '' if $bg eq 'inherit'; if ($bg ne '') { my $w = $self->{w}; my $h = $self->{h}; $svg .= "$indent\n"; } } # draw the border pieces my $x2 = $x + $self->{w} - 0.5; my $y2 = $y + $self->{h} - 0.5; my $style = $self->attribute('border-style')||'dashed'; my $att = { 'stroke' => $self->color_attribute('bordercolor'), 'stroke-dasharray' => $strokes->{$style}||'3, 1', 'stroke-width' => $self->attribute('borderwidth') || 1, }; $self->_adjust_dasharray($att); my $stroke = $self->_svg_attributes_as_txt($att, 0, 0); # x,y are not used my $c = $self->{cell_class}; $c =~ s/^\s+//; $c =~ s/\s+\z//; $x += 0.5; $y += 0.5; for my $class (split /\s+/, $c) { last if $class =~ /^(\s+|gi)\z/; # inner => no border, skip empty my $l = "$indent{$class} . " $stroke/>\n"; $l =~ s/XX0/$x/g; $l =~ s/XX1/$x2/g; $l =~ s/YY0/$y/g; $l =~ s/YY1/$y2/g; $svg .= $l; } $svg .= "\n"; $svg; } ############################################################################# ############################################################################# package Graph::Easy::Group; use vars qw/$VERSION/; $VERSION = '0.01'; sub as_svg { # output all cells of the group as svg my ($self, $xl, $yl, $indent, $rows, $cols) = @_; my $txt = ''; for my $cell (values %{$self->{_cells}}) { # get position from cell my $x = $cols->{ $cell->{x} } + $xl; my $y = $rows->{ $cell->{y} } + $yl; $txt .= $cell->as_svg($x,$y,$indent); } $txt; } ############################################################################# ############################################################################# package Graph::Easy::Edge; use vars qw/$VERSION/; $VERSION = '0.01'; use Graph::Easy::Edge::Cell qw/EDGE_HOLE/; sub as_svg { # output all cells of the edge as svg my ($self, $xl, $yl, $indent, $rows, $cols) = @_; my $cells = $self->{cells}; my $from = Graph::Easy::As_svg::_quote_name($self->{from}->{name}); my $to = Graph::Easy::As_svg::_quote_name($self->{to}->{name}); my $txt = " \n"; my $done_cells = 0; for my $cell (@$cells) { next if $cell->{type} == EDGE_HOLE; $done_cells++; # get position from cell my $x = $cols->{ $cell->{x} } + $xl; my $y = $rows->{ $cell->{y} } + $yl; $txt .= $cell->as_svg($x,$y,$indent); } # had no cells or only one "HOLE" return '' if $done_cells == 0; $txt; } ############################################################################# ############################################################################# package Graph::Easy::Node::Empty; use vars qw/$VERSION/; $VERSION = '0.01'; sub as_svg { # empty nodes are not rendered at all ''; } ############################################################################# ############################################################################# package Graph::Easy::Node; use vars qw/$VERSION/; $VERSION = '0.01'; BEGIN { *_sprintf = \&Graph::Easy::As_svg::_sprintf; *_quote = \&Graph::Easy::As_svg::_quote; *LINE_HEIGHT = \&Graph::Easy::LINE_HEIGHT; } sub _svg_dimensions { # Returns the dimensions of the node/cell derived from the label (or name) in characters. my ($self) = @_; # my $align = $self->attribute('align') || $self->default_attribute('align') || 'center'; # my $text_wrap = $self->attribute('text-wrap') || 'none'; my $align = $self->attribute('align'); my $text_wrap = $self->attribute('textwrap'); my ($lines, $aligns) = $self->_aligned_label($align, $text_wrap); my $w = 0; my $h = scalar @$lines; my $em = $self->EM(); foreach my $line (@$lines) { $line =~ s/^\s+//; $line =~ s/\s+$//; # rem spaces my $line_length = Graph::Easy::As_svg::_text_length($em, $line); $w = $line_length if $line_length > $w; } ($w,$h); } sub _svg_background { # draw the background for this node/cell, if nec. my ($self, $x, $y, $indent) = @_; my $bg = $self->background(); my $s = ''; if (ref $self->{edge}) { $bg = $self->{edge}->{group}->default_attribute('fill')||'#a0d0ff' if $bg eq '' && ref $self->{edge}->{group}; $s = ' stroke="none"'; } my $svg = ''; if ($bg ne 'inherit' && $bg ne '') { my $w = $self->{w}; my $h = $self->{h}; $svg .= "$indent\n"; } $svg; } BEGIN { *EM = \&Graph::Easy::EM; *text_styles_as_svg = \&Graph::Easy::text_styles_as_svg; *_svg_text = \&Graph::Easy::_svg_text; *_adjust_dasharray = \&Graph::Easy::_adjust_dasharray; } sub as_svg { # output a node as SVG my ($self,$x,$y,$indent) = @_; my $name = $self->{att}->{label}; $name = $self->{name} if !defined $name; $name = 'anon node ' . $self->{name} if $self->{class} eq 'node.anon'; my $em = $self->EM(); # multiplication factor chars * em = units (pixels) # the attributes of the element we will finally output my $att = $self->_svg_attributes($x,$y); # the output shape as svg-tag my $shape = $att->{shape}; # rect, circle etc delete $att->{shape}; return '' if $shape eq 'invisible'; # set a potential title my $title = _quote($self->title()); $att->{title} = $title if $title ne ''; # the original shape my $s = ''; $s = $self->attribute('shape') unless $self->isa_cell(); my $link = _quote($self->link()); my $old_indent = $indent; $indent = $indent x 2 if $link ne ''; my $out_name = Graph::Easy::As_svg::_quote_name($name); my $svg = "$indent\n"; # render the background, except for "rect" where it is not visible # (use the original shape in $s, or "rounded" will be wrong) $svg .= $self->_svg_background($x,$y, $indent) if $s ne 'rect'; my $bs = $self->attribute('borderstyle'); my $xt = int($x + $self->{w} / 2); my $yt = int($y + $self->{h} / 2); # render the node shape itself if ($shape eq 'point') { # include the point-shape my $s = $self->attribute('pointshape'); if ($s ne 'invisible') { $s = 'd-' . $s if $bs =~ /^double/ && $s =~ /^(square|diamond|circle|star)\z/; my $ps = $self->attribute('pointstyle'); # circle => filledcircle #$s = 'f-' . $s if $ps eq 'filled' && $s =~ /^(square|diamond|circle|star)\z/; my $a = { }; for my $key (keys %$att) { $a->{$key} = $att->{$key}; } $a->{stroke} = $self->color_attribute('bordercolor'); if ($s eq 'dot' || $ps eq 'filled') { $a->{fill} = $a->{stroke}; } my $att_txt = $self->_svg_attributes_as_txt($a, $xt, $yt); # center a square point-node $yt -= 5 if $s =~ 'square'; $xt -= 5 if $s =~ 'square'; $self->{graph}->_svg_use_def($s); $svg .= "$indent\n\n"; } else { $svg .= "\n"; } } elsif ($shape eq 'img') { require Image::Info; my $label = $self->label(); my $info = Image::Info::image_info($label); my $w = $info->{width}; my $h = $info->{height}; if ($info->{error}) { $self->_croak("Couldn't determine image dimensions from '$label': $info->{error}"); } # center the image my $x1 = $xt - $w / 2; my $y1 = $yt - $h / 2; $label = _quote($label); $svg .= "\n"; } else { # no border/shape for Group cells (we need to draw the border in pieces) if ($shape ne 'none' && !$self->isa('Graph::Easy::Group::Cell')) { # If we need to draw the border shape twice, put common attributes on # a around it. (In the case there is only "stroke: #000000;" it will # waste 4 bytes, but in all other cases save quite a few. my $group = {}; if ($bs =~ /^double/) { for my $a (qw/fill stroke stroke-dasharray/) { $group->{$a} = $att->{$a} if exists $att->{$a}; delete $att->{$a}; } } my $att_txt = $self->_svg_attributes_as_txt($att, $xt, $yt); my $shape_svg = "$indent<$shape$att_txt />\n"; # if border-style is double, do it again, sam. if ($bs =~ /^double/) { my $group_txt = $self->_svg_attributes_as_txt($group, $xt, $yt); $shape_svg = "$indent\n$indent" . $shape_svg; my $att = $self->_svg_attributes($x,$y, 3); for my $a (qw/fill stroke stroke-dasharray/) { delete $att->{$a}; } my $shape = $att->{shape}; # circle etc delete $att->{shape}; my $att_txt = $self->_svg_attributes_as_txt( $att, $xt, $yt ); $shape_svg .= "$indent$indent<$shape$att_txt />\n"; $shape_svg .= "$indent\n"; # close group } $svg .= $shape_svg; } ########################################################################### # include the label/name/text my ($w,$h) = $self->_svg_dimensions(); my $lh = $self->LINE_HEIGHT(); my $yt = int($y + $self->{h} / 2 + $lh / 3 - ($h -1) * $lh / 2); $yt += $self->{h} * 0.25 if $s =~ /^(triangle|trapezium)\z/; $yt -= $self->{h} * 0.25 if $s =~ /^inv(triangle|trapezium)\z/; $yt += $self->{h} * 0.10 if $s eq 'house'; $yt -= $self->{h} * 0.10 if $s eq 'invhouse'; my $color = $self->color_attribute('color') || 'black'; $svg .= $self->_svg_text($color, $indent, $xt, $yt, # left # right undef, int($x + $em/2), int($x + $self->{w} - $em/2)); } # Create the link $svg = $self->_link($svg, $old_indent, $title, $link) if $link ne ''; $svg; } sub _link { # put a link around a shape (including onclick handler to work around bugs) my ($self, $svg, $indent, $title, $link) = @_; # although the title is already included on the outer shape, we need to # add it to the link, too (for shape: none, and some user agents like # FF 1.5 display the title only while outside the text-area) $title = ' xlink:title="' . $title . '"' if $title ne ''; $svg =~ s/\n\z//; $svg = $indent . "\n" . $svg . $indent . "\n\n"; $svg; } sub _svg_attributes { # Return a hash with attributes for the node, like "x => 1, y => 1, w => 1, h => 1" # Especially usefull for shapes other than boxes. my ($self,$x,$y, $sub) = @_; # subtract factor, 0 or 2 for border-style: double $sub ||= 0; my $att = {}; my $shape = $self->shape(); my $em = $self->EM(); my $border_width = Graph::Easy::_border_width_in_pixels($self,$em); # subtract half of our border-width because the border-center would otherwise # be on the node's border-line and thus extending outward: my $bw2 = $border_width / 2; $sub += $bw2; my $w2 = $self->{w} / 2; my $h2 = $self->{h} / 2; # center my $cx = $x + $self->{w} / 2; my $cy = $y + $self->{h} / 2; my $double = 0; $double = 1 if ($self->attribute('border-style') || '') eq 'double'; my $x2 = $x + $self->{w} - $sub; my $y2 = $y + $self->{h} - $sub; $x += $sub; $y += $sub; my $sub3 = $sub / 3; # 0.333 * $sub my $sub6 = 2 * $sub / 3; # 0.666 * $sub if ($shape =~ /^(point|none)\z/) { } elsif ($shape eq 'circle') { $att->{cx} = $cx; $att->{cy} = $cy; $att->{r} = $self->{minw} > $self->{minh} ? $self->{minw} : $self->{minh}; $att->{r} /= 2; $att->{r} -= $sub; } elsif ($shape eq 'parallelogram') { my $xll = _sprintf($x - $sub3 + $self->{w} * 0.25); my $xrl = _sprintf($x2 + $sub3 - $self->{w} * 0.25); my $xl = _sprintf($x + $sub6); my $xr = _sprintf($x2 - $sub6); $shape = "polygon points=\"$xll,$y, $xr,$y, $xrl,$y2, $xl,$y2\""; } elsif ($shape eq 'trapezium') { my $xl = _sprintf($x - $sub3 + $self->{w} * 0.25); my $xr = _sprintf($x2 + $sub3 - $self->{w} * 0.25); my $xl1 = _sprintf($x + $sub3); my $xr1 = _sprintf($x2 - $sub3); $shape = "polygon points=\"$xl,$y, $xr,$y, $xr1,$y2, $xl1,$y2\""; } elsif ($shape eq 'invtrapezium') { my $xl = _sprintf($x - $sub3 + $self->{w} * 0.25); my $xr = _sprintf($x2 + $sub3 - $self->{w} * 0.25); my $xl1 = _sprintf($x + $sub3); my $xr1 = _sprintf($x2 - $sub3); $shape = "polygon points=\"$xl1,$y, $xr1,$y, $xr,$y2, $xl,$y2\""; } elsif ($shape eq 'diamond') { my $x1 = $cx; my $y1 = $cy; my $xl = _sprintf($x + $sub3); my $xr = _sprintf($x2 - $sub3); $shape = "polygon points=\"$xl,$y1, $x1,$y, $xr,$y1, $x1,$y2\""; } elsif ($shape eq 'house') { my $x1 = $cx; my $y1 = _sprintf($y - $sub3 + $self->{h} * 0.333); $shape = "polygon points=\"$x1,$y, $x2,$y1, $x2,$y2, $x,$y2, $x,$y1\""; } elsif ($shape eq 'pentagon') { my $x1 = $cx; my $x11 = _sprintf($x - $sub3 + $self->{w} * 0.25); my $x12 = _sprintf($x2 + $sub3 - $self->{w} * 0.25); my $y1 = _sprintf($y - $sub6 + $self->{h} * 0.333); my $xl = _sprintf($x + $sub3); my $xr = _sprintf($x2 - $sub3); $shape = "polygon points=\"$x1,$y, $xr,$y1, $x12,$y2, $x11,$y2, $xl,$y1\""; } elsif ($shape eq 'invhouse') { my $x1 = $cx; my $y1 = _sprintf($y - (1.4 * $sub) + $self->{h} * 0.666); $shape = "polygon points=\"$x,$y, $x2,$y, $x2,$y1, $x1,$y2, $x,$y1\""; } elsif ($shape eq 'septagon') { my $x15 = $cx; my $x11 = _sprintf($x2 + $sub3 - $self->{w} * 0.10); my $x14 = _sprintf($x - $sub3 + $self->{w} * 0.10); my $y11 = _sprintf($y - $sub3 + $self->{h} * 0.15); my $y13 = _sprintf($y2 + 0.85 * $sub - $self->{h} * 0.40); my $x12 = _sprintf($x2 + $sub6 - $self->{w} * 0.25); my $x13 = _sprintf($x - $sub6 + $self->{w} * 0.25); my $xl = _sprintf($x - 0.15 * $sub); my $xr = _sprintf($x2 + 0.15 * $sub); $shape = "polygon points=\"$x15,$y, $x11,$y11, $xr,$y13, $x12,$y2, $x13,$y2, $xl,$y13, $x14, $y11\""; } elsif ($shape eq 'octagon') { my $x11 = _sprintf($x - $sub3 + $self->{w} * 0.25); my $x12 = _sprintf($x2 + $sub3 - $self->{w} * 0.25); my $y11 = _sprintf($y - $sub6 + $self->{h} * 0.25); my $y12 = _sprintf($y2 + $sub6 - $self->{h} * 0.25); my $xl = _sprintf($x + $sub * 0.133); my $xr = _sprintf($x2 - $sub * 0.133); $shape = "polygon points=\"$xl,$y11, $x11,$y, $x12,$y, $xr,$y11, $xr,$y12, $x12,$y2, $x11,$y2, $xl,$y12\""; } elsif ($shape eq 'hexagon') { my $y1 = $cy; my $x11 = _sprintf($x - $sub6 + $self->{w} * 0.25); my $x12 = _sprintf($x2 + $sub6 - $self->{w} * 0.25); my $xl = _sprintf($x + $sub3); my $xr = _sprintf($x2 - $sub3); $shape = "polygon points=\"$xl,$y1, $x11,$y, $x12,$y, $xr,$y1, $x12,$y2, $x11,$y2\""; } elsif ($shape eq 'triangle') { my $x1 = $cx; my $xl = _sprintf($x + $sub); my $xr = _sprintf($x2 - $sub); my $yd = _sprintf($y2 + ($sub * 0.2 )); $shape = "polygon points=\"$x1,$y, $xr,$yd, $xl,$yd\""; } elsif ($shape eq 'invtriangle') { my $x1 = $cx; my $xl = _sprintf($x + $sub); my $xr = _sprintf($x2 - $sub); my $yd = _sprintf($y - ($sub * 0.2)); $shape = "polygon points=\"$xl,$yd, $xr,$yd, $x1,$y2\""; } elsif ($shape eq 'ellipse') { $att->{cx} = $cx; $att->{cy} = $cy; $att->{rx} = $w2 - $sub; $att->{ry} = $h2 - $sub; } else { if ($shape eq 'rounded') { # round corners by a fixed value $att->{ry} = '15'; $att->{rx} = '15'; $shape = 'rect'; } $att->{x} = $x; $att->{y} = $y; $att->{width} = _sprintf($self->{w} - $sub * 2); $att->{height} = _sprintf($self->{h} - $sub * 2); } $att->{shape} = $shape; my $border_style = $self->attribute('border-style') || 'solid'; my $border_color = $self->color_attribute('border-color') || 'black'; $att->{'stroke-width'} = $border_width if $border_width ne '1'; $att->{stroke} = $border_color; if ($border_style !~ /^(none|solid)/) { $att->{'stroke-dasharray'} = $strokes->{$border_style} if exists $strokes->{$border_style}; $self->_adjust_dasharray($att); } if ($border_style eq 'none') { delete $att->{'stroke-width'}; delete $att->{stroke}; } $att->{fill} = $self->color_attribute('fill') || 'white'; # include the fill for renderers that can't cope with CSS styles # delete $att->{fill} if $att->{fill} eq 'white'; # white is default $att->{rotate} = $self->angle(); $att; } sub _svg_attributes_as_txt { # convert hash with attributes to text to be included in SVG tag my ($self, $att, $x, $y) = @_; my $att_line = ''; # attributes as text (cur line) my $att_txt = ''; # attributes as text (all) foreach my $e (sort keys %$att) { # skip these next if $e =~ /^(arrow-?style|arrow-?shape|text-?style|label-?color| rows|columns|size|offset|origin|rotate|colorscheme)\z/x; $att_line .= " $e=\"$att->{$e}\""; if (length($att_line) > 75) { $att_txt .= "$att_line\n "; $att_line = ''; } } ########################################################################### # include the rotation my $r = $att->{rotate} || 0; $att_line .= " transform=\"rotate($r, $x, $y)\"" if $r != 0; if (length($att_line) > 75) { $att_txt .= "$att_line\n "; $att_line = ''; } $att_txt .= $att_line; $att_txt =~ s/\n \z//; # avoid a " >" on last line $att_txt; } sub _correct_size_svg { # Correct {w} and {h} for the node after parsing. my $self = shift; my $em = $self->EM(); # multiplication factor chars * em = units (pixels) return if defined $self->{w}; my $shape = $self->shape(); if ($shape eq 'point') { $self->{w} = $em * 3; $self->{h} = $em * 3; return; } my ($w,$h) = $self->_svg_dimensions(); my $lh = $self->LINE_HEIGHT(); # XXX TODO: that should use a changable padding factor (like "0.2 em" or "4") $self->{w} = int($w * $em + $em); $self->{h} = int($h * $lh + $em); my $border = 'none'; $border = $self->attribute('borderstyle') || '' if $shape ne 'none'; if ($border ne 'none') { my $bw = Graph::Easy::_border_width_in_pixels($self,$em); $self->{w} += $bw * 2; # *2 due to left/right and top/bottom $self->{h} += $bw * 2; } # for triangle or invtriangle: $self->{w} *= 1.4 if $shape =~ /triangle/; $self->{h} *= 1.8 if $shape =~ /triangle|trapezium/; $self->{w} *= 1.2 if $shape =~ /(parallelogram|trapezium|pentagon)/; if ($shape =~ /^(diamond|circle|octagon|hexagon|triangle)\z/) { # the min size is either w or h, depending on which is bigger my $max = $self->{w}; $max = $self->{h} if $self->{h} > $max; $self->{h} = $max; $self->{w} = $max; } } 1; ############################################################################# ############################################################################# package Graph::Easy::Edge::Cell; use vars qw/$VERSION/; $VERSION = '0.01'; BEGIN { *_sprintf = \&Graph::Easy::As_svg::_sprintf; *_quote = \&Graph::Easy::As_svg::_quote; } ############################################################################# ############################################################################# # Line drawing code for edges # define the line lengths for the different edge types sub LINE_HOR () { 0x0; } sub LINE_VER () { 0x1; } sub LINE_PATH() { 0x2; } sub LINE_MASK () { 0x0F; } sub LINE_DOUBLE () { 0x10; } # edge type line type spacing left/top # spacing right/bottom my $draw_lines = { # for selfloops, we use paths EDGE_N_W_S() => [ LINE_PATH, 'M', -1, -0.5, 'L', -1, -1.5, 'L', 1, -1.5, 'L', 1, -0.5 ], # v--| EDGE_S_W_N() => [ LINE_PATH, 'M', -1, 0.5, 'L', -1, 1.5, 'L', 1, 1.5, 'L', 1, 0.5 ], # ^--| EDGE_E_S_W() => [ LINE_PATH, 'M', 0.5, 1, 'L', 1.5, 1, 'L', 1.5, -1, 'L', 0.5, -1 ], # [_ EDGE_W_S_E() => [ LINE_PATH, 'M', -0.5, 1, 'L', -1.5, 1, 'L', -1.5, -1, 'L', -0.5, -1 ], # _] # everything else draws straight lines EDGE_VER() => [ LINE_VER, 0, 0 ], # | vertical line EDGE_HOR() => [ LINE_HOR, 0, 0 ], # -- vertical line EDGE_CROSS() => [ LINE_HOR, 0, 0, LINE_VER, 0, 0 ], # + crossing EDGE_S_E() => [ LINE_VER, 0.5, 0, LINE_HOR, 0.5, 0 ], # |_ corner (N to E) EDGE_N_W() => [ LINE_VER, 0, 0.5, LINE_HOR, 0, 0.5 ], # _| corner (N to W) EDGE_N_E() => [ LINE_VER, 0, 0.5, LINE_HOR, 0.5, 0 ], # ,- corner (S to E) EDGE_S_W() => [ LINE_VER, 0.5, 0, LINE_HOR, 0, 0.5 ], # -, corner (S to W) EDGE_S_E_W() => [ LINE_HOR, 0, 0, LINE_VER, 0.5, 0 ], # joint EDGE_N_E_W() => [ LINE_HOR, 0, 0, LINE_VER, 0, 0.5 ], # joint EDGE_E_N_S() => [ LINE_HOR, 0.5, 0, LINE_VER, 0, 0 ], # joint EDGE_W_N_S() => [ LINE_HOR, 0, 0.5, LINE_VER, 0, 0 ], # joint }; my $dimensions = { EDGE_VER() => [ 1, 2 ], # | EDGE_HOR() => [ 2, 1 ], # - EDGE_CROSS() => [ 2, 2 ], # + crossing EDGE_N_E() => [ 2, 2 ], # |_ corner (N to E) EDGE_N_W() => [ 2, 2 ], # _| corner (N to W) EDGE_S_E() => [ 2, 2 ], # ,- corner (S to E) EDGE_S_W() => [ 2, 2 ], # -, corner (S to W) EDGE_S_E_W => [ 2, 2 ], # -,- three-sided corner (S to W/E) EDGE_N_E_W => [ 2, 2 ], # -'- three-sided corner (N to W/E) EDGE_E_N_S => [ 2, 2 ], # |- three-sided corner (E to S/N) EDGE_W_N_S => [ 2, 2 ], # -| three-sided corner (W to S/N) EDGE_N_W_S() => [ 4, 2 ], # loops EDGE_S_W_N() => [ 4, 2 ], EDGE_E_S_W() => [ 2, 4 ], EDGE_W_S_E() => [ 2, 4 ], }; my $arrow_pos = { EDGE_N_W_S() => [ 1, -0.5 ], EDGE_S_W_N() => [ 1, 0.5 ], EDGE_E_S_W() => [ 0.5, -1 ], EDGE_W_S_E() => [ -0.5, -1 ], }; my $arrow_correct = { EDGE_END_S() => [ 'h', 1.5 ], EDGE_END_N() => [ 'h', 1.5 ], EDGE_START_S() => [ 'h', 1 ], EDGE_START_N() => [ 'h', 1 ], EDGE_END_W() => [ 'w', 1.5 ], EDGE_END_E() => [ 'w', 1.5 ], EDGE_START_W() => [ 'w', 1, ], EDGE_START_E() => [ 'w', 1, ], # EDGE_END_S() => [ 'h', 3.5, 'w', 2 ], # EDGE_END_N() => [ 'h', 3.5, 'w', 2 ], # EDGE_START_S() => [ 'h', 3 ], # EDGE_START_N() => [ 'h', 3 ], # EDGE_END_W() => [ 'w', 1.5, 'h', 2 ], # EDGE_END_E() => [ 'w', 1.5, 'h', 2 ], # EDGE_START_W() => [ 'w', 1, ], # EDGE_START_E() => [ 'w', 1, ], }; sub _arrow_pos { # compute the position of the arrow my ($self, $x, $w, $y, $h, $ddx, $ddy, $dx, $dy) = @_; my $em = $self->EM(); my $cell_type = $self->{type} & EDGE_TYPE_MASK; if (exists $arrow_pos->{$cell_type}) { $dx = $arrow_pos->{$cell_type}->[0] * $em; $dy = $arrow_pos->{$cell_type}->[1] * $em; $dx = $w + $dx if $dx < 0; $dy = $h + $dy if $dy < 0; $dx += $x; $dy += $y; } _sprintf($dx,$dy); } sub _svg_arrow { my ($self, $att, $x, $y, $type, $indent, $s) = @_; my $w = $self->{w}; my $h = $self->{h}; $s ||= 0; my $arrow_style = $self->attribute('arrow-style') || ''; return '' if $arrow_style eq 'none'; my $class = 'ah' . substr($arrow_style,0,1); # aho => ah $class = 'ah' if $class eq 'aho'; # ah => ahb for bold/broad/wide edges with open arrows $class .= 'b' if $s > 1 && $class eq 'ah'; # For the things to be "used" define these attributes, so if they # match, we can skip them, generating shorter output: my $DEF = { "stroke-linecap" => 'round', }; my $a = {}; for my $key (keys %$att) { next if $key =~ /^(stroke-dasharray|arrow-style|stroke-width)\z/; $a->{$key} = $att->{$key} unless exists $DEF->{$key} && $DEF->{$key} eq $att->{$key}; } if ($arrow_style eq 'closed') { $a->{fill} = $self->color_attribute('background') || 'inherit'; $a->{fill} = $self->{graph}->color_attribute('graph', 'background') || 'inherit' if $a->{fill} eq 'inherit'; $a->{fill} = 'white' if $a->{fill} eq 'inherit'; } elsif ($arrow_style eq 'filled') { # if fill is not defind, use the color my $fill = $self->raw_attribute('fill'); if (defined $fill) { $a->{fill} = $self->color_attribute('fill'); } else { $a->{fill} = $self->color_attribute('color'); } } elsif ($class eq 'ahb') { $a->{fill} = $self->color_attribute('color'); delete $a->{fill} unless $a->{fill}; } my $att_txt = $self->_svg_attributes_as_txt($a); $self->{graph}->_svg_use_def($class) if ref $self->{graph}; my $ar = "$indent 1; # displacement of the arrow, to account for wider lines my $dis = 0.1; my ($x1,$x2, $y1,$y2); if ($type & EDGE_END_N) { my $d = $dis; $d += $ss/150 if $ss > 1; $d *= $h if $d < 1; ($x1, $y1) = $self->_arrow_pos($x,$w,$y,$h, 0, $d, $x + $w / 2, $y + $d); $svg .= $ar . "transform=\"translate($x1 $y1)rotate(-90)$scale\"/>\n"; } if ($type & EDGE_END_S) { my $d = $dis; $d += $ss/150 if $ss > 1; $d *= $h if $d < 1; ($x1, $y1) = $self->_arrow_pos($x,$w,$y,$h, 0, $d, $x + $w / 2, $y + $h - $d); $svg .= $ar . "transform=\"translate($x1 $y1)rotate(90)$scale\"/>\n"; } if ($type & EDGE_END_W) { my $d = $dis; $d += $ss/50 if $ss > 1; $d *= $w if $d < 1; ($x1, $y1) = $self->_arrow_pos($x,$w,$y,$h, $d, 0, $x + $d, $y + $h / 2); $svg .= $ar . "transform=\"translate($x1 $y1)rotate(180)$scale\"/>\n"; } if ($type & EDGE_END_E) { my $d = $dis; $d += $ss/50 if $ss > 1; $d *= $w if $d < 1; ($x1, $y1) = $self->_arrow_pos($x,$w,$y,$h, $d, 0, $x + $w - $d, $y + $h / 2); my $a = $ar . "x=\"$x1\" y=\"$y1\"/>\n"; $a = $ar . "transform=\"translate($x1 $y1)$scale\"/>\n" if $scale; $svg .= $a; } $svg; } sub _svg_line_straight { # Generate SVG tags for a vertical/horizontal line, bounded by (x,y), (x+w,y+h). # $l and $r shorten the line left/right, or top/bottom, respectively. If $l/$r < 1, # in % (aka $l * w), otherwise in units. # "$s" means there is a starting point, so the line needs to be shorter. Likewise # for "$e", only on the "other" side. # VER: s = north, e = south, HOR: s = left, e= right my ($self, $x, $y, $type, $l, $r, $s, $e, $add, $lw) = @_; my $w = $self->{w}; my $h = $self->{h}; $add = '' unless defined $add; # additinal styles? my ($x1,$x2, $y1,$y2, $x3, $x4, $y3, $y4); $lw ||= 1; # line-width my $ltype = $type & LINE_MASK; if ($ltype == LINE_HOR) { $l += $s if $s; $r += $e if $e; # +/-$lw to close the gaps at corners $l *= $w - $lw if $l == 0.5; $r *= $w - $lw if $r == 0.5; $l *= $w if $l < 1; $r *= $w if $r < 1; $x1 = $x + $l; $x2 = $x + $w - $r; $y1 = $y + $h / 2; $y2 = $y1; if (($type & LINE_DOUBLE) != 0) { $y1--; $y2--; $y3 = $y1 + 2; $y4 = $y3; # shorten the line for end/start points $x1 += 1.5 if $s; $x2 -= 1.5 if $e; $x3 = $x1; $x4 = $x2; } } else { $l += $s if $s; $r += $e if $e; # +/-$lw to close the gaps at corners $l *= $h - $lw if $l == 0.5; $r *= $h - $lw if $r == 0.5; $l *= $h if $l < 1; $r *= $h if $r < 1; $x1 = $x + $w / 2; $x2 = $x1; $y1 = $y + $l; $y2 = $y + $h - $r; if (($type & LINE_DOUBLE) != 0) { $x1--; $x2--; $x3 = $x1 + 2; $x4 = $x3; # shorten the line for end/start points $y1 += 1.5 if $s; $y2 -= 1.5 if $e; $y3 = $y1; $y4 = $y2; } } ($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4) = _sprintf($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4); my @r = ( "" ); # for a double line push @r, "" if defined $x3; @r; } sub _svg_path { # Generate SVG tags for a path, bounded by (x,y), (x+w,y+h). # "$s" means there is a starting point, so the line needs to be shorter. Likewise # for "$e", only on the "other" end side. # The passed coords are relative to x,y, and in EMs. my ($self, $x, $y, $s, $e, $add, $lw, @coords) = @_; my $em = $self->EM(); my $w = $self->{w}; my $h = $self->{h}; $add = '' unless defined $add; # additinal styles? $lw ||= 1; # line-width my $d = ''; while (@coords) { my ($t, $xa, $ya) = splice (@coords,0,3); # 'M', '1', '-1' $xa *= $em; $xa += $w if $xa < 0; $ya *= $em; $ya += $h if $ya < 0; ($xa,$ya) = _sprintf($xa+$x,$ya+$y); $d .= "$t$xa $ya"; } ""; } ############################################################################# ############################################################################# sub _correct_size_svg { # correct the size for the edge cell my ($self,$format) = @_; return if defined $self->{w}; my $em = $self->EM(); # multiplication factor chars * em = units (pixels) #my $border = $self->{edge}->attribute('borderstyle'); # set the minimum width/height my $type = $self->{type} & EDGE_TYPE_MASK(); my $dim = $dimensions->{$type} || [ 3, 3 ]; ($self->{w}, $self->{h}) = ($dim->[0], $dim->[1]); # print STDERR "# min size at ($self->{x},$self->{y}): $self->{w} $self->{h} for $self->{type}\n"; # make it bigger for cells with the label if ($self->{type} & EDGE_LABEL_CELL) { my ($w,$h) = $self->_svg_dimensions(); # for vertical edges, multiply $w * 2 $w = $w * 2 + 2 if ($type == EDGE_VER); # add a bit for HOR edges $w = $w + 1 if ($type == EDGE_HOR); $self->{w} += $w; my $lh = $self->LINE_HEIGHT(); $self->{h} += $h * ($lh - $em) + 0.5; # add a bit for HOR edges $self->{h} += 2 if ($type == EDGE_HOR); } my $style = $self->{style}; # correct for bigger arrows my $ac = $self->arrow_count(); # if ($style =~ /^(broad|wide)/) { # for each end point, correct the size my $flags = ($self->{type} & EDGE_ARROW_MASK); # select the first bit (hopefully EDGE_ARROW_MASK == 0xFF my $start_bit = 0x800; while ($start_bit > 0x8) { my $a = $flags & $start_bit; $start_bit >>= 1; if ($a != 0) { my $ac = $arrow_correct->{$a}; my $idx = 0; while ($idx < @$ac) { my ($where, $add) = ($ac->[$idx], $ac->[$idx+1]); $idx +=2; $add += 0.5 if $style =~ /^wide/; $self->{$where} += $add; } } } } ($self->{w}, $self->{h}) = ($self->{w} * $em, $self->{h} * $em); } ############################################################################# ############################################################################# sub _svg_attributes { # Return a hash with attributes for the cell. my ($self, $em) = @_; my $att = {}; $att->{stroke} = $self->color_attribute('color') || 'black'; # include the stroke for renderers that can't cope with CSS styles # delete $att->{stroke} if $att->{stroke} eq 'black'; # black is default $att->{'stroke-width'} = 1; my $style = $self->{style}; if ($style ne 'solid') # solid line { $att->{'stroke-dasharray'} = $strokes->{$style} if exists $strokes->{$style}; } $att->{'stroke-width'} = 3 if $style =~ /^bold/; $att->{'stroke-width'} = $em / 2 if $style =~ /^broad/; $att->{'stroke-width'} = $em if $style =~ /^wide/; $self->_adjust_dasharray($att); $att->{'arrow-style'} = $self->attribute('arrow-style') || ''; $att; } sub _draw_edge_line_and_arrows { } sub as_svg { my ($self,$x,$y, $indent) = @_; my $em = $self->EM(); # multiplication factor chars * em = units (pixels) my $lh = $self->LINE_HEIGHT(); # the attributes of the element we will finally output my $att = $self->_svg_attributes($em); # set a potential title my $title = _quote($self->title()); $att->{title} = $title if $title ne ''; my $att_txt = $self->_svg_attributes_as_txt($att); my $type = $self->{type} & EDGE_TYPE_MASK(); my $end = $self->{type} & EDGE_END_MASK(); my $start = $self->{type} & EDGE_START_MASK(); my $svg = "$indent\n"; $svg .= $self->_svg_background($x,$y, $indent); my $style = $self->{style}; # dont render invisible edges return $svg if $style eq 'invisible'; my $sw = $att->{'stroke-width'} || 1; # for each line, include one SVG tag my $lines = [ @{$draw_lines->{$type}} ]; # make copy my $cross = ($self->{type} & EDGE_TYPE_MASK) == EDGE_CROSS; # we are a cross section? my $add; my @line_tags; while (@$lines > 0) { my ($type) = shift @$lines; my @coords; if ($type != LINE_PATH) { @coords = splice (@$lines, 0, 2); } else { # eat all @coords = @$lines; @$lines = (); } # start/end points my ($s,$e) = (undef,undef); # LINE_VER must come last if ($cross && $type == LINE_VER) { $style = $self->{style_ver}; my $sn = 1; $sn = 3 if $style =~ /^bold/; $sn = $em / 2 if $style =~ /^broad/; $sn = $em if $style =~ /^wide/; # XXX adjust dash array $add = ' stroke="' . $self->{color_ver} . '"' if $self->{color_ver}; $add .= ' stroke-dasharray="' . ($strokes->{$style}||'1 0') .'"'; $add .= ' stroke-width="' . $sn . '"' if $sn ne $sw; $add =~ s/^\s//; } my $bw = $self->{w} * 0.1; my $bwe = $self->{w} * 0.1 + $sw; my $bh = $em * 0.5; # self->{h} my $bhe = $self->{h} * 0.1 + $sw * 1; # VER: s = north, e = south, HOR: s = left, e= right if ($type == LINE_VER) { $e = $bhe if ($end & EDGE_END_S); $s = $bhe if ($end & EDGE_END_N); $e = $bh if ($start & EDGE_START_S); $s = $bh if ($start & EDGE_START_N); } else # $type == LINE_HOR { $e = $bwe if ($end & EDGE_END_E); $s = $bwe if ($end & EDGE_END_W); $e = $bw if ($start & EDGE_START_E); $s = $bw if ($start & EDGE_START_W); } if ($type != LINE_PATH) { $type += LINE_DOUBLE if $style =~ /^double/; push @line_tags, $self->_svg_line_straight($x, $y, $type, $coords[0], $coords[1], $s, $e, $add, $sw); } else { push @line_tags, $self->_svg_path($x, $y, $s, $e, $add, $sw, @coords); } } # end lines # XXX TODO: put these on the edge group, not on each cell # we can put the line tags into a and put stroke attributes on the g, # this will shorten the output $lines = ''; my $p = "\n"; my $i = $indent; if (@line_tags > 1) { $lines = "$indent\n"; $i .= $indent; $p = "\n$indent\n"; } else { $line_tags[0] =~ s/ \/>/$att_txt \/>/; } $lines .= $i . join("\n$i", @line_tags) . $p; $svg .= $lines; my $arrow = $end; # depending on end points, add the arrows my $scale = $att->{'stroke-width'}||1; $svg .= $self->_svg_arrow($att, $x, $y, $arrow, $indent, $scale) unless $arrow == 0 || $self->{edge}->undirected(); ########################################################################### # include the label/name/text if we are the label cell if (($self->{type} & EDGE_LABEL_CELL())) { my $label = $self->label(); $label = '' unless defined $label; if ($label ne '') { my ($w,$h) = $self->dimensions(); my $em2 = $em / 2; my $xt = int($x + $self->{w} / 2); my $yt = int($y + $self->{h} / 2 - $lh / 3 - ($h - 1) * $lh); # my $yt = int($y + ($self->{h} / 2) - $em2); my $style = ''; my $stype = $self->{type}; # for HOR edges if ($type == EDGE_HOR) { # put the edge text left-aligned on the line $xt = $x + 2 * $em; # if we have only one big arrow, shift the text left/right my $ac = $self->arrow_count(); my $style = $self->{style}; if ($ac == 1) { my $shift = 0.2; $shift = 0.5 if $style =~ /^broad/; $shift = 0.8 if $style =~ /^wide/; # <-- edges, shift right, otherwise left $shift = -$shift if ($end & EDGE_END_E) != 0; #print STDERR "# shift=$shift \n"; $xt = int($xt + 2 * $em * $shift); } } elsif ($type == EDGE_VER) { # put label on the right side of the edge $xt = $xt + $em2; my ($w,$h) = $self->dimensions(); $yt = int($y + $self->{h} / 2 - $h * $em2 + $em2); $style = ' text-anchor="start"'; } # selfloops else { # put label right of the edge # my ($w,$h) = $self->dimensions(); # hor loops: $yt += $em2 if $stype & EDGE_START_N; $yt -= $em2 if $stype & EDGE_START_S; $yt += $em if ($h > 1) && ($stype & EDGE_START_S); # vertical loops $yt = int($y + $self->{h} / 2) if ($stype & EDGE_START_E) || ($stype & EDGE_START_W); $xt = int($x + $em * 2) if ($stype & EDGE_START_E); $xt = int($x + $self->{w} - 2*$em) if ($stype & EDGE_START_W); $style = ' text-anchor="start"'; $style = ' text-anchor="middle"' if ($stype & EDGE_START_N) || ($stype & EDGE_START_S); $style = ' text-anchor="end"' if ($stype & EDGE_START_W); } my $color = $self->raw_attribute('labelcolor'); # fall back to color if label-color not defined $color = $self->color_attribute('color') if !defined $color; my $text = $self->_svg_text($color, $indent, $xt, $yt, $style, $xt, $x + $self->{w} - $em); my $link = _quote($self->link()); $text = Graph::Easy::Node::_link($self, $indent.$text, $indent, $title, $link) if $link ne ''; $svg .= $text; } } $svg .= "\n" unless $svg =~ /\n\n\z/; $svg; }