#!/usr/local/bin/perl

################################################### Credit
#
# Do a frame accurate digitization from VLAN by digitizing 
# chunks into memory at frame rate and then dumping those 
# disk. 
#
# Based on the tcsh script by 
#           "Thad E. Starner" <testarne@media.mit.edu>
#
# PERL code by 
#           "Christopher R. Wren" <cwren@media.mit.edu>
#           Fri Jul 14 14:37:55 1995 
#

################################################### Main

require('getopts.pl');

local($verbose) = 0;
local($time0)   = time();

if ($0 == "vlan_grab") {
    &vlan_grab_main();
}

exit 1;

################################################### vlan_gab_main
	
sub vlan_grab_main {
    # command line args
    local($starttc)  = '0:1:0:0';
    local($endtc)    = '0:1:1:0';
    local($frames)   = 20;
    local($filebase) = 'out';
    local($drop)     = 0;
    local($node)     = 2;
    local($label)    = 0;

    if (! do Getopts('s:e:c:f:n:d:i:hv')) {
	&vlan_grab_usage();
	exit 1;
    }

    if ($opt_h) { 
	&vlan_grab_usage();
	exit 1;
    }
	
    if ($opt_s) { $starttc  = $opt_s; }
    if ($opt_e) { $endtc    = $opt_e; }
    if ($opt_c) { $frames   = $opt_c; }
    if ($opt_f) { $filebase = $opt_f; }
    if ($opt_n) { $node     = $opt_n; }
    if ($opt_d) { $drop     = $opt_d; }
    if ($opt_i) { $label    = $opt_i; }
    if ($opt_v) { $verbose  = 1; }
		   
    if ($verbose) {
	print "Starting edit at ", &frame2tc(&tc2frame($starttc)), "\n";
	print "Ending   edit at ", &frame2tc(&tc2frame($endtc)), "\n";
	print "Dumping ", $frames, " at a time\n";
	print "Saving to file ", $filebase, "_xxxxx.rgb\n";
	print "Dropping ", $drop, " frames\n";
	print "Using VLAN node ", $node, "\n\n";
    }

# local variables
    local($start)   = &tc2frame($starttc);
    local($end)     = &tc2frame($endtc);
    local($current) = $start;
    local($tries)   = 0;
    local($fail)    = 5;
    local($status)  = 1;

# check sanity of arguments
    
    if ($frames < 1 ) {	       
	print STDERR "error:  must digitize at least one frame at a time";
	exit 1;
    }

    if ($end < $start ) {
	print STDERR "error:  start time is after end time";
	exit 1;
    }

# while we're not at the end 
# digitize another chunk

    $tries = 0;		# get the chunk
    $status = 0;
    while (!$status && ($tries < $fail)) { 
	if ($tries) {
	    print STDERR "init failure... retrying\n";
	    &init_vlan_grab($node); # 
	}

	$status = &init_vlan_grab($node);
	$tries += 1;
    }			       

    if (!$status) {
	print STDERR "Couldn't initialize vlan... exiting\n";
	exit 1;
    }

    while ($current <= $end) {

	if ( ($current + $frames) > $end) {	# check for overrun
	    $frames = $end - $current + 1;
	}

	printf("%4d frames at %10s to %s_%05d.rgb\t",
	       $frames, 
	       &frame2tc($current),
	       $filebase,
	       $label);
	if ($total != 0) {    
	    print "  eta: ", &compute_eta($total,$current,$end);
	}		       
	print "\n";

	$tries = 0;		# get the chunk
	$status = 0;
	while (!$status && ($tries < $fail)) { 
	    if ($tries) {
		print STDERR "grab failure... reinitializing\n";
	    }			
	    $status = &do_vlan_grab(&frame2tc($current),
				    $frames, 
				    $filebase, 
				    $label);
	    $tries += 1;
	}

	if (!$status) {
	    print STDERR "Too many failures... exiting\n";
	    exit 1;
	}

	

	$current += $frames + $drop;	# beginning of next chunk
	$total += $frames;	        # number of frames so far
	$label += $frames;	        # file label to use

    }
    exit 0;
}				
################################################### subroutines



