#!/usr/bin/perl -w
#
# sptxt2run - convert Spike2 export text file to runfile format
#
# Usage: sptxt2run textfile [runfile]
#  or    sptxt2run -b textfile ...
#  where	-b	 specifies batch mode, where all following arguments are
#			 textfile arguments, and the default runfile is used
#		textfile specifies Spike2 exported text file name
#		runfile	 specifies optional output run file name
#			 (by default, name is taken from text file)
#
# Copyright (c) 2015, Gilles Detillieux, Spinal Cord Research Centre,
# University of Manitoba.  All Rights Reserved.
#

use strict;

my $batch = 0;
if ($ARGV[0] eq "-b") {
   ++$batch;
   shift;
}
if ($ARGV[0] eq "--help" || !$batch && @ARGV > 2) {
   @ARGV = ();
}
die <<EOM unless @ARGV;
Usage: $0 textfile [runfile]
 or    $0 -b textfile ...
 where	-b		specifies batch mode, where all following arguments are
			textfile arguments, and the default runfile is used
	textfile	specifies Spike2 exported text file name
	runfile		specifies optional output run file name
			(by default, name is taken from text file)
EOM

arg: while (@ARGV) {
   my $sptfile = $ARGV[0];
   shift;
   if (!open(ST, "< $sptfile")) {
      warn "$0: Can't open file $sptfile: $!\n";
      last if (!$batch);
      shift if (@ARGV && !$batch);
      next;
   }
   my $ofile = $sptfile;
   $ofile =~ s/\.\w{3}$//;
   my $state = 0;
   my @wfs = ();
   my @chans = ();
   my @units = ();
   my @irates = ();
   my @rates = ();
   my @scales = ();
   my @offsets = ();
   my @sizes = ();
   my @divs = ();
   my $wn = -1;
   my $wchan = "";
   my $wrn = -1;
   my $vperad = 1.0;
   my $uuoffset = 0.0;
   my $wfile = "";
   my $lastwn = -1;
   while (<ST>) {
      s/\r//;
      if ($. == 1 && !m/"INFORMATION"/) {
         warn "$0: File $sptfile doesn't look like Spike 2 exported text format\n";
         last if (!$batch);
         shift if (@ARGV && !$batch);
         next arg;
      } elsif ($. == 2 && m/"(.*)\.smrx*"/i) {
         $ofile = $1;
#         print "Found output file name $ofile\n";
      } elsif ($. > 7 && m/"SUMMARY"/) {
         if (@ARGV && !$batch) {
            $ofile = $ARGV[0];
            shift;
         }
         $ofile =~ s/\.[fp]rm$//;
         $state = 1;	# summary or header scanning
#         print "Started summary scanning state $state\n";
      } elsif ($. > 8 && $state == 1 && m/"(\d+)"\s+"Waveform"\s+"([^"]*)"\s+"\s*([^"]*[^"\s])\s*"\s+([.\d]+)\s+([.\d]+)\s+(\d+)\s+(\d+)/) {
         push @wfs, $2;
         push @chans, $1;
         push @units, $3;
         push @irates, $4;
         push @rates, $5;
         push @scales, $6;
         push @offsets, $7;
         push @sizes, 0;
         push @divs, 0;
#         print "Found waveform $2, ch. $1 in summary scanning state $state\n";
      } elsif ($. > 8 && $state == 1 && m/"(\d+)"\s+"Waveform"\s+"([^"]*)"\s+"\s*([^"]*[^"\s])"\s+/) {
