File Coverage

blib/lib/Curses/UI/Dialog/Basic.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             # ----------------------------------------------------------------------
2             # Curses::UI::Dialog::Basic
3             #
4             # (c) 2001-2002 by Maurice Makaay. All rights reserved.
5             # This file is part of Curses::UI. Curses::UI is free software.
6             # You can redistribute it and/or modify it under the same terms
7             # as perl itself.
8             #
9             # Currently maintained by Marcus Thiesen
10             # e-mail: marcus@cpan.thiesenweb.de
11             # ----------------------------------------------------------------------
12              
13             package Curses::UI::Dialog::Basic;
14              
15 1     1   583 use strict;
  1         2  
  1         33  
16 1     1   666 use Curses;
  0            
  0            
17             use Curses::UI::Common;
18             use Curses::UI::Window;
19              
20             use vars qw(
21             $VERSION
22             @ISA
23             );
24              
25             @ISA = qw(
26             Curses::UI::Window
27             Curses::UI::Common
28             );
29              
30             $VERSION = '1.10';
31              
32             sub new ()
33             {
34             my $class = shift;
35              
36             my %userargs = @_;
37             keys_to_lowercase(\%userargs);
38              
39             my %args = (
40             -border => 1,
41             -message => '', # The message to show
42             -ipad => 1,
43             -fg => -1,
44             -bg => -1,
45              
46             %userargs,
47              
48             -titleinverse => 1,
49             -centered => 1,
50             );
51              
52             # Create a new object, but remember the current
53             # screen_too_small setting. The width needed for the
54             # buttons can only be computed in the second run
55             # of focus() and we do not want the first run to
56             # set screen_too_small to a true value because
57             # of this.
58             #
59             my $remember = $Curses::UI::screen_too_small;
60             my $this = $class->SUPER::new(%args);
61            
62             $this->add('message', 'TextViewer',
63             -border => 1,
64             -vscrollbar => 1,
65             -wrapping => 1,
66             -padbottom => 2,
67             -text => $this->{-message},
68             -bg => $this->{-bg},
69             -fg => $this->{-fg},
70             -bbg => $this->{-bg},
71             -bfg => $this->{-fg},
72             -focusable => 0,
73             );
74              
75             # Create a hash with arguments that may be passed to
76             # the Buttonbox class.
77             my %buttonargs = (
78             -buttonalignment => 'right',
79             );
80             foreach my $arg (qw(-buttons -selected -buttonalignment)) {
81             $buttonargs{$arg} = $this->{$arg}
82             if exists $this->{$arg};
83             }
84             my $b = $this->add(
85             'buttons', 'Buttonbox',
86             -y => -1,
87             -bg => $this->{-bg},
88             -fg => $this->{-fg},
89              
90             %buttonargs
91             );
92              
93             # Let the window in which the buttons are loose focus
94             # if a button is pressed.
95             $b->set_routine( 'press-button', sub {
96             my $this = shift;
97             my $parent = $this->parent;
98             $parent->loose_focus();
99             } );
100              
101             # Restore screen_too_small (see above) and
102             # start the second layout pass.
103             $Curses::UI::screen_too_small = $remember;
104             $this->layout;
105              
106             # Set the initial focus to the buttons.
107             $b->focus;
108            
109             return bless $this, $class;
110             }
111              
112             # TODO delete_curses_windows
113             sub layout()
114             {
115             my $this = shift;
116             return $this if $Curses::UI::screen_too_small;
117              
118             # The maximum available space on the screen.
119             my $avail_width = $ENV{COLS};
120             my $avail_height = $ENV{LINES};
121              
122             # Compute the maximum available space for the message.
123              
124             $this->process_padding;
125              
126             my $avail_textwidth = $avail_width;
127             $avail_textwidth -= 2; # border for the textviewer
128             $avail_textwidth -= 2 if $this->{-border};
129             $avail_textwidth -= $this->{-ipadleft} - $this->{-ipadright};
130              
131             my $avail_textheight = $avail_height;
132             $avail_textheight -= 2; # border for the textviewer
133             $avail_textheight -= 2; # empty line and line of buttons
134             $avail_textheight -= 2 if $this->{-border};
135             $avail_textheight -= $this->{-ipadtop} - $this->{-ipadbottom};
136              
137             # Break up the message in separate lines if neccessary.
138             my @lines = ();
139             foreach (split (/\n/, $this->{-message})) {
140             push @lines, @{text_wrap($_, $avail_textwidth)};
141             }
142              
143             # Compute the longest line in the message.
144             my $longest_line = 0;
145             foreach (@lines) {
146             $longest_line = length($_)
147             if (length($_) > $longest_line);
148             }
149              
150             # Compute the width of the buttons (if the buttons
151             # object is available. This is not the case just after
152             # new() calls SUPER::new()).
153             my $buttons = $this->getobj('buttons');
154             my $button_width = 0;
155             if (defined $buttons) {
156             $button_width = $buttons->compute_buttonwidth;
157             }
158              
159             # Decide what is the longest line.
160             $longest_line = $button_width if $longest_line < $button_width;
161              
162             # Check if there is enough space to show the widget.
163             if ($avail_textheight < 1 or $avail_textwidth < $longest_line) {
164             $Curses::UI::screen_too_small = 1;
165             return $this;
166             }
167              
168             # Compute the size of the widget.
169              
170             my $w = $longest_line;
171             $w += 2; # border of textviewer
172             $w += 2; # extra width for preventing wrapping of text
173             $w += 2 if $this->{-border};
174             $w += $this->{-ipadleft} + $this->{-ipadright};
175              
176             my $h = @lines;
177             $h += 2; # empty line + line of buttons
178             $h += 2; # border of textviewer
179             $h += 2 if $this->{-border};
180             $h += $this->{-ipadtop} + $this->{-ipadbottom};
181              
182             $this->{-width} = $w;
183             $this->{-height} = $h;
184              
185             $this->SUPER::layout;
186            
187             return $this;
188             }
189              
190             sub get()
191             {
192             my $this = shift;
193             $this->getobj('buttons')->get;
194             }
195              
196             1;
197              
198              
199             =pod
200              
201             =head1 NAME
202              
203             Curses::UI::Dialog::Basic - Create and manipulate basic dialogs
204              
205             =head1 CLASS HIERARCHY
206              
207             Curses::UI::Widget
208             |
209             +----Curses::UI::Container
210             |
211             +----Curses::UI::Window
212             |
213             +----Curses::UI::Dialog::Basic
214              
215              
216             =head1 SYNOPSIS
217              
218             use Curses::UI;
219             my $cui = new Curses::UI;
220             my $win = $cui->add('window_id', 'Window');
221              
222             # The hard way.
223             # -------------
224             my $dialog = $win->add(
225             'mydialog', 'Dialog::Basic',
226             -message => 'Hello, world!'
227             );
228             $dialog->focus;
229             $win->delete('mydialog');
230              
231             # The easy way (see Curses::UI documentation).
232             # --------------------------------------------
233             my $buttonvalue = $cui->dialog(-message => 'Hello, world!');
234              
235             # or even
236             $cui->dialog('Hello, world!');
237              
238              
239              
240              
241              
242             =head1 DESCRIPTION
243              
244             Curses::UI::Dialog::Basic is a basic dialog. This type of
245             dialog has a message on it and one or more buttons. It
246             can be used to show a message to the user of your program
247             ("The thingy has been updated") or to get some kind of
248             confirmation from the user ("Are you sure you want to
249             update the thingy?").
250              
251             See exampes/demo-Curses::UI::Dialog::Basic in the distribution
252             for a short demo.
253              
254              
255              
256             =head1 OPTIONS
257              
258             =over 4
259              
260             =item * B<-title> < TEXT >
261              
262             Set the title of the dialog window to TEXT.
263              
264             =item * B<-message> < TEXT >
265              
266             This option sets the message to show to TEXT. The text may
267             contain newline (\n) characters.
268              
269             =item * B<-buttons> < ARRAYREF >
270              
271             =item * B<-selected> < INDEX >
272              
273             =item * B<-buttonalignment> < VALUE >
274              
275             These options sets the buttons that have to be used. For an
276             explanation of these options, see the
277             L documentation.
278              
279             =back
280              
281              
282              
283              
284             =head1 METHODS
285              
286             =over 4
287              
288             =item * B ( HASH )
289              
290             =item * B ( )
291              
292             =item * B ( BOOLEAN )
293              
294             =item * B ( )
295              
296             These are standard methods. See L
297             for an explanation of these.
298              
299             =item * B ( )
300              
301             This method will call B on the buttons object of the dialog
302             and return its returnvalue. See L
303             for more information on this.
304              
305             =back
306              
307              
308              
309              
310             =head1 SEE ALSO
311              
312             L,
313             L,
314             L
315              
316              
317              
318              
319             =head1 AUTHOR
320              
321             Copyright (c) 2001-2002 Maurice Makaay. All rights reserved.
322              
323             Maintained by Marcus Thiesen (marcus@cpan.thiesenweb.de)
324              
325              
326             This package is free software and is provided "as is" without express
327             or implied warranty. It may be used, redistributed and/or modified
328             under the same terms as perl itself.
329