File Coverage

lib/Graph/Easy/As_svg.pm
Criterion Covered Total %
statement 754 921 81.8
branch 294 458 64.1
condition 50 109 45.8
subroutine 40 46 86.9
pod 7 10 70.0
total 1145 1544 74.1


line stmt bran cond sub pod time code
1             #############################################################################
2             # output the a Graph::Easy as SVG (Scalable Vector Graphics)
3             #
4             #############################################################################
5              
6             package Graph::Easy::As_svg;
7             $Graph::Easy::As_svg::VERSION = '0.26';
8 4     4   103805 use 5.010;
  4         11  
9              
10              
11 4     4   16 use strict;
  4         6  
  4         85  
12 4     4   16 use warnings;
  4         4  
  4         108  
13 4     4   14 use utf8;
  4         5  
  4         27  
14              
15             sub _text_length
16             {
17             # Take a string, and return its length, based on the font-size and the
18             # contents ("iii" is shorter than "WWW")
19 139     139   165 my ($em, $text) = @_;
20              
21             # For each len entry, count how often it matches the string
22             # if it matches 2 times "[Ww]", and 3 times "[i]" then we have
23             # (X - (2+3)) * EM + 2*$W*EM + 3*$I*EM where X is length($text), and
24             # $W and $I are sizes of "[Ww]" and "[i]", respectively.
25              
26 139         122 my $count = length($text);
27 139         102 my $len = 0; my $match;
  139         92  
28              
29 139         154 $match = $text =~ tr/'`//;
30 139         203 $len += $match * 0.25 * $em; $count -= $match;
  139         114  
31              
32 139         105 $match = $text =~ tr/Iijl!.,;:\|//;
33 139         155 $len += $match * 0.33 * $em; $count -= $match;
  139         96  
34              
35 139         105 $match = $text =~ tr/"Jft\(\)\[\]\{\}//;
36 139         120 $len += $match * 0.4 * $em; $count -= $match;
  139         93  
37              
38 139         123 $match = $text =~ tr/?//;
39 139         114 $len += $match * 0.5 * $em; $count -= $match;
  139         108  
40              
41 139         101 $match = $text =~ tr/crs_//;
42 139         112 $len += $match * 0.55 * $em; $count -= $match;
  139         112  
43              
44 4     4   715 $match = $text =~ tr/ELPaäevyz\\\/-//;
  4         4  
  4         51  
  139         270  
45 139         129 $len += $match * 0.6 * $em; $count -= $match;
  139         111  
46              
47 139         154 $match = $text =~ tr/1BZFbdghknopqux~üö//;
48 139         129 $len += $match * 0.65 * $em; $count -= $match;
  139         95  
49              
50 139         116 $match = $text =~ tr/KCVXY%023456789//;
51 139         128 $len += $match * 0.7 * $em; $count -= $match;
  139         96  
52              
53 139         158 $match = $text =~ tr/§€//;
54 139         112 $len += $match * 0.75 * $em; $count -= $match;
  139         86  
55              
56 139         161 $match = $text =~ tr/ÜÖÄßHGDSNQU$&//;
57 139         114 $len += $match * 0.8 * $em; $count -= $match;
  139         82  
58              
59 139         101 $match = $text =~ tr/AwO=+<>//;
60 139         119 $len += $match * 0.85 * $em; $count -= $match;
  139         86  
61              
62 139         104 $match = $text =~ tr/W//;
63 139         132 $len += $match * 0.90 * $em; $count -= $match;
  139         103  
64              
65 139         94 $match = $text =~ tr/M//;
66 139         123 $len += $match * 0.95 * $em; $count -= $match;
  139         93  
67              
68 139         94 $match = $text =~ tr/m//;
69 139         125 $len += $match * 1.03 * $em; $count -= $match;
  139         92  
70              
71 139         103 $match = $text =~ tr/@//;
72 139         108 $len += $match * 1.15 * $em; $count -= $match;
  139         93  
73              
74 139         157 $match = $text =~ tr/æ//;
75 139         111 $len += $match * 1.25 * $em; $count -= $match;
  139         91  
76              
77 139         139 $len += $count * $em; # anything else is 1.0
78              
79             # return length in "characters"
80 139         200 $len / $em;
81             }
82              
83             sub _quote_name
84             {
85 119     119   100 my $name = shift;
86 119         93 my $out_name = $name;
87              
88             # "--" is not allowed inside comments:
89 119         108 $out_name =~ s/--/- - /g;
90              
91             # "&", "<" and ">" will not work in comments, so quote them
92 119         96 $out_name =~ s/&/&/g;
93 119         102 $out_name =~ s/
94 119         82 $out_name =~ s/>/>/g;
95              
96 119         117 $out_name;
97             }
98              
99             sub _quote
100             {
101 289     289   15700 my ($txt) = @_;
102              
103             # "&", ,'"', "<" and ">" will not work in hrefs or texts
104 289         275 $txt =~ s/&/&/g;
105 289         232 $txt =~ s/
106 289         213 $txt =~ s/>/>/g;
107 289         222 $txt =~ s/"/"/g;
108              
109             # remove "\n"
110 289         237 $txt =~ s/(^|[^\\])\\[lcnr]/$1 /g;
111              
112 289         336 $txt;
113             }
114              
115             sub _sprintf
116             {
117 188     188   145 my $form = '%0.2f';
118              
119 188         128 my @rc;
120 188         180 for my $x (@_)
121             {
122 508 100 50     755 push @rc, undef and next unless defined $x;
123              
124 404         1399 my $y = sprintf($form, $x);
125              
126             # convert "10.00" to "10"
127 404         735 $y =~ s/\.0+\z//;
128             # strip tailing zeros on "0.10", but not from "100"
129 404         569 $y =~ s/(\.[0-9]+?)0+\z/$1/;
130              
131 404         496 push @rc, $y;
132             }
133              
134 188 100       509 wantarray ? @rc : $rc[0];
135             }
136              
137             #############################################################################
138             #############################################################################
139              
140             package Graph::Easy;
141             $Graph::Easy::VERSION = '0.26';
142 4     4   22638 use strict;
  4         5  
  4         217  
