File Coverage

blib/lib/Tickit/Widget/CheckButton.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              
6             package Tickit::Widget::CheckButton;
7              
8 1     1   907 use strict;
  1         2  
  1         22  
9 1     1   3 use warnings;
  1         2  
  1         20  
10 1     1   3 use base qw( Tickit::Widget );
  1         1  
  1         51  
11             use Tickit::Style;
12              
13             our $VERSION = '0.27';
14              
15             use Carp;
16              
17             use Tickit::Utils qw( textwidth );
18             use List::Util 1.33 qw( any );
19              
20             use constant CAN_FOCUS => 1;
21              
22             =head1 NAME
23              
24             C - a widget allowing a toggle true/false option
25              
26             =head1 SYNOPSIS
27              
28             use Tickit;
29             use Tickit::Widget::CheckButton;
30             use Tickit::Widget::VBox;
31              
32             my $vbox = Tickit::Widget::VBox->new;
33             $vbox->add( Tickit::Widget::CheckButton->new(
34             label => "Check button $_",
35             ) ) for 1 .. 5;
36              
37             Tickit->new( root => $vbox )->run;
38              
39             =head1 DESCRIPTION
40              
41             This class provides a widget which allows a true/false selection. It displays
42             a clickable indication of status and a caption. Clicking on the status or
43             caption inverts the status of the widget.
44              
45             This widget is part of an experiment in evolving the design of the
46             L widget integration code, and such is subject to change of
47             details.
48              
49             =head1 STYLE
50              
51             The default style pen is used as the widget pen. The following style pen
52             prefixes are also used:
53              
54             =over 4
55              
56             =item check => PEN
57              
58             The pen used to render the check marker
59              
60             =back
61              
62             The following style keys are used:
63              
64             =over 4
65              
66             =item check => STRING
67              
68             The text used to indicate the active status
69              
70             =item spacing => INT
71              
72             Number of columns of spacing between the check mark and the caption text
73              
74             =back
75              
76             The following style tags are used:
77              
78             =over 4
79              
80             =item :active
81              
82             Set when this button's status is true
83              
84             =back
85              
86             The following style actions are used:
87              
88             =over 4
89              
90             =item toggle
91              
92             The main action to activate the C handler.
93              
94             =back
95              
96             =cut
97              
98             style_definition base =>
99             check_fg => "hi-white",
100             check_b => 1,
101             check => "[ ]",
102             spacing => 2,
103             '' => "toggle";
104              
105             style_definition ':active' =>
106             b => 1,
107             check => "[X]";
108              
109             style_reshape_keys qw( spacing );
110              
111             style_reshape_textwidth_keys qw( check );
112              
113             use constant WIDGET_PEN_FROM_STYLE => 1;
114             use constant KEYPRESSES_FROM_STYLE => 1;
115              
116             =head1 CONSTRUCTOR
117              
118             =cut
119              
120             =head2 $checkbutton = Tickit::Widget::CheckButton->new( %args )
121              
122             Constructs a new C object.
123              
124             Takes the following named argmuents
125              
126             =over 8
127              
128             =item label => STRING
129              
130             The label text to display alongside this button.
131              
132             =item on_toggle => CODE
133              
134             Optional. Callback function to invoke when the check state is changed.
135              
136             =back
137              
138             =cut
139              
140             sub new
141             {
142             my $class = shift;
143             my %args = @_;
144              
145             my $self = $class->SUPER::new( %args );
146              
147             $self->set_label( $args{label} ) if defined $args{label};
148             $self->set_on_toggle( $args{on_toggle} ) if $args{on_toggle};
149              
150             return $self;
151             }
152              
153             sub lines
154             {
155             my $self = shift;
156             return 1;
157             }
158              
159             sub cols
160             {
161             my $self = shift;
162             return textwidth( $self->get_style_values( "check" ) ) +
163             $self->get_style_values( "spacing" ) +
164             textwidth( $self->{label} );
165             }
166              
167             =head1 ACCESSORS
168              
169             =cut
170              
171             =head2 $label = $checkbutton->label
172              
173             =head2 $checkbutton->set_label( $label )
174              
175             Returns or sets the label text of the button.
176              
177             =cut
178              
179             sub label
180             {
181             my $self = shift;
182             return $self->{label};
183             }
184              
185             sub set_label
186             {
187             my $self = shift;
188             ( $self->{label} ) = @_;
189             $self->reshape;
190             $self->redraw;
191             }
192              
193             =head2 $on_toggle = $checkbutton->on_toggle
194              
195             =cut
196              
197             sub on_toggle
198             {
199             my $self = shift;
200             return $self->{on_toggle};
201             }
202              
203             =head2 $checkbutton->set_on_toggle( $on_toggle )
204              
205             Return or set the CODE reference to be called when the button state is
206             changed.
207              
208             $on_toggle->( $checkbutton, $active )
209              
210             =cut
211              
212             sub set_on_toggle
213             {
214             my $self = shift;
215             ( $self->{on_toggle} ) = @_;
216             }
217              
218             =head1 METHODS
219              
220             =cut
221              
222             =head2 $checkbutton->activate
223              
224             Sets this button's active state to true.
225              
226             =cut
227              
228             sub activate
229             {
230             my $self = shift;
231             $self->{active} = 1;
232             $self->set_style_tag( active => 1 );
233             $self->{on_toggle}->( $self, 1 ) if $self->{on_toggle};
234             }
235              
236             =head2 $checkbutton->deactivate
237              
238             Sets this button's active state to false.
239              
240             =cut
241              
242             sub deactivate
243             {
244             my $self = shift;
245             $self->{active} = 0;
246             $self->set_style_tag( active => 0 );
247             $self->{on_toggle}->( $self, 0 ) if $self->{on_toggle};
248             }
249              
250             *key_toggle = \&toggle;
251             sub toggle
252             {
253             my $self = shift;
254             $self->is_active ? $self->deactivate : $self->activate;
255             return 1;
256             }
257              
258             =head2 $active = $checkbutton->is_active
259              
260             Returns this button's active state.
261              
262             =cut
263              
264             sub is_active
265             {
266             my $self = shift;
267             return !!$self->{active};
268             }
269              
270             sub reshape
271             {
272             my $self = shift;
273              
274             my $win = $self->window or return;
275              
276             my $check = $self->get_style_values( "check" );
277              
278             $win->cursor_at( 0, ( textwidth( $check )-1 ) / 2 );
279             }
280              
281             sub render_to_rb
282             {
283             my $self = shift;
284             my ( $rb, $rect ) = @_;
285              
286             $rb->clear;
287              
288             return if $rect->top > 0;
289              
290             $rb->goto( 0, 0 );
291              
292             $rb->text( my $check = $self->get_style_values( "check" ), $self->get_style_pen( "check" ) );
293             $rb->erase( $self->get_style_values( "spacing" ) );
294             $rb->text( $self->{label} );
295             $rb->erase_to( $rect->right );
296             }
297              
298             sub on_mouse
299             {
300             my $self = shift;
301             my ( $args ) = @_;
302              
303             return unless $args->type eq "press" and $args->button == 1;
304             return 1 unless $args->line == 0;
305              
306             $self->toggle;
307             }
308              
309             =head1 AUTHOR
310              
311             Paul Evans
312              
313             =cut
314              
315             0x55AA;