Initial checkout of Vore Tournament 0.1.alpha.
[voretournament/voretournament.git] / misc / tools / demotc.pl
1 #!/usr/bin/perl
2
3 # Fake demo "cutting" tool
4 # works by looking for time codes in the demo
5 # and injecting playback speed commands
6
7 use strict;
8 use warnings;
9
10 sub sanitize($)
11 {
12         my ($str) = @_;
13         $str =~ y/\000-\037//d;
14         return $str;
15 }
16
17 # opening the files
18
19 my ($in, $out, $tc0, $tc1, $pattern, $capture);
20
21 my $mode = shift @ARGV;
22 $mode = 'help' if not defined $mode;
23
24 if($mode eq 'grep' && @ARGV == 2)
25 {
26         $in = $ARGV[0];
27         $pattern = $ARGV[1];
28 }
29 elsif($mode eq 'uncut' && @ARGV == 2)
30 {
31         $in = $ARGV[0];
32         $out = $ARGV[1];
33 }
34 elsif($mode eq 'cut' && (@ARGV == 4 || @ARGV == 5))
35 {
36         $in = $ARGV[0];
37         $out = $ARGV[1];
38         $tc0 = $ARGV[2];
39         $tc1 = $ARGV[3];
40         $capture = (@ARGV == 5);
41 }
42 else
43 {
44         die "Usage: $0 cut infile outfile tc_start tc_end [--capture], or $0 uncut infile outfile, or $0 grep infile pattern\n"
45 }
46
47 if($mode ne 'grep')
48 {
49         $in ne $out
50                 or die "Input and output file may not be the same!";
51 }
52
53 open my $infh, "<", $in
54         or die "open $in: $!";
55 binmode $infh;
56
57 my $outfh;
58 if($mode ne 'grep') # cutting
59 {
60         open $outfh, ">", $out
61                 or die "open $out: $!";
62         binmode $outfh;
63 }
64
65 # 1. CD track
66
67 $/ = "\012";
68 my $cdtrack = <$infh>;
69 print $outfh $cdtrack if $mode ne 'grep';
70
71 # 2. packets
72
73 my $tc = undef;
74
75 my $first = 1;
76 my $demo_started = 0;
77 my $demo_stopped = 0;
78 my $inject_buffer = "";
79
80 use constant DEMOMSG_CLIENT_TO_SERVER => 0x80000000;
81 for(;;)
82 {
83         last
84                 unless 4 == read $infh, my $length, 4;
85         $length = unpack("V", $length);
86         if($length & DEMOMSG_CLIENT_TO_SERVER)
87         {
88                 # client-to-server packet
89                 $length = $length & ~DEMOMSG_CLIENT_TO_SERVER;
90                 die "Invalid demo packet"
91                         unless 12 == read $infh, my $angles, 12;
92                 die "Invalid demo packet"
93                         unless $length == read $infh, my($data), $length;
94
95                 next if $mode eq 'grep';
96                 print $outfh pack("V", length($data) | DEMOMSG_CLIENT_TO_SERVER);
97                 print $outfh $angles;
98                 print $outfh $data;
99                 next;
100         }
101         die "Invalid demo packet"
102                 unless 12 == read $infh, my $angles, 12;
103         die "Invalid demo packet"
104                 unless $length == read $infh, my($data), $length;
105         
106         # remove existing cut marks
107         $data =~ s{^\011\n//CUTMARK\n[^\0]*\0}{};
108         
109         if(substr($data, 0, 1) eq "\007") # svc_time
110         {
111                 $tc = unpack "f", substr $data, 1, 4;
112         }
113
114         if($mode eq 'cut' && defined $tc)
115         {
116                 if($first)
117                 {
118                         $inject_buffer = "\011\n//CUTMARK\nslowmo 100\n\000";
119                         $first = 0;
120                 }
121                 if($demo_started < 1 && $tc > $tc0 - 50)
122                 {
123                         $inject_buffer = "\011\n//CUTMARK\nslowmo 10\n\000";
124                         $demo_started = 1;
125                 }
126                 if($demo_started < 2 && $tc > $tc0 - 5)
127                 {
128                         $inject_buffer = "\011\n//CUTMARK\nslowmo 1\n\000";
129                         $demo_started = 2;
130                 }
131                 if($demo_started < 3 && $tc > $tc0)
132                 {
133                         if($capture)
134                         {
135                                 $inject_buffer = "\011\n//CUTMARK\ncl_capturevideo 1\n\000";
136                         }
137                         else
138                         {
139                                 $inject_buffer = "\011\n//CUTMARK\nslowmo 0; defer 1 \"slowmo 1\"\n\000";
140                         }
141                         $demo_started = 3;
142                 }
143                 if(!$demo_stopped && $tc > $tc1)
144                 {
145                         if($capture)
146                         {
147                                 $inject_buffer = "\011\n//CUTMARK\ncl_capturevideo 0; defer 0.5 \"disconnect\"\n\000";
148                         }
149                         else
150                         {
151                                 $inject_buffer = "\011\n//CUTMARK\ndefer 0.5 \"disconnect\"\n\000";
152                         }
153                         $demo_stopped = 1;
154                 }
155         }
156         elsif($mode eq 'grep')
157         {
158                 if(my @l = ($data =~ /$pattern/))
159                 {
160                         if(defined $tc)
161                         {
162                                 print "$tc:";
163                         }
164                         else
165                         {
166                                 print "start:";
167                         }
168                         for(@l)
169                         {
170                                 print " \"", sanitize($_), "\"";
171                         }
172                         print "\n";
173                 }
174         }
175         
176         next if $mode eq 'grep';
177         if(length($inject_buffer . $data) < 65536)
178         {
179                 $data = $inject_buffer . $data;
180                 $inject_buffer = "";
181         }
182         print $outfh pack("V", length $data);
183         print $outfh $angles;
184         print $outfh $data;
185 }
186
187 close $outfh if $mode ne 'grep';
188 close $infh;