File Coverage

blib/lib/Acme/Curses/Marquee.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package Acme::Curses::Marquee;
2              
3 1     1   111712 use warnings;
  1         2  
  1         33  
4 1     1   6 use strict;
  1         2  
  1         43  
5 1     1   537 use Curses qw( addstr refresh );
  0            
  0            
6              
7             =head1 NAME
8              
9             Acme::Curses::Marquee - Animated Figlet!
10              
11             =head1 VERSION
12              
13             Version 1.0
14              
15             =cut
16              
17             our $VERSION = '1.0';
18              
19             =head1 SYNOPSIS
20              
21             Acme::Curses::Marquee implements a scrolling messageboard widget,
22             using C to render the text.
23              
24             use Curses;
25             use Acme::Curses::Marquee;
26              
27             initscr;
28              
29             # curses halfdelay mode is what actually drives the display
30             # and its argument is what determines the rate of the crawl
31             halfdelay(1);
32              
33             # spawn subwindow to hold marquee and create marquee object
34             my $mw = subwin(9,80,0,0);
35             my $m = Acme::Curses::Marquee->new( window => $mw,
36             height => 9,
37             width => 80,
38             font => larry3d,
39             text => 'hello, world' );
40              
41             # then, in the event loop
42             while (1) {
43             my $ch = getch;
44             do_input_processing_and_other_crud();
45             $m->scroll;
46             }
47              
48             =head1 METHODS
49              
50             =head2 new
51              
52             Creates a new A::C::M object. Three arguments are required:
53              
54             * window
55             * height
56             * width
57              
58             C should be a curses window that the marquee can write
59             to. C and C should be the height and width of that
60             window, in characters.
61              
62             There are also two optional arguments: C, which sets the figlet
63             font of the marquee (defaults to the figlet default, 'standard'), and
64             C which will set an initial string to be displayed and cause the
65             marquee to start display as soon as it is created.
66              
67             =cut
68              
69             sub new {
70             my ($class,%args) = @_;
71              
72             die "Can't create marquee object without a host window\n"
73             unless( defined $args{window} );
74             die "Can't create marquee object without height value\n"
75             unless( defined $args{height} );
76             die "Can't create marquee object without width value\n"
77             unless( defined $args{width} );
78              
79             my $self = bless { win => $args{window},
80             height => $args{height},
81             width => $args{width},
82             font => $args{font} || 'standard',
83             srctxt => $args{text} || undef,
84             figtxt => '',
85             txtlen => 0,
86             offset => 0,
87             active => 0,
88             }, $class;
89              
90             $self->text($self->{srctext}) if (defined $self->{srctxt});
91              
92             return $self;
93             }
94              
95             =head2 scroll
96              
97             Scroll the marquee one position to the right.
98              
99             =cut
100              
101             sub scroll {
102             my $self = shift;
103             my $w = $self->{win};
104             my $x = $self->{width};
105             my $y = $self->{height};
106             my $len = $self->{txtlen};
107             my $off = $self->{offset};
108             my $fig = $self->{figtxt};
109              
110             for (0..$y) { addstr($w, $_, 0, (' ' x $x)) }
111              
112             $self->{offset} = 0 if ($self->{offset} == $len);
113              
114             foreach my $i (0..(@{$fig} - 1)) {
115             if ($off + $x > $len) {
116             my $end = $len - $off;
117             my $rem = $x - $end;
118             my $tmp = substr($fig->[$i],$off,$end);
119             $tmp .= substr($fig->[$i],0,$rem);
120             addstr($w, $i, 0, $tmp);
121             } else {
122             addstr($w, $i, 0, substr($fig->[$i],$off,$x));
123             }
124             }
125             $self->{offset}++;
126             refresh($w);
127             }
128              
129             =head2 text
130              
131             Take a new line of text for the marquee...
132              
133             $m->text("New line of text");
134              
135             ...render it via figlet, split it into an array, and perform width
136             adjustments as neccessary. Store the new text, figleted text, length
137             of figleted text lines, and set marquee state to active.
138              
139             =cut
140              
141             sub text {
142             my ($self,$text) = @_;
143             my $font = $self->{font};
144             my $width = length($text) * 12;
145             my $line = 0;
146              
147             # render text via figlet
148             my @fig = split(/\n/,`figlet -f $font -w $width '$text'`);
149              
150             # find longest line length
151             foreach my $i (0..(@fig - 1)) {
152             $line = length($fig[$i]) if (length($fig[$i]) > $line);
153             }
154              
155             # set line length to window width if shorter than that
156             $line = $self->{width} if ($line < $self->{width});
157              
158             # pad all lines window width or longest length + 5
159             foreach my $i (0..(@fig - 1)) {
160             my $len = length($fig[$i]);
161             my $pad = $line - $len;
162             $pad += 25 if ($len > ($self->{width} - 6));
163             $fig[$i] = join('',$fig[$i],(' 'x $pad));
164             }
165            
166             $self->{active} = 1;
167             $self->{offset} = 0;
168             $self->{srctxt} = $text;
169             $self->{txtlen} = length($fig[0]);
170             $self->{figtxt} = \@fig;
171             }
172              
173             =head2 font
174              
175             Sets the font of the marquee object and then calls C to make the
176             display change.
177              
178             $m->font('univers')
179              
180             This method should not be called before the marquee object is active.
181             No checking is done to ensure the spacified font exists.
182              
183             =cut
184              
185             sub font {
186             my ($self,$font) = @_;
187             $self->{font} = $font;
188             $self->text($self->{srctxt});
189             }
190              
191             =head2 is_active
192              
193             Returns the marquee object's status (whether text has been set or not)
194              
195             =cut
196              
197             sub is_active {
198             my $self = shift;
199             return $self->{active};
200             }
201              
202             =head1 TODO
203              
204             A couple of nice transitions when changing the message would be good.
205              
206             Left-to-right scrolling?
207              
208             =head1 AUTHOR
209              
210             Shawn Boyette, C<< >>
211              
212             =head1 BUGS
213              
214             Please report any bugs or feature requests to
215             C, or through the web interface at
216             L.
217             I will be notified, and then you'll automatically be notified of progress on
218             your bug as I make changes.
219              
220             =head1 ACKNOWLEDGEMENTS
221              
222             =head1 COPYRIGHT & LICENSE
223              
224             Copyright 2005 Shawn Boyette, All Rights Reserved.
225              
226             This program is free software; you can redistribute it and/or modify it
227             under the same terms as Perl itself.
228              
229             =cut
230              
231             1; # End of Acme::Curses::Marquee