File Coverage

lib/Graph/Easy/As_ascii.pm
Criterion Covered Total %
statement 427 436 97.9
branch 248 288 86.1
condition 55 77 71.4
subroutine 28 28 100.0
pod 1 1 100.0
total 759 830 91.4


line stmt bran cond sub pod time code
1             #############################################################################
2             # Render Nodes/Edges/Cells as ASCII/Unicode box drawing art
3             #
4             # (c) by Tels 2004-2007. Part of Graph::Easy
5             #############################################################################
6              
7             package Graph::Easy::As_ascii;
8              
9             $VERSION = '0.75';
10              
11 23     23   90105 use utf8;
  23         55  
  23         209  
12              
13             #############################################################################
14             #############################################################################
15              
16             package Graph::Easy::Edge::Cell;
17              
18 23     23   950 use strict;
  23         69  
  23         1048  
19 23     23   322 use warnings;
  23         161  
  23         126802  
20              
21             my $edge_styles = [
22             {
23             # style hor, ver, cross, corner (SE, SW, NE, NW)
24             'solid' => [ '--', "|", '+', '+','+','+','+' ], # simple line
25             'double' => [ '==', "H", "#", '#','#','#','#' ], # double line
26             'double-dash' => [ '= ', '"', "#", '#','#','#','#' ], # double dashed line
27             'dotted' => [ '..', ":", ':', '.','.','.','.' ], # dotted
28             'dashed' => [ '- ', "'", '+', '+','+','+','+' ], # dashed
29             'dot-dash' => [ '.-', "!", '+', '+','+','+','+' ], # dot-dash
30             'dot-dot-dash' => [ '..-', "!", '+', '+','+','+','+' ], # dot-dot-dash
31             'wave' => [ '~~', "}", '+', '*','*','*','*' ], # wave
32             'bold' => [ '##', "#", '#', '#','#','#','#' ], # bold
33             'bold-dash' => [ '# ', "#", '#', '#','#','#','#' ], # bold-dash
34             'wide' => [ '##', "#", '#', '#','#','#','#' ], # wide
35             'broad' => [ '##', "#", '#', '#','#','#','#' ], # broad
36             },
37             {
38             # style hor, ver, cross, corner (SE, SW, NE, NW)
39             'solid' => [ '─', '│', '┼', '┌', '┐', '└', '┘' ],
40             'double' => [ '═', '║', '╬', '╔', '╗', '╚', '╝' ],
41             'double-dash' => [ '═'.' ', '∥', '╬', '╔', '╗', '╚', '╝' ], # double dashed
42             'dotted' => [ '·', ':', '┼', '┌', '┐', '└', '┘' ], # dotted
43             'dashed' => [ '╴', '╵', '┘', '┌', '┐', '╵', '┘' ], # dashed
44             'dot-dash' => [ '·'.'-', "!", '┼', '┌', '┐', '└', '┘' ], # dot-dash
45             'dot-dot-dash' => [ ('·' x 2).'-', "!", '┼', '┌', '┐', '└', '┘' ], # dot-dot-dash
46             'wave' => [ '∼', '≀', '┼', '┌', '┐', '└', '┘' ], # wave
47             'bold' => [ '━', '┃', '╋', '┏', '┓', '┗', '┛' ], # bold
48             'bold-dash' => [ '━'.' ', '╻', '╋', '┏', '┓', '┗', '┛' ], # bold-dash
49             'broad' => [ '▬', '▮', '█', '█', '█', '█', '█' ], # wide
50             'wide' => [ '█', '█', '█', '█', '█', '█', '█' ], # broad
51              
52             # these two make it nec. to support multi-line styles for the vertical edge pieces
53             # 'broad-dash' => [ '◼', '◼', '◼', '◼', '◼', '◼', '◼' ], # broad-dash
54             # 'wide-dash' => [ ('█'x 2) .' ', '█', '█', '█', '█', '█', '█' ], # wide-dash
55             },
56             ];
57              
58             sub _edge_style
59             {
60 1519     1519   2163 my ($self, $st) = @_;
61              
62 1519   100     6853 my $g = $self->{graph}->{_ascii_style} || 0;
63 1519 100       6066 $st = $self->{style} unless defined $st;
64              
65 1519         5182 $edge_styles->[$g]->{ $st };
66             }
67              
68             # | | | | : } |
69             # ===+=== ###+### ....!.... ~~~+~~~ ----+--- ...+... .-.+.-.-
70             # | | | | : { |
71              
72             my $cross_styles = [
73             # normal cross
74             [
75             {
76             'boldsolid' => '┿',
77             'solidbold' => '╂',
78             'doublesolid' => '╪',
79             'soliddouble' => '╫',
80             'dashedsolid' => '┤',
81             'soliddashed' => '┴',
82             'doubledashed' => '╧',
83             'dasheddouble' => '╢',
84             },
85             {
86             'boldsolid' => '+',
87             'dashedsolid' => '+',
88             'dottedsolid' => '!',
89             'dottedwave' => '+',
90             'doublesolid' => '+',
91             'dot-dashsolid' => '+',
92             'dot-dot-dashsolid' => '+',
93             'soliddotted' => '+',
94             'solidwave' => '+',
95             'soliddashed' => '+',
96             'soliddouble' => 'H',
97             'wavesolid' => '+',
98             },
99             ],
100             undef, # HOR, cannot happen
101             undef, # VER, cannot happen
102             undef,
103             undef,
104             undef,
105             undef,
106             # S_E_W -+-
107             # |
108             [
109             {
110             'solidsolid' => '┬',
111             'boldbold' => '┳',
112             'doubledouble' => '╦',
113             'dasheddashed' => '╴',
114             'dotteddotted' => '·',
115             },
116             ],
117             # N_E_W |
118             # -+-
119             [
120             {
121             'solidsolid' => '┴',
122             'boldbold' => '┻',
123             'doubledouble' => '╩',
124             'dotteddotted' => '·',
125             },
126             ],
127             # E_N_S |
128             # +-
129             # |
130             [
131             {
132             'solidsolid' => '├',
133             'boldbold' => '┣',
134             'doubledouble' => '╠',
135             'dotteddotted' => ':',
136             },
137             ],
138             # W_N_S |
139             # -+
140             # |
141             [
142             {
143             'solidsolid' => '┤',
144             'boldbold' => '┫',
145             'doubledouble' => '╣',
146             'dotteddotted' => ':',
147             },
148             ] ];
149              
150             sub _arrow_style
151             {
152 1517     1517   2059 my $self = shift;
153              
154 1517         2422 my $edge = $self->{edge};
155              
156 1517         4661 my $as = $edge->attribute('arrowstyle');
157 1517 100       4767 $as = 'none' if $edge->{undirected};
158 1517         5297 $as;
159             }
160              
161             sub _arrow_shape
162             {
163 1427     1427   1968 my $self = shift;
164              
165 1427         2156 my $edge = $self->{edge};
166              
167 1427         4974 my $as = $edge->attribute('arrowshape');
168 1427         3083 $as;
169             }
170              
171             sub _cross_style
172             {
173 51     51   80 my ($self, $st, $corner_type) = @_;
174              
175 51   50     262 my $g = $self->{graph}->{_ascii_style} || 0;
176              
177             # 0 => 1, 1 => 0
178 51         62 $g = 1 - $g;
179              
180             # for ASCII, one style fist all (e.g a joint has still "+" as corner)
181 51 50       115 $corner_type = 0 unless defined $corner_type;
182 51 50       156 $corner_type = 0 if $g == 1;
183              
184 51         324 $cross_styles->[$corner_type]->[$g]->{ $st };
185             }
186              
187             sub _insert_label
188             {
189 830     830   1928 my ($self, $fb, $xs, $ys, $ws, $hs, $align_ver) = @_;
190              
191 830         2983 my $align = $self->{edge}->attribute('align');
192            
193 830         3535 my ($lines,$aligns) = $self->_aligned_label($align);
194              
195 830 50       2319 $ys = $self->{h} - scalar @$lines + $ys if $ys < 0;
196              
197 830   50     2047 $ws ||= 0; $hs ||= 0;
  830   50     1771  
198 830         1881 my $w = $self->{w} - $ws - $xs;
199 830         1465 my $h = $self->{h} - $hs - $ys;
200              
201 830         3029 $self->_printfb_aligned ($fb, $xs, $ys, $w, $h, $lines, $aligns, $align_ver);
202             }
203              
204             sub _draw_hor
205             {
206             # draw a HOR edge piece
207 601     601   1004 my ($self, $fb) = @_;
208              
209 601         1801 my $style = $self->_edge_style();
210            
211 601         1853 my $w = $self->{w};
212             # '-' => '-----', '.-' => '.-.-.-'
213             # "(2 + ... )" to get space for the offset
214 601         1019 my $len = length($style->[0]);
215 601         1754 my $line = $style->[0] x (2 + $w / $len);
216              
217             # '.-.-.-' => '-.-.-' if $x % $ofs == 1 (e.g. on odd positions)
218 601         1156 my $ofs = $self->{rx} % $len;
219 601         1222 my $type = ($self->{type} & (~EDGE_MISC_MASK));
220 601 100 100     3018 substr($line,0,$ofs) = '' if $ofs != 0
      66        
221             && ($type != EDGE_SHORT_E && $type != EDGE_SHORT_W);
222              
223 601 50       2065 $line = substr($line, 0, $w) if length($line) > $w;
224              
225             # handle start/end point
226              
227 601         1053 my $flags = $self->{type} & EDGE_FLAG_MASK;
228              
229 601         1509 my $as = $self->_arrow_style();
230 601 100       1332 my $ashape; $ashape = $self->_arrow_shape() if $as ne 'none';
  601         2540  
231              
232 601         1131 my $x = 0; # offset for the edge line
233 601         915 my $xs = 1; # offset for the edge label
234 601         839 my $xr = 0; # right offset for label
235 601 100       1527 if (($flags & EDGE_START_W) != 0)
236             {
237 307         539 $x++; chop($line); # ' ---'
  307         662  
238 307         496 $xs++;
239             }
240 601 100       1575 if (($flags & EDGE_START_E) != 0)
241             {
242 97         191 chop($line); # '--- '
243             }
244              
245 601 100       1478 if (($flags & EDGE_END_E) != 0)
246             {
247             # '--> '
248 322         518 chop($line);
249 322 100       1669 substr($line,-1,1) = $self->_arrow($as, ARROW_RIGHT, $ashape) if $as ne 'none';
250 322         679 $xr++;
251             }
252 601 100       1645 if (($flags & EDGE_END_W) != 0)
253             {
254             # ' <--'
255 101 100       391 substr($line,0,1) = ' ' if $as eq 'none';
256 101 100       540 substr($line,0,2) = ' ' . $self->_arrow($as, ARROW_LEFT, $ashape) if $as ne 'none';
257 101         181 $xs++;
258             }
259              
260 601         2595 $self->_printfb_line ($fb, $x, $self->{h} - 2, $line);
261              
262 601 100       3424 $self->_insert_label($fb, $xs, 0, $xs+$xr, 2, 'bottom' )
263             if ($self->{type} & EDGE_LABEL_CELL);
264              
265             }
266              
267             sub _draw_ver
268             {
269             # draw a VER edge piece
270 428     428   803 my ($self, $fb) = @_;
271              
272 428         1252 my $style = $self->_edge_style();
273              
274 428         931 my $h = $self->{h};
275             # '|' => '|||||', '{}' => '{}{}{}'
276 428         1469 my $line = $style->[1] x (1 + $h / length($style->[1]));
277 428 50       1471 $line = substr($line, 0, $h) if length($line) > $h;
278              
279 428         823 my $flags = $self->{type} & EDGE_FLAG_MASK;
280             # XXX TODO: handle here start points
281             # we get away with not handling them because in VER edges
282             # starting points are currently invisible.
283              
284 428         1148 my $as = $self->_arrow_style();
285 428 100       1186 if ($as ne 'none')
286             {
287 414         1024 my $ashape = $self->_arrow_shape();
288 414 100       1342 substr($line,0,1) = $self->_arrow($as,ARROW_UP, $ashape)
289             if (($flags & EDGE_END_N) != 0);
290 414 100       1521 substr($line,-1,1) = $self->_arrow($as,ARROW_DOWN, $ashape)
291             if (($flags & EDGE_END_S) != 0);
292             }
293 428         1343 $self->_printfb_ver ($fb, 2, 0, $line);
294              
295 428 100       2204 $self->_insert_label($fb, 4, 1, 4, 2, 'middle')
296             if ($self->{type} & EDGE_LABEL_CELL);
297              
298             }
299              
300             sub _draw_cross
301             {
302             # draw a CROSS sections, or a joint (which is a 3/4 cross)
303 52     52   114 my ($self, $fb) = @_;
304            
305             # vertical piece
306 52         186 my $style = $self->_edge_style( $self->{style_ver} );
307              
308 52         80 my $invisible = 0;
309 52         72 my $line;
310 52         95 my $flags = $self->{type} & EDGE_FLAG_MASK;
311 52         113 my $type = $self->{type} & EDGE_TYPE_MASK;
312 52         136 my $as = $self->_arrow_style();
313 52         129 my $y = $self->{h} - 2;
314              
315 52 50       154 print STDERR "# drawing cross at $self->{x},$self->{y} with flags $flags\n" if $self->{debug};
316              
317 52 50       153 if ($self->{style_ver} ne 'invisible')
318             {
319 52         98 my $h = $self->{h};
320             # '|' => '|||||', '{}' => '{}{}{}'
321 52         190 $line = $style->[1] x (2 + $h / length($style->[1]));
322              
323 52 50       186 $line = substr($line, 0, $h) if length($line) > $h;
324              
325 52 100       146 if ($as ne 'none')
326             {
327 50         126 my $ashape = $self->_arrow_shape();
328 50 100       190 substr($line,0,1) = $self->_arrow($as,ARROW_UP, $ashape)
329             if (($flags & EDGE_END_N) != 0);
330 50 100       159 substr($line,-1,1) = $self->_arrow($as,ARROW_DOWN, $ashape)
331             if (($flags & EDGE_END_S) != 0);
332             }
333              
334             # create joints
335 52 100       164 substr($line,0,$y) = ' ' x $y if $type == EDGE_S_E_W;
336 52 100       135 substr($line,$y,2) = ' ' if $type == EDGE_N_E_W;
337              
338 52         172 $self->_printfb_ver ($fb, 2, 0, $line);
339             }
340 0         0 else { $invisible++; }
341              
342             # horizontal piece
343 52         153 $style = $self->_edge_style();
344            
345 52 100       77 my $ashape; $ashape = $self->_arrow_style() if $as ne 'none';
  52         210  
346              
347 52 100       158 if ($self->{style} ne 'invisible')
348             {
349 51         91 my $w = $self->{w};
350             # '-' => '-----', '.-' => '.-.-.-'
351 51         95 my $len = length($style->[0]);
352 51         150 $line = $style->[0] x (2 + $w / $len);
353            
354             # '.-.-.-' => '-.-.-' if $x % $ofs == 1 (e.g. on odd positions)
355 51         128 my $ofs = $self->{rx} % $len;
356 51 100       286 substr($line,0,$ofs) = '' if $ofs != 0;
357              
358 51 50       164 $line = substr($line, 0, $w) if length($line) > $w;
359            
360 51         62 my $x = 0;
361 51 100       141 if (($flags & EDGE_START_W) != 0)
362             {
363 4         7 $x++; chop($line); # ' ---'
  4         12  
364             }
365 51 100       130 if (($flags & EDGE_START_E) != 0)
366             {
367 2         7 chop($line); # '--- '
368             }
369 51 100       116 if (($flags & EDGE_END_E) != 0)
370             {
371             # '--> '
372 7         16 chop($line);
373 7 100       39 substr($line,-1,1) = $self->_arrow($as, ARROW_RIGHT, $ashape)
374             if $as ne 'none';
375             }
376 51 50       131 if (($flags & EDGE_END_W) != 0)
377             {
378             # ' <--'
379 0 0       0 substr($line,0,1) = ' ' if $as eq 'none';
380 0 0       0 substr($line,0,2) = ' ' . $self->_arrow($as, ARROW_LEFT, $ashape)
381             if $as ne 'none';
382             }
383              
384 51 100       127 substr($line,0,2) = ' ' if $type == EDGE_E_N_S;
385 51 100       159 substr($line,2,$self->{w}-2) = ' ' x ($self->{w}-2) if $type == EDGE_W_N_S;
386              
387 51         163 $self->_printfb_line ($fb, $x, $y, $line);
388             }
389 1         14 else { $invisible++; }
390              
391 52 100       178 if (!$invisible)
392             {
393             # draw the crossing character only if both lines are visible
394 51         87 my $cross = $style->[2];
395 51         147 my $s = $self->{style} . $self->{style_ver};
396 51   66     172 $cross = ($self->_cross_style($s,$type) || $cross); # if $self->{style_ver} ne $self->{style};
397              
398 51         158 $self->_printfb ($fb, 2, $y, $cross);
399             }
400              
401             # done
402             }
403              
404             sub _draw_corner
405             {
406             # draw a corner (N_E, S_E etc)
407 352     352   628 my ($self, $fb) = @_;
408              
409 352         682 my $type = $self->{type} & EDGE_TYPE_MASK;
410 352         674 my $flags = $self->{type} & EDGE_FLAG_MASK;
411              
412             ############
413             # ........
414             # 0 : :
415             # 1 : : label would appear here
416             # 2 : +---: (w-3) = 3 chars wide
417             # 3 : | : always 1 char high
418             # .......:
419             # 012345
420              
421             # draw the vertical piece
422            
423             # get the style
424 352         958 my $style = $self->_edge_style();
425            
426 352         901 my $h = 1; my $y = $self->{h} -1;
  352         856  
427 352 100 100     2055 if ($type == EDGE_N_E || $type == EDGE_N_W)
428             {
429 176         284 $h = $self->{h} - 2; $y = 0;
  176         275  
430             }
431             # '|' => '|||||', '{}' => '{}{}{}'
432 352         1213 my $line = $style->[1] x (1 + $h / length($style->[1]));
433 352 50       1076 $line = substr($line, 0, $h) if length($line) > $h;
434              
435 352         983 my $as = $self->_arrow_style();
436 352         520 my $ashape;
437 352 100       882 if ($as ne 'none')
438             {
439 343         805 $ashape = $self->_arrow_shape();
440 343 100       1215 substr($line,0,1) = $self->_arrow($as, ARROW_UP, $ashape)
441             if (($flags & EDGE_END_N) != 0);
442 343 100       943 substr($line,-1,1) = $self->_arrow($as, ARROW_DOWN, $ashape)
443             if (($flags & EDGE_END_S) != 0);
444             }
445 352         1231 $self->_printfb_ver ($fb, 2, $y, $line);
446              
447             # horizontal piece
448 352         661 my $w = $self->{w} - 3; $y = $self->{h} - 2; my $x = 3;
  352         537  
  352         484  
449 352 100 100     2055 if ($type == EDGE_N_W || $type == EDGE_S_W)
450             {
451 173         239 $w = 2; $x = 0;
  173         255  
452             }
453              
454             # '-' => '-----', '.-' => '.-.-.-'
455 352         640 my $len = length($style->[0]);
456 352         1040 $line = $style->[0] x (2 + $w / $len);
457            
458             # '.-.-.-' => '-.-.-' if $x % $ofs == 1 (e.g. on odd positions)
459 352         743 my $ofs = ($x + $self->{rx}) % $len;
460 352 100       1140 substr($line,0,$ofs) = '' if $ofs != 0;
461              
462 352 50       1131 $line = substr($line, 0, $w) if length($line) > $w;
463            
464 352 100       1049 substr($line,-1,1) = ' ' if ($flags & EDGE_START_E) != 0;
465 352 100       772 substr($line,0,1) = ' ' if ($flags & EDGE_START_W) != 0;
466              
467 352 100       1010 if (($flags & EDGE_END_E) != 0)
468             {
469 26 100       92 substr($line,-1,1) = ' ' if $as eq 'none';
470 26 100       171 substr($line,-2,2) = $self->_arrow($as, ARROW_RIGHT, $ashape) . ' ' if $as ne 'none';
471             }
472 352 100       833 if (($flags & EDGE_END_W) != 0)
473             {
474 25 100       80 substr($line,0,1) = ' ' if $as eq 'none';
475 25 100       129 substr($line,0,2) = ' ' . $self->_arrow($as, ARROW_LEFT, $ashape) if $as ne 'none';
476             }
477              
478 352         1218 $self->_printfb_line ($fb, $x, $y, $line);
479              
480 352         724 my $idx = 3; # corner (SE, SW, NE, NW)
481 352 100       888 $idx = 4 if $type == EDGE_S_W;
482 352 100       737 $idx = 5 if $type == EDGE_N_E;
483 352 100       734 $idx = 6 if $type == EDGE_N_W;
484              
485             # insert the corner character
486 352         1056 $self->_printfb ($fb, 2, $y, $style->[$idx]);
487             }
488              
489             sub _draw_loop_hor
490             {
491 18     18   51 my ($self, $fb) = @_;
492              
493 18         52 my $type = $self->{type} & EDGE_TYPE_MASK;
494 18         46 my $flags = $self->{type} & EDGE_FLAG_MASK;
495              
496             ############
497             # ..........
498             # 0 : :
499             # 1 : : label would appear here
500             # 2 : +--+ : (w-6) = 2 chars wide
501             # 3 : | v : 1 char high
502             # .........:
503             # 01234567
504              
505             ############
506             # ..........
507             # 0 : | ^ : ver is h-2 chars high
508             # 1 : | | : label would appear here
509             # 2 : +--+ : (w-6) = 2 chars wide
510             # 3 : :
511             # .........:
512             # 01234567
513              
514             # draw the vertical pieces
515            
516             # get the style
517 18         65 my $style = $self->_edge_style();
518            
519 18         35 my $h = 1; my $y = $self->{h} - 1;
  18         101  
520 18 100       80 if ($type == EDGE_S_W_N)
521             {
522 10         21 $h = $self->{h} - 2; $y = 0;
  10         20  
523             }
524             # '|' => '|||||', '{}' => '{}{}{}'
525 18         84 my $line = $style->[1] x (1 + $h / length($style->[1]));
526 18 50       74 $line = substr($line, 0, $h) if length($line) > $h;
527            
528 18         68 my $as = $self->_arrow_style();
529 18 100       37 my $ashape; $ashape = $self->_arrow_shape() if $as ne 'none';
  18         111  
530              
531 18 100 66     102 if ($self->{edge}->{bidirectional} && $as ne 'none')
532             {
533 2 100       9 substr($line,0,1) = $self->_arrow($as, ARROW_UP, $ashape) if (($flags & EDGE_END_N) != 0);
534 2 100       8 substr($line,-1,1) = $self->_arrow($as, ARROW_DOWN, $ashape) if (($flags & EDGE_END_S) != 0);
535             }
536 18         94 $self->_printfb_ver ($fb, $self->{w}-3, $y, $line);
537              
538 18 100       73 if ($as ne 'none')
539             {
540 16 100       199 substr($line,0,1) = $self->_arrow($as, ARROW_UP, $ashape) if (($flags & EDGE_END_N) != 0);
541 16 100       87 substr($line,-1,1) = $self->_arrow($as, ARROW_DOWN, $ashape) if (($flags & EDGE_END_S) != 0);
542             }
543 18         58 $self->_printfb_ver ($fb, 2, $y, $line);
544              
545             # horizontal piece
546 18         38 my $w = $self->{w} - 6; $y = $self->{h} - 2; my $x = 3;
  18         39  
  18         98  
547              
548             # '-' => '-----', '.-' => '.-.-.-'
549 18         41 my $len = length($style->[0]);
550 18         63 $line = $style->[0] x (2 + $w / $len);
551            
552             # '.-.-.-' => '-.-.-' if $x % $ofs == 1 (e.g. on odd positions)
553 18         62 my $ofs = ($x + $self->{rx}) % $len;
554 18 100       73 substr($line,0,$ofs) = '' if $ofs != 0;
555              
556 18 50       81 $line = substr($line, 0, $w) if length($line) > $w;
557            
558 18         75 $self->_printfb_line ($fb, $x, $y, $line);
559            
560 18 100       41 my $corner_idx = 3; $corner_idx = 5 if $type == EDGE_S_W_N;
  18         71  
561              
562             # insert the corner characters
563 18         62 $self->_printfb ($fb, 2, $y, $style->[$corner_idx]);
564 18         85 $self->_printfb ($fb, $self->{w}-3, $y, $style->[$corner_idx+1]);
565              
566 18 100       39 my $align = 'bottom'; $align = 'top' if $type == EDGE_S_W_N;
  18         76  
567 18 50       408 $self->_insert_label($fb, 4, 0, 4, 2, $align)
568             if ($self->{type} & EDGE_LABEL_CELL);
569              
570             # done
571             }
572              
573             sub _draw_loop_ver
574             {
575 16     16   38 my ($self, $fb) = @_;
576              
577 16         48 my $type = $self->{type} & EDGE_TYPE_MASK;
578 16         39 my $flags = $self->{type} & EDGE_FLAG_MASK;
579              
580             ############
581             # ........
582             # 0 : : label would appear here
583             # 1 : +-- :
584             # 2 : | :
585             # 3 : +-> :
586             # .......:
587             # 012345
588              
589             # ........
590             # 0 : : label would appear here
591             # 1 : --+ :
592             # 2 : | :
593             # 3 : <-+ :
594             # .......:
595             # 012345
596              
597             ###########################################################################
598             # draw the vertical piece
599            
600             # get the style
601 16         70 my $style = $self->_edge_style();
602            
603 16         36 my $h = 1; my $y = $self->{h} - 3;
  16         43  
604             # '|' => '|||||', '{}' => '{}{}{}'
605 16         70 my $line = $style->[1] x (1 + $h / length($style->[1]));
606 16 50       67 $line = substr($line, 0, $h) if length($line) > $h;
607              
608 16 100       28 my $x = 2; $x = $self->{w}-3 if ($type == EDGE_E_S_W);
  16         61  
609 16         294 $self->_printfb_ver ($fb, $x, $y, $line);
610              
611             ###########################################################################
612             # horizontal pieces
613              
614 16         44 my $w = $self->{w} - 3; $y = $self->{h} - 4;
  16         33  
615 16 100       27 $x = 2; $x = 1 if ($type == EDGE_E_S_W);
  16         53  
616              
617             # '-' => '-----', '.-' => '.-.-.-'
618 16         36 my $len = length($style->[0]);
619 16         53 $line = $style->[0] x (2 + $w / $len);
620            
621             # '.-.-.-' => '-.-.-' if $x % $ofs == 1 (e.g. on odd positions)
622 16         49 my $ofs = ($x + $self->{rx}) % $len;
623 16 100       61 substr($line,0,$ofs) = '' if $ofs != 0;
624              
625 16 50       63 $line = substr($line, 0, $w) if length($line) > $w;
626              
627 16         63 my $as = $self->_arrow_style();
628 16 100       32 my $ashape; $ashape = $self->_arrow_shape() if $as ne 'none';
  16         90  
629            
630 16 100 66     90 if ($self->{edge}->{bidirectional} && $as ne 'none')
631             {
632 2 100       10 substr($line,0,1) = $self->_arrow($as, ARROW_LEFT, $ashape) if (($flags & EDGE_END_W) != 0);
633 2 100       11 substr($line,-1,1) = $self->_arrow($as, ARROW_RIGHT, $ashape) if (($flags & EDGE_END_E) != 0);
634             }
635              
636 16         87 $self->_printfb_line ($fb, $x, $y, $line);
637              
638 16 100       69 if ($as ne 'none')
639             {
640 14 100       144 substr($line,0,1) = $self->_arrow($as, ARROW_LEFT, $ashape) if (($flags & EDGE_END_W) != 0);
641 14 100       78 substr($line,-1,1) = $self->_arrow($as, ARROW_RIGHT, $ashape) if (($flags & EDGE_END_E) != 0);
642             }
643            
644 16         73 $self->_printfb_line ($fb, $x, $self->{h} - 2, $line);
645              
646 16 100       42 $x = 2; $x = $self->{w}-3 if ($type == EDGE_E_S_W);
  16         55  
647              
648 16 100       30 my $corner_idx = 3; $corner_idx = 4 if $type == EDGE_E_S_W;
  16         51  
649              
650             # insert the corner characters
651 16         70 $self->_printfb ($fb, $x, $y, $style->[$corner_idx]);
652 16         70 $self->_printfb ($fb, $x, $self->{h}-2, $style->[$corner_idx+2]);
653              
654 16 100       36 $x = 4; $x = 3 if ($type == EDGE_E_S_W);
  16         162  
655 16 50       111 $self->_insert_label($fb, $x, 0, $x, 4, 'bottom')
656             if ($self->{type} & EDGE_LABEL_CELL);
657              
658             # done
659             }
660              
661             # which method to call for which edge type
662             my $draw_dispatch =
663             {
664             EDGE_HOR() => '_draw_hor',
665             EDGE_VER() => '_draw_ver',
666              
667             EDGE_S_E() => '_draw_corner',
668             EDGE_S_W() => '_draw_corner',
669             EDGE_N_E() => '_draw_corner',
670             EDGE_N_W() => '_draw_corner',
671              
672             EDGE_CROSS() => '_draw_cross',
673             EDGE_W_N_S() => '_draw_cross',
674             EDGE_E_N_S() => '_draw_cross',
675             EDGE_N_E_W() => '_draw_cross',
676             EDGE_S_E_W() => '_draw_cross',
677              
678             EDGE_N_W_S() => '_draw_loop_hor',
679             EDGE_S_W_N() => '_draw_loop_hor',
680              
681             EDGE_E_S_W() => '_draw_loop_ver',
682             EDGE_W_S_E() => '_draw_loop_ver',
683             };
684              
685             sub _draw_label
686             {
687             # This routine is cunningly named _draw_label, because it actually
688             # draws the edge line(s). The label text will be drawn by the individual
689             # routines called below.
690 1477     1477   2483 my ($self, $fb, $x, $y) = @_;
691              
692 1477         5195 my $type = $self->{type} & EDGE_TYPE_MASK;
693              
694             # for cross sections, we maybe need to draw one of the parts:
695 1477 100 100     5342 return if $self->attribute('style') eq 'invisible' && $type ne EDGE_CROSS;
696              
697 1467         4188 my $m = $draw_dispatch->{$type};
698              
699 1467 50       3606 $self->_croak("Unknown edge type $type") unless defined $m;
700              
701             # store the coordinates of our upper-left corner (for seamless rendering)
702 1467   100     4743 $self->{rx} = $x || 0; $self->{ry} = $y || 0;
  1467   100     7840  
703 1467         7088 $self->$m($fb);
704 1467         3439 delete $self->{rx}; delete $self->{ry}; # no longer needed
  1467         4220  
705             }
706              
707             #############################################################################
708             #############################################################################
709              
710             package Graph::Easy::Node;
711              
712 23     23   275 use strict;
  23         618  
  23         112609  
