File Coverage

blib/lib/Tickit/Widget/GridBox.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2013-2015 -- leonerd@leonerd.org.uk
5              
6             package Tickit::Widget::GridBox;
7              
8 1     1   848 use strict;
  1         1  
  1         22  
9 1     1   3 use warnings;
  1         1  
  1         19  
10 1     1   3 use base qw( Tickit::ContainerWidget );
  1         1  
  1         81  
11             use Tickit::Style;
12              
13             our $VERSION = '0.27';
14              
15             use Carp;
16              
17             use Tickit::Utils 0.29 qw( distribute );
18              
19             use List::Util qw( sum max );
20              
21             =head1 NAME
22              
23             C - lay out a set of child widgets in a grid
24              
25             =head1 SYNOPSIS
26              
27             use Tickit;
28             use Tickit::Widget::GridBox;
29             use Tickit::Widget::Static;
30              
31             my $gridbox = Tickit::Widget::GridBox->new(
32             style => {
33             col_spacing => 2,
34             row_spacing => 1,
35             },
36             children => [
37             [ Tickit::Widget::Static->new( text => "top left" ),
38             Tickit::Widget::Static->new( text => "top right" ) ],
39             [ Tickit::Widget::Static->new( text => "bottom left" ),
40             Tickit::Widget::Static->new( text => "bottom right" ) ],
41             ],
42             );
43              
44             Tickit->new( root => $gridbox )->run;
45              
46             =head1 DESCRIPTION
47              
48             This container widget holds a set of child widgets distributed in a regular
49             grid shape across rows and columns.
50              
51             =head1 STYLE
52              
53             The default style pen is used as the widget pen.
54              
55             The following style keys are used:
56              
57             =over 4
58              
59             =item col_spacing => INT
60              
61             The number of columns of spacing between columns
62              
63             =item row_spacing => INT
64              
65             The number of rows of spacing between rows
66              
67             =back
68              
69             =cut
70              
71             style_definition base =>
72             row_spacing => 0,
73             col_spacing => 0;
74              
75             style_reshape_keys qw( row_spacing col_spacing );
76              
77             use constant WIDGET_PEN_FROM_STYLE => 1;
78              
79             =head1 CONSTRUCTOR
80              
81             =head2 $gridbox = Tickit::Widget::GridBox->new( %args )
82              
83             Constructs a new C object.
84              
85             Takes the following named arguments:
86              
87             =over 8
88              
89             =item children => ARRAY[ARRAY[Tickit::Widget]]
90              
91             Optional. If present, should be a 2D ARRAYref of ARRAYrefs containing the
92             C children to display in the grid. They are all added with no
93             additional options.
94              
95             =back
96              
97             =cut
98              
99             sub new
100             {
101             my $class = shift;
102             my %args = @_;
103              
104             exists $args{$_} and $args{style}{$_} = delete $args{$_} for qw( row_spacing col_spacing );
105              
106             my $self = $class->SUPER::new( %args );
107              
108             $self->{grid} = [];
109             $self->{max_col} = -1;
110              
111             if( my $children = $args{children} ) {
112             foreach my $row ( 0 .. $#$children ) {
113             foreach my $col ( 0 .. $#{ $children->[$row] } ) {
114             $self->add( $row, $col, $children->[$row][$col] );
115             }
116             }
117             }
118              
119             return $self;
120             }
121              
122             sub lines
123             {
124             my $self = shift;
125             my $row_spacing = $self->get_style_values( "row_spacing" );
126             my $max_row = $#{$self->{grid}};
127             my $max_col = $self->{max_col};
128             return ( sum( map {
129             my $r = $_;
130             max map {
131             my $c = $_;
132             my $child = $self->{grid}[$r][$c];
133             $child ? $child->requested_lines : 0;
134             } 0 .. $max_col
135             } 0 .. $max_row ) ) +
136             $row_spacing * ( $max_row - 1 );
137             }
138              
139             sub cols
140             {
141             my $self = shift;
142             my $col_spacing = $self->get_style_values( "col_spacing" );
143             my $max_row = $#{$self->{grid}};
144             my $max_col = $self->{max_col};
145             return ( sum( map {
146             my $c = $_;
147             max map {
148             my $r = $_;
149             my $child = $self->{grid}[$r][$c];
150             $child ? $child->requested_cols : 0;
151             } 0 .. $max_row
152             } 0 .. $max_col ) ) +
153             $col_spacing * ( $max_col - 1 );
154             }
155              
156             sub children
157             {
158             my $self = shift;
159             my $grid = $self->{grid};
160             map {
161             my $r = $_;
162             map {
163             $grid->[$r][$_] ? ( $grid->[$r][$_] ) : ()
164             } 0 .. $self->{max_col}
165             } 0.. $#$grid;
166             }
167              
168             =head1 METHODS
169              
170             =cut
171              
172             =head2 $count = $gridbox->rowcount
173              
174             =head2 $count = $gridbox->colcount
175              
176             Returns the number of rows or columns in the grid.
177              
178             =cut
179              
180             sub rowcount
181             {
182             my $self = shift;
183             return scalar @{ $self->{grid} }
184             }
185              
186             sub colcount
187             {
188             my $self = shift;
189             return $self->{max_col} + 1;
190             }
191              
192             =head2 $gridbox->add( $row, $col, $child, %opts )
193              
194             Sets the child widget to display in the given grid cell. Cells do not need to
195             be explicitly constructed; the grid will automatically expand to the size
196             required. This method can also be used to replace an existing child at the
197             given cell location. To remove a cell entirely, use the C method.
198              
199             The following options are recognised:
200              
201             =over 8
202              
203             =item col_expand => INT
204              
205             =item row_expand => INT
206              
207             Values for the C setting for this column or row of the table. The
208             largest C setting for any cell in a given column or row sets the value
209             used to distribute space to that column or row.
210              
211             =back
212              
213             =cut
214              
215             sub add
216             {
217             my $self = shift;
218             my ( $row, $col, $child, %opts ) = @_;
219              
220             if( my $old_child = $self->{grid}[$row][$col] ) {
221             $self->SUPER::remove( $old_child );
222             }
223              
224             $self->{max_col} = $col if $col > $self->{max_col};
225              
226             $self->{grid}[$row][$col] = $child;
227             $self->SUPER::add( $child,
228             col_expand => $opts{col_expand} || 0,
229             row_expand => $opts{row_expand} || 0,
230             );
231             }
232              
233             =head2 $gridbox->remove( $row, $col )
234              
235             Removes the child widget on display in the given cell. May shrink the grid if
236             this was the last child widget in the given row or column.
237              
238             =cut
239              
240             sub remove
241             {
242             my $self = shift;
243             my ( $row, $col ) = @_;
244              
245             my $grid = $self->{grid};
246              
247             my $child = $grid->[$row][$col];
248             undef $grid->[$row][$col];
249              
250             # Tidy up the row
251             my $max_col = 0;
252             foreach my $col ( reverse 0 .. $#{ $grid->[$row] } ) {
253             next if !defined $grid->[$row][$col];
254              
255             $max_col = $col+1;
256             last;
257             }
258              
259             splice @{ $grid->[$row] }, $max_col;
260              
261             # Tidy up the grid
262             my $max_row = 0;
263             foreach my $row ( reverse 0 .. $#$grid ) {
264             next if !defined $grid->[$row] or !@{ $grid->[$row] };
265              
266             $max_row = $row+1;
267             last;
268             }
269              
270             splice @$grid, $max_row;
271              
272             $self->{max_col} = max map { $_ ? $#$_ : 0 } @$grid;
273              
274             my $childrect = $child->window ? $child->window->rect : undef;
275              
276             $self->SUPER::remove( $child );
277              
278             $self->window->expose( $childrect ) if $childrect;
279             }
280              
281             =head2 $child = $gridbox->get( $row, $col )
282              
283             Returns the child widget at the given cell in the grid. If the row or column
284             index are beyond the bounds of the grid, or if there is no widget in the given
285             cell, returns C.
286              
287             =cut
288              
289             sub get
290             {
291             my $self = shift;
292             my ( $row, $col ) = @_;
293              
294             return undef if $row >= @{ $self->{grid} };
295             return $self->{grid}[$row][$col];
296             }
297              
298             =head2 @children = $gridbox->get_row( $row )
299              
300             =head2 @children = $gridbox->get_col( $col )
301              
302             Convenient shortcut to call C on an entire row or column of the grid.
303              
304             =cut
305              
306             sub get_row
307             {
308             my $self = shift;
309             my ( $row ) = @_;
310             return map { $self->get( $row, $_ ) } 0 .. $self->colcount - 1;
311             }
312              
313             sub get_col
314             {
315             my $self = shift;
316             my ( $col ) = @_;
317             return map { $self->get( $_, $col ) } 0 .. $self->rowcount - 1;
318             }
319              
320             =head2 $gridbox->insert_row( $before_row, [ @children ] )
321              
322             Inserts a new row into the grid by moving the existing rows after it lower
323             down. Any child widgets in the referenced array will be set on the cells of
324             the new row, at an column corresponding to its index in the array. A child of
325             C will be skipped over.
326              
327             =cut
328              
329             sub insert_row
330             {
331             my $self = shift;
332             my ( $row, $children ) = @_;
333              
334             splice @{ $self->{grid} }, $row, 0, [];
335              
336             foreach my $col ( 0 .. $#$children ) {
337             next unless my $child = $children->[$col];
338              
339             $self->add( $row, $col, $child ); # No options
340             }
341             }
342              
343             =head2 $gridbox->insert_col( $before_col, [ @children ] )
344              
345             Inserts a new column into the grid by moving the existing columns after it to
346             the right. Any child widgets in the referenced array will be set on the cells
347             of the new column, at a row corresponding to its index in the array. A child
348             of C will be skipped over.
349              
350             =cut
351              
352             sub insert_col
353             {
354             my $self = shift;
355             my ( $col, $children ) = @_;
356              
357             my $grid = $self->{grid};
358             $self->{max_col}++;
359              
360             foreach my $row ( 0 .. max( $self->rowcount, scalar @$children ) - 1 ) {
361             splice @{ $grid->[$row] //= [ ( undef ) x $col ] }, $col, 0, ( undef );
362              
363             next unless my $child = $children->[$row];
364              
365             $self->add( $row, $col, $child ); # No options
366             }
367             }
368              
369             =head2 $gridbox->append_row( [ @children ] )
370              
371             Shortcut to inserting a new row after the end of the current grid.
372              
373             =cut
374              
375             sub append_row
376             {
377             my $self = shift;
378             $self->insert_row( $self->rowcount, @_ );
379             }
380              
381             =head2 $gridbox->append_col( [ @children ] )
382              
383             Shortcut to inserting a new column after the end of the current grid.
384              
385             =cut
386              
387             sub append_col
388             {
389             my $self = shift;
390             $self->insert_col( $self->colcount, @_ );
391             }
392              
393             =head2 $gridbox->delete_row( $row )
394              
395             Deletes a row of the grid by moving the existing rows after it higher up.
396              
397             =cut
398              
399             sub delete_row
400             {
401             my $self = shift;
402             my ( $row ) = @_;
403              
404             $self->remove( $row, $_ ) for 0 .. $self->colcount - 1;
405              
406             splice @{ $self->{grid} }, $row, 1, ();
407             $self->children_changed;
408             }
409              
410             =head2 $gridbox->delete_col( $col )
411              
412             Deletes a column of the grid by moving the existing columns after it to the
413             left.
414              
415             =cut
416              
417             sub delete_col
418             {
419             my $self = shift;
420             my ( $col ) = @_;
421              
422             $self->remove( $_, $col ) for 0 .. $self->rowcount - 1;
423              
424             splice @{ $self->{grid}[$_] }, $col, 1, () for 0 .. $self->rowcount - 1;
425             $self->{max_col}--;
426             $self->children_changed;
427             }
428              
429             sub reshape
430             {
431             my $self = shift;
432             my $win = $self->window or return;
433              
434             my @row_buckets;
435             my @col_buckets;
436              
437             my $max_row = $self->rowcount - 1;
438             my $max_col = $self->colcount - 1;
439              
440             my ( $row_spacing, $col_spacing ) = $self->get_style_values(qw( row_spacing col_spacing ));
441              
442             foreach my $row ( 0 .. $max_row ) {
443             push @row_buckets, { fixed => $row_spacing } if @row_buckets;
444              
445             my $base = 0;
446             my $expand = 0;
447              
448             foreach my $col ( 0 .. $max_col ) {
449             my $child = $self->{grid}[$row][$col] or next;
450              
451             $base = max $base, $child->requested_lines;
452             $expand = max $expand, $self->child_opts( $child )->{row_expand};
453             }
454              
455             push @row_buckets, {
456             row => $row,
457             base => $base,
458             expand => $expand,
459             };
460             }
461              
462             foreach my $col ( 0 .. $max_col ) {
463             push @col_buckets, { fixed => $col_spacing } if @col_buckets;
464              
465             my $base = 0;
466             my $expand = 0;
467              
468             foreach my $row ( 0 .. $max_row ) {
469             my $child = $self->{grid}[$row][$col] or next;
470              
471             $base = max $base, $child->requested_cols;
472             $expand = max $expand, $self->child_opts( $child )->{col_expand};
473             }
474              
475             push @col_buckets, {
476             col => $col,
477             base => $base,
478             expand => $expand,
479             };
480             }
481              
482             distribute( $win->lines, @row_buckets );
483             distribute( $win->cols, @col_buckets );
484              
485             my @rows;
486             foreach ( @row_buckets ) {
487             $rows[$_->{row}] = [ $_->{start}, $_->{value} ] if defined $_->{row};
488             }
489              
490             my @cols;
491             foreach ( @col_buckets ) {
492             $cols[$_->{col}] = [ $_->{start}, $_->{value} ] if defined $_->{col};
493             }
494              
495             foreach my $row ( 0 .. $max_row ) {
496             foreach my $col ( 0 .. $max_col ) {
497             my $child = $self->{grid}[$row][$col] or next;
498              
499             # Don't try to use zero-sized rows or cols
500             next unless $rows[$row][1] and $cols[$col][1];
501              
502             my @geom = ( $rows[$row][0], $cols[$col][0], $rows[$row][1], $cols[$col][1] );
503              
504             if( my $childwin = $child->window ) {
505             $childwin->change_geometry( @geom );
506             }
507             else {
508             $childwin = $win->make_sub( @geom );
509             $child->set_window( $childwin );
510             }
511             }
512             }
513             }
514              
515             sub render_to_rb
516             {
517             my $self = shift;
518             my ( $rb, $rect ) = @_;
519              
520             $rb->eraserect( $rect );
521             }
522              
523             =head1 TODO
524              
525             =over 4
526              
527             =item *
528              
529             Add C methods for re-ordering existing rows or columns
530              
531             =item *
532              
533             Make C<{insert,append,delete,move}> operations more efficient by deferring the
534             C call until they are done.
535              
536             =back
537              
538             =head1 AUTHOR
539              
540             Paul Evans
541              
542             =cut
543              
544             0x55AA;