ttyrec/jsttyplay/preprocess.pl

#!/usr/bin/perl
use warnings;
use strict;
$| = 1;

my $coalesce_time = 0.05;
my $iframe_frequency = 100;

use Term::TtyRec;
use Term::Emulator::Parser;
use TermEncoder;
use FileHandle;
use Time::HiRes qw/ time sleep /;
use JSON;
use Carp;

$SIG{INT} = sub { confess };

sub openRec {
    my ($fn) = @_;
    my $fh = FileHandle->new($fn, "r") or die; # wtf.
    my $rec = Term::TtyRec->new($fh);
    return $rec;
}

my $readframes = 0;
{
    my $lasttime = undef;
    my @data = ();
    sub parseFrame {
        my ($rec, $term) = @_;
        local $_;
        while ( not @data or (defined $lasttime and $data[-1]->[0] - $lasttime < $coalesce_time) ) {
            my ($time, $data) = $rec->read_next;
            last unless defined $time;
            push @data, [$time, $data];
            $readframes++;
        }
        if ( @data > 1 ) {
            my $ld = pop @data;
            $term->parse($_) for map $_->[1], @data;
            $lasttime = $data[-1][0];
            @data = ($ld);
            return $lasttime;
        } elsif ( @data ) {
            $term->parse($_) for map $_->[1], @data;
            $lasttime = $data[-1][0];
            @data = ();
            return $lasttime;
        } else {
            return;
        }
    }
}

###

print "setup\n";

my $width   = 80;
my $height  = 24;
my $term    = undef;
my $rec     = undef;
my $outfile = undef;

while ( @ARGV ) {
    my $ar = shift;
    if ( $ar eq "--width" or $ar eq "-w" ) {
        $width = shift;
    } elsif ( $ar eq "--height" or $ar eq "-h" ) {
        $height = shift;
    } elsif ( $ar eq "--size" or $ar eq "-s" ) {
        my $size = shift;
        my ($w,$h) = ($size =~ /^(\d+)x(\d+)$/);
        die "size argument is malformed, use WIDxHEI\n"
            unless defined $w and defined $h;
        $width = $w;
        $height = $h;
    } elsif ( not defined $rec ) {
        $rec = openRec($ar);
    } elsif ( not defined $outfile ) {
        die "won't overwrite an existing file $ar"
            if -e $ar;
        $outfile = $ar;
    } else {
        die "unknown argument or too many arguments: $ar\n";
    }
}

$term = Term::Emulator::Parser->new( width => $width, height => $height, output_enable => 0 );
my $encoder = TermEncoder->new( term => $term );

my @timeline;

print "parse... 0 \033[K";

my %buffers = (
    d => ['as_string'],
    f => ['fg_as_string'],
    b => ['bg_as_string'],
    B => ['bold_as_string'],
    U => ['underline_as_string'],
);

my $lastx = undef;
my $lasty = undef;

for my $k ( keys %buffers ) {
    my $f = $buffers{$k}->[0];
    push @{$buffers{$k}}, $term->$f;
}

my $starttime = undef;
while ( defined(my $time = parseFrame($rec, $term)) ) {
    push @timeline, $encoder->frames % $iframe_frequency == 0 ? $encoder->next_iframe($time) : $encoder->next_pframe($time);
    print "\rparse... ".$encoder->frames." ($readframes) \033[K";
}

print "\rparsed ".$encoder->frames." frames ($readframes from ttyrec)\033[K\n";
print "serialize\n";

open my $sf, ">", $outfile or die "Couldn't open $outfile for writing: $!";
print $sf to_json { timeline => \@timeline, width => $width, height => $height };
close $sf;

print "done\n";

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