sub compute_eta	{
    local($total,$current,$end) = @_;

    local($sperframe) = (time() - $time0) / $total;
    local($finish)    = time() + ($sperframe * ($end - $current));
    local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
	localtime($finish);
    
    sprintf ("%02d/%02d/%02d %02d:%02d",
	     $mday, $mon+1, $year, $hour, $min);
}

sub vlan_grab_usage {
    print STDERR "usage: $0 [options]\n";
    print STDERR "\t-s h:mm:ss:ff  start timecode              [0:1:0:0]\n"; 
    print STDERR "\t-e h:mm:ss:ff  end timecode                [0:1:1:0]\n"; 
    print STDERR "\t-c <int>       number of framesdd per pass [20]\n"; 
    print STDERR "\t-f filename    base filename to write to   [out]\n"; 
    print STDERR "\t-i int         first file index to use     [00000]\n"; 
    print STDERR "\t-d int         num frames to skip per pass [0]\n"; 
    print STDERR "\t-n int         VLAN node to use            [2]\n"; 
    print STDERR "\t-v             set verbose mode\n"; 
    print STDERR "\t-h             print this message\n";
    exit 1;			
}

sub frame2tc {
    local($frame) = $_[0];	# one argument: frame number
				# convert frame number to valid timecode

    local($hour) = int($frame / 108000);
    $frame -= 108000 * $hour;

    local($min) = int($frame / 1800);
    $frame -= 1800 * $min;

    local($sec) = int($frame / 30);
    $frame -= 30* $sec;

    $tc = sprintf("%01d:%02d:%02d:%02d",
		  $hour, $min, $sec, $frame);
}


sub tc2frame {
    local($tc) = @_;		# one argument: a sloppy timecode 
				# convert anything that looks kind of
				# like a time timecode into a frame 
				# number

    local ($index) = index($tc,":"); # find the colons 
    if ($index == -1) {
	print STDERR "ill-formed timecode, must be h:mm:ss:ff\n";
	exit 1;
    }
    $hour  = substr($tc,0,$index);
    $tc    = substr($tc,$index+1);
    
    $index = index($tc,":");			      
    if ($index == -1) {
	print STDERR "ill-formed timecode, must be h:mm:ss:ff\n";
	exit 1;
    }
    $min   = substr($tc,0,$index);
    $tc    = substr($tc,$index+1);
    
    $index = index($tc,":");			      
    if ($index == -1) {
	print STDERR "ill-formed timecode, must be h:mm:ss:ff\n";
	exit 1;
    }
    $sec   = substr($tc,0,$index);
    $tc    = substr($tc,$index+1);
    
    if (length($tc) == 0) {
	print STDERR "ill-formed timecode, must be h:mm:ss:ff\n";
	exit 1;
    }
    $frame = $tc;
				# distill different time units into
				# frame numbers
    $frame = ($frame + 30*($sec + 60*($min + 60*$hour)));
    
    $frame;
}

sub exec_vlan {
    local($args) = $_[0];	# one argument a string of arguments
				# execute sir_vlan with given args and 
				# watch for error codes 

    local ($vlan) = "/usr/dmedia/bin/SIRIUS/sir_vlan";
    local ($execstring) = $vlan . " " . $args;
    local ($return) = 1;

    open(CHILD, $execstring . "|");

    while (<CHILD>) { 
	if (/ERROR/) {
	    print STDERR "failed vlan call: ", $execstring, "\n";
	    $return = 0;
	}
    }
    close(CHILD);

    $return;
}

