File Coverage

blib/lib/Acme/Curses/Marquee/Extensions.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Acme::Curses::Marquee::Extensions;
2 1     1   30301 use strict;
  1         2  
  1         39  
3 1     1   6 use warnings;
  1         2  
  1         39  
4             require 5.006;
5              
6 1     1   6 use base 'Acme::Curses::Marquee';
  1         7  
  1         776  
7             our $VERSION = 0.04;
8              
9 1     1   927 use Text::FIGlet 2.00;
  1         701749  
  1         12  
10 1     1   711 use Curses qw(A_BLINK); #Don't clobber scroll! XXX
  0            
  0            
11             use Term::ANSIColor; #Many curses don't have color
12             use Every;
13              
14             sub import{
15             use Acme::Curses::Marquee::EVIL; #XXX Pass along vertical
16             }
17              
18             sub new{
19             my $class = shift;
20             my %args = (
21             active => 0,
22             winh => 25,
23             winw => 80,
24             winx => 0,
25             winy => 0,
26             @_ );
27              
28             $args{srctxt} = delete($args{text});
29              
30             #Instantiate the font(s)
31             my $font;
32             if( ref($args{font}) eq 'ARRAY' ){
33             local($_);
34              
35             $args{_fonts} = $args{font};
36             $args{_fontSec} = pop @{$args{_fonts}} if $args{_fonts}->[-1] =~ /^\d+/;
37              
38             $font = $args{_font}->{ $args{font}=$_ } = font({}, $_, '-0') for
39             reverse @{$args{_fonts}};
40             }
41             else{
42             $font = $args{_font}->{$args{font}} = font({}, $args{font}, '-0');
43             }
44              
45             #For text's rendering
46             $args{height} = $font->{_header}->[1];
47             $args{width} = $args{winw};
48              
49             #Set up the display
50             $args{winy} ||= int($args{winh}/2 - $args{height}/2);
51             $args{win} = new Curses($args{height},$args{winw},$args{winy},$args{winx});
52              
53             my $self = bless \%args, $class;
54             $self->text($self->{srctxt}) if (defined $self->{srctxt});
55              
56             return $self;
57             }
58              
59             sub font {
60             $_[0]->{_font}->{$_[1]} = Text::FIGlet->new(-f=>$_[1]);
61             delete($_[0]->{_sweep});
62             return $_[-1] eq '-0' ? $_[0]->{_font}->{$_[1]} : shift->SUPER::font(@_);
63             }
64              
65             sub sweep{
66             my($self, $state) = @_;
67              
68             if( $state == -1 && $self->{offset} == int($self->{txtlen}/2) ){
69             $self->{txtlen} = $self->{_sweep};
70             }
71              
72             if( $state ){
73             return if exists($self->{_sweep});
74             $self->{offset} = $self->{_sweep} = $self->{txtlen};
75             $self->{txtlen}+= $self->{width};
76             }
77             else{
78             # $self->{offset} = 0;
79             $self->{txtlen} = delete($self->{_sweep});
80             }
81             }
82              
83             {
84             my $i = 0;
85             sub scroll{
86             my $self = shift;
87             #XXX offset would work if we could account for one wrap-around...
88             # if( defined($self->{_fonts}) && ($self->{offset} == $self->{txtlen}) ){
89             if( defined($self->{_fonts}) && every seconds=>$self->{_fontSec}||45 ){
90             #XXX reposition vertically iff auto-centered
91             $self->font( $self->{_fonts}->[ ++$i %scalar(@{ $self->{_fonts} }) ]);
92             }
93             $self->SUPER::scroll;
94             }
95             }
96              
97             {
98             my $i = 0;
99             my $rainbow = [qw/red yellow/,'bold yellow',qw/green cyan blue magenta/];
100             sub colors{
101             my($self, %p) = @_;
102             my @colors = @{$p{colors}||$rainbow};
103             if( every seconds=>$p{delay}||5 ){
104             print color $colors[$i++%scalar @colors];
105             }
106             }
107             }
108              
109             #XXX
110             sub blink{
111             print color 'blink';
112             }
113              
114             1;
115             __END__