Posted to tcl by dbohdan at Fri Mar 20 11:43:02 GMT 2015view pretty
namespace eval ::decoder { variable format { header { magic 6 a6 len 8 W version 11 a11 zeros2 21 cu21 tempo 4 f1 } instrument { track 1 cu1 zeros 3 cu3 lname 1 cu1 name $lname a${lname} party 16 cu16 } } variable } proc ::decoder::dump-dict {dictionary} { puts "{" foreach {key value} $dictionary { puts [format { %-8s "%s" %2d %2d} $key $value \ [llength $value] [string length $value]] } puts "}\n" } proc ::decoder::read-record {channel format} { set result {} foreach {field length binFormat} $format { dict with result { set length [subst $length] set binFormat [subst $binFormat] } set raw [read $channel $length] if {$raw eq ""} { # EOF. return } if {[binary scan $raw $binFormat processed]} { dict set result $field $processed } else { error "could not scan value \"$raw\" as \"$binFormat\"" } #dump-dict $result } return $result } proc ::decoder::pretty-print {data} { dict with data { dict with header { puts "[file tail $filename]" puts "Saved with HW Version: $version" puts "Tempo: $tempo" } foreach instrument $instruments { if {$instrument eq ""} { continue } dict with instrument { set party [string map {0 - 1 x} [join $party ""]] regsub {(....)(....)(....)(....)} $party {|\1|\2|\3|\4|} party puts "($track) $name\t$party" } } } } proc ::decoder::decode {filename} { variable format set ch [open $filename] fconfigure $ch -encoding binary -translation binary set result [list filename $filename] dict set result header [read-record $ch [dict get $format header]] dict set result instruments {} while {![eof $ch]} { catch { dict lappend result instruments \ [read-record $ch [dict get $format instrument]] } } close $ch return $result } set decoded [::decoder::decode [lindex $argv 0]] ::decoder::dump-dict $decoded ::decoder::pretty-print $decoded