sub do_vlan {
    local ($op,$arg) = @_;	# one or two args:
				#   o vlan command
				#   o optional argument 
				# notify user of status 
    local($return) = 0;

  parse: {
      $op=~/^INIT/ && do { 
	  if ($verbose) { print("\tINITIALIZING vlan bus\n"); }
	  $return = &exec_vlan('-a');
	  last parse; 
      };
      $op=~/^NODE/ && do { 
	  if ($verbose) { print("\tSELECT NODE: ", $arg, "\n");  }
	  $return = &exec_vlan('-c "ND ' . $arg . '"');
	  last parse; 
      };
      $op=~/^CLEAR/ && do { 
	  if ($verbose) { print("\tCLEAR NODE \n");  }
	  $return = &exec_vlan('-c "CL"');
	  last parse; 
      };
      $op=~/^IN/ && do { 
	  if ($verbose) { print("\tSET IN: ", $arg, "\n");  }
	  $return = &exec_vlan('-c "SI ' . $arg . '"');
	  last parse; 
      };
      $op=~/^DUR/ && do { 
	  if ($verbose) { print("\tSET DURATION: ", $arg, "\n");  }
	  $return = &exec_vlan('-c "SD ' . $arg . '"');
	  last parse; 
      };
      $op=~/^TRIG/ && do { 
	  if ($verbose) { print("\tENABLE TRIGGER \n");  }
	  $return = &exec_vlan('-c "CO"');
	  last parse; 
      };
      $op=~/^PRE/ && do { 
	  if ($verbose) { print("\tSET PRE-ROLL: ", $arg, "\n");  }
	  $return = &exec_vlan('-c "PR ' . $arg . '"');
	  last parse; 
      };
      $op=~/^COIN/ && do { 
	  if ($verbose) { print("\tSET COINCIDENCE POINT: ", $arg, "\n");  }
	  $return = &exec_vlan('-c "SC ' . $arg . '"');
	  last parse; 
      };
      $op=~/^VID/ && do { 
	  if ($verbose) { print("\tINSERT VIDEO \n");  }
	  $return = &exec_vlan('-c "TSV"');
	  last parse; 
      };
      $op=~/^GO/ && do { 
	  if ($verbose) { print("\tTRIGGERING EDIT\n");  }
	  $return = &exec_vlan('-c "RV"');
	  last parse; 
      };
  }
    
    $return; 
}

sub init_vlan_grab {
    local($node) = $_[0];
    local ($return) = 1;
				# initialize vlan node
    if ($verbose) { printf("init:  node %d\n", $node); }
    $return &= &do_vlan('INITIALIZE');
    $return &= &do_vlan('NODE',$node);
    $return &= &do_vlan('CLEAR');
    $return &= &do_vlan('TRIGGER ENABLE');
    $return &= &do_vlan('PREROLL','3:00');
    $return &= &do_vlan('COINCIDENCE POINT','2:29');
    $return &= &do_vlan('VIDEO INSERT');

    $return;
}

sub do_vlan_grab {
    local($return) = 1;

    local ($tc,$frames,$file,$startlabel) = @_;	# four arguments:
				# valid timecode to start recording chunk
				# number of frames in chunk
				# base filename to dump to
				# first file offset label in chunk


				# apraise user of the current task
    if ($verbose) {
	printf("grabbing %4d frames @ %s -> %s_%05d\n", 
	       $frames, $tc, $file, $startlabel);
    }

    $return &= &do_vlan('INSERTION',$tc);
    $return &= &do_vlan('DURATION', $frames);
    $return &= &do_vlan('GO');

    if ($return) {		# if setup was successful

	# warn the user of possible delay
	if ($verbose) {
	    print("digitizing: may take a while depending on disk speeds\n");
	}
	
	# Execute the grab, using trigger #3 (VLan)
	local($format) = 
	    "/usr/dmedia/bin/SIRIUS/sir_vidtomem -c%d -F2 -t3 -N%d %s";
	local($execstring) = sprintf($format, $frames, $startlabel, $file);
	local($status) = system($execstring);
	$status = int($status / 256);
	
	# watch for error from vidtomem
	if ($status != 0) { 
	    print (STDERR "vidtomem failed with status code: ",     
		   $status, "\n");
	    $return = 0;      
	}
    }
    
    $return;
}