#!/usr/bin/perl -w
#
# smr2run - convert Spike2 .smr (SON) file to runfile format
#

my $helpstr = <<EOM;
Usage: smr2run [-v] [-q] [-n] smrfile [runfile]
or     smr2run [-v] [-q] [-n] -b smrfile ...
where		-b	 specifies batch mode, where all following arguments are
			 file arguments, and the default runfile is used
		-v	 increases verbosity of output (may be repeated)
		-q	 quiets verbosity of output (may be repeated)
		-n	 specifies that no output files are generated, and only
			 does a dry run, reading and checking input file(s)
			 specifying -n twice does a quick check of headers only
			 and skips reading of waveform data
		smrfile	 specifies Spike2 .smr file name
		runfile	 specifies optional output run file name
			 (by default, name is taken from .smr file name)

Converts SON-format .smr file of Spike2 waveforms into SCRC runfile format.
Only data kinds 1 (Adc) and 9 (RealWave) are supported for now, and converted
to untriggered waveforms. Events and spike markers are skipped over in the
SMR file. 64-bit SMR files are not yet supported, only 32-bit.

Copyright (c) 2017, Gilles Detillieux, Spinal Cord Research Centre,
University of Manitoba.  All Rights Reserved.
EOM

#
# Based on SMR input processing in Neo:
# https://github.com/NeuralEnsemble/python-neo/blob/0.4.x/neo/io/spike2io.py
#

use strict;
use Time::Local;

my $pgm = $0;
$pgm =~ s/^.*\/bin\///;	# remove standard path name from arg 0
my $batch = 0;
my $verbose = 1;
my $outp = 1;
my $skipread = 0;
while (@ARGV && $ARGV[0] =~ m/^-/ && (my $a = $ARGV[0])) {
   shift;
   while (($a = substr($a, 1)) && (($_) = ($a =~ /^(.)/))) {
      if (m/b/i) {
         ++$batch;
      } elsif (m/v/i) {
         ++$verbose;
      } elsif (m/q/i) {
         --$verbose if $verbose > 0;
      } elsif (m/n/i) {
         ++$skipread if !$outp;		# 2nd -n means skip reading data
         $outp = 0;
      } else {
         @ARGV = ();
         last;
      }
   }
}
#print "batch $batch verbose $verbose outp $outp\n";
if (!@ARGV || !$batch && @ARGV > 2) {
   die $helpstr;
}
my $not = "Not ";
$not = "" if $outp;

