1 |
#!/usr/bin/perl |
2 |
use warnings; |
3 |
use strict; |
4 |
$| = 1; |
5 |
|
6 |
my $coalesce_time = 0.05; |
7 |
my $iframe_frequency = 100; |
8 |
|
9 |
use Term::TtyRec; |
10 |
use Term::Emulator::Parser; |
11 |
use TermEncoder; |
12 |
use FileHandle; |
13 |
use Time::HiRes qw/ time sleep /; |
14 |
use JSON; |
15 |
use Carp; |
16 |
|
17 |
$SIG{INT} = sub { confess }; |
18 |
|
19 |
sub openRec { |
20 |
my ($fn) = @_; |
21 |
my $fh = FileHandle->new($fn, "r") or die; # wtf. |
22 |
my $rec = Term::TtyRec->new($fh); |
23 |
return $rec; |
24 |
} |
25 |
|
26 |
my $readframes = 0; |
27 |
{ |
28 |
my $lasttime = undef; |
29 |
my @data = (); |
30 |
sub parseFrame { |
31 |
my ($rec, $term) = @_; |
32 |
local $_; |
33 |
while ( not @data or (defined $lasttime and $data[-1]->[0] - $lasttime < $coalesce_time) ) { |
34 |
my ($time, $data) = $rec->read_next; |
35 |
last unless defined $time; |
36 |
push @data, [$time, $data]; |
37 |
$readframes++; |
38 |
} |
39 |
if ( @data > 1 ) { |
40 |
my $ld = pop @data; |
41 |
$term->parse($_) for map $_->[1], @data; |
42 |
$lasttime = $data[-1][0]; |
43 |
@data = ($ld); |
44 |
return $lasttime; |
45 |
} elsif ( @data ) { |
46 |
$term->parse($_) for map $_->[1], @data; |
47 |
$lasttime = $data[-1][0]; |
48 |
@data = (); |
49 |
return $lasttime; |
50 |
} else { |
51 |
return; |
52 |
} |
53 |
} |
54 |
} |
55 |
|
56 |
### |
57 |
|
58 |
print "setup\n"; |
59 |
|
60 |
my $width = 80; |
61 |
my $height = 24; |
62 |
my $term = undef; |
63 |
my $rec = undef; |
64 |
my $outfile = undef; |
65 |
|
66 |
while ( @ARGV ) { |
67 |
my $ar = shift; |
68 |
if ( $ar eq "--width" or $ar eq "-w" ) { |
69 |
$width = shift; |
70 |
} elsif ( $ar eq "--height" or $ar eq "-h" ) { |
71 |
$height = shift; |
72 |
} elsif ( $ar eq "--size" or $ar eq "-s" ) { |
73 |
my $size = shift; |
74 |
my ($w,$h) = ($size =~ /^(\d+)x(\d+)$/); |
75 |
die "size argument is malformed, use WIDxHEI\n" |
76 |
unless defined $w and defined $h; |
77 |
$width = $w; |
78 |
$height = $h; |
79 |
} elsif ( not defined $rec ) { |
80 |
$rec = openRec($ar); |
81 |
} elsif ( not defined $outfile ) { |
82 |
die "won't overwrite an existing file $ar" |
83 |
if -e $ar; |
84 |
$outfile = $ar; |
85 |
} else { |
86 |
die "unknown argument or too many arguments: $ar\n"; |
87 |
} |
88 |
} |
89 |
|
90 |
$term = Term::Emulator::Parser->new( width => $width, height => $height, output_enable => 0 ); |
91 |
my $encoder = TermEncoder->new( term => $term ); |
92 |
|
93 |
my @timeline; |
94 |
|
95 |
print "parse... 0 \033[K"; |
96 |
|
97 |
my %buffers = ( |
98 |
d => ['as_string'], |
99 |
f => ['fg_as_string'], |
100 |
b => ['bg_as_string'], |
101 |
B => ['bold_as_string'], |
102 |
U => ['underline_as_string'], |
103 |
); |
104 |
|
105 |
my $lastx = undef; |
106 |
my $lasty = undef; |
107 |
|
108 |
for my $k ( keys %buffers ) { |
109 |
my $f = $buffers{$k}->[0]; |
110 |
push @{$buffers{$k}}, $term->$f; |
111 |
} |
112 |
|
113 |
my $starttime = undef; |
114 |
while ( defined(my $time = parseFrame($rec, $term)) ) { |
115 |
push @timeline, $encoder->frames % $iframe_frequency == 0 ? $encoder->next_iframe($time) : $encoder->next_pframe($time); |
116 |
print "\rparse... ".$encoder->frames." ($readframes) \033[K"; |
117 |
} |
118 |
|
119 |
print "\rparsed ".$encoder->frames." frames ($readframes from ttyrec)\033[K\n"; |
120 |
print "serialize\n"; |
121 |
|
122 |
open my $sf, ">", $outfile or die "Couldn't open $outfile for writing: $!"; |
123 |
print $sf to_json { timeline => \@timeline, width => $width, height => $height }; |
124 |
close $sf; |
125 |
|
126 |
print "done\n"; |
127 |
|