143              
144             BEGIN
145             {
146 4     4   13 *_quote = \&Graph::Easy::As_svg::_quote;
147 4         13300 *_svg_attributes_as_txt = \&Graph::Easy::Node::_svg_attributes_as_txt;
148             }
149              
150             sub EM
151             {
152             # return the height of one line in pixels, taking the font-size into account
153 588     588 0 502 my $self = shift;
154              
155             # default is 16 pixels (and 0.5 of that is a nice round number, like, oh, 8)
156 588         1034 $self->_font_size_in_pixels( 16 );
157             }
158              
159             sub LINE_HEIGHT
160             {
161             # return the height of one line in pixels, taking the font-size into account
162 258     258 0 199 my $self = shift;
163              
164             # default is 20% bigger than EM (to make a bit more space on multi-line
165             # labels for underlines etc)
166 258         405 $self->_font_size_in_pixels( 16 ) * 18 / 16;
167             }
168              
169             my $devs = {
170             'ah' =>
171             " \n 172             . '"ah" stroke-linecap="round" stroke-width="1">' . "\n"
173             . ' '. "\n"
174             . ' '. "\n"
175             . " \n",
176              
177             'ahb' =>
178             " \n 179             . '"ahb" stroke-linecap="round" stroke-width="1">' . "\n"
180             . ' '. "\n"
181             . ' '. "\n"
182             . ' '. "\n"
183             . " \n",
184              
185             'ahc' =>
186             " \n 187             . '"ahc" stroke-linecap="round" stroke-width="1">' . "\n"
188             . ' '. "\n"
189             . " \n",
190              
191             'ahf' =>
192             " \n 193             . '"ahf" stroke-linecap="round" stroke-width="1">' . "\n"
194             . ' '. "\n"
195             . " \n",
196              
197             # point-shapes
198             'diamond' =>
199             " 200             . '"diamond">' . "\n"
201             . ' '. "\n"
202             . " \n",
203             'circle' =>
204             " 205             . '"circle">' . "\n"
206             . ' '. "\n"
207             . " \n",
208             'star' =>
209             " 210             . '"star">' . "\n"
211             . ' '. "\n"
212             . " \n",
213             'square' =>
214             " 215             . '"square">' . "\n"
216             . ' '. "\n"
217             . " \n",
218             'dot' =>
219             " 220             . '"dot">' . "\n"
221             . ' '. "\n"
222             . " \n",
223             'cross' =>
224             " 225             . '"cross">' . "\n"
226             . ' '. "\n"
227             . ' '. "\n"
228             . " \n",
229              
230             # point-shapes with double border
231             'd-diamond' =>
232             " 233             . '"d-diamond">' . "\n"
234             . ' '. "\n"
235             . ' '. "\n"
236             . " \n",
237             'd-circle' =>
238             " 239             . '"d-circle">' . "\n"
240             . ' '. "\n"
241             . ' '. "\n"
242             . " \n",
243             'd-square' =>
244             " 245             . '"d-square">' . "\n"
246             . ' '. "\n"
247             . ' '. "\n"
248             . " \n",
249             'd-star' =>
250             " 251             . '"d-star">' . "\n"
252             . ' '. "\n"
253             . ' '. "\n"
254             . " \n",
255             };
256              
257             my $strokes = {
258             'dashed' => '3, 1',
259             'dotted' => '1, 1',
260             'dot-dash' => '1, 1, 3, 1',
261             'dot-dot-dash' => '1, 1, 1, 1, 3, 1',
262             'double-dash' => '3, 1',
263             'bold-dash' => '3, 1',
264             };
265              
266             sub _svg_use_def
267             {
268             # mark a certain def as used (to output it's definition later)
269 32     32   38 my ($self, $def_name) = @_;
270              
271 32         52 $self->{_svg_defs}->{$def_name} = 1;
272             }
273              
274             sub text_styles_as_svg
275             {
276 79     79 0 70 my $self = shift;
277              
278 79         59 my $style = '';
279 79         171 my $ts = $self->text_styles();
280              
281 79 50       2893 $style .= ' font-style="italic"' if $ts->{italic};
282 79 100       130 $style .= ' font-weight="bold"' if $ts->{bold};
283              
284 79 50 66     288 if ($ts->{underline} || $ts->{none} || $ts->{overline} || $ts->{'line-through'})
      33        
      33        
285             {
286             # XXX TODO: HTML does seem to allow only one of them
287 12         13 my @s;
288 12         15 foreach my $k (qw/underline overline line-through none/)
289             {
290 48 100       81 push @s, $k if $ts->{$k};
291             }
292 12         18 my $s = join(' ', @s);
293 12 50       35 $style .= " text-decoration=\"$s\"" if $s;
294             }
295              
296 79         66 my @styles;
297              
298             # XXX TODO: this will needless include the font-family if set via
299             # "node { font: X }:
300 79         137 my $ff = $self->attribute('font');
301 79 50       3033 push @styles, "font-family:$ff" if $ff;
302              
303             # XXX TODO: this will needless include the font-size if set via
304             # "node { font-size: X }:
305              
306 79 100       146 my $fs = $self->_font_size_in_pixels( 16 ); $fs = '' if $fs eq '16';
  79         3019  
307              
308             # XXX TODO:
309             # the 'style="font-size:XXpx"' is nec. for Batik 1.5 (Firefox and Opera also
310             # handle 'font-size="XXpx"'):
311 79 100       136 push @styles, "font-size:${fs}px" if $fs;
312              
313 79 50       235 $style .= ' style="' . (join(";", @styles)) . '"' if @styles > 0;
314              
315 79         145 $style;
316             }
317              
318             my $al_map = {
319             'c' => 'middle',
320             'l' => 'start',
321             'r' => 'end',
322             };
323              
324             sub _svg_text
325             {
326             # create a text via at pos x,y, indented by "$indent"
327 81     81   865 my ($self, $color, $indent, $x, $y, $style, $xl, $xr) = @_;
328              
329 81         139 my $align = $self->attribute('align');
330              
331 81         2991 my $text_wrap = $self->attribute('textwrap');
332 81         3482 my ($lines, $aligns) = $self->_aligned_label($align, $text_wrap);
333              
334             # We can't just join them togeter with 'x=".." dy="1em"' because Firefox 1.5
335             # doesn't support this (Batik does, tho). So calculate x and y on each tspan:
336              
337             #print STDERR "# xl $xl xr $xr\n";
338              
339 81         8218 my $label = '';
340 81 100       134 if (@$lines > 1)
341             {
342 1         3 my $lh = $self->LINE_HEIGHT(); my $em = $self->EM();
  1         41  
343 1         38 my $in = $indent . $indent;
344 1         3 my $dy = $y - $lh + $em;
345 1         4 $label = "\n$in"; $dy += $lh;
  1         1  
346 1         1 my $i = 0;
347 1         3 for my $line (@$lines)
348             {
349             # quote "<" and ">", "&" and also '"'
350 2         4 $line = _quote($line);
351 2   66     14 my $all = $aligns->[$i+1] || substr($align,0,1);
352 2         3 my $al = ' text-anchor="' . $al_map->{$all} . '"';
353             #print STDERR "$line $al $all $align\n";
354 2 50       5 $al = '' if $all eq substr($align,0,1);
355 2         1 my $xc = $x;
356 2 50       5 $xc = $xl if ($all eq 'l');
357 2 50       3 $xc = $xr if ($all eq 'r');
358 2 100       1 my $join = ""; $join .= "\n$in" if $i < @$lines - 1;
  2         7  
359 2         1 $dy += $lh;
360 2         2 $label .= $line . $join;
361 2         3 $i++;
362             }
363 1         2 $label .= "\n ";
364             }
365             else
366             {
367 80 100       211 $label = _quote($lines->[0]) if @$lines;
368             }
369              
370 81 100       71 my $fs; $fs = $self->text_styles_as_svg() if $label ne '';
  81         196  
371 81 100       141 $fs = '' unless defined $fs;
372              
373             # For an edge, the default stroke is black, but this will render a black
374             # outline around colored text. So disable the stroke with "none".
375 81 100       97 my $stroke = ''; $stroke = ' stroke="none"' if ref($self) =~ /Edge/;
  81         188  
376              
377 81 100       107 if (!defined $style)
378             {
379 66 100       98 $x = $xl if $align eq 'left';
380 66 50       82 $x = $xr if $align eq 'right';
381 66         55 $style = '';
382 66         153 my $def_align = $self->default_attribute('align');
383 66         1211 $style = ' text-anchor="' . $al_map->{substr($align,0,1)} . '"';
384             }
385 81         230 my $svg = "$indent$label\n";
386              
387 81         269 $svg . "\n"
388             }
389              
390             sub _remap_align
391             {
392 0     0   0 my ($self, $att, $val) = @_;
393              
394             # align: center; => text-anchor: middle; => supress as it is the default?
395             # return (undef,undef)if $val eq 'center';
396              
397 0 0       0 $val = 'middle' if $val eq 'center';
398              
399             # align: center; => text-anchor: middle;
400 0         0 ('text-anchor', $val);
401             }
402              
403             sub _remap_font_size
404              
405             {
406 0     0   0 my ($self, $att, $val) = @_;
407              
408             # "16" to "16px"
409 0 0       0 $val .= 'px' if $val =~ /^\d+\z/;
410              
411 0 0       0 if ($val =~ /em\z/)
412             {
413 0         0 $val = $self->_font_size_in_pixels( 16, $val ) . 'px';
414             }
415              
416 0         0 ('font-size', $val);
417             }
418              
419             sub _adjust_dasharray
420             {
421             # If the border is bigger than 1px, we need to adjust the dasharray to
422             # match it.
423 128     128   108 my ($self,$att) = @_;
424              
425             # convert "20px" to "20"
426             # convert "2em" to "xx"
427 128   100     208 my $s = $att->{'stroke-width'} || 1;
428              
429 128         120 $s =~ s/px//;
430              
431 128 50       173 if ($s =~ /(\d+)em/)
432             {
433 0         0 my $em = $self->EM();
434 0         0 $s = $1 * $em;
435             }
436 128         125 $att->{'stroke-width'} = $s;
437              
438 128 50       236 delete $att->{'stroke-width'} if $s eq '1';
439              
440 128 100       226 return $att unless exists $att->{'stroke-dasharray'};
441              
442             # for very thin line, make it a bit bigger as to be actually visible
443 76 50       140 $s = 2 if $s < 2;
444              
445 76         280 my @dashes = split /\s*,\s*/, $att->{'stroke-dasharray'};
446 76         82 for my $d (@dashes)
447             {
448 152         166 $d *= $s; # modify in place
449             }
450 76         115 $att->{'stroke-dasharray'} = join (',', @dashes);
451 76         89 $att;
452             }
453              
454             sub _as_svg
455             {
456             # convert the graph to SVG
457 29     29   37828 my ($self, $options) = @_;
458              
459             # set the info fields to defaults
460 29         122 $self->{svg_info} = { width => 0, height => 0 };
461              
462 29 100       159 $self->layout() unless defined $self->{score};
463              
464 29         75123 my ($rows,$cols,$max_x,$max_y) = $self->_prepare_layout('svg');
465 29         4270 my $cells = $self->{cells};
466 29         28 my $txt;
467              
468 29 100       61 if ($options->{standalone})
469             {
470 1         2 $txt .= <
471            
472            
473              
474             EOSVG
475             ;
476             }
477              
478 29         45 my $em = $self->EM();
479 29         1616 my $LINE_HEIGHT = $self->LINE_HEIGHT();
480              
481             # XXX TODO: that should use the padding/margin attribute from the graph
482 29         1256 my $xl = int($em / 2); my $yl = int($em / 2);
  29         37  
483 29         31 my $xr = int($em / 2); my $yr = int($em / 2);
  29         21  
484              
485 29         36 my $mx = $max_x + $xl + $xr;
486 29         32 my $my = $max_y + $yl + $yr;
487              
488             # we need both xmlns= and xmlns:xlink to make Firefix 1.5 happy :-(
489 29         1454 $txt .=
490             # ''
491             ''
492             ."\n\n\n";
494              
495 29         102 my $title = _quote($self->title());
496              
497 29 50       89 $txt .= "$title\n" if $title ne '';
498              
499 29         26 $txt .= "\n##devs##";
500              
501             # clear used definitions
502 29         45 $self->{_svg_defs} = {};
503              
504             # which attributes must be output as what name:
505 29         138 my $mutator = {
506             background => 'fill',
507             'align' => \&_remap_align,
508             'color' => 'stroke',
509             'fontsize' => \&_remap_font_size,
510             'font' => 'font-family',
511             };
512 29         76 my $skip = qr/^(
513             arrow(style|shape)|
514             (auto)?(link|title|label)|
515             bordercolor|
516             borderstyle|
517             borderwidth|
518             border|
519             color|
520             colorscheme|
521             comment|
522             columns|
523             flow|
524             format|
525             gid|
526             labelpos|
527             labelcolor|
528             linkbase|
529             line-height|
530             letter-spacing|
531             margin.*|
532             nodeclass|
533             padding.*|
534             rows|
535             root|
536             size|
537             style|
538             shape|
539             title|
540             type|
541             textstyle|
542             width|
543             rotate|
544             )\z/x;
545              
546 29         113 my $overlay = {
547             edge => {
548             "stroke" => 'black',
549             "text-align" => 'center',
550             "font-size" => '13px',
551             },
552             node => {
553             "font-size" => '16px',
554             "text-align" => 'center',
555             },
556             };
557             $overlay->{graph} =
558             {
559 29         70 "font-size" => '16px',
560             "text-align" => 'center',
561             "border" => '1px dashed #808080',
562             };
563             # generate the class attributes first
564 29         77 my $style = $self->_class_styles( $skip, $mutator, '', ' ', $overlay);
565              
566 29 50       9058 $txt .=
567             "\n \n"
568             ." \n"
569             if $style ne '';
570              
571 29         45 $txt .="\n\n";
572              
573             ###########################################################################
574             # prepare graph label output
575              
576 29         40 my $lp = 'top';
577 29         44 my ($lw,$lh) = Graph::Easy::Node::_svg_dimensions($self);
578             # some padding on the label
579 29         57 $lw = int($em*$lw + $em + 0.5); $lh = int($LINE_HEIGHT*$lh+0.5);
  29         35  
580              
581 29         68 my $label = $self->label();
582 29 100       177 if ($label ne '')
583             {
584 9         20 $lp = $self->attribute('labelpos');
585              
586             # handle the case where the graph label is bigger than the graph itself
587 9 50       390 if ($mx < ($lw+$em))
588             {
589             # move the content to the right to center it
590 0         0 $xl += (($lw+$em) - $mx) / 2;
591             # and then make the graph more wide
592 0         0 $mx = $em + $lw;
593             }
594              
595 9         10 $my += $lh;
596             }
597              
598             ###########################################################################
599             # output the graph's background and border
600              
601 29         34 my $em2 = $em / 2;
602              
603             {
604             # 'inherit' only works for HTML, not for SVG
605 29 50       23 my $bg = $self->color_attribute('fill'); $bg = 'white' if $bg eq 'inherit';
  29         61  
  29         2442  
606 29         58 my $bs = $self->attribute('borderstyle');
607 29 50       1119 my $cl = $self->color_attribute('bordercolor'); $cl = $bg if $bs eq 'none';
  29         1203  
608 29   50     58 my $bw = $self->attribute('borderwidth') || 1;
609              
610 29         989 $bw =~ s/px//;
611              
612             # We always need to output a background rectangle, otherwise printing the
613             # SVG from Firefox ends you up with a black background, which rather ruins
614             # the day:
615              
616             # XXX TODO adjust dasharray
617             my $att = {
618 29   50     179 'stroke-dasharray' => $strokes->{$bs} || '',
619             'stroke-width' => $bw,
620             'stroke' => $cl,
621             'fill' => $bg,
622             };
623             # avoid stroke-dasharray="":
624 29 50       75 delete $att->{'stroke-dasharray'} unless $att->{'stroke-dasharray'} ne '';
625              
626 29         61 my $d = $self->_svg_attributes_as_txt($self->_adjust_dasharray($att));
627              
628 29         48 my $xr = $mx + $em2;
629 29         28 my $yr = $my + $em2;
630              
631 29 50       55 if ($bs ne '')
632             {
633             # Provide some padding around the graph to avoid that the border sticks
634             # very close to the edge
635 29         38 $xl += $em2 + $bw;
636 29         28 $yl += $em2 + $bw;
637              
638 29         34 $xr += $em2 + 2 * $bw;
639 29         30 $yr += $em2 + 2 * $bw;
640              
641 29         26 $mx += $em + 4 * $bw;
642 29         33 $my += $em + 4 * $bw;
643             }
644              
645 29         26 my $bw_2 = $bw / 2;
646 29         323 $txt .= '' .
647             "\n\n\n";
648              
649             } # end outpuf of background
650              
651             ###########################################################################
652             # adjust space for the graph label and output the label
653              
654 29 100       46 if ($label ne '')
655             {
656 9 50       11 my $y = $yl + $em2; $y = $my - $lh + $em2 if $lp eq 'bottom';
  9         21  
657              
658             # also include a link on the label if nec.
659 9         25 my $link = _quote($self->link());
660              
661 9   50     24 my $l = Graph::Easy::Node::_svg_text($self,
662             $self->color_attribute('color') || 'black', ' ',
663             $mx / 2, $y, undef, $em2, $mx - $em2);
664              
665 9         35 $l =~ s/
666 9         20 $l = " \n" . $l;
667              
668 9 50       22 $l = Graph::Easy::Node::_link($self, $l, '', $title, $link) if $link ne '';
669              
670 9         19 $txt .= $l;
671              
672             # push content down if label is at top
673 9 50       23 $yl += $lh if $lp eq 'top';
674             }
675              
676             # Now output cells that belong to one edge/node together.
677             # But do the groups first, because edges/nodes are drawn on top of them.
678 29         72 for my $n ($self->groups(), $self->edges(), $self->sorted_nodes())
679             {
680 90         1109 my $x = $xl; my $y = $yl;
  90         83  
681 90 100 100     249 if ((ref($n) eq 'Graph::Easy::Node')
682             || (ref($n) eq 'Graph::Easy::Node::Anon'))
683             {
684             # get position from cell
685 57         91 $x += $cols->{ $n->{x} };
686 57         66 $y += $rows->{ $n->{y} };
687             }
688              
689 90         210 my $class = $n->class(); $class =~ s/\./_/; # node.city => node-city
  90         591  
690 90         175 my $obj_txt = $n->as_svg($x,$y,' ', $rows, $cols);
691 90 100       154 if ($obj_txt ne '')
692             {
693 89         337 $obj_txt =~ s/\n\z/<\/g>\n\n/;
694 89         189 my $id = $n->attribute('id');
695 89 100       3191 $id = $n->{id} if $id eq '';
696 89         124 $id =~ s/([\"\\])/\\$1/g;
697 89         262 $txt .= "\n" . $obj_txt;
698             }
699             }
700              
701             # include the used definitions into
702 29         107 my $d = '';
703 29         26 for my $key (keys %{$self->{_svg_defs}})
  29         71  
704             {
705 29         44 $d .= $devs->{$key};
706             }
707 29         179 $txt =~ s/##devs##/$d/;
708              
709 29         192 $txt =~ s/##MX##/$mx/;
710 29         142 $txt =~ s/##MY##/$my/;
711              
712 29         41 $txt .= ""; # finish
713              
714 29 100       54 $txt .= "\n" if $options->{standalone};
715              
716             # set the info fields:
717 29         49 $self->{svg_info}->{width} = $mx;
718 29         29 $self->{svg_info}->{height} = $my;
719              
720 29         271 $txt;
721             }
722              
723              
724             #############################################################################
725             #############################################################################
726              
727             package Graph::Easy::Node::Cell;
728             $Graph::Easy::Node::Cell::VERSION = '0.26';
729             sub as_svg
730             {
731 0     0 1 0 '';
732             }
733              
734             sub _correct_size_svg
735             {
736 4     4   45 my $self = shift;
737              
738 4         2 $self->{w} = 3;
739 4         7 $self->{h} = 3;
740 4         5 $self;
741             }
742              
743             #############################################################################
744             #############################################################################
745              
746             package Graph::Easy::Group::Cell;
747             $Graph::Easy::Group::Cell::VERSION = '0.26';
748             sub as_svg
749             {
750 55     55 1 69 my ($self,$x, $y, $indent) = @_;
751              
752 55         63 my $svg = $self->_svg_background($x,$y,$indent);
753              
754 55 100       103 $svg .= $self->SUPER::as_svg($x,$y,$indent) if $self->{has_label};
755              
756 55         102 $svg;
757             }
758              
759             my $coords = {
760             'gl' => 'x1="XX0" y1="YY0" x2="XX0" y2="YY1"',
761             'gt' => 'x1="XX0" y1="YY0" x2="XX1" y2="YY0"',
762             'gb' => 'x1="XX0" y1="YY1" x2="XX1" y2="YY1"',
763             'gr' => 'x1="XX1" y1="YY0" x2="XX1" y2="YY1"',
764             };
765              
766             sub _svg_background
767             {
768             # draw the background for this node/cell, if nec.
769 58     58   46 my ($self, $x, $y, $indent) = @_;
770              
771 58         105 my $bg = $self->background();
772              
773 58 50       1797 $bg = $self->{group}->default_attribute('fill') if $bg eq '';
774              
775 58         51 my $svg = '';
776 58 50       80 if ($bg ne '')
777             {
778 58 50       138 $bg = $self->{group}->color_attribute('fill') if $bg eq 'inherit';
779 58 50       2290 $bg = '' if $bg eq 'inherit';
780 58 50       70 if ($bg ne '')
781             {
782 58         55 my $w = $self->{w};
783 58         33 my $h = $self->{h};
784 58         289 $svg .= "$indent\n";
785             }
786             }
787              
788             # draw the border pieces
789 58         76 my $x2 = $x + $self->{w} - 0.5;
790 58         47 my $y2 = $y + $self->{h} - 0.5;
791              
792 58   50     109 my $style = $self->attribute('border-style')||'dashed';
793             my $att = {
794             'stroke' => $self->color_attribute('bordercolor'),
795 58   50     485 'stroke-dasharray' => $strokes->{$style}||'3, 1',
      50        
796             'stroke-width' => $self->attribute('borderwidth') || 1,
797             };
798 58         1016 $self->_adjust_dasharray($att);
799              
800 58         89 my $stroke = $self->_svg_attributes_as_txt($att, 0, 0); # x,y are not used
801              
802 58         59 my $c = $self->{cell_class}; $c =~ s/^\s+//; $c =~ s/\s+\z//;
  58         95  
  58         67  
803              
804 58         47 $x += 0.5;
805 58         37 $y += 0.5;
806 58         102 for my $class (split /\s+/, $c)
807             {
808 67 50       126 last if $class =~ /^(\s+|gi)\z/; # inner => no border, skip empty
809              
810 67         113 my $l = "$indent{$class} . " $stroke/>\n";
811              
812 67         247 $l =~ s/XX0/$x/g;
813 67         213 $l =~ s/XX1/$x2/g;
814 67         167 $l =~ s/YY0/$y/g;
815 67         167 $l =~ s/YY1/$y2/g;
816              
817 67         87 $svg .= $l;
818             }
819 58         51 $svg .= "\n";
820              
821 58         98 $svg;
822             }
823              
824             #############################################################################
825             #############################################################################
826              
827             package Graph::Easy::Group;
828             $Graph::Easy::Group::VERSION = '0.26';
829             sub as_svg
830             {
831             # output all cells of the group as svg
832 3     3 1 9 my ($self, $xl, $yl, $indent, $rows, $cols) = @_;
833              
834 3         4 my $txt = '';
835 3         4 for my $cell (values %{$self->{_cells}})
  3         8  
836             {
837             # get position from cell
838 55         70 my $x = $cols->{ $cell->{x} } + $xl;
839 55         55 my $y = $rows->{ $cell->{y} } + $yl;
840 55         81 $txt .= $cell->as_svg($x,$y,$indent);
841             }
842 3         11 $txt;
843             }
844              
845             #############################################################################
846             #############################################################################
847              
848             package Graph::Easy::Edge;
849             $Graph::Easy::Edge::VERSION = '0.26';
850 4     4   24 use Graph::Easy::Edge::Cell qw/EDGE_HOLE/;
  4         5  
  4         1194  
851              
852             sub as_svg
853             {
854             # output all cells of the edge as svg
855 30     30 1 39 my ($self, $xl, $yl, $indent, $rows, $cols) = @_;
856              
857 30         34 my $cells = $self->{cells};
858              
859 30         57 my $from = Graph::Easy::As_svg::_quote_name($self->{from}->{name});
860 30         51 my $to = Graph::Easy::As_svg::_quote_name($self->{to}->{name});
861 30         52 my $txt = " \n";
862 30         25 my $done_cells = 0;
863 30         38 for my $cell (@$cells)
864             {
865 37 50       63 next if $cell->{type} == EDGE_HOLE;
866 37         27 $done_cells++;
867             # get position from cell
868 37         49 my $x = $cols->{ $cell->{x} } + $xl;
869 37         40 my $y = $rows->{ $cell->{y} } + $yl;
870 37         70 $txt .= $cell->as_svg($x,$y,$indent);
871             }
872              
873             # had no cells or only one "HOLE"
874 30 50       90 return '' if $done_cells == 0;
875              
876 30         47 $txt;
877             }
878              
879             #############################################################################
880             #############################################################################
881              
882             package Graph::Easy::Node::Empty;
883             $Graph::Easy::Node::Empty::VERSION = '0.26';
884             sub as_svg
885             {
886             # empty nodes are not rendered at all
887 0     0 1 0 '';
888             }
889              
890             #############################################################################
891             #############################################################################
892              
893             package Graph::Easy::Node;
894             $Graph::Easy::Node::VERSION = '0.26';
895             BEGIN
896             {
897 4     4   18 *_sprintf = \&Graph::Easy::As_svg::_sprintf;
898 4         15 *_quote = \&Graph::Easy::As_svg::_quote;
899 4         1412 *LINE_HEIGHT = \&Graph::Easy::LINE_HEIGHT;
900             }
901              
902             sub _svg_dimensions
903             {
904             # Returns the dimensions of the node/cell derived from the label (or name) in characters.
905 220     220   204 my ($self) = @_;
906              
907             # my $align = $self->attribute('align') || $self->default_attribute('align') || 'center';
908             # my $text_wrap = $self->attribute('text-wrap') || 'none';
909 220         361 my $align = $self->attribute('align');
910 220         6907 my $text_wrap = $self->attribute('textwrap');
911 220         7546 my ($lines, $aligns) = $self->_aligned_label($align, $text_wrap);
912              
913 220         13878 my $w = 0; my $h = scalar @$lines;
  220         200  
914 220         298 my $em = $self->EM();
915 220         7426 foreach my $line (@$lines)
916             {
917 134         176 $line =~ s/^\s+//; $line =~ s/\s+$//; # rem spaces
  134         153  
918 134         199 my $line_length = Graph::Easy::As_svg::_text_length($em, $line);
919 134 100       302 $w = $line_length if $line_length > $w;
920             }
921 220         422 ($w,$h);
922             }
923              
924             sub _svg_background
925             {
926             # draw the background for this node/cell, if nec.
927 54     54   62 my ($self, $x, $y, $indent) = @_;
928              
929 54         101 my $bg = $self->background();
930              
931 54         9190 my $s = '';
932 54 100       100 if (ref $self->{edge})
933             {
934             $bg = $self->{edge}->{group}->default_attribute('fill')||'#a0d0ff'
935 37 50 0     77 if $bg eq '' && ref $self->{edge}->{group};
      33        
936 37         34 $s = ' stroke="none"';
937             }
938              
939 54         43 my $svg = '';
940 54 100 66     115 if ($bg ne 'inherit' && $bg ne '')
941             {
942 8         9 my $w = $self->{w};
943 8         9 my $h = $self->{h};
944 8         63 $svg .= "$indent\n";
945             }
946 54         91 $svg;
947             }
948              
949             BEGIN
950             {
951 4     4   15 *EM = \&Graph::Easy::EM;
952 4         21 *text_styles_as_svg = \&Graph::Easy::text_styles_as_svg;
953 4         12 *_svg_text = \&Graph::Easy::_svg_text;
954 4         12932 *_adjust_dasharray = \&Graph::Easy::_adjust_dasharray;
955             }
956              
957             sub as_svg
958             {
959             # output a node as SVG
960 60     60 1 69 my ($self,$x,$y,$indent) = @_;
961              
962 60         71 my $name = $self->{att}->{label};
963 60 100       103 $name = $self->{name} if !defined $name;
964 60 100       101 $name = 'anon node ' . $self->{name} if $self->{class} eq 'node.anon';
965              
966 60         82 my $em = $self->EM(); # multiplication factor chars * em = units (pixels)
967              
968             # the attributes of the element we will finally output
969 60         2572 my $att = $self->_svg_attributes($x,$y);
970              
971             # the output shape as svg-tag
972 60         72 my $shape = $att->{shape}; # rect, circle etc
973 60         70 delete $att->{shape};
974              
975 60 100       97 return '' if $shape eq 'invisible';
976              
977             # set a potential title
978 59         118 my $title = _quote($self->title());
979 59 100       100 $att->{title} = $title if $title ne '';
980              
981             # the original shape
982 59 100       57 my $s = ''; $s = $self->attribute('shape') unless $self->isa_cell();
  59         221  
983              
984 59         1708 my $link = _quote($self->link());
985 59 50       59 my $old_indent = $indent; $indent = $indent x 2 if $link ne '';
  59         88  
986              
987 59         81 my $out_name = Graph::Easy::As_svg::_quote_name($name);
988 59         92 my $svg = "$indent\n";
989              
990             # render the background, except for "rect" where it is not visible
991             # (use the original shape in $s, or "rounded" will be wrong)
992 59 100       116 $svg .= $self->_svg_background($x,$y, $indent) if $s ne 'rect';
993              
994 59         107 my $bs = $self->attribute('borderstyle');
995              
996 59         2012 my $xt = int($x + $self->{w} / 2);
997 59         73 my $yt = int($y + $self->{h} / 2);
998              
999             # render the node shape itself
1000 59 100       134 if ($shape eq 'point')
    50          
1001             {
1002             # include the point-shape
1003 2         10 my $s = $self->attribute('pointshape');
1004              
1005 2 50       53 if ($s ne 'invisible')
1006             {
1007 2 100 66     15 $s = 'd-' . $s if $bs =~ /^double/ && $s =~ /^(square|diamond|circle|star)\z/;
1008              
1009 2         5 my $ps = $self->attribute('pointstyle');
1010              
1011             # circle => filledcircle
1012             #$s = 'f-' . $s if $ps eq 'filled' && $s =~ /^(square|diamond|circle|star)\z/;
1013              
1014 2         45 my $a = { };
1015 2         5 for my $key (keys %$att)
1016             {
1017 6         9 $a->{$key} = $att->{$key};
1018             }
1019 2         5 $a->{stroke} = $self->color_attribute('bordercolor');
1020 2 50 33     92 if ($s eq 'dot' || $ps eq 'filled')
1021             {
1022 0         0 $a->{fill} = $a->{stroke};
1023             }
1024              
1025 2         5 my $att_txt = $self->_svg_attributes_as_txt($a, $xt, $yt);
1026              
1027             # center a square point-node
1028 2 50       5 $yt -= 5 if $s =~ 'square';
1029 2 50       6 $xt -= 5 if $s =~ 'square';
1030              
1031 2         5 $self->{graph}->_svg_use_def($s);
1032              
1033 2         11 $svg .= "$indent\n\n";
1034             }
1035 0         0 else { $svg .= "\n"; }
1036             }
1037             elsif ($shape eq 'img')
1038             {
1039 0         0 require Image::Info;
1040              
1041 0         0 my $label = $self->label();
1042 0         0 my $info = Image::Info::image_info($label);
1043 0         0 my $w = $info->{width};
1044 0         0 my $h = $info->{height};
1045 0 0       0 if ($info->{error})
1046             {
1047 0         0 $self->_croak("Couldn't determine image dimensions from '$label': $info->{error}");
1048             }
1049             # center the image
1050 0         0 my $x1 = $xt - $w / 2;
1051 0         0 my $y1 = $yt - $h / 2;
1052              
1053 0         0 $label = _quote($label);
1054 0         0 $svg .= "\n";
1055             }
1056             else
1057             {
1058             # no border/shape for Group cells (we need to draw the border in pieces)
1059 57 100 66     379 if ($shape ne 'none' && !$self->isa('Graph::Easy::Group::Cell'))
1060             {
1061             # If we need to draw the border shape twice, put common attributes on
1062             # a around it. (In the case there is only "stroke: #000000;" it will
1063             # waste 4 bytes, but in all other cases save quite a few.
1064              
1065 54         60 my $group = {};
1066 54 50       84 if ($bs =~ /^double/)
1067             {
1068 0         0 for my $a (qw/fill stroke stroke-dasharray/)
1069             {
1070 0 0       0 $group->{$a} = $att->{$a} if exists $att->{$a}; delete $att->{$a};
  0         0  
1071             }
1072             }
1073              
1074 54         91 my $att_txt = $self->_svg_attributes_as_txt($att, $xt, $yt);
1075              
1076 54         89 my $shape_svg = "$indent<$shape$att_txt />\n";
1077              
1078             # if border-style is double, do it again, sam.
1079 54 50       73 if ($bs =~ /^double/)
1080             {
1081 0         0 my $group_txt = $self->_svg_attributes_as_txt($group, $xt, $yt);
1082              
1083 0         0 $shape_svg = "$indent\n$indent" . $shape_svg;
1084              
1085 0         0 my $att = $self->_svg_attributes($x,$y, 3);
1086 0         0 for my $a (qw/fill stroke stroke-dasharray/)
1087             {
1088 0         0 delete $att->{$a};
1089             }
1090              
1091 0         0 my $shape = $att->{shape}; # circle etc
1092 0         0 delete $att->{shape};
1093              
1094 0         0 my $att_txt = $self->_svg_attributes_as_txt( $att, $xt, $yt );
1095              
1096 0         0 $shape_svg .= "$indent$indent<$shape$att_txt />\n";
1097              
1098 0         0 $shape_svg .= "$indent\n"; # close group
1099             }
1100 54         91 $svg .= $shape_svg;
1101             }
1102              
1103             ###########################################################################
1104             # include the label/name/text
1105              
1106 57         93 my ($w,$h) = $self->_svg_dimensions();
1107 57         98 my $lh = $self->LINE_HEIGHT();
1108              
1109 57         2497 my $yt = int($y + $self->{h} / 2 + $lh / 3 - ($h -1) * $lh / 2);
1110              
1111 57 50       104 $yt += $self->{h} * 0.25 if $s =~ /^(triangle|trapezium)\z/;
1112 57 50       80 $yt -= $self->{h} * 0.25 if $s =~ /^inv(triangle|trapezium)\z/;
1113 57 50       84 $yt += $self->{h} * 0.10 if $s eq 'house';
1114 57 50       91 $yt -= $self->{h} * 0.10 if $s eq 'invhouse';
1115              
1116 57   50     109 my $color = $self->color_attribute('color') || 'black';
1117              
1118             $svg .= $self->_svg_text($color, $indent, $xt, $yt,
1119             # left # right
1120 57         4939 undef, int($x + $em/2), int($x + $self->{w} - $em/2));
1121             }
1122              
1123             # Create the link
1124 59 50       152 $svg = $self->_link($svg, $old_indent, $title, $link) if $link ne '';
1125              
1126 59         195 $svg;
1127             }
1128              
1129             sub _link
1130             {
1131             # put a link around a shape (including onclick handler to work around bugs)
1132 1     1   2 my ($self, $svg, $indent, $title, $link) = @_;
1133              
1134             # although the title is already included on the outer shape, we need to
1135             # add it to the link, too (for shape: none, and some user agents like
1136             # FF 1.5 display the title only while outside the text-area)
1137 1 50       4 $title = ' xlink:title="' . $title . '"' if $title ne '';
1138              
1139 1         2 $svg =~ s/\n\z//;
1140 1         5 $svg =
1141             $indent . "\n" . $svg .
1142             $indent . "\n\n";
1143              
1144 1         1 $svg;
1145             }
1146              
1147             sub _svg_attributes
1148             {
1149             # Return a hash with attributes for the node, like "x => 1, y => 1, w => 1, h => 1"
1150             # Especially usefull for shapes other than boxes.
1151 60     60   68 my ($self,$x,$y, $sub) = @_;
1152              
1153             # subtract factor, 0 or 2 for border-style: double
1154 60   50     175 $sub ||= 0;
1155              
1156 60         67 my $att = {};
1157              
1158 60         121 my $shape = $self->shape();
1159              
1160 60         1478 my $em = $self->EM();
1161 60         2382 my $border_width = Graph::Easy::_border_width_in_pixels($self,$em);
1162              
1163             # subtract half of our border-width because the border-center would otherwise
1164             # be on the node's border-line and thus extending outward:
1165 60         4245 my $bw2 = $border_width / 2; $sub += $bw2;
  60         60  
1166              
1167 60         73 my $w2 = $self->{w} / 2;
1168 60         53 my $h2 = $self->{h} / 2;
1169              
1170             # center
1171 60         65 my $cx = $x + $self->{w} / 2;
1172 60         51 my $cy = $y + $self->{h} / 2;
1173              
1174 60 100 50     45 my $double = 0; $double = 1 if ($self->attribute('border-style') || '') eq 'double';
  60         109  
1175              
1176 60         2107 my $x2 = $x + $self->{w} - $sub;
1177 60         68 my $y2 = $y + $self->{h} - $sub;
1178              
1179 60         62 $x += $sub; $y += $sub;
  60         39  
1180              
1181 60         52 my $sub3 = $sub / 3; # 0.333 * $sub
1182 60         56 my $sub6 = 2 * $sub / 3; # 0.666 * $sub
1183              
1184 60 100       543 if ($shape =~ /^(point|none)\z/)
    100          
    50          
    50          
    50          
    100          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
1185             {
1186             }
1187             elsif ($shape eq 'circle')
1188             {
1189 1         2 $att->{cx} = $cx;
1190 1         2 $att->{cy} = $cy;
1191 1 50       4 $att->{r} = $self->{minw} > $self->{minh} ? $self->{minw} : $self->{minh};
1192 1         1 $att->{r} /= 2;
1193 1         1 $att->{r} -= $sub;
1194             }
1195             elsif ($shape eq 'parallelogram')
1196             {
1197 0         0 my $xll = _sprintf($x - $sub3 + $self->{w} * 0.25);
1198 0         0 my $xrl = _sprintf($x2 + $sub3 - $self->{w} * 0.25);
1199              
1200 0         0 my $xl = _sprintf($x + $sub6);
1201 0         0 my $xr = _sprintf($x2 - $sub6);
1202              
1203 0         0 $shape = "polygon points=\"$xll,$y, $xr,$y, $xrl,$y2, $xl,$y2\"";
1204             }
1205             elsif ($shape eq 'trapezium')
1206             {
1207 0         0 my $xl = _sprintf($x - $sub3 + $self->{w} * 0.25);
1208 0         0 my $xr = _sprintf($x2 + $sub3 - $self->{w} * 0.25);
1209              
1210 0         0 my $xl1 = _sprintf($x + $sub3);
1211 0         0 my $xr1 = _sprintf($x2 - $sub3);
1212              
1213 0         0 $shape = "polygon points=\"$xl,$y, $xr,$y, $xr1,$y2, $xl1,$y2\"";
1214             }
1215             elsif ($shape eq 'invtrapezium')
1216             {
1217 0         0 my $xl = _sprintf($x - $sub3 + $self->{w} * 0.25);
1218 0         0 my $xr = _sprintf($x2 + $sub3 - $self->{w} * 0.25);
1219              
1220 0         0 my $xl1 = _sprintf($x + $sub3);
1221 0         0 my $xr1 = _sprintf($x2 - $sub3);
1222              
1223 0         0 $shape = "polygon points=\"$xl1,$y, $xr1,$y, $xr,$y2, $xl,$y2\"";
1224             }
1225             elsif ($shape eq 'diamond')
1226             {
1227 1         1 my $x1 = $cx;
1228 1         2 my $y1 = $cy;
1229              
1230 1         6 my $xl = _sprintf($x + $sub3);
1231 1         2 my $xr = _sprintf($x2 - $sub3);
1232              
1233 1         8 $shape = "polygon points=\"$xl,$y1, $x1,$y, $xr,$y1, $x1,$y2\"";
1234             }
1235             elsif ($shape eq 'house')
1236             {
1237 0         0 my $x1 = $cx;
1238 0         0 my $y1 = _sprintf($y - $sub3 + $self->{h} * 0.333);
1239              
1240 0         0 $shape = "polygon points=\"$x1,$y, $x2,$y1, $x2,$y2, $x,$y2, $x,$y1\"";
1241             }
1242             elsif ($shape eq 'pentagon')
1243             {
1244 0         0 my $x1 = $cx;
1245 0         0 my $x11 = _sprintf($x - $sub3 + $self->{w} * 0.25);
1246 0         0 my $x12 = _sprintf($x2 + $sub3 - $self->{w} * 0.25);
1247 0         0 my $y1 = _sprintf($y - $sub6 + $self->{h} * 0.333);
1248              
1249 0         0 my $xl = _sprintf($x + $sub3);
1250 0         0 my $xr = _sprintf($x2 - $sub3);
1251              
1252 0         0 $shape = "polygon points=\"$x1,$y, $xr,$y1, $x12,$y2, $x11,$y2, $xl,$y1\"";
1253             }
1254             elsif ($shape eq 'invhouse')
1255             {
1256 0         0 my $x1 = $cx;
1257 0         0 my $y1 = _sprintf($y - (1.4 * $sub) + $self->{h} * 0.666);
1258              
1259 0         0 $shape = "polygon points=\"$x,$y, $x2,$y, $x2,$y1, $x1,$y2, $x,$y1\"";
1260             }
1261             elsif ($shape eq 'septagon')
1262             {
1263 0         0 my $x15 = $cx;
1264              
1265 0         0 my $x11 = _sprintf($x2 + $sub3 - $self->{w} * 0.10);
1266 0         0 my $x14 = _sprintf($x - $sub3 + $self->{w} * 0.10);
1267              
1268 0         0 my $y11 = _sprintf($y - $sub3 + $self->{h} * 0.15);
1269 0         0 my $y13 = _sprintf($y2 + 0.85 * $sub - $self->{h} * 0.40);
1270              
1271 0         0 my $x12 = _sprintf($x2 + $sub6 - $self->{w} * 0.25);
1272 0         0 my $x13 = _sprintf($x - $sub6 + $self->{w} * 0.25);
1273              
1274 0         0 my $xl = _sprintf($x - 0.15 * $sub);
1275 0         0 my $xr = _sprintf($x2 + 0.15 * $sub);
1276              
1277 0         0 $shape = "polygon points=\"$x15,$y, $x11,$y11, $xr,$y13, $x12,$y2, $x13,$y2, $xl,$y13, $x14, $y11\"";
1278             }
1279             elsif ($shape eq 'octagon')
1280             {
1281 0         0 my $x11 = _sprintf($x - $sub3 + $self->{w} * 0.25);
1282 0         0 my $x12 = _sprintf($x2 + $sub3 - $self->{w} * 0.25);
1283 0         0 my $y11 = _sprintf($y - $sub6 + $self->{h} * 0.25);
1284 0         0 my $y12 = _sprintf($y2 + $sub6 - $self->{h} * 0.25);
1285              
1286 0         0 my $xl = _sprintf($x + $sub * 0.133);
1287 0         0 my $xr = _sprintf($x2 - $sub * 0.133);
1288              
1289 0         0 $shape = "polygon points=\"$xl,$y11, $x11,$y, $x12,$y, $xr,$y11, $xr,$y12, $x12,$y2, $x11,$y2, $xl,$y12\"";
1290             }
1291             elsif ($shape eq 'hexagon')
1292             {
1293 0         0 my $y1 = $cy;
1294 0         0 my $x11 = _sprintf($x - $sub6 + $self->{w} * 0.25);
1295 0         0 my $x12 = _sprintf($x2 + $sub6 - $self->{w} * 0.25);
1296              
1297 0         0 my $xl = _sprintf($x + $sub3);
1298 0         0 my $xr = _sprintf($x2 - $sub3);
1299              
1300 0         0 $shape = "polygon points=\"$xl,$y1, $x11,$y, $x12,$y, $xr,$y1, $x12,$y2, $x11,$y2\"";
1301             }
1302             elsif ($shape eq 'triangle')
1303             {
1304 0         0 my $x1 = $cx;
1305              
1306 0         0 my $xl = _sprintf($x + $sub);
1307 0         0 my $xr = _sprintf($x2 - $sub);
1308              
1309 0         0 my $yd = _sprintf($y2 + ($sub * 0.2 ));
1310              
1311 0         0 $shape = "polygon points=\"$x1,$y, $xr,$yd, $xl,$yd\"";
1312             }
1313             elsif ($shape eq 'invtriangle')
1314             {
1315 0         0 my $x1 = $cx;
1316              
1317 0         0 my $xl = _sprintf($x + $sub);
1318 0         0 my $xr = _sprintf($x2 - $sub);
1319              
1320 0         0 my $yd = _sprintf($y - ($sub * 0.2));
1321              
1322 0         0 $shape = "polygon points=\"$xl,$yd, $xr,$yd, $x1,$y2\"";
1323             }
1324             elsif ($shape eq 'ellipse')
1325             {
1326 0         0 $att->{cx} = $cx;
1327 0         0 $att->{cy} = $cy;
1328 0         0 $att->{rx} = $w2 - $sub;
1329 0         0 $att->{ry} = $h2 - $sub;
1330             }
1331             else
1332             {
1333 56 100       86 if ($shape eq 'rounded')
1334             {
1335             # round corners by a fixed value
1336 13         25 $att->{ry} = '15';
1337 13         14 $att->{rx} = '15';
1338 13         13 $shape = 'rect';
1339             }
1340 56         82 $att->{x} = $x;
1341 56         60 $att->{y} = $y;
1342 56         106 $att->{width} = _sprintf($self->{w} - $sub * 2);
1343 56         98 $att->{height} = _sprintf($self->{h} - $sub * 2);
1344             }
1345 60         73 $att->{shape} = $shape;
1346              
1347 60   50     127 my $border_style = $self->attribute('border-style') || 'solid';
1348 60   50     2313 my $border_color = $self->color_attribute('border-color') || 'black';
1349              
1350 60 100       2579 $att->{'stroke-width'} = $border_width if $border_width ne '1';
1351 60         82 $att->{stroke} = $border_color;
1352              
1353 60 100       159 if ($border_style !~ /^(none|solid)/)
1354             {
1355             $att->{'stroke-dasharray'} = $strokes->{$border_style}
1356 4 100       15 if exists $strokes->{$border_style};
1357 4         8 $self->_adjust_dasharray($att);
1358             }
1359              
1360 60 100       91 if ($border_style eq 'none')
1361             {
1362 1         1 delete $att->{'stroke-width'};
1363 1         1 delete $att->{stroke};
1364             }
1365              
1366 60   50     115 $att->{fill} = $self->color_attribute('fill') || 'white';
1367             # include the fill for renderers that can't cope with CSS styles
1368             # delete $att->{fill} if $att->{fill} eq 'white'; # white is default
1369              
1370 60         5356 $att->{rotate} = $self->angle();
1371 60         797 $att;
1372             }
1373              
1374             sub _svg_attributes_as_txt
1375             {
1376             # convert hash with attributes to text to be included in SVG tag
1377 213     213   222 my ($self, $att, $x, $y) = @_;
1378              
1379 213         168 my $att_line = ''; # attributes as text (cur line)
1380 213         162 my $att_txt = ''; # attributes as text (all)
1381 213         700 foreach my $e (sort keys %$att)
1382             {
1383             # skip these
1384 699 100       1314 next if $e =~
1385             /^(arrow-?style|arrow-?shape|text-?style|label-?color|
1386             rows|columns|size|offset|origin|rotate|colorscheme)\z/x;
1387              
1388 606         973 $att_line .= " $e=\"$att->{$e}\"";
1389 606 100       817 if (length($att_line) > 75)
1390             {
1391 40         68 $att_txt .= "$att_line\n "; $att_line = '';
  40         47  
1392             }
1393             }
1394              
1395             ###########################################################################
1396             # include the rotation
1397              
1398 213   100     633 my $r = $att->{rotate} || 0;
1399              
1400 213 100       317 $att_line .= " transform=\"rotate($r, $x, $y)\"" if $r != 0;
1401 213 100       283 if (length($att_line) > 75)
1402             {
1403 3         4 $att_txt .= "$att_line\n "; $att_line = '';
  3         4  
1404             }
1405              
1406 213         230 $att_txt .= $att_line;
1407 213         235 $att_txt =~ s/\n \z//; # avoid a " >" on last line
1408 213         306 $att_txt;
1409             }
1410              
1411             sub _correct_size_svg
1412             {
1413             # Correct {w} and {h} for the node after parsing.
1414 112     112   1674 my $self = shift;
1415              
1416 112         147 my $em = $self->EM(); # multiplication factor chars * em = units (pixels)
1417              
1418 112 100       3680 return if defined $self->{w};
1419              
1420 108         204 my $shape = $self->shape();
1421 108 100       1443 if ($shape eq 'point')
1422             {
1423 2         5 $self->{w} = $em * 3;
1424 2         2 $self->{h} = $em * 3;
1425 2         4 return;
1426             }
1427              
1428 106         147 my ($w,$h) = $self->_svg_dimensions();
1429              
1430 106         153 my $lh = $self->LINE_HEIGHT();
1431             # XXX TODO: that should use a changable padding factor (like "0.2 em" or "4")
1432 106         2898 $self->{w} = int($w * $em + $em);
1433 106         119 $self->{h} = int($h * $lh + $em);
1434              
1435 106         90 my $border = 'none';
1436 106 50 50     255 $border = $self->attribute('borderstyle') || '' if $shape ne 'none';
1437              
1438 106 100       2323 if ($border ne 'none')
1439             {
1440 105         178 my $bw = Graph::Easy::_border_width_in_pixels($self,$em);
1441 105         4608 $self->{w} += $bw * 2; # *2 due to left/right and top/bottom
1442 105         107 $self->{h} += $bw * 2;
1443             }
1444              
1445             # for triangle or invtriangle:
1446 106 50       146 $self->{w} *= 1.4 if $shape =~ /triangle/;
1447 106 50       136 $self->{h} *= 1.8 if $shape =~ /triangle|trapezium/;
1448 106 50       138 $self->{w} *= 1.2 if $shape =~ /(parallelogram|trapezium|pentagon)/;
1449              
1450 106 100       245 if ($shape =~ /^(diamond|circle|octagon|hexagon|triangle)\z/)
1451             {
1452             # the min size is either w or h, depending on which is bigger
1453 2 100       4 my $max = $self->{w}; $max = $self->{h} if $self->{h} > $max;
  2         6  
1454 2         3 $self->{h} = $max;
1455 2         4 $self->{w} = $max;
1456             }
1457             }
1458              
1459             1;
1460              
1461             #############################################################################
1462             #############################################################################
1463              
1464             package Graph::Easy::Edge::Cell;
1465             $Graph::Easy::Edge::Cell::VERSION = '0.26';
1466             BEGIN
1467             {
1468 4     4   13 *_sprintf = \&Graph::Easy::As_svg::_sprintf;
1469 4         12869 *_quote = \&Graph::Easy::As_svg::_quote;
1470             }
1471              
1472             #############################################################################
1473             #############################################################################
1474             # Line drawing code for edges
1475              
1476             # define the line lengths for the different edge types
1477              
1478             sub LINE_HOR () { 0x0; }
1479             sub LINE_VER () { 0x1; }
1480             sub LINE_PATH() { 0x2; }
1481              
1482             sub LINE_MASK () { 0x0F; }
1483             sub LINE_DOUBLE () { 0x10; }
1484              
1485             # edge type line type spacing left/top
1486             # spacing right/bottom
1487              
1488             my $draw_lines = {
1489             # for selfloops, we use paths
1490             EDGE_N_W_S() => [ LINE_PATH, 'M', -1, -0.5, 'L', -1, -1.5, 'L', 1, -1.5, 'L', 1, -0.5 ], # v--|
1491             EDGE_S_W_N() => [ LINE_PATH, 'M', -1, 0.5, 'L', -1, 1.5, 'L', 1, 1.5, 'L', 1, 0.5 ], # ^--|
1492             EDGE_E_S_W() => [ LINE_PATH, 'M', 0.5, 1, 'L', 1.5, 1, 'L', 1.5, -1, 'L', 0.5, -1 ], # [_
1493             EDGE_W_S_E() => [ LINE_PATH, 'M', -0.5, 1, 'L', -1.5, 1, 'L', -1.5, -1, 'L', -0.5, -1 ], # _]
1494              
1495             # everything else draws straight lines
1496             EDGE_VER() => [ LINE_VER, 0, 0 ], # | vertical line
1497             EDGE_HOR() => [ LINE_HOR, 0, 0 ], # -- vertical line
1498              
1499             EDGE_CROSS() => [ LINE_HOR, 0, 0, LINE_VER, 0, 0 ], # + crossing
1500              
1501             EDGE_S_E() => [ LINE_VER, 0.5, 0, LINE_HOR, 0.5, 0 ], # |_ corner (N to E)
1502             EDGE_N_W() => [ LINE_VER, 0, 0.5, LINE_HOR, 0, 0.5 ], # _| corner (N to W)
1503             EDGE_N_E() => [ LINE_VER, 0, 0.5, LINE_HOR, 0.5, 0 ], # ,- corner (S to E)
1504             EDGE_S_W() => [ LINE_VER, 0.5, 0, LINE_HOR, 0, 0.5 ], # -, corner (S to W)
1505              
1506             EDGE_S_E_W() => [ LINE_HOR, 0, 0, LINE_VER, 0.5, 0 ], # joint
1507             EDGE_N_E_W() => [ LINE_HOR, 0, 0, LINE_VER, 0, 0.5 ], # joint
1508             EDGE_E_N_S() => [ LINE_HOR, 0.5, 0, LINE_VER, 0, 0 ], # joint
1509             EDGE_W_N_S() => [ LINE_HOR, 0, 0.5, LINE_VER, 0, 0 ], # joint
1510             };
1511              
1512             my $dimensions = {
1513             EDGE_VER() => [ 1, 2 ], # |
1514             EDGE_HOR() => [ 2, 1 ], # -
1515              
1516             EDGE_CROSS() => [ 2, 2 ], # + crossing
1517              
1518             EDGE_N_E() => [ 2, 2 ], # |_ corner (N to E)
1519             EDGE_N_W() => [ 2, 2 ], # _| corner (N to W)
1520             EDGE_S_E() => [ 2, 2 ], # ,- corner (S to E)
1521             EDGE_S_W() => [ 2, 2 ], # -, corner (S to W)
1522              
1523             EDGE_S_E_W => [ 2, 2 ], # -,- three-sided corner (S to W/E)
1524             EDGE_N_E_W => [ 2, 2 ], # -'- three-sided corner (N to W/E)
1525             EDGE_E_N_S => [ 2, 2 ], # |- three-sided corner (E to S/N)
1526             EDGE_W_N_S => [ 2, 2 ], # -| three-sided corner (W to S/N)
1527              
1528             EDGE_N_W_S() => [ 4, 2 ], # loops
1529             EDGE_S_W_N() => [ 4, 2 ],
1530             EDGE_E_S_W() => [ 2, 4 ],
1531             EDGE_W_S_E() => [ 2, 4 ],
1532             };
1533              
1534             my $arrow_pos = {
1535             EDGE_N_W_S() => [ 1, -0.5 ],
1536             EDGE_S_W_N() => [ 1, 0.5 ],
1537             EDGE_E_S_W() => [ 0.5, -1 ],
1538             EDGE_W_S_E() => [ -0.5, -1 ],
1539             };
1540              
1541             my $arrow_correct = {
1542             EDGE_END_S() => [ 'h', 1.5 ],
1543             EDGE_END_N() => [ 'h', 1.5 ],
1544             EDGE_START_S() => [ 'h', 1 ],
1545             EDGE_START_N() => [ 'h', 1 ],
1546             EDGE_END_W() => [ 'w', 1.5 ],
1547             EDGE_END_E() => [ 'w', 1.5 ],
1548             EDGE_START_W() => [ 'w', 1, ],
1549             EDGE_START_E() => [ 'w', 1, ],
1550             # EDGE_END_S() => [ 'h', 3.5, 'w', 2 ],
1551             # EDGE_END_N() => [ 'h', 3.5, 'w', 2 ],
1552             # EDGE_START_S() => [ 'h', 3 ],
1553             # EDGE_START_N() => [ 'h', 3 ],
1554             # EDGE_END_W() => [ 'w', 1.5, 'h', 2 ],
1555             # EDGE_END_E() => [ 'w', 1.5, 'h', 2 ],
1556             # EDGE_START_W() => [ 'w', 1, ],
1557             # EDGE_START_E() => [ 'w', 1, ],
1558             };
1559              
1560             sub _arrow_pos
1561             {
1562             # compute the position of the arrow
1563 33     33   45 my ($self, $x, $w, $y, $h, $ddx, $ddy, $dx, $dy) = @_;
1564              
1565 33         49 my $em = $self->EM();
1566 33         1277 my $cell_type = $self->{type} & EDGE_TYPE_MASK;
1567 33 50       69 if (exists $arrow_pos->{$cell_type})
1568             {
1569 0         0 $dx = $arrow_pos->{$cell_type}->[0] * $em;
1570 0         0 $dy = $arrow_pos->{$cell_type}->[1] * $em;
1571              
1572 0 0       0 $dx = $w + $dx if $dx < 0;
1573 0 0       0 $dy = $h + $dy if $dy < 0;
1574              
1575 0         0 $dx += $x;
1576 0         0 $dy += $y;
1577             }
1578              
1579 33         82 _sprintf($dx,$dy);
1580             }
1581              
1582             sub _svg_arrow
1583             {
1584 33     33   1208 my ($self, $att, $x, $y, $type, $indent, $s) = @_;
1585              
1586 33         33 my $w = $self->{w};
1587 33         35 my $h = $self->{h};
1588 33   100     55 $s ||= 0;
1589              
1590 33   50     79 my $arrow_style = $self->attribute('arrow-style') || '';
1591 33 50       1406 return '' if $arrow_style eq 'none';
1592              
1593 33         61 my $class = 'ah' . substr($arrow_style,0,1);
1594             # aho => ah
1595 33 100       54 $class = 'ah' if $class eq 'aho';
1596             # ah => ahb for bold/broad/wide edges with open arrows
1597 33 50 33     63 $class .= 'b' if $s > 1 && $class eq 'ah';
1598              
1599             # For the things to be "used" define these attributes, so if they
1600             # match, we can skip them, generating shorter output:
1601 33         707 my $DEF = {
1602             "stroke-linecap" => 'round',
1603             };
1604              
1605 33         37 my $a = {};
1606 33         62 for my $key (keys %$att)
1607             {
1608 75 100       188 next if $key =~ /^(stroke-dasharray|arrow-style|stroke-width)\z/;
1609             $a->{$key} = $att->{$key}
1610 30 50 33     92 unless exists $DEF->{$key} && $DEF->{$key} eq $att->{$key};
1611             }
1612 33 50       101 if ($arrow_style eq 'closed')
    100          
    50          
1613             {
1614 0   0     0 $a->{fill} = $self->color_attribute('background') || 'inherit';
1615 0 0 0     0 $a->{fill} = $self->{graph}->color_attribute('graph', 'background') || 'inherit' if $a->{fill} eq 'inherit';
1616 0 0       0 $a->{fill} = 'white' if $a->{fill} eq 'inherit';
1617             }
1618             elsif ($arrow_style eq 'filled')
1619             {
1620             # if fill is not defind, use the color
1621 1         4 my $fill = $self->raw_attribute('fill');
1622 1 50       15 if (defined $fill)
1623             {
1624 0         0 $a->{fill} = $self->color_attribute('fill');
1625             }
1626             else
1627             {
1628 1         3 $a->{fill} = $self->color_attribute('color');
1629             }
1630             }
1631             elsif ($class eq 'ahb')
1632             {
1633 0 0       0 $a->{fill} = $self->color_attribute('color'); delete $a->{fill} unless $a->{fill};
  0         0  
1634             }
1635              
1636 33         130 my $att_txt = $self->_svg_attributes_as_txt($a);
1637              
1638 33 100       751 $self->{graph}->_svg_use_def($class) if ref $self->{graph};
1639              
1640 33         55 my $ar = "$indent
1641              
1642 33         24 my $svg = '';
1643              
1644 33         52 my $ss = int($s / 4 + 1); #ss = 1 if $ss < 1;
1645 33 50       23 my $scale = ''; $scale = "scale($ss)" if $ss > 1;
  33         51  
1646              
1647             # displacement of the arrow, to account for wider lines
1648 33         21 my $dis = 0.1;
1649              
1650 33         26 my ($x1,$x2, $y1,$y2);
1651              
1652 33 100       49 if ($type & EDGE_END_N)
1653             {
1654 1 50       1 my $d = $dis; $d += $ss/150 if $ss > 1; $d *= $h if $d < 1;
  1 50       3  
  1         3  
1655 1         3 ($x1, $y1) = $self->_arrow_pos($x,$w,$y,$h, 0, $d, $x + $w / 2, $y + $d);
1656 1         3 $svg .= $ar . "transform=\"translate($x1 $y1)rotate(-90)$scale\"/>\n";
1657             }
1658 33 100       56 if ($type & EDGE_END_S)
1659             {
1660 3 50       4 my $d = $dis; $d += $ss/150 if $ss > 1; $d *= $h if $d < 1;
  3 50       7  
  3         8  
1661              
1662 3         11 ($x1, $y1) = $self->_arrow_pos($x,$w,$y,$h, 0, $d, $x + $w / 2, $y + $h - $d);
1663 3         11 $svg .= $ar . "transform=\"translate($x1 $y1)rotate(90)$scale\"/>\n";
1664             }
1665 33 50       47 if ($type & EDGE_END_W)
1666             {
1667 0 0       0 my $d = $dis; $d += $ss/50 if $ss > 1; $d *= $w if $d < 1;
  0 0       0  
  0         0  
1668              
1669 0         0 ($x1, $y1) = $self->_arrow_pos($x,$w,$y,$h, $d, 0, $x + $d, $y + $h / 2);
1670 0         0 $svg .= $ar . "transform=\"translate($x1 $y1)rotate(180)$scale\"/>\n";
1671             }
1672 33 100       51 if ($type & EDGE_END_E)
1673             {
1674 29 50       20 my $d = $dis; $d += $ss/50 if $ss > 1; $d *= $w if $d < 1;
  29 50       40  
  29         48  
1675              
1676 29         90 ($x1, $y1) = $self->_arrow_pos($x,$w,$y,$h, $d, 0, $x + $w - $d, $y + $h / 2);
1677 29         60 my $a = $ar . "x=\"$x1\" y=\"$y1\"/>\n";
1678 29 50       41 $a = $ar . "transform=\"translate($x1 $y1)$scale\"/>\n" if $scale;
1679 29         46 $svg .= $a;
1680             }
1681              
1682 33         123 $svg;
1683             }
1684              
1685             sub _svg_line_straight
1686             {
1687             # Generate SVG tags for a vertical/horizontal line, bounded by (x,y), (x+w,y+h).
1688             # $l and $r shorten the line left/right, or top/bottom, respectively. If $l/$r < 1,
1689             # in % (aka $l * w), otherwise in units.
1690             # "$s" means there is a starting point, so the line needs to be shorter. Likewise
1691             # for "$e", only on the "other" side.
1692             # VER: s = north, e = south, HOR: s = left, e= right
1693 41     41   2263 my ($self, $x, $y, $type, $l, $r, $s, $e, $add, $lw) = @_;
1694              
1695 41         39 my $w = $self->{w};
1696 41         30 my $h = $self->{h};
1697              
1698 41 50       70 $add = '' unless defined $add; # additinal styles?
1699              
1700 41         31 my ($x1,$x2, $y1,$y2, $x3, $x4, $y3, $y4);
1701              
1702 41   100     67 $lw ||= 1; # line-width
1703              
1704 41         35 my $ltype = $type & LINE_MASK;
1705 41 100       50 if ($ltype == LINE_HOR)
1706             {
1707 34 100       58 $l += $s if $s;
1708 34 100       52 $r += $e if $e;
1709             # +/-$lw to close the gaps at corners
1710 34 50       53 $l *= $w - $lw if $l == 0.5;
1711 34 100       47 $r *= $w - $lw if $r == 0.5;
1712 34 100       49 $l *= $w if $l < 1;
1713 34 100       54 $r *= $w if $r < 1;
1714              
1715 34         27 $x1 = $x + $l; $x2 = $x + $w - $r;
  34         34  
1716 34         40 $y1 = $y + $h / 2; $y2 = $y1;
  34         20  
1717 34 100       57 if (($type & LINE_DOUBLE) != 0)
1718             {
1719 15         13 $y1--; $y2--; $y3 = $y1 + 2; $y4 = $y3;
  15         13  
  15         12  
  15         14  
1720             # shorten the line for end/start points
1721 15 50       22 $x1 += 1.5 if $s; $x2 -= 1.5 if $e;
  15 50       22  
1722 15         12 $x3 = $x1; $x4 = $x2;
  15         10  
1723             }
1724             }
1725             else
1726             {
1727 7 100       11 $l += $s if $s;
1728 7 100       12 $r += $e if $e;
1729             # +/-$lw to close the gaps at corners
1730 7 100       13 $l *= $h - $lw if $l == 0.5;
1731 7 50       11 $r *= $h - $lw if $r == 0.5;
1732 7 100       12 $l *= $h if $l < 1;
1733 7 100       10 $r *= $h if $r < 1;
1734              
1735 7         12 $x1 = $x + $w / 2; $x2 = $x1;
  7         6  
1736 7         7 $y1 = $y + $l; $y2 = $y + $h - $r;
  7         6  
1737 7 50       12 if (($type & LINE_DOUBLE) != 0)
1738             {
1739 0         0 $x1--; $x2--; $x3 = $x1 + 2; $x4 = $x3;
  0         0  
  0         0  
  0         0  
1740             # shorten the line for end/start points
1741 0 0       0 $y1 += 1.5 if $s; $y2 -= 1.5 if $e;
  0 0       0  
1742 0         0 $y3 = $y1; $y4 = $y2;
  0         0  
1743             }
1744             }
1745              
1746 41         68 ($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4) = _sprintf($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4);
1747              
1748 41         119 my @r = ( "" );
1749              
1750             # for a double line
1751 41 100       79 push @r, ""
1752             if defined $x3;
1753              
1754 41         130 @r;
1755             }
1756              
1757             sub _svg_path
1758             {
1759             # Generate SVG tags for a path, bounded by (x,y), (x+w,y+h).
1760             # "$s" means there is a starting point, so the line needs to be shorter. Likewise
1761             # for "$e", only on the "other" end side.
1762             # The passed coords are relative to x,y, and in EMs.
1763 0     0   0 my ($self, $x, $y, $s, $e, $add, $lw, @coords) = @_;
1764              
1765 0         0 my $em = $self->EM();
1766              
1767 0         0 my $w = $self->{w};
1768 0         0 my $h = $self->{h};
1769              
1770 0 0       0 $add = '' unless defined $add; # additinal styles?
1771 0   0     0 $lw ||= 1; # line-width
1772 0         0 my $d = '';
1773              
1774 0         0 while (@coords)
1775             {
1776 0         0 my ($t, $xa, $ya) = splice (@coords,0,3); # 'M', '1', '-1'
1777              
1778 0 0       0 $xa *= $em; $xa += $w if $xa < 0;
  0         0  
1779 0 0       0 $ya *= $em; $ya += $h if $ya < 0;
  0         0  
1780              
1781 0         0 ($xa,$ya) = _sprintf($xa+$x,$ya+$y);
1782              
1783 0         0 $d .= "$t$xa $ya";
1784             }
1785 0         0 "";
1786             }
1787              
1788             #############################################################################
1789             #############################################################################
1790              
1791             sub _correct_size_svg
1792             {
1793             # correct the size for the edge cell
1794 37     37   585 my ($self,$format) = @_;
1795              
1796 37 100       66 return if defined $self->{w};
1797              
1798 35         52 my $em = $self->EM(); # multiplication factor chars * em = units (pixels)
1799              
1800             #my $border = $self->{edge}->attribute('borderstyle');
1801              
1802             # set the minimum width/height
1803 35         1402 my $type = $self->{type} & EDGE_TYPE_MASK();
1804 35   50     77 my $dim = $dimensions->{$type} || [ 3, 3 ];
1805 35         64 ($self->{w}, $self->{h}) = ($dim->[0], $dim->[1]);
1806              
1807             # print STDERR "# min size at ($self->{x},$self->{y}): $self->{w} $self->{h} for $self->{type}\n";
1808              
1809             # make it bigger for cells with the label
1810 35 100       57 if ($self->{type} & EDGE_LABEL_CELL)
1811             {
1812 28         47 my ($w,$h) = $self->_svg_dimensions();
1813              
1814             # for vertical edges, multiply $w * 2
1815 28 100       58 $w = $w * 2 + 2 if ($type == EDGE_VER);
1816             # add a bit for HOR edges
1817 28 100       48 $w = $w + 1 if ($type == EDGE_HOR);
1818 28         32 $self->{w} += $w;
1819 28         48 my $lh = $self->LINE_HEIGHT();
1820 28         1052 $self->{h} += $h * ($lh - $em) + 0.5;
1821             # add a bit for HOR edges
1822 28 100       56 $self->{h} += 2 if ($type == EDGE_HOR);
1823             }
1824              
1825 35         35 my $style = $self->{style};
1826              
1827             # correct for bigger arrows
1828 35         77 my $ac = $self->arrow_count();
1829             # if ($style =~ /^(broad|wide)/)
1830             {
1831             # for each end point, correct the size
1832 35         278 my $flags = ($self->{type} & EDGE_ARROW_MASK);
  35         35  
1833              
1834             # select the first bit (hopefully EDGE_ARROW_MASK == 0xFF
1835 35         30 my $start_bit = 0x800;
1836              
1837 35         60 while ($start_bit > 0x8)
1838             {
1839 280         177 my $a = $flags & $start_bit; $start_bit >>= 1;
  280         168  
1840 280 100       428 if ($a != 0)
1841             {
1842 56         61 my $ac = $arrow_correct->{$a};
1843 56         37 my $idx = 0;
1844 56         75 while ($idx < @$ac)
1845             {
1846 56         82 my ($where, $add) = ($ac->[$idx], $ac->[$idx+1]); $idx +=2;
  56         46  
1847 56 50       88 $add += 0.5 if $style =~ /^wide/;
1848 56         127 $self->{$where} += $add;
1849             }
1850             }
1851             }
1852             }
1853              
1854 35         103 ($self->{w}, $self->{h}) = ($self->{w} * $em, $self->{h} * $em);
1855             }
1856              
1857             #############################################################################
1858             #############################################################################
1859              
1860             sub _svg_attributes
1861             {
1862             # Return a hash with attributes for the cell.
1863 37     37   40 my ($self, $em) = @_;
1864              
1865 37         46 my $att = {};
1866              
1867 37   50     84 $att->{stroke} = $self->color_attribute('color') || 'black';
1868             # include the stroke for renderers that can't cope with CSS styles
1869             # delete $att->{stroke} if $att->{stroke} eq 'black'; # black is default
1870              
1871 37         2954 $att->{'stroke-width'} = 1;
1872              
1873 37         39 my $style = $self->{style};
1874 37 100       61 if ($style ne 'solid') # solid line
1875             {
1876             $att->{'stroke-dasharray'} = $strokes->{$style}
1877 15 50       46 if exists $strokes->{$style};
1878             }
1879              
1880 37 50       62 $att->{'stroke-width'} = 3 if $style =~ /^bold/;
1881 37 50       55 $att->{'stroke-width'} = $em / 2 if $style =~ /^broad/;
1882 37 50       60 $att->{'stroke-width'} = $em if $style =~ /^wide/;
1883              
1884 37         64 $self->_adjust_dasharray($att);
1885              
1886 37   50     75 $att->{'arrow-style'} = $self->attribute('arrow-style') || '';
1887 37         1417 $att;
1888             }
1889              
1890             sub _draw_edge_line_and_arrows
1891       0     {
1892             }
1893              
1894             sub as_svg
1895             {
1896 37     37 1 43 my ($self,$x,$y, $indent) = @_;
1897              
1898 37         76 my $em = $self->EM(); # multiplication factor chars * em = units (pixels)
1899 37         1540 my $lh = $self->LINE_HEIGHT();
1900              
1901             # the attributes of the element we will finally output
1902 37         1314 my $att = $self->_svg_attributes($em);
1903              
1904             # set a potential title
1905 37         97 my $title = _quote($self->title());
1906 37 50       71 $att->{title} = $title if $title ne '';
1907              
1908 37         69 my $att_txt = $self->_svg_attributes_as_txt($att);
1909              
1910 37         49 my $type = $self->{type} & EDGE_TYPE_MASK();
1911 37         42 my $end = $self->{type} & EDGE_END_MASK();
1912 37         42 my $start = $self->{type} & EDGE_START_MASK();
1913              
1914 37         102 my $svg = "$indent\n";
1915              
1916 37         947 $svg .= $self->_svg_background($x,$y, $indent);
1917              
1918 37         40 my $style = $self->{style};
1919              
1920             # dont render invisible edges
1921 37 50       68 return $svg if $style eq 'invisible';
1922              
1923 37   50     106 my $sw = $att->{'stroke-width'} || 1;
1924              
1925             # for each line, include one SVG tag
1926 37         30 my $lines = [ @{$draw_lines->{$type}} ]; # make copy
  37         82  
1927              
1928 37         57 my $cross = ($self->{type} & EDGE_TYPE_MASK) == EDGE_CROSS; # we are a cross section?
1929 37         27 my $add;
1930              
1931             my @line_tags;
1932 37         63 while (@$lines > 0)
1933             {
1934 38         45 my ($type) = shift @$lines;
1935              
1936 38         31 my @coords;
1937 38 50       55 if ($type != LINE_PATH)
1938             {
1939 38         73 @coords = splice (@$lines, 0, 2);
1940             }
1941             else
1942             {
1943             # eat all
1944 0         0 @coords = @$lines; @$lines = ();
  0         0  
1945             }
1946              
1947             # start/end points
1948 38         42 my ($s,$e) = (undef,undef);
1949              
1950             # LINE_VER must come last
1951 38 50 33     72 if ($cross && $type == LINE_VER)
1952             {
1953 0         0 $style = $self->{style_ver};
1954 0         0 my $sn = 1;
1955 0 0       0 $sn = 3 if $style =~ /^bold/;
1956 0 0       0 $sn = $em / 2 if $style =~ /^broad/;
1957 0 0       0 $sn = $em if $style =~ /^wide/;
1958              
1959             # XXX adjust dash array
1960 0 0       0 $add = ' stroke="' . $self->{color_ver} . '"' if $self->{color_ver};
1961 0   0     0 $add .= ' stroke-dasharray="' . ($strokes->{$style}||'1 0') .'"';
1962 0 0       0 $add .= ' stroke-width="' . $sn . '"' if $sn ne $sw;
1963 0         0 $add =~ s/^\s//;
1964             }
1965              
1966 38         46 my $bw = $self->{w} * 0.1;
1967 38         50 my $bwe = $self->{w} * 0.1 + $sw;
1968 38         32 my $bh = $em * 0.5; # self->{h}
1969 38         46 my $bhe = $self->{h} * 0.1 + $sw * 1;
1970              
1971             # VER: s = north, e = south, HOR: s = left, e= right
1972 38 100       55 if ($type == LINE_VER)
1973             {
1974 5 100       11 $e = $bhe if ($end & EDGE_END_S);
1975 5 50       7 $s = $bhe if ($end & EDGE_END_N);
1976 5 50       7 $e = $bh if ($start & EDGE_START_S);
1977 5 100       8 $s = $bh if ($start & EDGE_START_N);
1978             }
1979             else # $type == LINE_HOR
1980             {
1981 33 100       60 $e = $bwe if ($end & EDGE_END_E);
1982 33 50       46 $s = $bwe if ($end & EDGE_END_W);
1983 33 50       50 $e = $bw if ($start & EDGE_START_E);
1984 33 100       47 $s = $bw if ($start & EDGE_START_W);
1985             }
1986              
1987 38 50       47 if ($type != LINE_PATH)
1988             {
1989 38 100       80 $type += LINE_DOUBLE if $style =~ /^double/;
1990 38         94 push @line_tags, $self->_svg_line_straight($x, $y, $type, $coords[0], $coords[1], $s, $e, $add, $sw);
1991             }
1992             else
1993             {
1994 0         0 push @line_tags, $self->_svg_path($x, $y, $s, $e, $add, $sw, @coords);
1995             }
1996             } # end lines
1997              
1998             # XXX TODO: put these on the edge group, not on each cell
1999              
2000             # we can put the line tags into a and put stroke attributes on the g,
2001             # this will shorten the output
2002              
2003 37         33 $lines = ''; my $p = "\n"; my $i = $indent;
  37         42  
  37         30  
2004 37 100       53 if (@line_tags > 1)
2005             {
2006 16         31 $lines = "$indent\n";
2007 16         14 $i .= $indent;
2008 16         21 $p = "\n$indent\n";
2009             }
2010             else
2011             {
2012 21         89 $line_tags[0] =~ s/ \/>/$att_txt \/>/;
2013             }
2014 37         91 $lines .= $i . join("\n$i", @line_tags) . $p;
2015              
2016 37         41 $svg .= $lines;
2017              
2018 37         25 my $arrow = $end;
2019              
2020             # depending on end points, add the arrows
2021 37   50     119 my $scale = $att->{'stroke-width'}||1;
2022             $svg .= $self->_svg_arrow($att, $x, $y, $arrow, $indent, $scale)
2023 37 100 66     157 unless $arrow == 0 || $self->{edge}->undirected();
2024              
2025             ###########################################################################
2026             # include the label/name/text if we are the label cell
2027              
2028 37 100       68 if (($self->{type} & EDGE_LABEL_CELL()))
2029             {
2030 30 50       67 my $label = $self->label(); $label = '' unless defined $label;
  30         1561  
2031              
2032 30 100       57 if ($label ne '')
2033             {
2034 15         47 my ($w,$h) = $self->dimensions();
2035 15         2515 my $em2 = $em / 2;
2036 15         30 my $xt = int($x + $self->{w} / 2);
2037 15         41 my $yt = int($y + $self->{h} / 2 - $lh / 3 - ($h - 1) * $lh);
2038             # my $yt = int($y + ($self->{h} / 2) - $em2);
2039              
2040 15         16 my $style = '';
2041              
2042 15         15 my $stype = $self->{type};
2043              
2044             # for HOR edges
2045 15 100       26 if ($type == EDGE_HOR)
    50          
2046             {
2047             # put the edge text left-aligned on the line
2048 14         14 $xt = $x + 2 * $em;
2049              
2050             # if we have only one big arrow, shift the text left/right
2051 14         38 my $ac = $self->arrow_count();
2052 14         117 my $style = $self->{style};
2053              
2054 14 50       30 if ($ac == 1)
2055             {
2056 14         9 my $shift = 0.2;
2057 14 50       28 $shift = 0.5 if $style =~ /^broad/;
2058 14 50       26 $shift = 0.8 if $style =~ /^wide/;
2059             # <-- edges, shift right, otherwise left
2060 14 50       28 $shift = -$shift if ($end & EDGE_END_E) != 0;
2061             #print STDERR "# shift=$shift \n";
2062 14         22 $xt = int($xt + 2 * $em * $shift);
2063             }
2064             }
2065             elsif ($type == EDGE_VER)
2066             {
2067             # put label on the right side of the edge
2068 1         1 $xt = $xt + $em2;
2069 1         3 my ($w,$h) = $self->dimensions();
2070 1         99 $yt = int($y + $self->{h} / 2 - $h * $em2 + $em2);
2071 1         2 $style = ' text-anchor="start"';
2072             }
2073             # selfloops
2074             else
2075             {
2076             # put label right of the edge
2077             # my ($w,$h) = $self->dimensions();
2078              
2079             # hor loops:
2080 0 0       0 $yt += $em2 if $stype & EDGE_START_N;
2081 0 0       0 $yt -= $em2 if $stype & EDGE_START_S;
2082 0 0 0     0 $yt += $em
2083             if ($h > 1) && ($stype & EDGE_START_S);
2084              
2085             # vertical loops
2086 0 0 0     0 $yt = int($y + $self->{h} / 2)
2087             if ($stype & EDGE_START_E) || ($stype & EDGE_START_W);
2088              
2089 0 0       0 $xt = int($x + $em * 2) if ($stype & EDGE_START_E);
2090 0 0       0 $xt = int($x + $self->{w} - 2*$em) if ($stype & EDGE_START_W);
2091              
2092 0         0 $style = ' text-anchor="start"';
2093 0 0 0     0 $style = ' text-anchor="middle"'
2094             if ($stype & EDGE_START_N) || ($stype & EDGE_START_S);
2095 0 0       0 $style = ' text-anchor="end"' if ($stype & EDGE_START_W);
2096             }
2097              
2098 15         41 my $color = $self->raw_attribute('labelcolor');
2099              
2100             # fall back to color if label-color not defined
2101 15 100       292 $color = $self->color_attribute('color') if !defined $color;
2102              
2103 15         1008 my $text = $self->_svg_text($color, $indent, $xt, $yt, $style, $xt, $x + $self->{w} - $em);
2104              
2105 15         44 my $link = _quote($self->link());
2106 15 100       47 $text = Graph::Easy::Node::_link($self, $indent.$text, $indent, $title, $link) if $link ne '';
2107              
2108 15         53 $svg .= $text;
2109              
2110             }
2111             }
2112              
2113 37 100       103 $svg .= "\n" unless $svg =~ /\n\n\z/;
2114              
2115 37         168 $svg;
2116             }
2117              
2118             __END__