#!/usr/bin/perl
#
# 2005-12-07 // entstanden aus beformat2.pl:
#   > "erweitert" dieses um zwei FUnktionen
#     1. die WErte aus der MSG save_result in spalten schreiben
#     2. alle MSG, Start/Stop/Set entfernen...
#   > wird einfach am Ende angehaengt; (d.h. hat die gesamte Funktionalitaet
#     von beformat2.pl)
#
# HWH: testen: fuer bsp-files beformat2-output mit 3-outpout vgl. --> 
#    Fix/Sac/blink-num
#    + in soffice letzte spalten pruefen.
#
#
# assert: 
# 1. strlen(timestamp) in rawfile == 10
# 2. rawfile enthaelt daten fuer alle sets, die auch in begfile vorkommen,
#    in gleicher reihenfolge
#
# Uli
#
# > Scene Image - Messages ...
#
#
# Formatting done by Begaze (Column/Value):
# 
# Fixations:
# 0  Event Type
# 1  Set
# 2  Start
# 3  End
# 4  Duration
# 5  Location X
# 6  Location Y
# 7  Dispersion X
# 8  Dispersion Y
# 9  Object hit
my $FIXCOLS = 9;		#-=1 weil es auf die Tabs ankommt

#
# Saccades:
# 0  Event Type
# 1  Set
# 2  Start
# 3  End
# 4  Duration 
# 5  Start Pos X
# 6  Start Pos Y	
# 7  End Pos X	
# 8  End Pos Y	
# 9  Amplitude
# 10 Peak Speed
# 11 Peak Speed At
# 12 Average Speed
# 13 Peak Accel.
# 14 Peak Decel
# 15 Average Accel
#
my $SACCOLS = 15;		#-=1 weil es auf die Tabs ankommt

# Blinks:
# 0  Event Type
# 1  Set
# 2  Start 
# 3  End
# 4  Duration
my $BLINKCOLS = 4;		#-=1 weil es auf die Tabs ankommt

# --> wieviele Spalten insgesamt --> entspricht Anzahl tabs
my $ALLCOLS = $FIXCOLS + $SACCOLS + $BLINKCOLS +2;

use Term::ReadKey;

#Variablen

# Define seperator (TAB!)
my $sep = "\t";
#my $sep = ";";
my $flag=0;
my $done=0;

my @begbuffer;			#Buffer for one set out of begaze-file
my @rawbuffer;			#Buffer for one set out of raw-file

my $nextbegline;		#zwischenspeichern der ersten Zeile des naechsten sets
my $flagfixhit=0;		#Fixation schon angetroffen
my $flagsachit=0;		#Saccade schon angetroffen
my $curline;			#aktuelle Zeile, wird aufgebaut und in begbuffer gepusht
my @begbuffer;
my $begstart=0;			#Startzeitpunkt des aktuellen Sets!
my $begset=-1;			#aktuelle setnum

#subs

sub showusage
  {
    print STDERR "usage: $0 BEGAZE_FILE RAWDATA_FILE OUTPUT_FILE\n";
    exit 1;
  }

sub message_contained		#($message)
  {
    my $message = $_[0];
    $message =~ s/\?/\\\?/;
    #    $message = qr/$message/;
    #    print STDERR "dbg: message_contained: started for $message\n";
    #run through begbuffer
    foreach $i (@begbuffer) {
      #	chomp($i);
      #	print STDERR "dbg: processing $i\n" if ($begset eq 9);
      @begcols = split /\t/, $i;
	
      if (($i =~ /^User Event/) && ($begcols[3] =~ /$message/)) { #wenn fuer Vgl. relevante Zeile gefunden
	#	    print STDERR "dbg: true $i\n" if ($begset eq 9);
	return 1;
      }
    }
    #    print STDERR "dbg: false $i\n" if ($begset eq 9);
    return 0;
  }

