File Coverage

blib/lib/UI/Various/RichTerm/Listbox.pm
Criterion Covered Total %
statement 23 95 24.2
branch 0 36 0.0
condition 0 3 0.0
subroutine 8 14 57.1
pod n/a
total 31 148 20.9


line stmt bran cond sub pod time code
1             package UI::Various::RichTerm::Listbox;
2              
3             # Author, Copyright and License: see end of file
4              
5             =head1 NAME
6              
7             UI::Various::RichTerm::Listbox - concrete implementation of L
8              
9             =head1 SYNOPSIS
10              
11             # This module should never be used directly!
12             # It is used indirectly via the following:
13             use UI::Various::Listbox;
14              
15             =head1 ABSTRACT
16              
17             This module is the specific implementation of L using
18             the rich terminal UI.
19              
20             =head1 DESCRIPTION
21              
22             The documentation of this module is only intended for developers of the
23             package itself.
24              
25             Note that RichTerm's listboxes can only page forward
26              
27             =cut
28              
29             #########################################################################
30              
31 6     6   67 use v5.14;
  6         17  
32 6     6   27 use strictures;
  6         9  
  6         30  
33 6     6   876 no indirect 'fatal';
  6         11  
  6         27  
34 6     6   305 no multidimensional;
  6         14  
  6         32  
35 6     6   304 use warnings 'once';
  6         11  
  6         382  
36              
37             our $VERSION = '0.22';
38              
39 6     6   36 use UI::Various::core;
  6         11  
  6         31  
40 6     6   43 use UI::Various::Listbox;
  6         13  
  6         225  
41 6     6   33 use UI::Various::RichTerm::base qw(%D);
  6         9  
  6         10227  
