File Coverage

blib/lib/Term/VT102/Boundless.pm
Criterion Covered Total %
statement 46 46 100.0
branch 15 20 75.0
condition n/a
subroutine 9 9 100.0
pod 3 3 100.0
total 73 78 93.5


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package Term::VT102::Boundless;
4 1     1   66327 use base qw/Term::VT102/;
  1         2  
  1         722  
5              
6 1     1   9727 use strict;
  1         2  
  1         19  
7 1     1   6 use warnings;
  1         2  
  1         571  
8              
9             our $VERSION = "0.05";
10              
11             sub new {
12 1     1 1 556 my ( $class, @args ) = @_;
13              
14 1         9 my $self = $class->SUPER::new(
15             cols => 1,
16             rows => 1,
17             @args,
18             );
19              
20 1         261 return $self;
21             }
22              
23             sub _process_text {
24 2     2   1150 my ( $self, $text ) = @_;
25              
26 2 50       8 return if ($self->{'_xon'} == 0);
27              
28 2         5 my ( $x, $y ) = @{ $self }{qw(x y)};
  2         5  
29              
30             # for is used for aliasing
31 2         6 for my $row ( $self->{'scrt'}[$y] ) {
32 2 100       6 $row = '' unless defined $row;
33              
34 2 100       5 if ( length($row) < $x ) {
35 1         4 $row .= " " x ( $x - length($row) );
36             }
37              
38 2         5 substr ( $row, $x - 1, length $text) = $text;
39              
40 2         3 my $newcols = length $row;
41 2 50       8 $self->{'cols'} = $newcols if $newcols > $self->{'cols'};
42             }
43              
44 2         7 for my $row_attrs ( $self->{'scra'}[$y] ) {
45 2 100       5 $row_attrs = '' unless defined $row_attrs;
46              
47 2 100       7 if ( ( length($row_attrs) / 2 ) < $x ) {
48 1         4 $row_attrs .= Term::VT102::DEFAULT_ATTR_PACKED x ( $x - ( length($row_attrs) / 2 ) );
49             }
50              
51 2         9 substr ( $row_attrs, 2 * ($x - 1), 2 * (length $text) ) = $self->{'attr'} x (length $text);
52             }
53              
54 2         4 $self->{'x'} += length $text;
55              
56 2         10 $self->callback_call('ROWCHANGE', $y, 0);
57             }
58              
59             sub _move_down { # move cursor down
60 1     1   1135 my ( $self, $num ) = @_;
61              
62 1 50       5 $num = 1 if (not defined $num);
63 1 50       3 $num = 1 if ($num < 1);
64              
65 1         3 $self->{'y'} += $num;
66 1 50       4 return if ($self->{'y'} <= $self->{'srb'});
67              
68 1         5 $self->{'srb'} = $self->{'rows'} = $self->{'y'};
69             }
70              
71             sub row_attr {
72 2     2 1 1058 my ( $self, $row, @args ) = @_;
73 2         9 $self->_extend_row($row);
74 2         12 $self->SUPER::row_attr( $row, @args );
75             }
76              
77             sub row_text {
78 2     2 1 1568 my ( $self, $row, @args ) = @_;
79 2         7 $self->_extend_row($row);
80 2         14 $self->SUPER::row_text( $row, @args );
81             }
82              
83             sub _extend_row {
84 4     4   8 my ( $self, $row ) = @_;
85              
86             # if the screen has grown since a row was processed, fill in the missing bits
87              
88 4 100       18 if ( (my $extend = $self->{cols} - length($self->{scrt}[$row])) > 0 ) {
89 1         4 $self->{scra}[$row] .= Term::VT102::DEFAULT_ATTR_PACKED x $extend; # FIXME use the last attr in the row instead?
90 1         11 $self->{scrt}[$row] .= ("\x00" x $extend);
91             }
92             }
93              
94             __PACKAGE__;
95              
96             __END__