#!/bin/sh
# -*-Mode:Tcl-*- \
exec tclsh "$0" "$@"

namespace eval dat {} 

proc dat::dat2list {data} {
 set negn 1
 binary scan $data S negn
 if {$negn>0} {
  Error "Bad input. Not a dat-file?"
 }
 set frmsz [expr -2*$negn]
 lappend head $negn ""
 binary scan $data a4a[expr $frmsz-4]S* junk hh shorts
 foreach {c1 c2} [split $hh ""] {lappend head ${c1}${c2}}
 lappend out $head
 for {set pos 0} {$pos<[llength $shorts]} {incr pos [expr -$negn]} {
  set fnr [lindex $shorts $pos]
  set labnum [lindex $shorts [expr $pos+1]]
  set lab [format %c%c [expr $labnum/256] [expr $labnum%256]]
  set val [lrange $shorts [expr $pos+2] [expr $pos-$negn-1]]
  lappend out [concat $fnr [list $lab] $val]
 }
 return $out
}


proc dat::list2dat {l} { 
 set frmsz [llength [lindex $l 0]]
 set data [binary format S [expr -$frmsz]]
 append data [binary format c2 {0 0}]
 foreach var [lrange [lindex $l 0] 2 end] {
  if {[string length $var] > 2} {
   Error "bad header: variable names can only be 2 characters: \"$var\" (line 1)"
  }
  append data [binary format a2 $var]
 }
 set fnr 1
 foreach frame [lrange $l 1 end] {
  if {[llength $frame]!=$frmsz} {
   Error "bad frame: line has not the same length as header (line [expr $fnr+1])"
  }
  set values {}
  foreach val [lrange $frame 2 end] {lappend values [expr {round($val)}]}
  set lab [lindex $frame 1]
  if {[string length $lab] > 2} {
   Error "bad frame: labels can only be 2 characters: \"$lab\" (line [expr $fnr+1])"
  }
  append data [binary format Sa2S[expr $frmsz-2] $fnr $lab $values]
  incr fnr
 }
 return $data
}

proc Error {msg} {
 if [info exists ::tk_version] {
  tk_messageBox -message $msg -icon error
 } else {
  puts stderr $msg
  puts stderr "Try [file tail $::argv0] -help for more information."
 }
 exit
}

proc Usage {} {
 puts stderr "\tUsage: datconvert/datread/datwrite \[options]"
 puts stderr "\tConvert between binary multi-channel dat-file and ASCII table formats."
 puts stderr "\tInput is read from std input and output is written to std output."
 puts stderr ""
 puts stderr "\tOptions:"
 puts stderr "\t-infile FILE    read input from FILE"
 puts stderr "\t-outfile FILE   write output to FILE"
 puts stderr "\t-ifs C          use C as inter-field-separator (default is TAB)"
 puts stderr "\t-ils C          use C as inter-line-separator (default is NEWLINE)"
 puts stderr "\t                C can be SPACE, TAB, NEWLINE or any printing char"
 puts stderr "\t-mode MODE      if MODE=datread, convert from datfile to ASCII"
 puts stderr "\t                if MODE=datwrite, convert from ASCII to datfile"
 puts stderr "\t-help           display this message"
 puts stderr ""
 puts stderr "\tASCII table format:"
 puts stderr "\tA number of lines, all with equal number of fields"
 puts stderr "\tThe first line is a header with the following format:"
 puts stderr ""
 puts stderr "\tDummy\tDummy\tP1\tP2\tP3\tP4 ... PN"
 puts stderr ""
 puts stderr "\tP1..N are two-character parameter names"
 puts stderr "\tRemaining lines contain frame data with the following format:"
 puts stderr ""
 puts stderr "\tFrame#\tLabel\tVal1\tVal2\tVal3 ... ValN"
 puts stderr ""
 puts stderr "\tLabels are two characters wide. Values are short unsigned integers."
 puts stderr "\tIn datwrite mode, frame numbers are ignored."
 puts stderr ""
 puts stderr "\tAuthor:"
 puts stderr "\tJonas Beskow <beskow@speech.kth.se>"

}

if [string match *help* $argv] {
 Usage
 exit
}

set IFS \t
set ILS \n
set in stdin
set out stdout
set mode [file tail $::argv0]
set map {TAB \t SPACE " " NEWLINE \n}
set infile ""
set outfile ""

if [info exists tk_version] {
 set mode datread
 label .mode -text Mode: -anchor w
 radiobutton .datread -variable mode -value datread -text datread
 radiobutton .datwrite -variable mode -value datwrite -text datwrite
 grid .mode .datread .datwrite -sticky news

 label .inl -text "Input file:" -anchor w
 entry .ine -textvariable infile -width 40
 button .inb -text Browse... -command {set tmp [tk_getOpenFile -initialdir [file dirname $infile]];if {$tmp!=""} {set infile $tmp}}
 grid .inl .ine .inb -sticky news

 label .outl -text "Output file:" -anchor w
 entry .oute -textvariable outfile -width 40
 button .outb -text Browse... -command {set tmp [tk_getSaveFile -initialdir [file dirname $outfile]];if {$tmp!=""} {set outfile $tmp}}
 grid .outl .oute .outb -sticky news

 label .dummy
 button .conv -text "Convert" -command {set go 1}
 button .exit -text "Exit" -bg red -command exit
 grid .dummy .conv .exit -sticky news
 vwait go
 if {$infile == "" || $outfile == ""} {
  Error "Bad infile or outfile"
 }
}

foreach {opt val} $argv {
 switch -glob -- $opt {
  -mode {
   set mode $val
  }
  -in* {
   set infile $val
  }
  -out* {
   if [catch {set out [open $val w]} err] {Error $err}
  }
  -ifs {
   set IFS [string map $map $val]
  }
  -ils {
   set ILS [string map $map $val]
  }
  default {
   Error "invalid option $opt"
  }
 }
}

if {$infile != ""} {
 if [catch {set in [open $infile r]} err] {Error $err}
}

if {$outfile != ""} {
 if [catch {set out [open $outfile w]} err] {Error $err}
}

if {$mode=="datread"} {
 fconfigure $in -translation binary -encoding binary
 set res ""
 foreach row [dat::dat2list [read $in]] {
  lappend all [join $row $IFS]
 }
 puts -nonewline $out [join $all $ILS]
} else {
 fconfigure $out -translation binary
 foreach line [split [string trim [read $in]] $ILS] {
  lappend data [split [string trim $line] $IFS]
 }
 puts -nonewline $out [dat::list2dat $data]
}


if {$in!="stdin"} {close $in}
if {$out!="stdin"} {close $out}