misc/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 for(;;)
  81 {
  82         last
  83                 unless 4 == read $infh, my $length, 4;
  84         $length = unpack("V", $length);
  85         die "Invalid demo packet"
  86                 unless 12 == read $infh, my $angles, 12;
  87         die "Invalid demo packet"
  88                 unless $length == read $infh, my($data), $length;
  89
  90         # remove existing cut marks
  91         $data =~ s{^\011\n//CUTMARK\n[^\0]*\0}{};
  92
  93         if(substr($data, 0, 1) eq "\007") # svc_time
  94         {
  95                 $tc = unpack "f", substr $data, 1, 4;
  96         }
  97
  98         if($mode eq 'cut' && defined $tc)
  99         {
 100                 if($first)
 101                 {
 102                         $inject_buffer = "\011\n//CUTMARK\nslowmo 100\n\000";
 103                         $first = 0;
 104                 }
 105                 if($demo_started < 1 && $tc > $tc0 - 50)
 106                 {
 107                         $inject_buffer = "\011\n//CUTMARK\nslowmo 10\n\000";
 108                         $demo_started = 1;
 109                 }
 110                 if($demo_started < 2 && $tc > $tc0 - 5)
 111                 {
 112                         $inject_buffer = "\011\n//CUTMARK\nslowmo 1\n\000";
 113                         $demo_started = 2;
 114                 }
 115                 if($demo_started < 3 && $tc > $tc0)
 116                 {
 117                         if($capture)
 118                         {
 119                                 $inject_buffer = "\011\n//CUTMARK\ncl_capturevideo 1\n\000";
 120                         }
 121                         else
 122                         {
 123                                 $inject_buffer = "\011\n//CUTMARK\nslowmo 0; defer 1 \"slowmo 1\"\n\000";
 124                         }
 125                         $demo_started = 3;
 126                 }
 127                 if(!$demo_stopped && $tc > $tc1)
 128                 {
 129                         if($capture)
 130                         {
 131                                 $inject_buffer = "\011\n//CUTMARK\ncl_capturevideo 0; defer 0.5 \"disconnect\"\n\000";
 132                         }
 133                         else
 134                         {
 135                                 $inject_buffer = "\011\n//CUTMARK\ndefer 0.5 \"disconnect\"\n\000";
 136                         }
 137                         $demo_stopped = 1;
 138                 }
 139         }
 140         elsif($mode eq 'grep')
 141         {
 142                 if(my @l = ($data =~ /$pattern/))
 143                 {
 144                         print "$tc:";
 145                         for(@l)
 146                         {
 147                                 print " \"", sanitize($_), "\"";
 148                         }
 149                         print "\n";
 150                 }
 151         }
 152
 153         next if $mode eq 'grep';
 154         if(length($inject_buffer . $data) < 65536)
 155         {
 156                 $data = $inject_buffer . $data;
 157                 $inject_buffer = "";
 158         }
 159         print $outfh pack("V", length $data);
 160         print $outfh $angles;
 161         print $outfh $data;
 162 }
 163
 164 close $outfh if $mode ne 'grep';
 165 close $infh;