Posted to tcl by dbohdan at Fri Mar 20 11:43:02 GMT 2015view raw
- 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