1 |
dpavlin |
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 |
|
|
|