File Coverage

blib/lib/Tickit/Widget/Placegrid.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 -- leonerd@leonerd.org.uk
5             # Original render code by Tom Molesworth
6              
7             package Tickit::Widget::Placegrid;
8              
9 1     1   783 use strict;
  1         2  
  1         22  
10 1     1   3 use warnings;
  1         0  
  1         22  
11 1     1   2 use base qw( Tickit::Widget );
  1         1  
  1         83  
12             use Tickit::Style;
13             use Tickit::RenderBuffer qw( LINE_SINGLE LINE_THICK );
14              
15             our $VERSION = '0.27';
16              
17             use Tickit::Utils qw( textwidth );
18              
19             =head1 NAME
20              
21             C - a placeholder grid display
22              
23             =head1 DESCRIPTION
24              
25             This class provides a widget which displays a simple grid pattern in its
26             display area, and prints the size of the area in its centre.
27              
28             It is intended as a placeholder for other widget code while applications are
29             under development. It easily allows a container to have a child that can take
30             any size, and will keep its window area painted (so avoiding bugs caused by
31             "empty" containers that do not clear unused child areas).
32              
33             =head1 STYLE
34              
35             The default style pen is used as the widget pen. The following style pen
36             prefixes are also used:
37              
38             =over 4
39              
40             =item grid => PEN
41              
42             The pen used to render the grid lines
43              
44             =back
45              
46             =cut
47              
48             style_definition base =>
49             fg => "white",
50             grid_fg => "blue";
51              
52             use constant WIDGET_PEN_FROM_STYLE => 1;
53              
54             =head1 CONSTRUCTOR
55              
56             =head2 $placegrid = Tickit::Widget::Placegrid->new( %args )
57              
58             Constructs a new C object.
59              
60             Takes the following named arguments.
61              
62             =over 8
63              
64             =item title => STR
65              
66             Optional. If provided, prints an identifying title just above the box
67             dimensions in the centre of the grid.
68              
69             =back
70              
71             =cut
72              
73             sub new
74             {
75             my $class = shift;
76             my %args = @_;
77             my $self = $class->SUPER::new( %args );
78              
79             $self->{title} = $args{title};
80              
81             return $self;
82             }
83              
84             sub lines { 1 }
85             sub cols { 1 }
86              
87             sub render_to_rb
88             {
89             my $self = shift;
90             my ( $rb, $rect ) = @_;
91              
92             $rb->clear($self->pen);
93              
94             my ($w, $h) = map $self->window->$_ - 1, qw(cols lines);
95              
96             $rb->setpen($self->get_style_pen("grid"));
97             $rb->hline_at(0, 0, $w, LINE_THICK);
98             $rb->hline_at($h, 0, $w, LINE_THICK);
99             $rb->hline_at($h / 2, 0, $w, LINE_SINGLE);
100             $rb->vline_at(0, $h, 0, LINE_THICK);
101             $rb->vline_at(0, $h, $w, LINE_THICK);
102             $rb->vline_at(0, $h, $w / 2, LINE_SINGLE);
103              
104             $rb->setpen($self->pen);
105              
106             if(defined(my $title = $self->{title})) {
107             $rb->text_at(($h / 2) - 1, (1 + $w - textwidth($title)) / 2, $title);
108             }
109              
110             my $txt = '(' . $self->window->cols . ',' . $self->window->lines . ')';
111             $rb->text_at($h / 2, (1 + $w - textwidth($txt)) / 2, $txt);
112             }
113              
114             =head1 AUTHOR
115              
116             Original rendering code by Tom Molesworth
117              
118             Widget wrapping by Paul Evans
119              
120             =cut
121              
122             0x55AA;