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