arg: while (@ARGV) {
   my $smrfile = $ARGV[0];
   shift;
   if (!open(SM, "< $smrfile")) {
      warn "$pgm: Can't open file $smrfile: $!\n";
      last if (!$batch);
      shift if (@ARGV && !$batch);
      next;
   }
   binmode(SM);
   my $ofile = $smrfile;
   $ofile =~ s/\.\w{3}$//;
   if (@ARGV && !$batch) {
      $ofile = $ARGV[0];
      $ofile =~ s/\.[fp]rm$//;
      shift;
   }
   my @wfs = ();
   my @chans = ();
   my @units = ();
   my @irates = ();
   my @rates = ();
   my @scales = ();
   my @offsets = ();
   my @minvs = ();
   my @maxvs = ();
   my @sizes = ();
   my @divs = ();
   my @interleave = ();
   my @kinds = ();
   my @fblks = ();
   my @nblks = ();

   my $vperad = 1.0;
   my $uuoffset = 0.0;

   my $buffer;
   my ($systemid, $copyrt, $creator, $uspt, $tpadc, $filestate, $firstdata);
   my ($nchan, $chansize, $extradata, $bufsize, $osfmt, $maxftime);
   my ($dtimebase, $dtimedetail);
   my ($dtimesec, $dtimemin, $dtimehour, $dtimeday, $dtimemon, $dtimeyear);
   my @comment = ();
   my $hdrfmt = "(s a10 a8 s s s l s s s s s l d C C C C C C s x47 " .
               "x a79 x a79 x a79 x a79 x a79)<";
   my $hdrsize = 507;
   my $fhdrsize = 512;
   my ($delsize, $ndelblk, $frstblk, $lstblk, $blocks, $nextra, $pretrig, $fr0);
   my ($pysz, $mdata, $cmt, $mchtime, $lchdv, $phychan, $title, $idrate, $kind);
   my ($ncmt, $ntitle, $nunit);
   my $chhdrfmt = "(s l l l s s s s s s C a71 l l s C a9 f C x)<";
   my $chhdrsize = 124;
   my $fchhdrsize = 140;
   my ($pvblk, $nxblk, $sttime, $entime, $chn, $items);
   my $blhdrfmt = "(l l l l s s)<";
   my $blhdrsize = 20;
   my $wn = -1;
   my $wfile = "";
   my $lastwn = -1;
   my $b;

   my $nr = read(SM, $buffer, $fhdrsize);
   ($systemid, $copyrt, $creator, $uspt, $tpadc, $filestate, $firstdata,
    $nchan, $chansize, $extradata, $bufsize, $osfmt, $maxftime, $dtimebase,
    $dtimedetail, $dtimesec, $dtimemin, $dtimehour, $dtimeday, $dtimemon,
    $dtimeyear, $comment[0], $comment[1], $comment[2],
    $comment[3], $comment[4]) = unpack($hdrfmt, $buffer);
   my $adctime = 1;
   if ($nr != $fhdrsize || $copyrt !~ m/\(C\) CED/) {
      warn "$pgm: File $smrfile doesn't look like Spike 2 .smr format\n";
      last if (!$batch);
      shift if (@ARGV && !$batch);
      next;
   }
   if ($systemid < 6) {
      $dtimebase = 1e-6;
      $adctime = $tpadc;
   }
   if ($dtimeyear < 1970 || $dtimeyear > 2100
         || $dtimemon < 1 || $dtimemon > 12
         || $dtimeday < 1 || $dtimeday > 31
         || $dtimehour < 0 || $dtimehour > 23
         || $dtimemin < 0 || $dtimemin > 59
         || $dtimesec < 0 || $dtimesec > 59) {
      $dtimedetail = 0;
      $dtimesec = 0;
      $dtimemin = 0;
      $dtimehour = 0;
      $dtimeday = 0;
      $dtimemon = 0;
      $dtimeyear = 0;
   }
   print STDERR "$smrfile: SON version $systemid, $copyrt\n" if $verbose;
   if ($copyrt !~ m/\(C\) CED/) {
      print STDERR "mismatch in header copyright value\n" if $verbose;
   }
   print STDERR "creator: $creator, hdr size: $nr/$fhdrsize\n" if $verbose > 1;
   print STDERR "us/time: $uspt, time/adc: $tpadc, state: $filestate, " .
               "channels: $nchan\n" if $verbose > 1;
   print STDERR "chan size: $chansize, extra: $extradata, buffer: $bufsize\n"
      if $verbose > 2;
   print STDERR "os format: $osfmt, maxftime: $maxftime, timebase: $dtimebase\n"
      if $verbose > 2;
   printf STDERR "Time: %04d-%02d-%02d %02d:%02d:%02d\n",
         $dtimeyear, $dtimemon, $dtimeday, $dtimehour, $dtimemin, $dtimesec
      if $verbose && $dtimeyear;
   if ($systemid >= 6) {
    print STDERR "comments: @comment\n" if $verbose > 1;
#    print STDERR "comments: \n";
#    for ($wn = 0; $wn < @comment; ++$wn) { print STDERR "$comment[$wn]\n"; }
   }
   for ($wn = 0; $wn < $nchan; ++$wn) {
      $nr = read(SM, $buffer, $fchhdrsize);
      if ($nr != $fchhdrsize) {
         warn "$pgm: Can't read channel header for channel $wn in $smrfile\n";
         last if (!$batch);
         shift if (@ARGV && !$batch);
         next arg;
      }
      ($delsize, $ndelblk, $frstblk, $lstblk, $blocks, $nextra, $pretrig, $fr0,
       $pysz, $mdata, $ncmt, $cmt, $mchtime, $lchdv, $phychan, $ntitle, $title,
       $idrate, $kind) = unpack($chhdrfmt, $buffer);
      $cmt = substr($cmt, 0, $ncmt);
      $title = substr($title, 0, $ntitle);
      $chans[$wn] = $phychan;
      $wfs[$wn] = $title;
      $irates[$wn] = $idrate;
      $rates[$wn] = $idrate;	# for now
      $fblks[$wn] = $frstblk;
      $nblks[$wn] = $blocks;
      # kind: 0=empty, 1=Adc, 2=EventFall, 3=EventRise, 4=EventBoth,
      # 5=Marker, 6=AdcMark, 7=RealMark, 8=TextMark, 9=RealWave
      print STDERR "Chan $wn: ($phychan) $title, kind: $kind, $idrate Hz, " .
         "'$cmt'\n" if ($kind == 1 || $kind == 9) && $verbose ||
                       $kind && $verbose > 1 || $verbose > 2;
      print STDERR "del size: $delsize, blks: $ndelblk ($frstblk..$lstblk)/" .
         "$blocks, extra: $nextra\n" if $verbose > 2;
      print STDERR "pretrig: $pretrig, fr0: $fr0, pysize: $pysz, " .
         "mdata: $mdata, mcht: $mchtime\n" if $verbose > 2;
      print STDERR "l ch div: $lchdv, ncmt: $ncmt, ntitle: $ntitle\n"
         if $verbose > 2;
      $offsets[$wn] = 0;
      $scales[$wn] = 0;
      $minvs[$wn] = 0;
      $maxvs[$wn] = 0;
      if ($kind == 1 || $kind == 6) {
         ($scales[$wn], $offsets[$wn], $nunit, $units[$wn], $divs[$wn]) =
            unpack("x$chhdrsize f f C a5 s", $buffer);
         $units[$wn] = substr($units[$wn], 0, $nunit);
         if ($systemid >= 6) {
            $interleave[$wn] = $divs[$wn];
            $divs[$wn] = $lchdv;
         }
         if ($verbose) {
            print STDERR "  kind Adc"; print STDERR "Mark" if $kind == 6;
            print STDERR ",";
            print STDERR "  scale x$scales[$wn] +$offsets[$wn], " .
               "units: $units[$wn], div: $divs[$wn]\n";
         }
      } elsif ($kind == 7 || $kind == 9) {
         ($minvs[$wn], $maxvs[$wn], $nunit, $units[$wn], $divs[$wn]) =
            unpack("x$chhdrsize f f C a5 s", $buffer);
         $units[$wn] = substr($units[$wn], 0, $nunit);
         if ($systemid >= 6) {
            $interleave[$wn] = $divs[$wn];
            $divs[$wn] = $lchdv;
         }
         $offsets[$wn] = ($maxvs[$wn]+$minvs[$wn])/2.0;
         $scales[$wn] = ($maxvs[$wn]-$minvs[$wn])/10.0;
         if ($verbose) {
            print STDERR "  kind Real"; print STDERR "Mark" if $kind == 7;
            print STDERR "Wave" if $kind == 9; print STDERR ",";
            print STDERR "  scale \[$minvs[$wn]..$maxvs[$wn]\], " .
               "units: $units[$wn], div: $divs[$wn]\n" if $kind != 9;
         }
         if ($kind == 9) {
            # looks like we need to override the wisdom of the Neo folks here...
            $scales[$wn] = $minvs[$wn];
            $offsets[$wn] = $maxvs[$wn];
            print STDERR "  scale x$scales[$wn] +$offsets[$wn], " .
               "units: $units[$wn], div: $divs[$wn]\n" if $verbose;
         }
      } elsif ($kind == 4) {
         my ($initlow, $nextlow) = unpack("x$chhdrsize C C", $buffer);
         print STDERR "  kind EventBoth, init $initlow, next $nextlow\n"
            if $verbose;
      }
      if ($divs[$wn]) {
         $rates[$wn] = 1.0 / ($divs[$wn] * $uspt * $adctime * $dtimebase);
         my $rr = $rates[$wn]*$divs[$wn];
         print STDERR "  real rate: $rates[$wn] ($rr/$divs[$wn])\n"
            if $verbose > 1;
      }
      $kinds[$wn] = $kind;
      $sizes[$wn] = 0;
      $lastwn = $wn;
   }

wf: for ($wn = 0; $wn < $nchan; ++$wn) {
      next unless $divs[$wn] && ($kinds[$wn] == 1 || $kinds[$wn] == 9);
      if (!$outp && $skipread) {
         $sizes[$wn] = int(($maxftime+$divs[$wn]-1)/$divs[$wn]);
         next;
      }
      my @sa;
      my $ssz = 2;
      $ssz = 4 if ($kinds[$wn] == 9);
      $uuoffset = $offsets[$wn];
      $vperad = 2**16 / ($scales[$wn] * 10);
      $wfile = sprintf("$ofile.w%02d", $wn);
      if ($outp) {
         open(WF, "> $wfile") || die "$pgm: Can't create file $wfile: $!\n";
         binmode(WF);
      }
      $lastwn = $wn;
      print STDERR $not . "Writing $wfile... " if $verbose;
      print STDERR "read:" if $verbose > 2;
      $nxblk = $fblks[$wn];
      for ($b = 0; $b < $nblks[$wn]; ++$b) {
         seek(SM, $nxblk, 0) if $nxblk > 0;
         $nr = read(SM, $buffer, $blhdrsize);
         if ($nr != $blhdrsize) {
            close(WF) if $outp;
            warn "\n" if $verbose;
            warn "$pgm: Can't read block header $b for chan $wn in $smrfile\n";
            warn "$pgm: Got $nr of $blhdrsize bytes at start $fblks[$wn]\n"
               if $verbose;
            warn "$pgm: on to block at $nxblk\n" if $verbose && $b > 0;
            next wf;
         }
         my $bll = $nxblk + $nr;
         ($pvblk, $nxblk, $sttime, $entime, $chn, $items) =
            unpack($blhdrfmt, $buffer);
         $nr = 0;
         $nr = read(SM, $buffer, $ssz * $items) if $items > 0;
         print STDERR " $nr" if $verbose > 2;
         print STDERR "\@$bll" if $verbose > 3;
         if ($nr != $ssz * $items) {
            close(WF) if $outp;
            warn "\n" if $verbose;
            warn "$pgm: Can't read data block $b for chan $wn in $smrfile\n";
            warn "$pgm: Got $nr bytes of $items $ssz-byte items\n" if $verbose;
            $bll -= $blhdrsize;
            warn "Block hdr $b: $pvblk<-$bll->$nxblk [$sttime..$entime]"
               . " ch$chn $items items\n" if $verbose > 2;
            next wf;
         }
         $bll -= $blhdrsize;
         print STDERR "\nBlock hdr $b: $pvblk<-$bll->$nxblk [$sttime..$entime]"
            . " ch$chn $items items\n" if $verbose > 4;
         if ($ssz == 4) {
            @sa = unpack('f<*', $buffer);
            $sa[$_] = int(($sa[$_] - $uuoffset) * $vperad + 32767.5)-32767
               for 0..@sa-1;
         } else {
            @sa = unpack('s<*', $buffer);
         }
         print WF pack('n*', @sa) if $outp;
         $sizes[$wn] += @sa;
      }
      close(WF) if $outp;
      print STDERR " $sizes[$wn] samples.\n" if $verbose;
   }
   close(SM);
   
   # 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]);
   }
   my $rdiv = 0;
   for ($wn = 0; $wn <= $lastwn; ++$wn) {
      next if !$divs[$wn];
      $rdiv = $divs[$wn] if !$rdiv;
      $rdiv = gcd($rdiv, $divs[$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);
      next if !$divs[$wn];
      $divs[$wn] /= $rdiv;
      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"
      if $verbose > 2;
   print STDERR $not . "Writing $ofile.frm...  " if $verbose;
   if ($outp) {
      system("dd if=/dev/zero 'of=$ofile.frm' count=1 bs=2048 2>/dev/null");
      open(RH,"> $ofile.rhd") || die "$pgm: 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";
      if ($dtimeyear) {
         my $stime = timelocal($dtimesec, $dtimemin, $dtimehour,
                                $dtimeday, $dtimemon-1, $dtimeyear);
         print RH "STARTTIME='$stime'\n";
         print STDERR "STARTTIME='$stime'\n" if $verbose > 2;
      }
      for ($wn = 0; $wn <= $lastwn; ++$wn) {
         next if (!$scales[$wn] || !$sizes[$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'") if $verbose > 2;
      system("echo Y | salvagerun '$ofile' 2>/dev/null") if $verbose <= 2;
   }
   my $rl = $length / $rsamprate;
   print STDERR "$length samples @ $rsamprate Hz ($rl sec.)\n" if $verbose;
   print STDERR "Ideal sample rate $samprate Hz.\n" if $verbose > 2;
   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;
}
