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