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