42              
43             require Exporter;
44             our @ISA = qw(UI::Various::Listbox UI::Various::RichTerm::base);
45             our @EXPORT_OK = qw();
46              
47             #########################################################################
48             #########################################################################
49              
50             =head1 _Entry - helper class
51              
52             C<_Entry> is an internal helper class used to access the currently
53             selectable entries of the listbox.
54              
55             =cut
56              
57             package UI::Various::RichTerm::Listbox::_Entry
58             {
59             sub new($$)
60             {
61 0     0     my $self = { listbox => $_[1], index => $_[2] };
62 0           bless $self, 'UI::Various::RichTerm::Listbox::_Entry';
63             }
64             sub _process($)
65             {
66 0     0     my ($self) = @_;
67 0           $self->{listbox}->_process($self->{index});
68             }
69             };
70              
71             #########################################################################
72             #########################################################################
73              
74             =head1 METHODS
75              
76             =cut
77              
78             #########################################################################
79              
80             =head2 B<_additional_active> - return helper array of active entries
81              
82             my @active = $ui_element->_additional_active;
83              
84             =head3 description:
85              
86             Return a list of C> elements
87             for each visible line of the listbox (the listbox's height in total).
88              
89             Note that those are in addition to the one of the listbox itself, which is
90             used to page forward.
91              
92             Also note that empty entries (when the height is greater than the amount of
93             visible listbox entries) are silently ignored during processing in
94             C>
95              
96             =head3 returns:
97              
98             helper array of active entries
99              
100             =cut
101              
102             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
103              
104             sub _additional_active($)
105             {
106 0     0     my ($self) = @_;
107 0           my @active = ();
108 0 0         if ($self->selection > 0)
109             {
110 0           local $_;
111 0           foreach (0 .. $self->height - 1)
112             {
113 0           push @active,
114             UI::Various::RichTerm::Listbox::_Entry->new($self, $_);
115             }
116 0           $self->{_active} = \@active;
117             }
118 0           return @active;
119             }
120              
121             #########################################################################
122              
123             =head2 B<_prepare> - prepare UI element
124              
125             ($width, $height) = $ui_element->_prepare($content_width);
126              
127             =head3 example:
128              
129             my ($w, $h) = $_->_prepare($content_width);
130             $width < $w and $width = $w;
131             $height += $h;
132              
133             =head3 parameters:
134              
135             $content_width preferred width of content
136              
137             =head3 description:
138              
139             Prepare output of the UI element by determining and returning the space it
140             wants or needs. I
141             C container elements!>
142              
143             =head3 returns:
144              
145             width and height the UI element will require or need when printed
146              
147             =cut
148              
149             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
150              
151             sub _prepare($$)
152             {
153 0     0     my ($self, $content_width) = @_;
154 0           local $_ = @{$self->{texts}};
  0            
155 0           my $w = 2 + 3 * length($_); # minimum width for I-K/N title
156              
157 0           foreach (@{$self->{texts}})
  0            
158             {
159 0           my $_w = length($_);
160 0 0         $w >= $_w or $w = $_w;
161             }
162 0 0         $w <= $self->width or $w = $self->width;
163 0           return ($w, $self->height + 1);
164             }
165              
166             #########################################################################
167              
168             =head2 B<_show> - return formatted UI element
169              
170             $string = $ui_element->_show($prefix, $width, $height, $pre_active);
171              
172             =head3 example:
173              
174             my ($w, $h) = $_->_prepare($content_width);
175             ...
176             $_->_show('<1> ', $w, $h, $pre_active);
177              
178             =head3 parameters:
179              
180             $prefix text in front of first line
181             $width the width returned by _prepare above
182             $height the height returned by _prepare above
183             $pre_active format string for prefixes
184              
185             =head3 description:
186              
187             Return the formatted (rectangular) text box of the UI element. Its height
188             will be exactly as specified, unless there hasn't been enough space. The
189             weight is similarly as specified plus the width needed for the prefix.
190             I
191             elements!>
192              
193             =head3 returns:
194              
195             the rectangular text box for UI element
196              
197             =cut
198              
199             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
200              
201             sub _show($$$$)
202             {
203 0     0     my ($self, $prefix, $width, $height, $pre_active) = @_;
204 0           my $blank = ' ' x length($prefix);
205 0           my ($i, $h, $selection) = ($self->first, $self->height, $self->selection);
206 0           my @text = ();
207 0           my $entries = @{$self->texts};
  0            
208 0 0         if ($entries)
209             {
210 0           my $last = $i + $h;
211 0 0         $last <= $entries or $last = $entries;
212 0           $prefix =~ s/ $/+/;
213 0           push @text, $prefix . ($i + 1) . '-' . $last . '/' . $entries;
214             }
215             else
216 0           { push @text, $blank. "0/0\n"; }
217 0           local $_ = 0;
218 0           while ($_ < $h)
219             {
220 0 0 0       if (0 <= $i && $i < $entries)
221             {
222 0           my $text = $self->{texts}[$i];
223 0 0         length($text) <= $width or $text = substr($text, 0, $width);
224 0 0         if (0 == $selection)
225 0           { $text = $blank . $text; }
226             else
227             {
228 0 0         if ($self->{_selected}[$i] ne ' ')
229 0           { $text = $D{SL1} . $text . $D{SL0}; }
230 0           $prefix = $blank;
231 0           my $tl = $self->_toplevel;
232 0 0         if ($tl)
233             {
234 0           my $active = $self->{_active}[$_];
235 0           my $active_index = $tl->{_active_index}{$active};
236 0           $prefix = sprintf($pre_active, $active_index);
237             }
238 0           $text = $prefix . $text;
239             }
240             ##### selected entries become BOLD or INVERTED:
241 0           push @text, $text;
242 0           $i++;
243             }
244             else
245 0           { push @text, ' '; }
246 0           $_++;
247             }
248 0           return $self->_format('', '', '', \@text, '', '', $width, $height);
249             }
250              
251             #########################################################################
252              
253             =head2 B<_process> - handle action of UI element
254              
255             $ui_element->_process;
256              
257             =head3 description:
258              
259             Handle the action of the UI element (aka select one of the radio buttons).
260              
261             =cut
262              
263             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
264              
265             sub _process($$)
266             {
267 0     0     my ($self, $index) = @_;
268              
269 0 0         if (defined $index)
270             {
271 0           local $_ = $self->{first} + $index;
272 0 0         $_ < @{$self->texts} or return;
  0            
273 0 0         if (1 == $self->selection)
274             {
275 0           foreach my $i (0..$#{$self->texts})
  0            
276             {
277             $self->{_selected}[$i] =
278 0 0         $i != $_ ? ' ' : $self->{_selected}[$i] eq ' ' ? '*' : ' ';
    0          
279             }
280             }
281             else
282             {
283 0 0         $self->{_selected}[$_] = $self->{_selected}[$_] eq ' ' ? '*' : ' ';
284             }
285             }
286             else
287             {
288 0           my $h = $self->height;
289 0           my $entries = @{$self->texts};
  0            
290 0           $self->{first} += $h;
291 0 0         if ($self->{first} >= $entries)
    0          
292             {
293 0           $self->{first} = 0;
294             }
295             elsif ($self->{first} + $h > $entries)
296             {
297 0           $self->{first} = $entries - $h;
298             }
299             }
300             }
301              
302             1;
303              
304             #########################################################################
305             #########################################################################
306              
307             =head1 SEE ALSO
308              
309             L, L
310              
311             =head1 LICENSE
312              
313             Copyright (C) Thomas Dorner.
314              
315             This library is free software; you can redistribute it and/or modify it
316             under the same terms as Perl itself. See LICENSE file for more details.
317              
318             =head1 AUTHOR
319              
320             Thomas Dorner Edorner (at) cpan (dot) orgE
321              
322             =cut