File Coverage

blib/lib/UI/Various/RichTerm/base.pm
Criterion Covered Total %
statement 26 69 37.6
branch 0 22 0.0
condition 0 3 0.0
subroutine 9 11 81.8
pod n/a
total 35 105 33.3


line stmt bran cond sub pod time code
1             package UI::Various::RichTerm::base;
2              
3             # Author, Copyright and License: see end of file
4              
5             =head1 NAME
6              
7             UI::Various::RichTerm::base - abstract helper class for RichTerm's UI elements
8              
9             =head1 SYNOPSIS
10              
11             # This module should only be used by the UI::Various::RichTerm UI
12             # element classes!
13              
14             =head1 ABSTRACT
15              
16             This module provides some helper functions for the UI elements of the rich
17             console.
18              
19             =head1 DESCRIPTION
20              
21             The documentation of this module is only intended for developers of the
22             package itself.
23              
24             All functions of the module will be included as second "base
25             class" (in C<@ISA>). Note that this is not a diamond pattern as this "base
26             class" does not import anything besides C.
27              
28             =head2 Global Definitions
29              
30             =over
31              
32             =cut
33              
34             #########################################################################
35              
36 6     6   67 use v5.14;
  6         17  
37 6     6   36 use strictures;
  6         10  
  6         27  
38 6     6   874 no indirect 'fatal';
  6         12  
  6         26  
39 6     6   325 no multidimensional;
  6         11  
  6         51  
40 6     6   239 use warnings 'once';
  6         12  
  6         239  
41              
42 6     6   2829 use Text::Wrap;
  6         15363  
  6         527  
43             $Text::Wrap::huge = 'overflow';
44             $Text::Wrap::unexpand = 0;
45              
46             our $VERSION = '0.22';
47              
48 6     6   45 use UI::Various::core;
  6         13  
  6         40  
49              
50             require Exporter;
51             our @ISA = qw(Exporter);
52             our @EXPORT_OK = qw(%D);
53              
54             #########################################################################
55              
56             =item B<%D>
57              
58             a hash of decoration characters for window borders (C to C without
59             C), box borders (C, C and C), check boxes (C and C),
60             radio buttons (C and C), normal buttons (C and C
), selected
61             (C and C) and underline (C and C).
62              
63             =cut
64              
65 6         1775 use constant DECO_ASCII => (W7 => '#', W8 => '=', W9 => '#',
66             W4 => '"', W6 => '"',
67             W1 => '#', W2 => '=', W3 => '#',
68             B7 => '+', B8 => '-', B9 => '+',
69             b8 => '+',
70             B4 => '|', B5 => '|', B6 => '|',
71             b4 => '+', b5 => '+', b6 => '+',
72             c5 => '-',
73             B1 => '+', B2 => '-', B3 => '+',
74             b2 => '+',
75             BL => '[', BR => ']',
76             CL => '[', CR => ']',
77             RL => '(', RR => ')',
78             SL1 => "\e[7m", SL0 => "\e[27m",
79 6     6   43 UL1 => "\e[4m", UL0 => "\e[24m");
  6         16  
80              
81             # https://www.utf8-chartable.de/unicode-utf8-table.pl?start=9472&number=128
82             # (not yet supported, we'll probably check I18N::Langinfo::langinfo):
83 6         5662 use constant DECO_UTF8 => (W7 => "\x{2554}", W8 => "\x{2550}", W9 => "\x{2557}",
84             W4 => "\x{2551}", W6 => "\x{2551}",
85             W1 => "\x{255a}", W2 => "\x{2550}", W3 => "\x{255d}",
86             B7 => "\x{250c}", B8 => "\x{2500}", B9 => "\x{2510}",
87             b8 => "\x{252C}",
88             B4 => "\x{2502}", B5 => "\x{2502}", B6 => "\x{2502}",
89             b4 => "\x{251C}", b5 => "\x{253C}", b6 => "\x{2524}",
90             c5 => "\x{2500}",
91             B1 => "\x{2514}", B2 => "\x{2500}", B3 => "\x{2518}",
92             b2 => "\x{2534}",
93             BL => "\x{2503}", BR => "\x{2503}",
94             CL => '[', CR => ']',
95             RL => '(', RR => ')',
96             SL1 => "\e[7m", SL0 => "\e[27m",
97 6     6   37 UL1 => "\e[4m", UL0 => "\e[24m");
  6         10  
