#!/usr/bin/perl -w
#
# script to fix flycamone AVI files
# Copyright (C) 2008  christian mock <cm@tahina.priv.at>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use strict;
use File::Format::RIFF;

my $target_fps = 25;
my $target_us = int(1000000 / $target_fps);

my $ifn = shift || die "usage: $0 infile.avi outfile.avi\n";
my $ofn = shift || die "usage: $0 infile.avi outfile.avi\n";

open(IN, $ifn) || die "open $ifn: $!\n";

open(OUT, "|mencoder -oac copy -ovc copy -idx -force-avi-aspect 4:3 -o $ofn -")
  || die "open |mencoder: $!\n";

my $riff = File::Format::RIFF->read(\*IN);

my $us_frame;
my $tot_frames;
my $au_rate;
my $au_samp_size;
my $i = 0; # top level chunk index in file

checkchunk(\$riff, 'RIFF', 'AVI ', "file header");

my($chunk) = $riff->at($i++);

## first chunk: avi header
checkchunk(\$chunk, 'LIST','hdrl', "first chunk");

foreach my $item ($chunk->data) {
  if($item->id eq 'avih') {
    print "avih: size ", $item->size, "\n"; # 4 bytes each...
    my $data = $item->data;
    $us_frame = unpack('L', $data);
    my $streams = unpack('L',substr($data,24,4));
    $tot_frames = unpack('L',substr($data,16,4));
    die "avih: streams ($streams) must be 2\n" unless $streams == 2;
    printf "frame rate: %.2f -> %.2f\n", 1e6/$us_frame, 1e6/$target_us;
    substr($data,0,4,pack('L', $target_us)); # replace
    $item->data($data);
  } elsif($item->id eq 'LIST' && $item->type eq 'strl') { # stream list
    print "strl\n";
    foreach my $strli ($item->data) {
      if($strli->id eq 'strh') { # stream header
	if($strli->data =~ /^vidsMJPG/) {
	  my $data = $strli->data;
	  my $scale = unpack('L', substr($data, 20, 4));
	  if($scale != $us_frame) {
	    die sprintf("differing us_frame/scale in avih vs strh, %d/%d\n",
			$us_frame, $scale);
	  }
	  substr($data,20,4,pack('L',$target_us)); # replace
	  $strli->data($data);
	} elsif($strli->data =~ /^auds\0\0\0\0/) {
	  my $data = $strli->data;
	  $au_rate = unpack('L',substr($data,24,4));
	  $au_samp_size = unpack('L',substr($data,44,4));
	  print "audio rate $au_rate samplesize $au_samp_size\n";
	}
      }
    }
  }
  else { print "other\n" };
}

defined $us_frame || die "missing us_frame\n";
defined $tot_frames || die "missing tot_frames\n";
defined $au_rate || die "missing auds sample rate\n";
defined $au_samp_size || die "missing samp_size\n";

## last chunk should be 'idx1', we drop it and have mencoder reconstruct it
my $lastchunk = $riff->at($riff->numChunks-1);
if($lastchunk->id ne 'idx1') {
  die "last chunk in file not 'idx1'\n";
}
$riff->pop;

while($chunk = $riff->at($i++)) {
  printf "chunk %d: %s\n", $i, $chunk->id;
  if($chunk->id eq 'LIST' && $chunk->type eq 'movi') {
    my $fnum = 0;
    my @newlist = ();
    my @vcoll = ();
    my $frame;
    my $time = 0; # "real time" at start of this audio frame's period
    my $t = 0; # time accumulator for video frames
    while ($frame = $chunk->shift) {
      if($frame->id eq '00dc') { # video frame
	push(@vcoll, $frame);
      } elsif($frame->id eq '01wb') { # audio frame
	## here's the meat of this mess...
	my $nv = scalar(@vcoll);
	my $ftime = $frame->size / ($au_rate * $au_samp_size);
	my $t_nv = $target_fps * $ftime;
	printf "audio frame %d: prec. video %d, frame time %.3f, time %.3f\n",
	  $fnum, $nv, $ftime, $time + $ftime;
	printf "    curfps %.3f, target frames %.2f\n", $nv / $ftime,
	  $t_nv;

	if($nv == 0) {
	  ## bug in flycam: continues to record audio frames, but no
	  ## video frames. we terminate here...
	  print "END OF VIDEO STREAM, terminating\n";
	  last;
	}

	my $etime = $time + $ftime;
	my $vft = 0;
	while($t < $etime) {
	  my $idx = int(($t - $time) / ($ftime / $nv));
	  push(@newlist, $vcoll[$idx]);
	  $vft++;
	  printf "        %.3f %2d\n", $t, $idx;
	  $t += 1/$target_fps;
	}
	print "    vframes: $vft\n\n";

	push(@newlist, $frame);
	$time = $etime;
	@vcoll = ();
      } else {
	die sprintf("frame $fnum: unknown ID <%s>\n", $frame->id);
      }
      $fnum++;
    }
    $chunk->data(\@newlist);
    print "\n";
  }
}


$riff->write(\*OUT);
close(IN);
close(OUT);

sub checkchunk {
  my $chunk = shift;
  my $id = shift;
  my $type = shift;
  my $where = shift;

  die "$where: expecting id $id, got $id\n" unless $$chunk->id eq $id;
  if(defined $type) {
    die "$where: expecting type $type, got $type\n"
      unless $$chunk->type eq $type;
  }
}