| 1 |
package TermEncoder; |
| 2 |
use strict; |
| 3 |
|
| 4 |
use Time::HiRes qw/ time /; |
| 5 |
|
| 6 |
sub new { |
| 7 |
my ($class, %args) = @_; |
| 8 |
my $self = bless {}, $class; |
| 9 |
|
| 10 |
die unless exists $args{'term'}; |
| 11 |
$self->{'term'} = delete $args{'term'}; |
| 12 |
|
| 13 |
$self->{'frames'} = 0; |
| 14 |
$self->{'buffers'} = { |
| 15 |
d => ['as_string'], |
| 16 |
f => ['fg_as_string'], |
| 17 |
b => ['bg_as_string'], |
| 18 |
B => ['bold_as_string'], |
| 19 |
U => ['underline_as_string'], |
| 20 |
}; |
| 21 |
|
| 22 |
return $self; |
| 23 |
} |
| 24 |
|
| 25 |
sub is_dirty { |
| 26 |
my ($self) = @_; |
| 27 |
|
| 28 |
return 1 if $self->{'frames'} == 0; |
| 29 |
|
| 30 |
for my $bufk ( keys %{$self->{'buffers'}} ) { |
| 31 |
my $buf = $self->{'buffers'}->{$bufk}; |
| 32 |
my $fn = $buf->[0]; |
| 33 |
return 1 if $buf->[1] ne $self->{'term'}->$fn; |
| 34 |
} |
| 35 |
|
| 36 |
return 0; |
| 37 |
} |
| 38 |
|
| 39 |
sub next_pframe { |
| 40 |
my ($self, $time) = @_; |
| 41 |
$time = time unless defined $time; |
| 42 |
|
| 43 |
return $self->next_iframe($time) if $self->{'frames'} == 0; |
| 44 |
|
| 45 |
my $fs = { t => $time+0, x => $self->{'term'}->curposx+0, y => $self->{'term'}->curposy+0 }; |
| 46 |
|
| 47 |
for my $bufk ( keys %{$self->{'buffers'}} ) { |
| 48 |
my $buf = $self->{'buffers'}->{$bufk}; |
| 49 |
my $fn = $buf->[0]; |
| 50 |
my $new = $self->{'term'}->$fn; |
| 51 |
$fs->{$bufk} = $self->_compress_pframe_block( $buf->[1], $new ) |
| 52 |
if $buf->[1] ne $new; |
| 53 |
$buf->[1] = $new; |
| 54 |
} |
| 55 |
|
| 56 |
$self->{'frames'}++; |
| 57 |
return $fs; |
| 58 |
} |
| 59 |
|
| 60 |
sub next_iframe { |
| 61 |
my ($self, $time) = @_; |
| 62 |
$time = time unless defined $time; |
| 63 |
|
| 64 |
my $fs = { t => $time+0, i => 1, x => $self->{'term'}->curposx+0, y => $self->{'term'}->curposy+0 }; |
| 65 |
|
| 66 |
for my $bufk ( keys %{$self->{'buffers'}} ) { |
| 67 |
my $buf = $self->{'buffers'}->{$bufk}; |
| 68 |
my $fn = $buf->[0]; |
| 69 |
my $info = $self->{'term'}->$fn; |
| 70 |
$fs->{$bufk} = $self->_compress_iframe_block( $info ); |
| 71 |
$buf->[1] = $info; |
| 72 |
} |
| 73 |
|
| 74 |
$self->{'frames'}++; |
| 75 |
return $fs; |
| 76 |
} |
| 77 |
|
| 78 |
sub _compress_iframe_block { |
| 79 |
my ($self, $block) = @_; |
| 80 |
|
| 81 |
my @out = (); |
| 82 |
my @rows = split /\n/, $block; |
| 83 |
|
| 84 |
my $lastrow = undef; |
| 85 |
for my $r ( @rows ) { |
| 86 |
if ( defined $lastrow and $lastrow eq $r ) { |
| 87 |
push @out, 'd'; # duplicate last row |
| 88 |
} else { |
| 89 |
if ( (substr($r,0,1) x length($r)) eq $r ) { |
| 90 |
push @out, ['a', substr($r,0,1)]; # one-char line |
| 91 |
} else { |
| 92 |
push @out, ['r', $r]; # raw line |
| 93 |
} |
| 94 |
# TODO: RLE line |
| 95 |
} |
| 96 |
$lastrow = $r; |
| 97 |
} |
| 98 |
|
| 99 |
return \@out; |
| 100 |
} |
| 101 |
|
| 102 |
sub _compress_pframe_block { |
| 103 |
my ($self, $old, $new) = @_; |
| 104 |
my @old = split /\n/, $old; |
| 105 |
my @new = split /\n/, $new; |
| 106 |
die if @old != @new; |
| 107 |
my @diff; |
| 108 |
MAINROW: for my $row ( 0 .. $#old ) { NEXTER: { |
| 109 |
if ( $new[$row] ne $old[$row] ) { |
| 110 |
for my $other ( 0 .. $#old ) { |
| 111 |
if ( $new[$row] eq $old[$other] ) { |
| 112 |
# row copy mode |
| 113 |
push @diff, ['cp', $other+0, $row+0]; |
| 114 |
last NEXTER; |
| 115 |
} |
| 116 |
} |
| 117 |
|
| 118 |
if ( substr($new[$row],0,1) x length($new[$row]) eq $new[$row] ) { |
| 119 |
# one char line mode |
| 120 |
push @diff, [$row+0, ['a', substr($new[$row],0,1).""]]; |
| 121 |
last NEXTER; |
| 122 |
} |
| 123 |
|
| 124 |
my @off = map { substr($old[$row], $_, 1) ne substr($new[$row], $_, 1) } 0 .. length($old[$row])-1; |
| 125 |
my @offchunks = (); |
| 126 |
for my $i ( 0 .. $#off ) { |
| 127 |
if ( $off[$i] ) { |
| 128 |
if ( @offchunks and $offchunks[-1][1] >= $i-4 ) { # coalesce if there's less than 3 chars between |
| 129 |
$offchunks[-1][1] = $i; |
| 130 |
} else { |
| 131 |
push @offchunks, [$i,$i]; |
| 132 |
} |
| 133 |
} |
| 134 |
} |
| 135 |
|
| 136 |
for my $ch ( @offchunks ) { |
| 137 |
if ( $ch->[0] == $ch->[1] ) { |
| 138 |
# char mode |
| 139 |
push @diff, [$row+0, $ch->[0]+0, substr($new[$row], $ch->[0], 1).""]; |
| 140 |
} else { |
| 141 |
my $chunk = substr($new[$row], $ch->[0], $ch->[1]-$ch->[0]+1); |
| 142 |
if ( substr($chunk,0,1) x length($chunk) eq $chunk ) { |
| 143 |
# one char chunk mode |
| 144 |
push @diff, [$row+0, $ch->[0]+0, $ch->[1]+0, ['a',substr($chunk,0,1).""]]; |
| 145 |
} else { |
| 146 |
# chunk mode |
| 147 |
push @diff, [$row+0, $ch->[0]+0, $ch->[1]+0, $chunk.""]; |
| 148 |
} |
| 149 |
} |
| 150 |
} |
| 151 |
} |
| 152 |
} # NEXTER |
| 153 |
$old[$row] = $new[$row]; |
| 154 |
} |
| 155 |
return \@diff; |
| 156 |
} |
| 157 |
|
| 158 |
sub frames { $_[0]->{'frames'} } |
| 159 |
|
| 160 |
1; |
| 161 |
|
Parent Directory
| 
Revision Log