713              
714             sub _framebuffer
715             {
716             # generate an actual framebuffer consisting of spaces
717 3653     3653   9345 my ($self, $w, $h) = @_;
718              
719 3653 50       7270 print STDERR "# trying to generate framebuffer of undefined width for $self->{name}\n",
720             join (": ", caller(),"\n") if !defined $w;
721              
722 3653         4067 my @fb;
723              
724 3653         7637 my $line = ' ' x $w;
725 3653         6709 for my $y (1..$h)
726             {
727 13211         25724 push @fb, $line;
728             }
729 3653         11912 \@fb;
730             }
731              
732             sub _printfb_aligned
733             {
734 1953     1953   4857 my ($self,$fb, $x1,$y1, $w,$h, $lines, $aligns, $align_ver) = @_;
735              
736 1953 100       4726 $align_ver = 'middle' unless $align_ver;
737              
738             # $align_ver eq 'middle':
739 1953         7082 my $y = $y1 + ($h / 2) - (scalar @$lines / 2);
740 1953 100       5067 if ($align_ver eq 'top')
741             {
742 21         52 $y = $y1;
743 21         46 $y1 = 0;
744             }
745 1953 100       4389 if ($align_ver eq 'bottom')
746             {
747 493         702 $y = $h - scalar @$lines; $y1 = 0;
  493         916  
748             }
749              
750 1953         2612 my $xc = ($w / 2);
751              
752 1953         2683 my $i = 0;
753 1953         7387 while ($i < @$lines)
754             {
755             # get the line and her alignment
756 1254         3093 my ($l,$al) = ($lines->[$i],$aligns->[$i]);
757              
758 1254         1787 my $x = 0; # left is default
759              
760 1254 100       4642 $x = $xc - length($l) / 2 if $al eq 'c';
761 1254 100       3340 $x = $w - length($l) if $al eq 'r';
762              
763             # now print the line (inlined print_fb_line for speed)
764 1254         5139 substr ($fb->[int($y+$i+$y1)], int($x+$x1), length($l)) = $l;
765              
766 1254         6364 $i++;
767             }
768             }
769              
770             sub _printfb_line
771             {
772             # Print one textline into a framebuffer
773             # Caller MUST ensure proper size of FB, for speed reasons,
774             # we do not check whether text fits!
775 1061     1061   2205 my ($self, $fb, $x, $y, $l) = @_;
776              
777             # [0] = '0123456789...'
778              
779 1061         4158 substr ($fb->[$y], $x, length($l)) = $l;
780             }
781              
782             sub _printfb
783             {
784             # Print (potential a multiline) text into a framebuffer
785             # Caller MUST ensure proper size of FB, for speed reasons,
786             # we do not check whether the text fits!
787 5439     5439   16091 my ($self, $fb, $x, $y, @lines) = @_;
788              
789             # [0] = '0123456789...'
790             # [1] = '0123456789...' etc
791              
792 5439         10267 for my $l (@lines)
793             {
794             # # XXX DEBUG:
795             # if ( $x + length($l) > length($fb->[$y]))
796             # {
797             # require Carp;
798             # Carp::confess("substr outside framebuffer");
799             # }
800              
801 6079         10295 substr ($fb->[$y], $x, length($l)) = $l; $y++;
  6079         36853  
802             }
803             }
804              
805             sub _printfb_ver
806             {
807             # Print a string vertical into a framebuffer.
808             # Caller MUST ensure proper size of FB, for speed reasons,
809             # we do not check whether text fits!
810 884     884   1907 my ($self, $fb, $x, $y, $line) = @_;
811              
812             # this more than twice as fast as:
813             # "@pieces = split//,$line; _printfb(...)"
814              
815 884         1471 my $y1 = $y + length($line);
816 884         10011 substr ($fb->[$y1], $x, 1) = chop($line) while ($y1-- > $y);
817             }
818              
819             # for ASCII and box drawing:
820              
821             # the array contains for each style:
822             # upper left edge
823             # upper right edge
824             # lower right edge
825             # lower left edge
826             # hor style (top edge)
827             # hor style (bottom side)
828             # ver style (right side) (multiple characters possible)
829             # ver style (left side) (multiple characters possible)
830             # T crossing (see drawing below)
831             # T to right
832             # T to left
833             # T to top
834             # T shape (to bottom)
835            
836             #
837             # +-----4-----4------+
838             # | | | |
839             # | | | |
840             # | | | |
841             # 1-----0-----3------2 1 = T to right, 2 = T to left, 3 T to top
842             # | | 0 = cross, 4 = T shape
843             # | |
844             # | |
845             # +-----+
846              
847             my $border_styles =
848             [
849             {
850             solid => [ '+', '+', '+', '+', '-', '-', [ '|' ], [ '|' ], '+', '+', '+', '+', '+' ],
851             dotted => [ '.', '.', ':', ':', '.', '.', [ ':' ], [ ':' ], '.', '.', '.', '.', '.' ],
852             dashed => [ '+', '+', '+', '+', '- ', '- ', [ "'" ], [ "'" ], '+', '+', '+', '+', '+' ],
853             'dot-dash' => [ '+', '+', '+', '+', '.-', '.-', [ '!' ], [ '!' ], '+', '+', '+', '+', '+' ],
854             'dot-dot-dash' => [ '+', '+', '+', '+', '..-', '..-', [ '|', ':' ], [ '|',':' ], '+', '+', '+', '+', '+' ],
855             bold => [ '#', '#', '#', '#', '#', '#', [ '#' ], [ '#' ], '#', '#', '#', '#', '#' ],
856             'bold-dash' => [ '#', '#', '#', '#', '# ', '# ', ['#',' ' ], [ '#',' ' ], '#', '#', '#', '#', '#' ],
857             double => [ '#', '#', '#', '#', '=', '=', [ 'H' ], [ 'H' ], '#', '#', '#', '#', '#' ],
858             'double-dash' => [ '#', '#', '#', '#', '= ', '= ', [ '"' ], [ '"' ], '#', '#', '#', '#', '#' ],
859             wave => [ '+', '+', '+', '+', '~', '~', [ '{', '}' ], [ '{','}' ], '+', '+', '+', '+', '+' ],
860             broad => [ '#', '#', '#', '#', '#', '#', [ '#' ], [ '#' ], '#', '#', '#', '#', '#' ],
861             wide => [ '#', '#', '#', '#', '#', '#', [ '#' ], [ '#' ], '#', '#', '#', '#', '#' ],
862             none => [ ' ', ' ', ' ', ' ', ' ', ' ', [ ' ' ], [ ' ' ], ' ', ' ', ' ', ' ', ' ' ],
863             },
864             {
865             solid => [ '┌', '┐', '┘', '└', '─', '─', [ '│' ], [ '│' ], '┼', '├', '┤', '┴', '┬' ],
866             double => [ '╔', '╗', '╝', '╚', '═', '═', [ '║' ], [ '║' ], '┼', '├', '┤', '┴', '┬' ],
867             dotted => [ '┌', '┐', '┘', '└', '⋯', '⋯', [ '⋮' ], [ '⋮' ], '┼', '├', '┤', '┴', '┬' ],
868             dashed => [ '┌', '┐', '┘', '└', '−', '−', [ '╎' ], [ '╎' ], '┼', '├', '┤', '┴', '┬' ],
869             'dot-dash' => [ '┌', '┐', '┘', '└', '·'.'-', '·'.'-', ['!'], ['!'], '┼', '├', '┤', '┴', '┬' ],
870             'dot-dot-dash' => [ '┌', '┐', '┘', '└', ('·' x 2) .'-', ('·' x 2) .'-', [ '│', ':' ], [ '│', ':' ], '┼', '├', '┤', '┴', '┬' ],
871             bold => [ '┏', '┓', '┛', '┗', '━', '━', [ '┃' ], [ '┃' ], '┼', '├', '┤', '┴', '┬' ],
872             'bold-dash' => [ '┏', '┓', '┛', '┗', '━'.' ', '━'.' ', [ '╻' ], [ '╻' ], '┼', '├', '┤', '┴', '┬' ],
873             'double-dash' => [ '╔', '╗', '╝', '╚', '═'.' ', '═'.' ', [ '∥' ], [ '∥' ], '┼', '├', '┤', '┴', '┬' ],
874             wave => [ '┌', '┐', '┘', '└', '∼', '∼', [ '≀' ], [ '≀' ], '┼', '├', '┤', '┴', '┬' ],
875             broad => [ '▛', '▜', '▟', '▙', '▀', '▄', [ '▌' ], [ '▐' ], '▄', '├', '┤', '┴', '┬' ],
876             wide => [ '█', '█', '█', '█', '█', '█', [ '█' ], [ '█' ], '█', '█', '█', '█', '█' ],
877             none => [ ' ', ' ', ' ', ' ', ' ', ' ', [ ' ' ], [ ' ' ], ' ', ' ', ' ', ' ', ' ', ],
878             },
879             ];
880              
881             # for boxart and rounded corners on node-borders:
882             # upper left edge
883             # upper right edge
884             # lower right edge
885             # lower left edge
886              
887             my $rounded_edges = [ '╭', '╮', '╯', '╰', ];
888              
889             # for ASCII/boxart drawing slopes/slants
890             # lower-left to upper right (repeated twice)
891             # lower-right to upper left (repeated twice)
892             my $slants = [
893             # ascii
894             {
895             solid => [ '/' , '\\' ],
896             dotted => [ '.' , '.' ],
897             dashed => [ '/ ', '\\ ' ],
898             'dot-dash' => [ './', '.\\' ],
899             'dot-dot-dash' => [ '../', '..\\' ],
900             bold => [ '#' , '#' ],
901             'bold-dash' => [ '# ' , '# ' ],
902             'double' => [ '/' , '\\' ],
903             'double-dash' => [ '/ ' , '\\ ' ],
904             wave => [ '/ ' , '\\ ' ],
905             broad => [ '#' , '#' ],
906             wide => [ '#' , '#' ],
907             },
908             # boxart
909             {
910             solid => [ '╱' , '╲' ],
911             dotted => [ '⋰' , '⋱' ],
912             dashed => [ '╱ ', '╲ ' ],
913             'dot-dash' => [ '.╱', '.╲' ],
914             'dot-dot-dash' => [ '⋰╱', '⋱╲' ],
915             bold => [ '#' , '#' ],
916             'bold-dash' => [ '# ' , '# ' ],
917             'double' => [ '╱' , '╲' ],
918             'double-dash' => [ '╱ ' , '╲ ' ],
919             wave => [ '╱ ' , '╲ ' ],
920             broad => [ '#' , '#' ],
921             wide => [ '#' , '#' ],
922             },
923             ];
924              
925             # ASCII and box art: the different point shapes and styles
926             my $point_shapes =
927             [ {
928             filled =>
929             {
930             'star' => '*',
931             'square' => '#',
932             'dot' => '.',
933             'circle' => 'o', # unfortunately, there is no filled o in ASCII
934             'cross' => '+',
935             'diamond' => '<>',
936             'x' => 'X',
937             },
938             closed =>
939             {
940             'star' => '*',
941             'square' => '#',
942             'dot' => '.',
943             'circle' => 'o',
944             'cross' => '+',
945             'diamond' => '<>',
946             'x' => 'X',
947             },
948             },
949             {
950             filled =>
951             {
952             'star' => '★',
953             'square' => '■',
954             'dot' => '·',
955             'circle' => '●',
956             'cross' => '+',
957             'diamond' => '◆',
958             'x' => '╳',
959             },
960             closed =>
961             {
962             'star' => '☆',
963             'square' => '□',
964             'dot' => '·',
965             'circle' => '○',
966             'cross' => '+',
967             'diamond' => '◇',
968             'x' => '╳',
969             },
970             }
971             ];
972              
973             sub _point_style
974             {
975 8     8   17 my ($self, $shape, $style) = @_;
976              
977 8 50       26 return '' if $shape eq 'invisible';
978              
979 8 100       60 if ($style =~ /^(star|square|dot|circle|cross|diamond)\z/)
980             {
981             # support the old "pointstyle: diamond" notion:
982 6         9 $shape = $style; $style = 'filled';
  6         12  
983             }
984              
985 8 50       21 $style = 'filled' unless defined $style;
986 8   50     47 my $g = $self->{graph}->{_ascii_style} || 0;
987 8         41 $point_shapes->[$g]->{$style}->{$shape};
988             }
989              
990             sub _border_style
991             {
992 5396     5396   21582 my ($self, $style, $type) = @_;
993              
994             # make a copy so that we can modify it
995 5396   100     23416 my $g = $self->{graph}->{_ascii_style} || 0;
996 5396         6102 my $s = [ @{ $border_styles->[ $g ]->{$style} } ];
  5396         29017  
997              
998 5396 50       18126 die ("Unknown $type border style '$style'") if @$s == 0;
999              
1000 5396         6931 my $shape = 'rect';
1001 5396 100       26582 $shape = $self->attribute('shape') unless $self->isa_cell();
1002 5396 100       21337 return $s unless $shape eq 'rounded';
1003              
1004             # if shape: rounded, overlay the rounded edge pieces
1005 24 100       158 splice (@$s, 0, 4, @$rounded_edges)
1006             if $style =~ /^(solid|dotted|dashed|dot-dash|dot-dot-dash)\z/;
1007              
1008             # '####' => ' ### '
1009 24 50 33     134 splice (@$s, 0, 4, (' ', ' ', ' ', ' '))
1010             if $g == 0 || $style =~ /^(bold|wide|broad|double|double-dash|bold-dash)\z/;
1011              
1012 24         67 $s;
1013             }
1014              
1015             #############################################################################
1016             # different arrow styles and shapes in ASCII and boxart
1017              
1018             my $arrow_form =
1019             {
1020             normal => 0,
1021             sleek => 1, # slightly squashed
1022             };
1023              
1024             my $arrow_shapes =
1025             {
1026             triangle => 0,
1027             diamond => 1,
1028             box => 2,
1029             dot => 3,
1030             inv => 4, # an inverted triangle
1031             line => 5,
1032             cross => 6,
1033             x => 7,
1034             };
1035              
1036             # todo: ≪ ≫
1037              
1038             my $arrow_styles =
1039             [
1040             [
1041             # triangle
1042             {
1043             open => [ '>', '<', '^', 'v' ],
1044             closed => [ '>', '<', '^', 'v' ],
1045             filled => [ '>', '<', '^', 'v' ],
1046             },
1047             {
1048             open => [ '>', '<', '∧', '∨' ],
1049             closed => [ '▷', '◁', '△', '▽' ],
1050             filled => [ '▶', '◀', '▲', '▼' ],
1051             }
1052             ], [
1053             # diamond
1054             {
1055             open => [ '>', '<', '^', 'v' ],
1056             closed => [ '>', '<', '^', 'v' ],
1057             filled => [ '>', '<', '^', 'v' ],
1058             },
1059             {
1060             open => [ '>', '<', '∧', '∨' ],
1061             closed => [ '◇', '◇', '◇', '◇' ],
1062             filled => [ '◆', '◆', '◆', '◆' ],
1063             }
1064             ], [
1065             # box
1066             {
1067             open => [ ']', '[', '°', 'u' ],
1068             closed => [ 'D', 'D', 'D', 'D' ],
1069             filled => [ '#', '#', '#', '#' ],
1070             },
1071             {
1072             open => [ '⊐', '⊐', '⊓', '⊔' ],
1073             closed => [ '◻', '◻', '◻', '◻' ],
1074             filled => [ '◼', '◼', '◼', '◼' ],
1075             }
1076             ], [
1077             # dot
1078             {
1079             open => [ ')', '(', '^', 'u' ],
1080             closed => [ 'o', 'o', 'o', 'o' ],
1081             filled => [ '*', '*', '*', '*' ],
1082             },
1083             {
1084             open => [ ')', '(', '◠', '◡' ],
1085             closed => [ '○', '○', '○', '○' ],
1086             filled => [ '●', '●', '●', '●' ],
1087             }
1088             ], [
1089             # inv
1090             {
1091             open => [ '<', '>', 'v', '^' ],
1092             closed => [ '<', '>', 'v', '^' ],
1093             filled => [ '<', '>', 'v', '^' ],
1094             },
1095             {
1096             open => [ '<', '>', '∨', '∧' ],
1097             closed => [ '◁', '▷', '▽', '△' ],
1098             filled => [ '◀', '▶', '▼', '▲' ],
1099             }
1100             ], [
1101             # line
1102             {
1103             open => [ '|', '|', '_', '-' ],
1104             closed => [ '|', '|', '_', '-' ],
1105             filled => [ '|', '|', '_', '-' ],
1106             },
1107             {
1108             open => [ '⎥', '⎢', '_', '¯' ],
1109             closed => [ '⎥', '⎢', '_', '¯' ],
1110             filled => [ '⎥', '⎢', '_', '¯' ],
1111             }
1112             ], [
1113             # cross
1114             {
1115             open => [ '+', '+', '+', '+' ],
1116             closed => [ '+', '+', '+', '+' ],
1117             filled => [ '+', '+', '+', '+' ],
1118             },
1119             {
1120             open => [ '┼', '┼', '┼', '┼' ],
1121             closed => [ '┼', '┼', '┼', '┼' ],
1122             filled => [ '┼', '┼', '┼', '┼' ],
1123             }
1124             ], [
1125             # x
1126             {
1127             open => [ 'x', 'x', 'x', 'x' ],
1128             closed => [ 'x', 'x', 'x', 'x' ],
1129             filled => [ 'x', 'x', 'x', 'x' ],
1130             },
1131             {
1132             open => [ 'x', 'x', 'x', 'x' ],
1133             closed => [ 'x', 'x', 'x', 'x' ],
1134             filled => [ '⧓', '⧓', 'x', 'x' ],
1135             }
1136             ]
1137             ];
1138              
1139             sub _arrow
1140             {
1141             # return an arror, depending on style and direction
1142 870     870   2172 my ($self, $style, $dir, $shape) = @_;
1143              
1144 870 50       1926 $shape = '' unless defined $shape;
1145 870   50     4160 $shape = $arrow_shapes->{$shape} || 0;
1146              
1147 870   100     3681 my $g = $self->{graph}->{_ascii_style} || 0;
1148 870         4399 $arrow_styles->[$shape]->[$g]->{$style}->[$dir];
1149             }
1150              
1151             # To convert an HTML arrow to Unicode:
1152             my $arrow_dir = {
1153             '>' => 0,
1154             '<' => 1,
1155             '^' => 2,
1156             'v' => 3,
1157             };
1158              
1159             sub _unicode_arrow
1160             {
1161             # return an arror in unicode, depending on style and direction
1162 24     24   72 my ($self, $shape, $style, $arrow_text) = @_;
1163              
1164 24 50       98 $shape = '' unless defined $shape;
1165 24   50     252 $shape = $arrow_shapes->{$shape} || 0;
1166              
1167 24   50     138 my $dir = $arrow_dir->{$arrow_text} || 0;
1168              
1169 24         236 $arrow_styles->[$shape]->[1]->{$style}->[$dir];
1170             }
1171              
1172             #############################################################################
1173              
1174             #
1175             # +---4---4---4---+
1176             # | | | | |
1177             # | | | | |
1178             # | | | | |
1179             # 1---0---3---0---2 1 = T to right, 2 = T to left, 3 T to top
1180             # | | | | 0 = cross, 4 = T shape
1181             # | | | |
1182             # | | | |
1183             # +---+ +---+
1184              
1185             sub _draw_border
1186             {
1187             # draws a border into the framebuffer
1188 1860     1860   8865 my ($self, $fb, $do_right, $do_bottom, $do_left, $do_top, $x, $y) = @_;
1189              
1190 1860 100       5697 return if $do_right.$do_left.$do_bottom.$do_top eq 'nonenonenonenone';
1191              
1192 1710         2727 my $g = $self->{graph};
1193              
1194 1710         2621 my $w = $self->{w};
1195 1710 100       4466 if ($do_top ne 'none')
1196             {
1197 1255         4025 my $style = $self->_border_style($do_top, 'top');
1198              
1199             # top-left corner piece is only there if we have a left border
1200 1255 100       2121 my $tl = $style->[0]; $tl = '' if $do_left eq 'none';
  1255         3072  
1201              
1202             # generate the top border
1203 1255         5083 my $top = $style->[4] x (($self->{w}) / length($style->[4]) + 1);
1204              
1205 1255         1927 my $len = length($style->[4]);
1206              
1207             # for seamless rendering
1208 1255 100       2967 if (defined $x)
1209             {
1210 208         299 my $ofs = $x % $len;
1211 208 100       849 substr($top,0,$ofs) = '' if $ofs != 0;
1212             }
1213              
1214             # insert left upper corner (if it is there)
1215 1255 100       4045 substr($top,0,1) = $tl if $tl ne '';
1216              
1217 1255 100       3981 $top = substr($top,0,$w) if length($top) > $w;
1218            
1219             # top-right corner piece is only there if we have a right border
1220 1255 100       3344 substr($top,-1,1) = $style->[1] if $do_right ne 'none';
1221              
1222             # if the border must be collapsed, modify top-right edge piece:
1223 1255 50       3268 if ($self->{border_collapse_right})
1224             {
1225             # place "4" (see drawing above)
1226 0         0 substr($top,-1,1) = $style->[10];
1227             }
1228              
1229             # insert top row into FB
1230 1255         10777 $self->_printfb( $fb, 0,0, $top);
1231             }
1232              
1233 1710 100       4964 if ($do_bottom ne 'none')
1234             {
1235 1273         3535 my $style = $self->_border_style($do_bottom, 'bottom');
1236              
1237             # bottom-left corner piece is only there if we have a left border
1238 1273 100       2822 my $bl = $style->[3]; $bl = '' if $do_left eq 'none';
  1273         3658  
1239              
1240             # the bottom row '+--------+' etc
1241 1273         4444 my $bottom = $style->[5] x (($self->{w}) / length($style->[5]) + 1);
1242              
1243 1273         2553 my $len = length($style->[5]);
1244            
1245             # for seamless rendering
1246 1273 100       2809 if (defined $x)
1247             {
1248 208         300 my $ofs = $x % $len;
1249 208 100       612 substr($bottom,0,$ofs) = '' if $ofs != 0;
1250             }
1251              
1252             # insert left bottom corner (if it is there)
1253 1273 100       4295 substr($bottom,0,1) = $bl if $bl ne '';
1254              
1255 1273 100       3659 $bottom = substr($bottom,0,$w) if length($bottom) > $w;
1256              
1257             # bottom-right corner piece is only there if we have a right border
1258 1273 100       3782 substr($bottom,-1,1) = $style->[2] if $do_right ne 'none';
1259              
1260             # if the border must be collapsed, modify bottom-right edge piece:
1261 1273 50 33     6880 if ($self->{border_collapse_right} || $self->{border_collapse_bottom})
1262             {
1263 0 0       0 if ($self->{rightbelow_count} > 0)
1264             {
1265             # place a cross or T piece (see drawing above)
1266 0         0 my $piece = 8; # cross
1267             # inverted T
1268 0 0 0     0 $piece = 11 if $self->{rightbelow_count} < 2 && !$self->{have_below};
1269 0 0 0     0 $piece = 10 if $self->{rightbelow_count} < 2 && !$self->{have_right};
1270 0         0 substr($bottom,-1,1) = $style->[$piece];
1271             }
1272             }
1273              
1274             # insert bottom row into FB
1275 1273         9216 $self->_printfb( $fb, 0,$self->{h}-1, $bottom);
1276             }
1277              
1278 1710 100       11776 return if $do_right.$do_left eq 'nonenone'; # both none => done
1279              
1280 1434         4015 my $style = $self->_border_style($do_left, 'left');
1281 1434         2873 my $left = $style->[6];
1282 1434         1727 my $lc = scalar @{ $style->[6] } - 1; # count of characters
  1434         3352  
1283              
1284 1434         3691 $style = $self->_border_style($do_right, 'right');
1285 1434         3986 my $right = $style->[7];
1286 1434         2092 my $rc = scalar @{ $style->[7] } - 1; # count of characters
  1434         3160  
1287              
1288 1434         2020 my (@left, @right);
1289 1434         1641 my $l = 0; my $r = 0; # start with first character
  1434         1723  
1290 1434 100       2337 my $s = 1; $s = 0 if $do_top eq 'none';
  1434         4253  
1291              
1292 1434         2793 my $h = $self->{h} - 2;
1293 1434 100 100     4411 $h ++ if defined $x && $do_bottom eq 'none'; # for seamless rendering
1294 1434         3077 for ($s..$h)
1295             {
1296 1895 100       3123 push @left, $left->[$l]; $l ++; $l = 0 if $l > $lc;
  1895         2436  
  1895         3838  
1297 1895 100       3344 push @right, $right->[$r]; $r ++; $r = 0 if $r > $rc;
  1895         2054  
  1895         6018  
1298             }
1299             # insert left/right columns into FB
1300 1434 100       5605 $self->_printfb( $fb, 0, $s, @left) unless $do_left eq 'none';
1301 1434 100       6003 $self->_printfb( $fb, $w-1, $s, @right) unless $do_right eq 'none';
1302              
1303 1434         8005 $self;
1304             }
1305            
1306             sub _draw_label
1307             {
1308             # Draw the node label into the framebuffer
1309 1086     1086   2107 my ($self, $fb, $x, $y, $shape) = @_;
1310              
1311 1086 100       3088 if ($shape eq 'point')
1312             {
1313             # point-shaped nodes do not show their label in ASCII
1314 7         22 my $style = $self->attribute('pointstyle');
1315 7         34 my $shape = $self->attribute('pointshape');
1316 7         23 my $l = $self->_point_style($shape,$style);
1317              
1318 7 50       37 $self->_printfb_line ($fb, 2, $self->{h} - 2, $l) if $l;
1319 7         20 return;
1320             }
1321              
1322             # +----
1323             # | Label
1324             # 2,1: ----^
1325              
1326 1079         3175 my $w = $self->{w} - 4; my $xs = 2;
  1079         1548  
1327 1079         2056 my $h = $self->{h} - 2; my $ys = 0.5;
  1079         1358  
1328 1079         3619 my $border = $self->attribute('borderstyle');
1329 1079 100       2628 if ($border eq 'none')
1330             {
1331 10         40 $w += 2; $h += 2;
  10         21  
1332 10         18 $xs = 1; $ys = 0;
  10         33  
1333             }
1334              
1335 1079         3781 my $align = $self->attribute('align');
1336 1079         5194 $self->_printfb_aligned ($fb, $xs, $ys, $w, $h, $self->_aligned_label($align));
1337             }
1338              
1339             sub as_ascii
1340             {
1341             # renders a node or edge like:
1342             # +--------+ .......... ""
1343             # | A node | or : A node : or " --> "
1344             # +--------+ .......... ""
1345 1095     1095 1 2461 my ($self, $x,$y) = @_;
1346              
1347 1095         1809 my $shape = 'rect';
1348 1095 50       6482 $shape = $self->attribute('shape') unless $self->isa_cell();
1349              
1350 1095 100       3622 if ($shape eq 'edge')
1351             {
1352 3         17 my $edge = Graph::Easy::Edge->new();
1353 3         16 my $cell = Graph::Easy::Edge::Cell->new( edge => $edge, x => $x, y => $y );
1354 3         10 $cell->{w} = $self->{w};
1355 3         8 $cell->{h} = $self->{h};
1356 3         13 $cell->{att}->{label} = $self->label();
1357 3         22 $cell->{type} =
1358             Graph::Easy::Edge::Cell->EDGE_HOR +
1359             Graph::Easy::Edge::Cell->EDGE_LABEL_CELL;
1360 3         12 return $cell->as_ascii();
1361             }
1362              
1363             # invisible nodes, or very small ones
1364 1092 100 100     10001 return '' if $shape eq 'invisible' || $self->{w} == 0 || $self->{h} == 0;
      66        
1365              
1366 1086         5143 my $fb = $self->_framebuffer($self->{w}, $self->{h});
1367              
1368             # point-shaped nodes do not have a border
1369 1086 100       3541 if ($shape ne 'point')
1370             {
1371             #########################################################################
1372             # draw our border into the framebuffer
1373              
1374 1079         2188 my $cache = $self->{cache};
1375 1079   100     11301 my $b_top = $cache->{top_border} || 'none';
1376 1079   100     3248 my $b_left = $cache->{left_border} || 'none';
1377 1079   100     3864 my $b_right = $cache->{right_border} || 'none';
1378 1079   100     2917 my $b_bottom = $cache->{bottom_border} || 'none';
1379              
1380 1079         3511 $self->_draw_border($fb, $b_right, $b_bottom, $b_left, $b_top);
1381             }
1382              
1383             ###########################################################################
1384             # "draw" the label into the framebuffer (e.g. the node/edge and the text)
1385              
1386 1086         3822 $self->_draw_label($fb, $x, $y, $shape);
1387            
1388 1086         11821 join ("\n", @$fb);
1389             }
1390              
1391             1;
1392             __END__