File Coverage

blib/lib/UI/Various/Main.pm
Criterion Covered Total %
statement 81 81 100.0
branch 22 22 100.0
condition 12 12 100.0
subroutine 18 18 100.0
pod 8 8 100.0
total 141 141 100.0


line stmt bran cond sub pod time code
1             package UI::Various::Main;
2              
3             # Author, Copyright and License: see end of file
4              
5             =head1 NAME
6              
7             UI::Various::Main - general main "Window Manager" class of L
8              
9             =head1 SYNOPSIS
10              
11             use UI::Various;
12             my $main = UI::Various::main();
13             $main->window(...);
14             $main->mainloop();
15              
16             =head1 ABSTRACT
17              
18             This module defines the general main "Window Manager" class of an
19             application using L. It keeps track of active / inactive
20             windows and / or the active dialogue. In addition it manages global
21             attributes of the current UI, e.g. size of the display.
22              
23             =head1 DESCRIPTION
24              
25             L's "Window Manager" is a singleton keeping track of all
26             windows and dialogues of the application. It takes care of setting them up
27             for the currently used UI and removing them when they are no longer needed.
28             In addition it triggers the event loops of the current UI (aka their main
29             loops).
30              
31             In addition it holds some convenience methods to ease creating windows and
32             some specific dialogues (see L below).
33              
34             The "Window Manager" holds the following attributes (besides those inherited
35             from C):
36              
37             =head2 Attributes
38              
39             =over
40              
41             =cut
42              
43             #########################################################################
44              
45 22     22   229 use v5.14;
  22         69  
46 22     22   105 use strictures;
  22         32  
  22         107  
47 22     22   3426 no indirect 'fatal';
  22         45  
  22         94  
48 22     22   1143 no multidimensional;
  22         51  
  22         133  
49 22     22   640 use warnings 'once';
  22         30  
  22         1073  
50              
51             our $VERSION = '0.24';
52              
53 22     22   853 use UI::Various::core;
  22         52  
  22         445  
54 22     22   5438 use UI::Various::container;
  22         48  
  22         1294  
55 22     22   106 BEGIN { require 'UI/Various/' . UI::Various::core::using() . '/Main.pm'; }
56              
57             require Exporter;
58             our @ISA = qw(UI::Various::container);
59             our @EXPORT_OK = qw();
60              
61             my $self = undef; # UI::Various::Main's singleton!
62              
63             #########################################################################
64              
65             =item max_height [ro]
66              
67             maximum height of an application window in (approximately) characters as
68             defined by the underlying UI system and screen / terminal size
69              
70             =cut
71              
72             sub max_height($) # 'public' getter
73             {
74 2     2 1 992 return get('max_height', $self);
75             }
76              
77             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
78              
79             =item max_width [ro]
80              
81             maximum width of an application window in (approximately) characters as
82             defined by the underlying UI system and screen / terminal size
83              
84             =cut
85              
86             sub max_width($) # 'public' getter
87             {
88 599     599 1 1156 return get('max_width', $self);
89             }
90              
91             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
92              
93             =back
94              
95             =head3 modified attributes
96              
97             The following attribute behave slightly different from their general
98             description in L. First of all (except for
99             initialisation) they always ignore the passed object and use the internal
100             singleton object instead. In addition they are no longer B but
101             B or mandatory, as the main "Window Manager" is the one object
102             defining the defaults for all others that do not set them.
103              
104             =over
105              
106             =item L [rw, fixed, optional]
107              
108             =item L [rw, fixed, optional]
109              
110             =back
111              
112             =cut
113              
114             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
115              
116             sub height($;$)
117             {
118 13     13 1 1550 local $_ = shift;
119             # ignore probably wrong pointer to singleton after initialisation:
120 13 100       129 defined $self and $_ = $self;
121 13         171 $_->SUPER::height(@_);
122             }
123              
124             sub width($;$)
125             {
126 27     27 1 1786 local $_ = shift;
127             # ignore probably wrong pointer to singleton after initialisation:
128 27 100       91 defined $self and $_ = $self;
129 27         197 $_->SUPER::width(@_);
130             }
131              
132             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
133              
134             =pod
135              
136             Note that all accessor methods can also be called via the package name
137             itself, e.g. C. As the "Window Manager" is
138             a singleton, it always accesses the sole existing instance anyway.
139              
140             =cut
141              
142             #########################################################################
143             #
144             # internal constants and data:
145              
146 22     22   135 use constant ALLOWED_PARAMETERS => UI::Various::widget::COMMON_PARAMETERS;
  22         37  
  22         1462  
147 22         19534 use constant DEFAULT_ATTRIBUTES => (max_height => undef,
148 22     22   123 max_width => undef);
  22         43  
