line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
############################################################################# |
2
|
|
|
|
|
|
|
# A cell of a group during layout. Part of Graph::Easy. |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
############################################################################# |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package Graph::Easy::Group::Cell; |
7
|
|
|
|
|
|
|
|
8
|
48
|
|
|
48
|
|
784
|
use Graph::Easy::Node; |
|
48
|
|
|
|
|
53
|
|
|
48
|
|
|
|
|
1947
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
@ISA = qw/Graph::Easy::Node/; |
11
|
|
|
|
|
|
|
$VERSION = '0.76'; |
12
|
|
|
|
|
|
|
|
13
|
48
|
|
|
48
|
|
167
|
use strict; |
|
48
|
|
|
|
|
47
|
|
|
48
|
|
|
|
|
863
|
|
14
|
48
|
|
|
48
|
|
135
|
use warnings; |
|
48
|
|
|
|
|
56
|
|
|
48
|
|
|
|
|
1497
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
BEGIN |
17
|
|
|
|
|
|
|
{ |
18
|
48
|
|
|
48
|
|
1464
|
*get_attribute = \&attribute; |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
############################################################################# |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# The different types for a group-cell: |
24
|
|
|
|
|
|
|
use constant { |
25
|
48
|
|
|
|
|
31987
|
GROUP_INNER => 0, # completely sourounded by group cells |
26
|
|
|
|
|
|
|
GROUP_RIGHT => 1, # right border only |
27
|
|
|
|
|
|
|
GROUP_LEFT => 2, # left border only |
28
|
|
|
|
|
|
|
GROUP_TOP => 3, # top border only |
29
|
|
|
|
|
|
|
GROUP_BOTTOM => 4, # bottom border only |
30
|
|
|
|
|
|
|
GROUP_ALL => 5, # completely sourounded by non-group cells |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
GROUP_BOTTOM_RIGHT => 6, # bottom and right border |
33
|
|
|
|
|
|
|
GROUP_BOTTOM_LEFT => 7, # bottom and left border |
34
|
|
|
|
|
|
|
GROUP_TOP_RIGHT => 8, # top and right border |
35
|
|
|
|
|
|
|
GROUP_TOP_LEFT => 9, # top and left order |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
GROUP_MAX => 5, # max number |
38
|
48
|
|
|
48
|
|
156
|
}; |
|
48
|
|
|
|
|
49
|
|
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
my $border_styles = |
41
|
|
|
|
|
|
|
{ |
42
|
|
|
|
|
|
|
# type top, bottom, left, right, class |
43
|
|
|
|
|
|
|
GROUP_INNER() => [ 0, 0, 0, 0, ['gi'] ], |
44
|
|
|
|
|
|
|
GROUP_RIGHT() => [ 0, 0, 0, 1, ['gr'] ], |
45
|
|
|
|
|
|
|
GROUP_LEFT() => [ 0, 0, 1, 0, ['gl'] ], |
46
|
|
|
|
|
|
|
GROUP_TOP() => [ 1, 0, 0, 0, ['gt'] ], |
47
|
|
|
|
|
|
|
GROUP_BOTTOM() => [ 0, 1, 0, 0, ['gb'] ], |
48
|
|
|
|
|
|
|
GROUP_ALL() => [ 0, 0, 0, 0, ['ga'] ], |
49
|
|
|
|
|
|
|
GROUP_BOTTOM_RIGHT() => [ 0, 1, 0, 1, ['gb','gr'] ], |
50
|
|
|
|
|
|
|
GROUP_BOTTOM_LEFT() => [ 0, 1, 1, 0, ['gb','gl'] ], |
51
|
|
|
|
|
|
|
GROUP_TOP_RIGHT() => [ 1, 0, 0, 1, ['gt','gr'] ], |
52
|
|
|
|
|
|
|
GROUP_TOP_LEFT() => [ 1, 0, 1, 0, ['gt','gl'] ], |
53
|
|
|
|
|
|
|
}; |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
my $border_name = [ 'top', 'bottom', 'left', 'right' ]; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub _css |
58
|
|
|
|
|
|
|
{ |
59
|
4
|
|
|
4
|
|
6
|
my ($c, $id, $group, $border) = @_; |
60
|
|
|
|
|
|
|
|
61
|
4
|
|
|
|
|
6
|
my $css = ''; |
62
|
|
|
|
|
|
|
|
63
|
4
|
|
|
|
|
8
|
for my $type (0 .. 5) |
64
|
|
|
|
|
|
|
{ |
65
|
24
|
|
|
|
|
26
|
my $b = $border_styles->{$type}; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# If border eq 'none', this would needlessly repeat the "border: none" |
68
|
|
|
|
|
|
|
# from the general group class. |
69
|
24
|
50
|
|
|
|
30
|
next if $border eq 'none'; |
70
|
|
|
|
|
|
|
|
71
|
24
|
|
|
|
|
27
|
my $cl = '.' . $b->[4]->[0]; # $cl .= "-$group" unless $group eq ''; |
72
|
|
|
|
|
|
|
|
73
|
24
|
|
|
|
|
28
|
$css .= "table.graph$id $cl {"; |
74
|
24
|
100
|
|
|
|
36
|
if ($type == GROUP_INNER) |
|
|
100
|
|
|
|
|
|
75
|
|
|
|
|
|
|
{ |
76
|
4
|
|
|
|
|
6
|
$css .= " border: none;"; # shorter CSS |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
elsif ($type == GROUP_ALL) |
79
|
|
|
|
|
|
|
{ |
80
|
4
|
|
|
|
|
6
|
$css .= " border-style: $border;"; # shorter CSS |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
else |
83
|
|
|
|
|
|
|
{ |
84
|
16
|
|
|
|
|
25
|
for (my $i = 0; $i < 4; $i++) |
85
|
|
|
|
|
|
|
{ |
86
|
64
|
100
|
|
|
|
120
|
$css .= ' border-' . $border_name->[$i] . "-style: $border;" if $b->[$i]; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
} |
89
|
24
|
|
|
|
|
18
|
$css .= "}\n"; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
4
|
|
|
|
|
20
|
$css; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
############################################################################# |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub _init |
98
|
|
|
|
|
|
|
{ |
99
|
|
|
|
|
|
|
# generic init, override in subclasses |
100
|
944
|
|
|
944
|
|
739
|
my ($self,$args) = @_; |
101
|
|
|
|
|
|
|
|
102
|
944
|
|
|
|
|
872
|
$self->{class} = 'group'; |
103
|
944
|
|
|
|
|
744
|
$self->{cell_class} = ' gi'; |
104
|
944
|
|
|
|
|
776
|
$self->{name} = ''; |
105
|
|
|
|
|
|
|
|
106
|
944
|
|
|
|
|
673
|
$self->{'x'} = 0; |
107
|
944
|
|
|
|
|
659
|
$self->{'y'} = 0; |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
# XXX TODO check arguments |
110
|
944
|
|
|
|
|
2215
|
foreach my $k (sort keys %$args) |
111
|
|
|
|
|
|
|
{ |
112
|
3772
|
|
|
|
|
4232
|
$self->{$k} = $args->{$k}; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
944
|
50
|
|
|
|
1394
|
if (defined $self->{group}) |
116
|
|
|
|
|
|
|
{ |
117
|
|
|
|
|
|
|
# register ourselves at this group |
118
|
944
|
|
|
|
|
1507
|
$self->{group}->_add_cell ($self); |
119
|
|
|
|
|
|
|
# XXX CHECK also implement sub_class() |
120
|
944
|
|
|
|
|
843
|
$self->{class} = $self->{group}->{class}; |
121
|
944
|
50
|
|
|
|
1227
|
$self->{class} = 'group' unless defined $self->{class}; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
944
|
|
|
|
|
3048
|
$self; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub _set_type |
128
|
|
|
|
|
|
|
{ |
129
|
|
|
|
|
|
|
# set the proper type of this cell based on the sourrounding cells |
130
|
942
|
|
|
942
|
|
1266
|
my ($self, $cells) = @_; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
# +------+--------+-------+ |
133
|
|
|
|
|
|
|
# | LT TOP RU | |
134
|
|
|
|
|
|
|
# + + + + |
135
|
|
|
|
|
|
|
# | LEFT INNER Right | |
136
|
|
|
|
|
|
|
# + + + + |
137
|
|
|
|
|
|
|
# | LB BOTTOM RB | |
138
|
|
|
|
|
|
|
# +------+--------+-------+ |
139
|
|
|
|
|
|
|
|
140
|
942
|
|
|
|
|
2067
|
my @coord = ( |
141
|
|
|
|
|
|
|
[ 0, -1, ' gt' ], |
142
|
|
|
|
|
|
|
[ +1, 0, ' gr' ], |
143
|
|
|
|
|
|
|
[ 0, +1, ' gb' ], |
144
|
|
|
|
|
|
|
[ -1, 0, ' gl' ], |
145
|
|
|
|
|
|
|
); |
146
|
|
|
|
|
|
|
|
147
|
942
|
|
|
|
|
986
|
my ($sx,$sy) = ($self->{x},$self->{y}); |
148
|
|
|
|
|
|
|
|
149
|
942
|
|
|
|
|
604
|
my $class = ''; |
150
|
942
|
|
|
|
|
578
|
my $gr = $self->{group}; |
151
|
942
|
|
|
|
|
774
|
foreach my $co (@coord) |
152
|
|
|
|
|
|
|
{ |
153
|
3768
|
|
|
|
|
3545
|
my ($x,$y,$c) = @$co; $x += $sx; $y += $sy; |
|
3768
|
|
|
|
|
2429
|
|
|
3768
|
|
|
|
|
2130
|
|
154
|
3768
|
|
|
|
|
3552
|
my $cell = $cells->{"$x,$y"}; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# belongs to the same group? |
157
|
3768
|
100
|
|
|
|
2138
|
my $go = 0; $go = $cell->group() if UNIVERSAL::can($cell, 'group'); |
|
3768
|
|
|
|
|
7924
|
|
158
|
|
|
|
|
|
|
|
159
|
3768
|
100
|
100
|
|
|
10753
|
$class .= $c unless defined $go && $gr == $go; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
942
|
100
|
|
|
|
1160
|
$class = ' ga' if $class eq ' gt gr gb gl'; |
163
|
|
|
|
|
|
|
|
164
|
942
|
|
|
|
|
875
|
$self->{cell_class} = $class; |
165
|
|
|
|
|
|
|
|
166
|
942
|
|
|
|
|
1643
|
$self; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub _set_label |
170
|
|
|
|
|
|
|
{ |
171
|
37
|
|
|
37
|
|
46
|
my $self = shift; |
172
|
|
|
|
|
|
|
|
173
|
37
|
|
|
|
|
61
|
$self->{has_label} = 1; |
174
|
|
|
|
|
|
|
|
175
|
37
|
|
|
|
|
117
|
$self->{name} = $self->{group}->label(); |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
sub shape |
179
|
|
|
|
|
|
|
{ |
180
|
0
|
|
|
0
|
1
|
0
|
'rect'; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
sub attribute |
184
|
|
|
|
|
|
|
{ |
185
|
3533
|
|
|
3533
|
1
|
2624
|
my ($self, $name) = @_; |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# print STDERR "called attribute($name)\n"; |
188
|
|
|
|
|
|
|
# return $self->{group}->attribute($name); |
189
|
|
|
|
|
|
|
|
190
|
3533
|
|
|
|
|
2622
|
my $group = $self->{group}; |
191
|
|
|
|
|
|
|
|
192
|
3533
|
100
|
|
|
|
4776
|
return $group->{att}->{$name} if exists $group->{att}->{$name}; |
193
|
|
|
|
|
|
|
|
194
|
3190
|
50
|
|
|
|
3842
|
$group->{cache} = {} unless exists $group->{cache}; |
195
|
3190
|
100
|
|
|
|
3744
|
$group->{cache}->{att} = {} unless exists $group->{cache}->{att}; |
196
|
|
|
|
|
|
|
|
197
|
3190
|
|
|
|
|
2279
|
my $cache = $group->{cache}->{att}; |
198
|
3190
|
100
|
|
|
|
7022
|
return $cache->{$name} if exists $cache->{$name}; |
199
|
|
|
|
|
|
|
|
200
|
176
|
|
|
|
|
306
|
$cache->{$name} = $group->attribute($name); |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
48
|
|
|
48
|
|
228
|
use constant isa_cell => 1; |
|
48
|
|
|
|
|
48
|
|
|
48
|
|
|
|
|
21319
|
|
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
############################################################################# |
206
|
|
|
|
|
|
|
# conversion to ASCII or HTML |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub as_ascii |
209
|
|
|
|
|
|
|
{ |
210
|
833
|
|
|
833
|
1
|
734
|
my ($self, $x,$y) = @_; |
211
|
|
|
|
|
|
|
|
212
|
833
|
|
|
|
|
1427
|
my $fb = $self->_framebuffer($self->{w}, $self->{h}); |
213
|
|
|
|
|
|
|
|
214
|
833
|
|
|
|
|
1153
|
my $border_style = $self->attribute('borderstyle'); |
215
|
833
|
|
|
|
|
610
|
my $EM = 14; |
216
|
|
|
|
|
|
|
# use $self here and not $self->{group} to engage attribute cache: |
217
|
833
|
|
|
|
|
1294
|
my $border_width = Graph::Easy::_border_width_in_pixels($self,$EM); |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
# convert overly broad borders to the correct style |
220
|
833
|
50
|
|
|
|
1399
|
$border_style = 'bold' if $border_width > 2; |
221
|
833
|
50
|
33
|
|
|
1456
|
$border_style = 'broad' if $border_width > $EM * 0.2 && $border_width < $EM * 0.75; |
222
|
833
|
50
|
|
|
|
1093
|
$border_style = 'wide' if $border_width >= $EM * 0.75; |
223
|
|
|
|
|
|
|
|
224
|
833
|
100
|
|
|
|
1076
|
if ($border_style ne 'none') |
225
|
|
|
|
|
|
|
{ |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
######################################################################### |
228
|
|
|
|
|
|
|
# draw our border into the framebuffer |
229
|
|
|
|
|
|
|
|
230
|
769
|
|
|
|
|
647
|
my $c = $self->{cell_class}; |
231
|
|
|
|
|
|
|
|
232
|
769
|
|
|
|
|
561
|
my $b_top = $border_style; |
233
|
769
|
|
|
|
|
598
|
my $b_left = $border_style; |
234
|
769
|
|
|
|
|
514
|
my $b_right = $border_style; |
235
|
769
|
|
|
|
|
579
|
my $b_bottom = $border_style; |
236
|
769
|
50
|
|
|
|
1193
|
if ($c !~ 'ga') |
237
|
|
|
|
|
|
|
{ |
238
|
769
|
100
|
|
|
|
1125
|
$b_top = 'none' unless $c =~ /gt/; |
239
|
769
|
100
|
|
|
|
980
|
$b_left = 'none' unless $c =~ /gl/; |
240
|
769
|
100
|
|
|
|
1053
|
$b_right = 'none' unless $c =~ /gr/; |
241
|
769
|
100
|
|
|
|
1063
|
$b_bottom = 'none' unless $c =~ /gb/; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
769
|
|
|
|
|
1332
|
$self->_draw_border($fb, $b_right, $b_bottom, $b_left, $b_top, $x, $y); |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
833
|
100
|
|
|
|
1157
|
if ($self->{has_label}) |
248
|
|
|
|
|
|
|
{ |
249
|
|
|
|
|
|
|
# include our label |
250
|
|
|
|
|
|
|
|
251
|
33
|
|
|
|
|
53
|
my $align = $self->attribute('align'); |
252
|
|
|
|
|
|
|
# the default label cell as a top border, but no left/right border |
253
|
33
|
|
|
|
|
38
|
my $ys = 0.5; |
254
|
33
|
100
|
|
|
|
62
|
$ys = 0 if $border_style eq 'none'; |
255
|
33
|
100
|
|
|
|
43
|
my $h = $self->{h} - 1; $h ++ if $border_style eq 'none'; |
|
33
|
|
|
|
|
51
|
|
256
|
|
|
|
|
|
|
|
257
|
33
|
|
|
|
|
86
|
$self->_printfb_aligned ($fb, 0, $ys, $self->{w}, $h, |
258
|
|
|
|
|
|
|
$self->_aligned_label($align), 'middle'); |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
833
|
|
|
|
|
2735
|
join ("\n", @$fb); |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
sub class |
265
|
|
|
|
|
|
|
{ |
266
|
2
|
|
|
2
|
1
|
4
|
my $self = shift; |
267
|
|
|
|
|
|
|
|
268
|
2
|
|
|
|
|
6
|
$self->{class} . $self->{cell_class}; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
############################################################################# |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
# for rendering this cell as ASCII/Boxart, we need to correct our width based |
274
|
|
|
|
|
|
|
# on whether we have a border or not. But this is only known after parsing is |
275
|
|
|
|
|
|
|
# complete. |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
sub _correct_size |
278
|
|
|
|
|
|
|
{ |
279
|
833
|
|
|
833
|
|
657
|
my ($self,$format) = @_; |
280
|
|
|
|
|
|
|
|
281
|
833
|
50
|
|
|
|
1111
|
if (!defined $self->{w}) |
282
|
|
|
|
|
|
|
{ |
283
|
833
|
|
|
|
|
907
|
my $border = $self->attribute('borderstyle'); |
284
|
833
|
|
|
|
|
754
|
$self->{w} = 0; |
285
|
833
|
|
|
|
|
616
|
$self->{h} = 0; |
286
|
|
|
|
|
|
|
# label needs space |
287
|
833
|
100
|
|
|
|
1117
|
$self->{h} = 1 if $self->{has_label}; |
288
|
833
|
100
|
|
|
|
998
|
if ($border ne 'none') |
289
|
|
|
|
|
|
|
{ |
290
|
|
|
|
|
|
|
# class "gt", "gb", "gr" or "gr" will be compressed away |
291
|
|
|
|
|
|
|
# (e.g. only edge cells will be existent) |
292
|
769
|
100
|
100
|
|
|
3208
|
if ($self->{has_label} || ($self->{cell_class} =~ /g[rltb] /)) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
293
|
|
|
|
|
|
|
{ |
294
|
170
|
|
|
|
|
162
|
$self->{w} = 2; |
295
|
170
|
|
|
|
|
147
|
$self->{h} = 2; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
elsif ($self->{cell_class} =~ /^ g[rl]\z/) |
298
|
|
|
|
|
|
|
{ |
299
|
228
|
|
|
|
|
210
|
$self->{w} = 2; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
elsif ($self->{cell_class} =~ /^ g[bt]\z/) |
302
|
|
|
|
|
|
|
{ |
303
|
246
|
|
|
|
|
249
|
$self->{h} = 2; |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
} |
307
|
833
|
100
|
|
|
|
1549
|
if ($self->{has_label}) |
308
|
|
|
|
|
|
|
{ |
309
|
33
|
|
|
|
|
91
|
my ($w,$h) = $self->dimensions(); |
310
|
33
|
|
|
|
|
48
|
$self->{h} += $h; |
311
|
33
|
|
|
|
|
67
|
$self->{w} += $w; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
1; |
316
|
|
|
|
|
|
|
__END__ |