1# ----------------------------------------------------------------------
2# Curses::UI::Label
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# TODO: fix dox
14
15package Curses::UI::Label;
16
17use strict;
18use Curses;
19use Curses::UI::Widget;
20use Curses::UI::Common;
21
22use vars qw(
23    $VERSION
24    @ISA
25);
26
27$VERSION = '1.11';
28
29@ISA = qw(
30    Curses::UI::Widget
31);
32
33sub new ()
34{
35    my $class = shift;
36
37    my %userargs = @_;
38    keys_to_lowercase(\%userargs);
39
40    my %args = (
41        -parent          => undef,    # the parent window
42        -width           => undef,    # the width of the label
43        -height          => undef,    # the height of the label
44        -x               => 0,        # the hor. pos. rel. to the parent
45        -y               => 0,        # the vert. pos. rel. to the parent
46        -text            => undef,    # the text to show
47        -textalignment   => undef,    # left / middle / right
48        -bold            => 0,        # Special attributes
49        -reverse         => 0,
50        -underline       => 0,
51        -dim             => 0,
52        -blink           => 0,
53        -paddingspaces   => 0,        # Pad text with spaces?
54	-bg              => -1,
55	-fg              => -1,
56
57        %userargs,
58
59        -nocursor        => 1,        # This widget uses no cursor
60        -focusable       => 0,        # This widget can't be focused
61    );
62
63    # Get the text dimension if -width or -height is undefined.
64    my @text_dimension = (undef,1);
65    unless (defined $args{-width} and defined $args{-height}) {
66        @text_dimension = text_dimension($args{-text})
67            if defined $args{-text};
68    }
69
70    # If the -height is not set, determine the height
71    # using the initial contents of the -text.
72    if (not defined $args{-height})
73    {
74        my $l = $text_dimension[1];
75        $l = 1 if $l <= 0;
76        $args{-height} = height_by_windowscrheight($l, %args);
77    }
78
79    # No width given? Then make the width the same size
80    # as the text. No initial text? Then let
81    # Curses::UI::Widget figure it out.
82    $args{-width} = width_by_windowscrwidth($text_dimension[0], %args)
83        unless defined $args{-width} or not defined $args{-text};
84
85    # If no text was defined (how silly...) we define an empty string.
86    $args{-text} = '' unless defined $args{-text};
87
88    # Create the widget.
89    my $this = $class->SUPER::new( %args );
90
91    $this->layout();
92
93    return $this;
94}
95
96sub layout()
97{
98    my $this = shift;
99    $this->SUPER::layout or return;
100    return $this;
101}
102
103
104sub bold ($;$)      { shift()->set_attribute('-bold', shift())      }
105sub reverse ($;$)   { shift()->set_attribute('-reverse', shift())   }
106sub underline ($;$) { shift()->set_attribute('-underline', shift()) }
107sub dim ($;$)       { shift()->set_attribute('-dim', shift())       }
108sub blink ($;$)     { shift()->set_attribute('-blink', shift())     }
109
110sub set_attribute($$;)
111{
112    my $this = shift;
113    my $attribute = shift;
114    my $value = shift || 0;
115
116    $this->{$attribute} = $value;
117    $this->intellidraw;
118
119    return $this;
120}
121
122
123
124sub text($;$)
125{
126    my $this = shift;
127    my $text = shift;
128
129    if (defined $text)
130    {
131        $this->{-text} = $text;
132        $this->intellidraw;
133        return $this;
134    } else {
135        return $this->{-text};
136    }
137}
138
139sub get() { shift()->text }
140
141sub textalignment($;)
142{
143    my $this = shift;
144    my $value = shift;
145    $this->{-textalignment} = $value;
146    $this->intellidraw;
147    return $this;
148}
149
150sub compute_xpos()
151{
152    my $this = shift;
153    my $line = shift;
154
155    # Compute the x location of the text.
156    my $xpos = 0;
157    if (defined $this->{-textalignment})
158    {
159        if ($this->{-textalignment} eq 'right') {
160	    $xpos = $this->canvaswidth - length($line);
161        } elsif ($this->{-textalignment} eq 'middle') {
162	    $xpos = int (($this->canvaswidth-length($line))/2);
163        }
164    }
165    $xpos = 0 if $xpos < 0;
166    return $xpos;
167}
168
169sub draw(;$)
170{
171    my $this = shift;
172    my $no_doupdate = shift || 0;
173
174    # Draw the widget.
175    $this->SUPER::draw(1) or return $this;
176
177    # Clear all attributes.
178    $this->{-canvasscr}->attroff(A_REVERSE);
179    $this->{-canvasscr}->attroff(A_BOLD);
180    $this->{-canvasscr}->attroff(A_UNDERLINE);
181    $this->{-canvasscr}->attroff(A_BLINK);
182    $this->{-canvasscr}->attroff(A_DIM);
183
184    # Set wanted attributes.
185    $this->{-canvasscr}->attron(A_REVERSE)   if $this->{-reverse};
186    $this->{-canvasscr}->attron(A_BOLD)      if $this->{-bold};
187    $this->{-canvasscr}->attron(A_UNDERLINE) if $this->{-underline};
188    $this->{-canvasscr}->attron(A_BLINK)     if $this->{-blink};
189    $this->{-canvasscr}->attron(A_DIM)       if $this->{-dim};
190
191    # Let there be color
192    if ($Curses::UI::color_support) {
193	my $co = $Curses::UI::color_object;
194	my $pair = $co->get_color_pair(
195			     $this->{-fg},
196			     $this->{-bg});
197
198	$this->{-canvasscr}->attron(COLOR_PAIR($pair));
199
200    }
201
202    # Draw the text. Clip it if it is too long.
203    my $ypos = 0;
204    my $split = split_to_lines($this->{-text});
205    foreach my $line (@$split)
206    {
207        if (length($line) > $this->canvaswidth) {
208            # Break text
209            $line = substr($line, 0, $this->canvaswidth);
210            $line =~ s/.$/\$/;
211        } elsif ($this->{-paddingspaces}) {
212            $this->{-canvasscr}->addstr($ypos, 0, " "x$this->canvaswidth);
213        }
214
215        my $xpos = $this->compute_xpos($line);
216        $this->{-canvasscr}->addstr($ypos, $xpos, $line);
217
218        $ypos++;
219    }
220
221    $this->{-canvasscr}->noutrefresh;
222    doupdate() unless $no_doupdate;
223
224    return $this;
225}
226
227
228
229
2301;
231
232
233=pod
234
235=head1 NAME
236
237Curses::UI::Label - Create and manipulate label widgets
238
239=head1 CLASS HIERARCHY
240
241 Curses::UI::Widget
242    |
243    +----Curses::UI::Label
244
245
246
247=head1 SYNOPSIS
248
249    use Curses::UI;
250    my $cui = new Curses::UI;
251    my $win = $cui->add('window_id', 'Window');
252
253    my $label = $win->add(
254        'mylabel', 'Label',
255        -text      => 'Hello, world!',
256        -bold      => 1,
257    );
258
259    $label->draw;
260
261
262
263=head1 DESCRIPTION
264
265Curses::UI::Label is a widget that shows a textstring.
266This textstring can be drawn using these special
267features: bold, dimmed, reverse, underlined, and blinking.
268
269See exampes/demo-Curses::UI::Label in the distribution
270for a short demo.
271
272
273
274=head1 STANDARD OPTIONS
275
276B<-parent>, B<-x>, B<-y>, B<-width>, B<-height>,
277B<-pad>, B<-padleft>, B<-padright>, B<-padtop>, B<-padbottom>,
278B<-ipad>, B<-ipadleft>, B<-ipadright>, B<-ipadtop>, B<-ipadbottom>,
279B<-title>, B<-titlefullwidth>, B<-titlereverse>, B<-onfocus>,
280B<-onblur>
281
282For an explanation of these standard options, see
283L<Curses::UI::Widget|Curses::UI::Widget>.
284
285
286
287
288=head1 WIDGET-SPECIFIC OPTIONS
289
290=over 4
291
292=item * B<-height> < VALUE >
293
294If you do not define B<-height>, the label will compute
295its needed height using the initial B<-text>.
296
297=item * B<-text> < TEXT >
298
299This will set the text on the label to TEXT.
300
301=item * B<-textalignment> < VALUE >
302
303This option controls how the text should be aligned inside
304the label. VALUE can be 'left', 'middle' and 'right'. The
305default value for this option is 'left'.
306
307=item * B<-paddingspaces> < BOOLEAN >
308
309This option controls if padding spaces should be added
310to the text if the text does not fill the complete width
311of the widget. The default value for BOOLEAN is false.
312An example use of this option is:
313
314    $win->add(
315        'label', 'Label',
316        -width         => -1,
317        -paddingspaces => 1,
318        -text          => 'A bit of text',
319    );
320
321This will create a label that fills the complete width of
322your screen and which will be completely in reverse font
323(also the part that has no text on it). See the demo
324in the distribution (examples/demo-Curses::UI::Label)
325for a clear example of this)
326
327=item * B<-bold> < BOOLEAN >
328
329If BOOLEAN is true, text on the label will be drawn in
330a bold font.
331
332=item * B<-dim> < BOOLEAN >
333
334If BOOLEAN is true, text on the label will be drawn in
335a dim font.
336
337=item * B<-reverse> < BOOLEAN >
338
339If BOOLEAN is true, text on the label will be drawn in
340a reverse font.
341
342=item * B<-underline> < BOOLEAN >
343
344If BOOLEAN is true, text on the label will be drawn in
345an underlined font.
346
347=item * B<-blink> < BOOLEAN >
348
349If BOOLEAN is option is true, text on the label will be
350drawn in a blinking font.
351
352=back
353
354
355
356
357=head1 METHODS
358
359=over 4
360
361=item * B<new> ( OPTIONS )
362
363=item * B<layout> ( )
364
365=item * B<draw> ( BOOLEAN )
366
367=item * B<intellidraw> ( )
368
369=item * B<focus> ( )
370
371=item * B<onFocus> ( CODEREF )
372
373=item * B<onBlur> ( CODEREF )
374
375These are standard methods. See L<Curses::UI::Widget|Curses::UI::Widget>
376for an explanation of these.
377
378=item * B<bold> ( BOOLEAN )
379
380=item * B<dim> ( BOOLEAN )
381
382=item * B<reverse> ( BOOLEAN )
383
384=item * B<underline> ( BOOLEAN )
385
386=item * B<blink> ( BOOLEAN )
387
388These methods can be used to control the font in which the text on
389the label is drawn, after creating the widget. The font option
390will be turned on for a true value of BOOLEAN.
391
392=item * B<textalignment> ( VALUE )
393
394Set the textalignment. VALUE can be 'left',
395'middle' or 'right'.
396
397=item * B<text> ( [TEXT] )
398
399Without the TEXT argument, this method will return the current
400text of the widget. With a TEXT argument, the text on the widget
401will be set to TEXT.
402
403=item * B<get> ( )
404
405This will call the B<text> method without any argument and thus
406it will return the current text of the label.
407
408=back
409
410
411
412
413=head1 DEFAULT BINDINGS
414
415Since a Label is a non-interacting widget, it does not have
416any bindings.
417
418
419
420
421=head1 SEE ALSO
422
423L<Curses::UI|Curses::UI>,
424L<Curses::UI::Widget|Curses::UI::Widget>,
425
426
427
428
429=head1 AUTHOR
430
431Copyright (c) 2001-2002 Maurice Makaay. All rights reserved.
432
433Maintained by Marcus Thiesen (marcus@cpan.thiesenweb.de)
434
435
436This package is free software and is provided "as is" without express
437or implied warranty. It may be used, redistributed and/or modified
438under the same terms as perl itself.
439
440