149              
150             #########################################################################
151             #########################################################################
152              
153             =head1 METHODS
154              
155             Besides the accessors (attributes) described above and by
156             L as well as the methods
157             inherited from L and
158             L, the following
159             additional methods are provided by the main "Window Manager" class itself:
160              
161             =cut
162              
163             #########################################################################
164              
165             =head2 B - constructor
166              
167             see L
168             constructor for UI elements>
169              
170             =cut
171              
172             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
173              
174             sub new($;\[@$])
175             {
176 35     35 1 1801805 debug(1, __PACKAGE__, '::new');
177 35 100       186 unless (defined $self)
178             {
179 14         291 $self = construct({ (DEFAULT_ATTRIBUTES) },
180             '^(?:' . join('|', ALLOWED_PARAMETERS) . ')$',
181             @_);
182 14         101 $self->{ui} = UI::Various::core::ui();
183 14         108 $self->_init;
184 14 100 100     342 if (not defined $self->{height} or
185             $self->{height} > $self->{max_height})
186 13         148 { $self->{height} = $self->{max_height}; }
187 14 100 100     409 if (not defined $self->{width} or
188             $self->{width} > $self->{max_width})
189 3         50 { $self->{width} = $self->{max_width}; }
190             debug(1, __PACKAGE__, '::new: ',
191             $self->{width}, 'x', $self->{height}, ' / ',
192 14         406 $self->{max_width}, 'x', $self->{max_height});
193             }
194 35         254 return $self;
195             }
196              
197             #########################################################################
198              
199             =head2 B - add new window to application
200              
201             $window = $main->window([$rh_attributes,] @ui_elements);
202              
203             =head3 example:
204              
205             $main->window(UI::Various::Text->new(text => 'Hello World!'),
206             UI::Various::Button->new(text => 'Quit',
207             code => sub{ exit(); }));
208              
209             =head3 parameters:
210              
211             $rh_attributes optional reference to hash with attributes
212             @ui_elements array with possible UI elements of a window
213              
214             =head3 description:
215              
216             Add a new window to the application. An optional attribute HASH is passed
217             on to the created window while optional other UI elements are added in the
218             specified sequence.
219              
220             =head3 returns:
221              
222             the new window or undef in case of an error
223              
224             =cut
225              
226             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
227              
228             sub window($@)
229             {
230 12     12 1 2369 debug(2, __PACKAGE__, '::window');
231 12         24 my $self = shift;
232 12         23 local $_;
233              
234 12         26 my @ui_elements = ();
235 12         25 my $rh_attributes = {};
236 12         66 while ($_ = shift)
237             {
238 38 100       169 if (ref($_) eq 'HASH')
    100          
239             {
240 6         17 $rh_attributes = $_; # last definition wins!
241             }
242             elsif ($_->isa('UI::Various::widget'))
243             {
244 31 100 100     205 if ($_->isa('UI::Various::Window') or
245             $_->isa('UI::Various::Dialog'))
246             {
247 2         13 error('invalid_object__1_in_call_to__2__3',
248             ref($_), __PACKAGE__, 'window');
249 2         38 return undef;
250             }
251 29         120 push @ui_elements, $_;
252             }
253             else
254             {
255 1         107 error('invalid_parameter__1_in_call_to__2__3',
256             ref($_), __PACKAGE__, 'window');
257 1         7 return undef;
258             }
259             }
260 9         37 my $window = UI::Various::Window->new($rh_attributes);
261 9         32 $window->add($_) foreach @ui_elements;
262 9         31 return $window;
263             }
264              
265             #########################################################################
266              
267             =head2 B - add new dialogue to application
268              
269             $dialog = $main->dialog([$rh_attributes,] @ui_elements);
270              
271             =head3 example:
272              
273             $main->dialog(UI::Various::Text->new(text => 'Hello World!'),
274             UI::Various::Button->new(text => 'Quit',
275             code => sub{ exit(); }));
276              
277             =head3 parameters:
278              
279             $rh_attributes optional reference to hash with attributes
280             @ui_elements array with possible UI elements of a dialogue
281              
282             =head3 description:
283              
284             Add a new dialogue to the application. An optional attribute HASH is passed
285             on to the created dialogue while optional other UI elements are added in the
286             specified sequence.
287              
288             Note that in C the call blocks until the dialogue has finished! (It
289             will therefore return C in those cases.)
290              
291             =head3 returns:
292              
293             the new dialogue or undef in case of an error (and always in C)
294              
295             =cut
296              
297             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
298              
299             sub dialog($@)
300             {
301 10     10 1 1673 debug(2, __PACKAGE__, '::dialog');
302 10         13 my $self = shift;
303 10         12 local $_;
304              
305 10         14 my @ui_elements = ();
306 10         13 my $rh_attributes = {};
307 10         30 while ($_ = shift)
308             {
309 35 100       105 if (ref($_) eq 'HASH')
    100          
310             {
311 6         13 $rh_attributes = $_; # last definition wins!
312             }
313             elsif ($_->isa('UI::Various::widget'))
314             {
315 28 100 100     118 if ($_->isa('UI::Various::Window') or
316             $_->isa('UI::Various::Dialog'))
317             {
318 2         8 error('invalid_object__1_in_call_to__2__3',
319             ref($_), __PACKAGE__, 'dialog');
320 2         9 return undef;
321             }
322 26         62 push @ui_elements, $_;
323             }
324             else
325             {
326 1         6 error('invalid_parameter__1_in_call_to__2__3',
327             ref($_), __PACKAGE__, 'dialog');
328 1         15 return undef;
329             }
330             }
331 7         19 my $dialog = UI::Various::Dialog->new($rh_attributes);
332 7         19 $dialog->add($_) foreach @ui_elements;
333 7         23 return $dialog;
334             }
335              
336             #########################################################################
337              
338             =head2 B - main event loop of an application
339              
340             $main->mainloop();
341              
342             =head3 description:
343              
344             The main event loop of the application, handling every
345             C> and C> until
346             none is left or the application exits.
347              
348             =cut
349              
350             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
351              
352             sub mainloop($)
353 1     1 1 7 { fatal('specified_implementation_missing'); }
354              
355             1;
356              
357             #########################################################################
358             #########################################################################
359              
360             =head1 SEE ALSO
361              
362             L
363              
364             =head1 LICENSE
365              
366             Copyright (C) Thomas Dorner.
367              
368             This library is free software; you can redistribute it and/or modify it
369             under the same terms as Perl itself. See LICENSE file for more details.
370              
371             =head1 AUTHOR
372              
373             Thomas Dorner Edorner (at) cpan (dot) orgE
374              
375             =cut