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__ |