sub insert_message		#($message)
  {
    my $line = $_[0];
    my $aktindex = -1;
    my $reltime = 0;
    
    my @columns = split /\t/, $line;
    my @begcols;
    my $mess_time =  substr($columns[0], 0, 7); #Zeitstempel der raw-message
    my $message;
    $message = ($columns[2] =~ /^Scene Image/) ? $columns[2] : substr($columns[2], 11); # get content only

    #    print STDERR "dbg: insert_message: started for $message\n" if ($begset eq 1);
    #run through begbuffer
    foreach $i (@begbuffer) {
      $aktindex++;
      #	print STDERR "dbg: processing $i\n";
      @begcols = split /\t/, $i;
      if ($i =~ /^Fixation|^User Event|(\t){$FIXCOLS}Saccade|(\t){$FIXCOLS+$SACCOLS}Blink/) { #wenn fuer Vgl. relevante Zeile gefunden
	$aktsetnum = defined($begcols[27]) ? $begcols[27] : (defined($begcols[11]) ? $begcols[11] : $begcols[1]);
	$reltime = defined($begcols[28]) ? $begcols[28] : (defined($begcols[12]) ? $begcols[12] : $begcols[2]);;

	#	    print STDERR "dbg1: start: $begstart; messtime= $mess_time; akttime = ($reltime+$begstart)\n" if ($begset eq 1);  

	if ($mess_time > ($reltime+$begstart)) { # solange rawtime <= reltime
	  #		$first_loop = 0;
	  #		print STDERR "dbg: skipping line: $i;\n" if ($begset eq 1);
	  next;			#naechste Zeile
	}
	    
	# gefunden! --> an diesem Index einfuegen:
	#	    if ($mess_time > ($reltime+$begstart))
	#	    {  #wenn message-time > akt-time --> einfuegen
	#		print STDERR "dbg: rawtime bigger: $mess_time > ($reltime+$begstart) on index $aktindex\n" if ($begset eq 1) ;
	#--> ab einschl. aktuellem alle folgenden El. um 1 nach 
	# hinten schieben
	$#begbuffer++;
	for ($j=$#begbuffer-1; $j>=$aktindex; $j--) {
	  #		print STDERR "dbg3: shifting ($j) to ($j+1) : '$begbuffer[$j]' --> '$begbuffer[$j+1]'\n";
	  $begbuffer[$j+1]=$begbuffer[$j];
	}
	# message hier einfuegen:
	$new_time = $mess_time - $begstart;
	$new_time = $new_time >= 0 ? $new_time : 0;
	$newmessage="User Event\t" . $aktsetnum . "\t" . "$new_time" . "\t" . $message . "\n";
	$begbuffer[$aktindex]=$newmessage;
	#		print STDERR "dbg: inserted newmessage ($newmessage) on indexnum $aktindex\n";
	return $aktindex;
	#	    }
      }				#if relevante Zeile
      #	$aktindex++;
      # end foreach bufferline}
    }
    #am Ende angekommen --> hier einfuegen:
    $#begbuffer++;
    $new_time = $mess_time - $begstart;
    $new_time = $new_time >= 0 ? $new_time : 0;
    $newmessage="User Event\t" . $aktsetnum . "\t" . "$new_time" . "\t" . $message . "\n";
    $begbuffer[$#begbuffer]=$newmessage;

    return $#begbuffer;
  }

###########################
#
#main
#
############################

#print STDERR "$#ARGV\n";

showusage() if ( $#ARGV ne 2 );

#print STDERR "0: $ARGV[0]   1:$ARGV[1]";

#Open inputfiles
open(BEGAZE, "< $ARGV[0]")
  or die "beformat.pl: Couldn't open $ARGV[0]!\n";
open(RAW, "< $ARGV[1]")
  or die "beformat.pl: Couldn't open $ARGV[1]!\n";
open(OUT, "> $ARGV[2]")
  or die "beformat.pl: Couldn't open $ARGV[2]!\n";


#skip raw-header:
my $done=0; 
while (! $done) {
  $rawpos=tell RAW;
  $_ = <RAW>;
  #    print;
  if (/^\d+/) {
    $done = 1;
  }
}
seek RAW, $rawpos, 0;		#eine Zeile zurueckspringen

#Jump to first "^Set" in Begaze-file
chomp($line=<BEGAZE>);
while ($line !~ /^Set/ ) {
  #    print OUT "$line\n";
  chomp($line=<BEGAZE>);
}
$nextbegline = $line;

#write Header
print OUT "Header for Fixation/Saccade/Blink:\n";
print OUT "Fix. Event Type\tFix. Set\tFix. Start\tFix. End\tFix. Duration\tFix. Location X\tFix. Location Y\tFix. Dispersion X\tFix. Dispersion Y\tFix. Object hit\tSac. Event Type\tSac. Set\tSac. Start\tSac. End\tSac. Duration\tSac. Start Pos X\tSac. Start Pos Y\tSac. End Pos X\tSac. End Pos Y\tSac. Amplitude\tSac. Peak Speed\tSac. Peak Speed At\tSac. Average Speed\tSac. Peak Accel.\tSac. Peak Decel\tSac. Average Accel\tBlink Event Type\tBlink Set\tBlink Start\tBlink End\tBlink Duration\tsave-NR\tsave-ImgIndex\tsave-RT\tsave-correct\n";

$done=0;
while (! $done) {
  #erste Zeile schreiben (Set)
  push (@begbuffer, "\n" . $nextbegline . "\n"); #Set nicht mehr in buffer; beformat3
  $begset=-1;
  #Read next set in BEGAZE into begbuffer
  chomp($line=<BEGAZE>);
  #    print $line;

  ##############
  # 1. begaze-file umformatieren
  ################


  while ($line !~ /^Set/ && defined($line)) {
    #lines to keep unmodified
    if ($line =~ /^Start \[ms\]:\t(\d+)/ ) {
      push (@begbuffer, $line . "\n");
      $begstart=$1;
    }
    if ( $line =~ /^Duration \[ms\]:/) {
      push (@begbuffer, $line . "\n");
    } elsif ($line =~ /^User Event\t(\d+)/) {
      if ($begset eq -1) {
	$begset = $1;
	print "\nProcessing Set # $begset ...\n";
	print "... reformatting BEGAZE-data\n";
      }
      if ($flagfixhit || $flagsachit) #wenn gerade eine curline aufgebaut
	{			#wird
	  push (@begbuffer, $curline . "\n"); #-> diese pushen
	  $flagfixhit=$flagsachit=0;
	}
      push (@begbuffer, $line . "\n"); #und userevent pushen
      #	    @columns = split /\t/, $_;
      #	    print STDERR "@columns[0]$sep@columns[1]$sep@columns[2]$sep@columns[3]$sep@columns[4]\n";
    }				#end elseif
    elsif ($line =~ /^Fixation L\t(\d+)/) {
      if ($begset eq -1) {
	$begset = $1;
	print "\nProcessing Set # $begset ...\n";
	print "... reformatting BEGAZE-data\n";
      }
      if ($flagfixhit || $flagsachit) #wenn gerade eine curline aufgebaut
	{              		#wird
	  push (@begbuffer, $curline . "\n"); #-> diese pushen
	  $flagfixhit=$flagsachit=0;
	}

      $curline = $line;
      # case: not all columns used -> fill up with tabs
      @columns = split /\t/, $line;
      for ($i=0; $i < $FIXCOLS-$#columns;$i++) {
	$curline .= "$sep"; 
      }
      $flagfixhit = 1;
    }				#end elsif Fixation
    elsif ($line =~ /^Saccade L\t(\d+)/) {
      if ($begset eq -1) {
	$begset = $1;
	print "\nProcessing Set # $begset ...\n";
	print "... reformatting BEGAZE-data\n";
      }
      if ($flagsachit)		#wenn zuletzt eine sac in curline
	{                               
	  push (@begbuffer, $curline . "\n"); #-> diese pushen
	  $flagfixhit=$flagsachit=0;
	}

      #	    @columns = split /\t/, $line;
      if ($flagfixhit)		#wenn schon eine Fixation in curstring
	{
	  #		$tmp=join $sep, @columns;
	  $curline .= $line;
	  #		print STDERR "inside: curline= $curline\n";
	} else			#wenn nicht:  X spalten leer lassen
	  {
	    $curline = "$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep";
	    $curline .= $line;
	  }
      # case: not all columns used -> fill up with tabs
      @columns = split /\t/, $line;
      for ($i=0; $i < $SACCOLS-$#columns;$i++) {
	$curline .= "$sep"; 
      }
      $flagsachit=1; 
    }				# end elsif Saccade
    elsif ($line =~ /^Blink/) {
      #	    @columns = split /\t/, $_;
      if ($flagsachit)		#wenn (mind.) sac in curline: direkt drankleben
	{
	  $curline .= $line;
	} elsif ($flagfixhit)	# wenn nur fix in curline: spalten fuer sac
	  {
	    #		$curline .= "vorher";
	    # ueberspringen
	    $curline .= "$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep";
	    #		$curline .= "nacher";
	    $curline .= $line;
	  } else		#wenn noch nichts in curstring: fix und sac-spalten skippen
	    {
	      $curline = "$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep$sep";
	      $curline .= $line;
	    }
	    
      # case: not all columns used -> fill up with tabs
      #	    @columns = split /\t/, $line;
      #	    for ($i=0; $i < $BLINKCOLS-$#columns;$i++)
      #	    {
      #		$curline .= "$sep"; 
      #	    }

      # --> curline vollstaendig
      push (@begbuffer, $curline . "\n"); #-> diese pushen
      $flagfixhit=$flagsachit=0;
    }				#end if Blink

				# "Table Header ..." OR blank lines
    #	if ($line =~ /^Table Header/ || /^$/ || /^Event Type\tSet\tStart\tEnd/)
    else {
      if ($flagfixhit || $flagsachit) {
	push (@begbuffer, $curline . "\n"); #-> diese pushen
	$flagfixhit=$flagsachit=0;
      }
      chomp($line=<BEGAZE>);
      next;
    }				#end else

    #read next line;
    chomp($line=<BEGAZE>);
  }				#end while "reading begbuffer"
    
  if (!defined($line))		#Wenn wegen EOF abgebrochen
    {
      #letzte Reste screiben:
      if ($flagfixhit || $flagsachit) #wenn gerade eine curline aufgebaut
	{
	  push (@begbuffer, $curline . "\n"); #-> diese pushen
	  $flagfixhit=$flagsachit=0;
	}
      $done=1;
    } else			#Zeile "Set ..." schreiben
      {
	$nextbegline = $line;
      }

  #    print @begbuffer; 
  #    ReadLine(0);
    
  ##############
  # 2. begaze- und raw-file zusammenfuehren
  ################

  print "... comparing BEGAZE data and RAW data\n";
  $rawdone=0;
  $inside_flag=0;
  while (! $rawdone) {
    $rawpos=tell RAW;

    if (!defined($line = <RAW>)) {
      #	    print STDERR "dbg1\n";
      $rawdone=1;
      next;
    }
    chomp($line);
    #	print STDERR "in line: $line\n";
    if (! $line =~ /^(\d+)\t([A-Z]{3})/) #no data line --> end
      {
	#	    print STDERR "dbg2\n";
	$rawdone = 1;
	next;
      }
    @columns = split "\t", $line;

    #Wenn bei naechster "Scene Image"-Meldung angekommen.
    if ($inside_flag && $columns[1] =~ /MSG/ && $columns[2] =~ /^Scene/) {
      seek RAW, $rawpos, 0;	#eine Zeile zurueckspringen
      $rawdone = 1;
      next;
    }

    if ($columns[1] =~ /SMP/ && $columns[2] ne $begset) #if not in begset
      {
	#	    print STDERR "dbg3: col: $columns[2] begset: $begset\n";
	$rawdone = 1;
	next;
      }
    if ($columns[1] =~ /MSG/)	#found message
      {
	$inside_flag = 1;
	$message = ($columns[2] =~ /^Scene Image/) ? $columns[2] : substr($columns[2], 11); # get content only
	#	    print STDERR "dbg: found MSG '$message'\n" if ($begset eq 1);
	if (! &message_contained($message)) {
	  #		print STDERR "dbg: message not contained --> trying to add!\n"  if ($begset eq 9);
	  $insret=&insert_message($line);
	  print "Inserted at index $insret: '$message'\n";
	  #		    print STDERR "dbg: have inserted MSG '$line' --> new buffer:\n";
	  #		    print @begbuffer;
	}			#end if contained
	else {
	  #		print STDERR "dbg: message '$message' already contained!\n" if ($begset eq 9);
	}			# end else
      }				#end if MSG in $line.
  }				#end while not rawdone


  ##############
  # 3. save_result-Werte in spalten
  #    und: alle user_events raus
  ################
    
  print "... inserting save-values; deleting non-data lines\n";

  #    print STDERR "entring ...\n";
  #save-Werte finden
  foreach $k (@begbuffer) {
    if ($k =~ /save_result: Nr: (\d+); ImgIndex: (\d+), rt: (\d+); correct\? (\d)/) {
      #	    print STDERR "found save-vals in '$k' \n";
      $save_nr=$1;
      $save_imgIndex=$2;
      $save_rt=$3;
      $save_correct=$4;
    }
  }

  #an jede non-user-event-Zeile anhaengen; diese rauswerfen
    
  for ($k=0; $k<=$#begbuffer; $k++) {
    if ($begbuffer[$k] !~ /Fixation|Saccade|Blink/) #=~ /^User Event|^Set|^Start|^Duration|^$/)
      {
	#	    print STDERR "deleting: $begbuffer[$k]\n";
	#	    print STDERR "\n--------------\n @begbuffer \n --------\n";
	splice(@begbuffer, $k, 1);
	#	    print STDERR "\n--------------\n @begbuffer \n --------\n";

	$k--;
      } else {
	#    print STDERR "adding save-values to: $begbuffer[$k] \n";
	chomp($begbuffer[$k]);
	#pruefen ob korrekte Anzahl tabs und ggf. auffuellen
	$begbuffer[$k] =~ s/\t+$//; #trailing tabs entfernen
	@columns = split /\t/, $begbuffer[$k];
	#	    printf STDERR "adding tabs: %d; ALL: %d; colnum=%d\n",  $ALLCOLS-$#columns,$ALLCOLS,$#columns;
	for ($i=0; $i < $ALLCOLS-$#columns;$i++) {
	  $begbuffer[$k] .= "$sep"; 
	}
	$begbuffer[$k] .= $sep . $save_nr . $sep . $save_imgIndex . $sep . $save_rt . $sep . $save_correct . "\n";
      }
  }

  ##############
  # x. fertig --> ausgeben
  ################

  print OUT @begbuffer;
  
  #begbuffer leeren
  @begbuffer = undef;
  #    print STDERR "end main loop\n";
  #	    print STDERR "\n--------------\n @begbuffer \n --------\n";
}


close(BEGAZE);
close(RAW);
close(OUT);

exit 0;

#EOF