98              
99             our %D = DECO_ASCII;
100              
101             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
102              
103              
104             #########################################################################
105             #########################################################################
106              
107             =back
108              
109             =head1 METHODS
110              
111             The module provides the following common (internal) methods for all
112             UI::Various::RichTerm UI element classes:
113              
114             =cut
115              
116             #########################################################################
117              
118             =head2 B<_size> - determine size of UI element
119              
120             ($width, $height) = $ui_element->_size($string, $content_width);
121              
122             =head3 example:
123              
124             my ($w, $h) = $self->_size($self->text, $content_width);
125              
126             =head3 parameters:
127              
128             $string the string to be analysed
129             $content_width preferred width of content
130              
131             =head3 description:
132              
133             This method determines the width and height of a UI element.
134              
135             If the UI element has it's own defined (not inherited) widht and/or height,
136             no other calculation is made (no matter if the string will fit or not).
137              
138             If no own width is defined, the text will be wrapped into lines no longer
139             than the given preferred maximum width and the length of the longest of line
140             is returned. If a sub-string has no word boundary to break it into chunks
141             smaller than C<$content_width>, C<$content_width> is returned even though
142             the string will not really fit when it will be displayed later.)
143              
144             If no own height is defined, the number of lines of the wrapped string is
145             returned.
146              
147             =head3 returns:
148              
149             width and height of the string when it will be displayed later
150              
151             =cut
152              
153             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
154              
155             sub _size($$$)
156             {
157 0     0     my ($self, $string, $content_width) = @_;
158              
159 0           my ($w, $h) = ($self->{width}, $self->{height});
160 0 0 0       $w and $h and return ($w, $h);
161              
162 0 0         $Text::Wrap::columns = ($w ? $w : $content_width) + 1;
163 0           $string = wrap('', '', $string);
164 0           my @lines = split "\n", $string;
165              
166 0 0         unless ($w)
167             {
168 0           $w = 0;
169 0           local $_;
170 0           foreach (map { length($_) } @lines)
  0            
171 0 0         { $w >= $_ or $w = $_; }
172 0 0         $w <= $content_width or $w = $content_width;
173             }
174              
175 0 0         $h or $h = @lines;
176 0           return ($w, $h);
177             }
178              
179             #########################################################################
180              
181             =head2 B<_format> - format text according to given options
182              
183             $string = $ui_element->_format($prefix, $decoration_before, $effect_before,
184             $text, $effect_after, $decoration_after,
185             $width, $height);
186             or
187              
188             $string = $ui_element->_format($prefix, $decoration_before, $effect_before,
189             \@text, $effect_after, $decoration_after,
190             $width, $height);
191              
192             =head3 example:
193              
194             my ($w, $h) = $self->_size($self->text, $content_width);
195             $string = $self->_format('(1) ', '', '[ ', $self->text, ' ]', '', $w, $h);
196              
197             =head3 parameters:
198              
199             $prefix text in front of first line
200             $decoration_before decoration before content of each line
201             $effect_before effect before content of each line
202             $text string to be wrapped or reference to wrapped text lines
203             $effect_after end of effect after content of each line
204             $decoration_after decoration after content of each line
205             $width the width returned by _size above
206             $height the height returned by _size above
207              
208             =head3 description:
209              
210             This method formats the given text into a text box of the previously
211             (C>) determined width and
212             height, decorates it with some additional strings (e.g. to symbolise a
213             button) and a prefix set by its parent. Note that the (latter) prefix is
214             only added to the first line with text, all additional lines gets a blank
215             prefix of the same length.
216              
217             Also note that the given text can either be a string which is wrapped or a
218             reference to an array of already wrapped strings that only need the final
219             formatting.
220              
221             The decorations and prefix will cause the resulting text box to be wider
222             than the given width, which only describes the width of the text itself.
223             The effect is sort of a zero-width decoration (applied to the text without
224             padding), usually an ANSI escape sequence.
225              
226             And as already described under C
227             element>> above, the layout will be broken if it can't fit. The display of
228             everything is preferred over cutting of possible important parts.
229              
230             =head3 returns:
231              
232             the rectangular text box for the given string
233              
234             =cut
235              
236             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
237              
238             sub _format($$$$$$$$$)
239             {
240 0     0     my ($self, $prefix, $deco_before, $effect_before, $text,
241             $effect_after, $deco_after, $w, $h) = @_;
242 0           my $alignment = 7; # TODO L8R: $self->alignment;
243              
244 0           my $len_p = length($prefix);
245 0           my ($len_d_bef, $len_d_aft) = (length($deco_before), length($deco_after));
246 0           my $blank_prefix = ' ' x $len_p;
247 0           local $_;
248              
249             # TODO L8R: handle colour (add to front of DECO-1, reset after DECO-2)
250              
251             # format text-box:
252             # wrap text, if applicable:
253 0           my @text;
254 0 0         if (ref($text) eq 'ARRAY')
255 0           { push @text, split("\n", $_) foreach @{$text}; }
  0            
256             else
257             {
258 0           $Text::Wrap::columns = $w + 1;
259 0           @text = split "\n", wrap('', '', $text);
260             }
261 0           foreach (0..$#text)
262             {
263 0           my $text_no_ansi = $text[$_];
264 0           $text_no_ansi =~ s/\e[[0-9;]*m//g;
265 0           my $l = length($text_no_ansi);
266 0           $text[$_] = $effect_before . $text[$_] . $effect_after;
267 0 0         if ($l < $w)
268             {
269             # TODO: this is only the code for the alignments 1/4/7:
270 0           { $text[$_] .= ' ' x ($w - $l); }
  0            
271             }
272 0 0         $text[$_] = ($_ == 0 ? $prefix : $blank_prefix)
273             . $deco_before . $text[$_] . $deco_after;
274             }
275 0 0         if ($h > @text)
276             {
277 0           my $empty = ' ' x ($len_d_bef + $w + $len_d_aft);
278 0           foreach (scalar(@text)..$h-1)
279             {
280 0 0         my $p = $_ == 0 ? $prefix : $blank_prefix;
281             # TODO: this is only the code for the alignments 7/8/9:
282 0           { push @text, $p . $empty; }
  0            
283              
284             }
285             }
286              
287 0           return join("\n", @text);
288             }
289              
290             1;
291              
292             #########################################################################
293             #########################################################################
294              
295             =head1 SEE ALSO
296              
297             L
298              
299             =head1 LICENSE
300              
301             Copyright (C) Thomas Dorner.
302              
303             This library is free software; you can redistribute it and/or modify it
304             under the same terms as Perl itself. See LICENSE file for more details.
305              
306             =head1 AUTHOR
307              
308             Thomas Dorner Edorner (at) cpan (dot) orgE
309              
310             =cut