File Coverage

lib/Graph/Easy/Group/Cell.pm
Criterion Covered Total %
statement 116 117 99.1
branch 55 64 85.9
condition 7 9 77.7
subroutine 14 15 93.3
pod 4 4 100.0
total 196 209 93.7


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__