File Coverage

lib/Graph/Easy/Layout/Grid.pm
Criterion Covered Total %
statement 125 125 100.0
branch 37 42 88.1
condition 40 43 93.0
subroutine 6 6 100.0
pod n/a
total 208 216 96.3


line stmt bran cond sub pod time code
1             #############################################################################
2             # Grid-management and layout preparation.
3             #
4             # (c) by Tels 2004-2006.
5             #############################################################################
6              
7             package Graph::Easy::Layout::Grid;
8              
9             $VERSION = '0.76';
10              
11             #############################################################################
12             #############################################################################
13              
14             package Graph::Easy;
15              
16 11     11   38 use strict;
  11         12  
  11         324  
17 11     11   34 use warnings;
  11         10  
  11         297  
18              
19 11     11   34 use Graph::Easy::Util qw(ord_values);
  11         11  
  11         2460  
20              
21             sub _balance_sizes
22             {
23             # Given a list of column/row sizes and a minimum size that their sum must
24             # be, will grow individual sizes until the constraint (sum) is met.
25 337     337   2698 my ($self, $sizes, $need) = @_;
26              
27             # XXX TODO: we can abort the loop and distribute the remaining nec. size
28             # once all elements in $sizes are equal.
29              
30 337 100       483 return if $need < 1;
31              
32             # if there is only one element, return it immediately
33 283 100       412 if (@$sizes == 1)
34             {
35 155 100       239 $sizes->[0] = $need if $sizes->[0] < $need;
36 155         146 return;
37             }
38              
39             # endless loop until constraint is met
40 128         106 while (1)
41             {
42              
43             # find the smallest size, and also compute their sum
44 221         148 my $sum = 0; my $i = 0;
  221         163  
45 221         167 my $sm = $need + 1; # start with an arbitrary size
46 221         180 my $sm_i = 0; # if none is != 0, then use the first
47 221         225 for my $s (@$sizes)
48             {
49 722         442 $sum += $s;
50 722 100       827 next if $s == 0;
51 541 100       611 if ($s < $sm)
52             {
53 226         139 $sm = $s; $sm_i = $i;
  226         145  
54             }
55 541         393 $i++;
56             }
57              
58             # their sum is already equal or bigger than what we need?
59 221 100       341 last if $sum >= $need;
60              
61             # increase the smallest size by one, then try again
62 93         65 $sizes->[$sm_i]++;
63             }
64              
65             # use Data::Dumper; print STDERR "# " . Dumper($sizes),"\n";
66              
67 128         129 undef;
68             }
69              
70             sub _prepare_layout
71             {
72             # this method is used by as_ascii() and as_svg() to find out the
73             # sizes and placement of the different cells (edges, nodes etc).
74 251     251   303 my ($self,$format) = @_;
75              
76             # Find out for each row and column how big they are:
77             # +--------+-----+------+
78             # | Berlin | --> | Bonn |
79             # +--------+-----+------+
80             # results in:
81             # w, h, x, y
82             # 0,0 => 10, 3, 0, 0
83             # 1,0 => 7, 3, 10, 0
84             # 2,0 => 8, 3, 16, 0
85              
86             # Technically, we also need to "compress" away non-existent columns/rows.
87             # We achieve that by simply rendering them with size 0, so they become
88             # practically invisible.
89              
90 251         326 my $cells = $self->{cells};
91 251         273 my $rows = {};
92 251         257 my $cols = {};
93              
94             # the last column/row (highest X,Y pair)
95 251         252 my $mx = -1000000; my $my = -1000000;
  251         208  
96              
97             # We need to do this twice, once for single-cell objects, and again for
98             # objects covering multiple cells. The single-cell objects can be solved
99             # first:
100              
101             # find all x and y occurrences to sort them by row/columns
102 251         417 for my $cell (ord_values $cells)
103             {
104 4127         5136 my ($x,$y) = ($cell->{x}, $cell->{y});
105              
106             {
107 11     11   42 no strict 'refs';
  11         12  
  11         6818  
  4127         2819  
108              
109 4127         4334 my $method = '_correct_size_' . $format;
110 4127 50       10999 $method = '_correct_size' unless $cell->can($method);
111 4127         8035 $cell->$method();
112             }
113              
114 4127   100     7116 my $w = $cell->{w} || 0;
115 4127   100     6024 my $h = $cell->{h} || 0;
116              
117             # Set the minimum cell size only for single-celled objects:
118 4127 100 100     15773 if ( (($cell->{cx}||1) + ($cell->{cy}||1)) == 2)
      100        
119             {
120             # record maximum size for that col/row
121 3962 100 100     10299 $rows->{$y} = $h if $h >= ($rows->{$y} || 0);
122 3962 100 100     9884 $cols->{$x} = $w if $w >= ($cols->{$x} || 0);
123             }
124              
125             # Find highest X,Y pair. Always use x,y, and not x+cx,y+cy, because
126             # a multi-celled object "sticking" out will not count unless there
127             # is another object in the same row/column.
128 4127 100       5189 $mx = $x if $x > $mx;
129 4127 100       6232 $my = $y if $y > $my;
130             }
131              
132             # insert a dummy row/column with size=0 as last
133 251         989 $rows->{$my+1} = 0;
134 251         388 $cols->{$mx+1} = 0;
135              
136             # do the last step again, but for multi-celled objects
137 251         588 for my $cell (ord_values $cells)
138             {
139 4127         3913 my ($x,$y) = ($cell->{x}, $cell->{y});
140              
141 4127   100     5810 my $w = $cell->{w} || 0;
142 4127   100     5719 my $h = $cell->{h} || 0;
143              
144             # Set the minimum cell size only for multi-celled objects:
145 4127 100 100     13976 if ( (($cell->{cx} || 1) + ($cell->{cy}||1)) > 2)
      100        
146             {
147 165   100     339 $cell->{cx} ||= 1;
148 165   100     357 $cell->{cy} ||= 1;
149              
150             # do this twice, for X and Y:
151              
152             # print STDERR "\n# ", $cell->{name} || $cell->{id}, " cx=$cell->{cx} cy=$cell->{cy} $cell->{w},$cell->{h}:\n";
153              
154             # create an array with the current sizes for the affacted rows/columns
155 165         125 my @sizes;
156              
157             # print STDERR "# $cell->{cx} $cell->{cy} at cx:\n";
158              
159             # XXX TODO: no need to do this for empty/zero cols
160 165         349 for (my $i = 0; $i < $cell->{cx}; $i++)
161             {
162 458   100     1198 push @sizes, $cols->{$i+$x} || 0;
163             }
164 165         385 $self->_balance_sizes(\@sizes, $cell->{w});
165             # store the result back
166 165         321 for (my $i = 0; $i < $cell->{cx}; $i++)
167             {
168             # print STDERR "# store back $sizes[$i] to col ", $i+$x,"\n";
169 458         711 $cols->{$i+$x} = $sizes[$i];
170             }
171              
172 165         184 @sizes = ();
173              
174             # print STDERR "# $cell->{cx} $cell->{cy} at cy:\n";
175              
176             # XXX TODO: no need to do this for empty/zero cols
177 165         285 for (my $i = 0; $i < $cell->{cy}; $i++)
178             {
179 473   100     1086 push @sizes, $rows->{$i+$y} || 0;
180             }
181 165         232 $self->_balance_sizes(\@sizes, $cell->{h});
182             # store the result back
183 165         301 for (my $i = 0; $i < $cell->{cy}; $i++)
184             {
185             # print STDERR "# store back $sizes[$i] to row ", $i+$y,"\n";
186 473         816 $rows->{$i+$y} = $sizes[$i];
187             }
188             }
189             }
190              
191 251 50       834 print STDERR "# Calculating absolute positions for rows/columns\n" if $self->{debug};
192              
193             # Now run through all rows/columns and get their absolute pos by taking all
194             # previous ones into account.
195 251         268 my $pos = 0;
196 251         1057 for my $y (sort { $a <=> $b } keys %$rows)
  2843         2297  
197             {
198 1443         998 my $s = $rows->{$y};
199 1443         963 $rows->{$y} = $pos; # first is 0, second is $rows[1] etc
200 1443         1442 $pos += $s;
201             }
202 251         298 $pos = 0;
203 251         615 for my $x (sort { $a <=> $b } keys %$cols)
  2994         2182  
204             {
205 1526         1036 my $s = $cols->{$x};
206 1526         1039 $cols->{$x} = $pos;
207 1526         1098 $pos += $s;
208             }
209              
210             # find out max. dimensions for framebuffer
211 251 50       489 print STDERR "# Finding max. dimensions for framebuffer\n" if $self->{debug};
212 251         228 my $max_y = 0; my $max_x = 0;
  251         203  
213              
214 251         501 for my $v (ord_values $cells)
215             {
216             # Skip multi-celled nodes for later.
217 4127 100 100     13855 next if ($v->{cx}||1) + ($v->{cy}||1) != 2;
      100        
218              
219             # X and Y are col/row, so translate them to real pos
220 3962         3238 my $x = $cols->{ $v->{x} };
221 3962         2968 my $y = $rows->{ $v->{y} };
222              
223             # Also set correct the width/height of each cell to be the maximum
224             # width/height of that row/column and store the previous size in 'minw'
225             # and 'minh', respectively.
226              
227 3962         3377 $v->{minw} = $v->{w};
228 3962         3203 $v->{minh} = $v->{h};
229              
230             # find next col/row
231 3962         2666 my $nx = $v->{x} + 1;
232 3962         2755 my $next_col = $cols->{ $nx };
233 3962         2624 my $ny = $v->{y} + 1;
234 3962         2638 my $next_row = $rows->{ $ny };
235              
236 3962         4722 $next_col = $cols->{ ++$nx } while (!defined $next_col);
237 3962         4659 $next_row = $rows->{ ++$ny } while (!defined $next_row);
238              
239 3962         2978 $v->{w} = $next_col - $x;
240 3962         2687 $v->{h} = $next_row - $y;
241              
242 3962         2855 my $m = $y + $v->{h} - 1;
243 3962 100       4398 $max_y = $m if $m > $max_y;
244 3962         2691 $m = $x + $v->{w} - 1;
245 3962 100       5084 $max_x = $m if $m > $max_x;
246             }
247              
248             # repeat the previous step, now for multi-celled objects
249 251         851 foreach my $v (ord_values ( $self->{cells} ))
250             {
251 4127 100 100     19402 next unless defined $v->{x} && (($v->{cx}||1) + ($v->{cy}||1) > 2);
      100        
      66        
252              
253             # X and Y are col/row, so translate them to real pos
254 165         208 my $x = $cols->{ $v->{x} };
255 165         171 my $y = $rows->{ $v->{y} };
256              
257 165         190 $v->{minw} = $v->{w};
258 165         292 $v->{minh} = $v->{h};
259              
260             # find next col/row
261 165   50     344 my $nx = $v->{x} + ($v->{cx} || 1);
262 165         202 my $next_col = $cols->{ $nx };
263 165   50     300 my $ny = $v->{y} + ($v->{cy} || 1);
264 165         151 my $next_row = $rows->{ $ny };
265              
266 165         275 $next_col = $cols->{ ++$nx } while (!defined $next_col);
267 165         248 $next_row = $rows->{ ++$ny } while (!defined $next_row);
268              
269 165         183 $v->{w} = $next_col - $x;
270 165         167 $v->{h} = $next_row - $y;
271              
272 165         149 my $m = $y + $v->{h} - 1;
273 165 50       240 $max_y = $m if $m > $max_y;
274 165         133 $m = $x + $v->{w} - 1;
275 165 50       241 $max_x = $m if $m > $max_x;
276             }
277              
278             # return what we found out:
279 251         1036 ($rows,$cols,$max_x,$max_y);
280             }
281              
282             1;
283             __END__