#         print "Partial match of waveform $2, ch. $1 in summary scanning state $state\n";
      } elsif ($. > 8 && $state == 1 && m/^\s*$/) {
         $state = 2;	# channel scanning
#         print "Started channel scanning state $state\n";
      } elsif ($state == 2 && m/"CHANNEL"\s"(\d+)"/) {
         if (!@wfs) {
            warn "$0: File $sptfile has no waveforms in summary section\n";
            last if (!$batch);
            shift if (@ARGV && !$batch);
            next arg;
         }
         ++$wn;
         $state = 3;	# channel section check
         $wchan = $1;
         $wrn = $.;
#         print "Started channel section check state $state\n";
      } elsif ($state == 3 && $. == $wrn+1) {
         if (m/"Waveform"/) {
            $state = 4;	# channel start scan
            if ($wchan ne $chans[$wn]) {
               warn "$0: File $sptfile has waveforms out of order (got $wchan when $chans[$wn] expected)\n";
               last if (!$batch);
               shift if (@ARGV && !$batch);
               next arg;
            }
#            print "Started channel start scan state $state, for waveform no. $wn\n";
         } else {
            $state = 2;	# back to channel scanning
            --$wn;
#            print "Returned to channel scanning state $state, not a waveform\n";
         }
      } elsif ($state == 4 && $. == $wrn+3 && m/"([^"]*)"/) {
         warn "$0: Warning - File $sptfile has waveform name mismatch on chan. $wchan (got $1 when $wfs[$wn] expected)\n" unless $1 eq $wfs[$wn];
      } elsif ($state == 4 && $. == $wrn+5 && m/"\s*([^"]*[^"\s])\s*"\s+([\.\d]+)/) {
         warn "$0: Warning - File $sptfile has waveform unit mismatch on chan. $wchan (got $1 when $units[$wn] expected)\n" unless $1 eq $units[$wn];
         warn "$0: Warning - File $sptfile has waveform rate mismatch on chan. $wchan (got $2 when $irates[$wn] expected)\n" unless $2 eq $irates[$wn];
      } elsif ($state == 4 && $. == $wrn+6 && m/"START"/) {
         $state = 5;	# channel data reading
         $uuoffset = $offsets[$wn];
         $vperad = 2**16 / ($scales[$wn] * 10);
         $wfile = sprintf("$ofile.w%02d", $wn);
         open(WF, "> $wfile") || die "$0: Can't create file $wfile: $!\n";
         binmode(WF);
         $lastwn = $wn;
#         print "Started channel data reading state $state, $wfile\n";
         print STDERR "Writing $wfile...  ";
         while (<ST>) {
            last if (m/^\s*$/);
            if (m/^\s*-*[\.\d]+\s*$/) {
               print WF pack('n', int(($_ - $uuoffset) * $vperad + 32767.5)-32767);
               ++$sizes[$wn];
            }
         }
         close(WF);
         print STDERR "$sizes[$wn] samples.\n";
         $state = 2;	# back to channel scanning
#         print "Returned to channel scanning state $state, done wf # $wn\n";
#      } elsif ($. > 8) {
#         print "Unmatched line $. in state $state: $_";
      }
   }
   close(ST);
   
   # determine common sampling rate based on effective ideal rates of waveforms
   my $samprate = $irates[0];
   for ($wn = 1; $wn <= $lastwn; ++$wn) {
      $samprate = lcm($samprate, $irates[$wn]);
   }
   
   # determine each wf's divisor based on common rate
   # find longest total length and wf with smallest divisor (highest rate)
   my $length = 0;
   my $sdwn = -1;
   for ($wn = 0; $wn <= $lastwn; ++$wn) {
      $divs[$wn] = int($samprate/$irates[$wn] + 0.5);
      my $l = ($sizes[$wn]-1) * $divs[$wn] + 1;
      $sdwn = $wn if ($sdwn < 0 || $divs[$wn] < $divs[$sdwn]);
      $length = $l if ($length < $l);
   }
   my $rsamprate = $rates[$sdwn] * $divs[$sdwn];	# actual sampling rate
   
   #print STDERR "Last wf # $lastwn (of $wn), smallest divisor at wf # $sdwn\n";
   print STDERR "Writing $ofile.frm...  ";
   system("dd if=/dev/zero 'of=$ofile.frm' count=1 bs=2048 2>/dev/null");
   open(RH, "> $ofile.rhd") || die "$0: Can't create file $ofile.rhd: $!\n";
   print RH "#run header parameters\n";
   print RH "LENGTH='$length'\n";
   print RH "SAMPRATE='$rsamprate'\n";
   print RH "NFRAMES='0'\n";
   print RH "FRMSIZ='8'\n";
   for ($wn = 0; $wn <= $lastwn; ++$wn) {
      my $z = int(-$offsets[$wn] * 2**16 / ($scales[$wn] * 10) + 32767.5)-32767;
      my $h = 2**14;
      my $l = int($scales[$wn] * 10 / 4 * 1000000 + 32767.5) - 32767;
      $l /= 1000 if ($units[$wn] =~ m/mv/i);
      print RH "REGDIV_$wn='$divs[$wn]'\n";
      print RH "REGCHAN_$wn='$chans[$wn]'\n";
      print RH "REGCALZERO_$wn='$z'\n";
      print RH "REGCALHEIGHT_$wn='$h'\n";
      print RH "REGCALLEVEL_$wn='$l'\n";
      print RH "REGCALGAIN_$wn='0'\n";
      print RH "REGCALNAME_$wn='$wfs[$wn]'\n";
   }
   close(RH);
   # convert .rhd file to proper run header in .frm file, replacing null header
   system("echo Y | salvagerun '$ofile' 2>/dev/null");
   print STDERR "$length samples @ $rsamprate Hz.\n";
   last if (!$batch);
}

# calculate GCD & LCM using Euclid's algorithm
sub gcd {
   my ($a, $b) = @_;
   ($a,$b) = ($b,$a) if $a > $b;
   while ($a) {
      ($a, $b) = ($b % $a, $a);
   }
   return $b;
}

sub lcm {
   my ($a, $b) = @_;
   return $a / gcd($a, $b) * $b;
}
