#!/usr/local/bin/tclm -f
#
# Copyright (c) 1993 Michael B. Durian.  All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#	This product includes software developed by Michael B. Durian.
# 4. The name of the the Author may be used to endorse or promote 
#    products derived from this software without specific prior written 
#    permission.
#
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 
# WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  
# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#

# minfo,v 1.6 1993/04/08 04:16:01 durian Exp

# get filename arg
if {[string compare [lindex $argv 0] "-f"] == 0} {
	set midi_file_name [lindex $argv 2]
} else {
	set midi_file_name [lindex $argv 0]
}

proc FormatEvent {event} {
	global pos

	# get the timing part of the event
	set timing [lindex $event 0]

	# determine offset from start of track
	set pos [expr {$timing + $pos}]
	set out [format "%6d: " $pos]

	case [lindex $event 1] in {
	noteoff {
		set chan [lindex $event 2]
		set pitch [lindex $event 3]
		set vel [lindex $event 4]
		append out "NOTEOFF channel $chan pitch $pitch velocity $vel"
	} noteon {
		set chan [lindex $event 2]
		set pitch [lindex $event 3]
		set vel [lindex $event 4]
		append out "NOTEON channel $chan pitch $pitch velocity $vel"
	} keypressure {
		set chan [lindex $event 2]
		set pitch [lindex $event 3]
		set pres [lindex $event 4]
		append out \
		    "KEY PRESSURE channel $chan pitch $pitch pressure $pres"
	} parameter {
		set chan [lindex $event 2]
		set param [lindex $event 3]
		set set [lindex $event 4]
		append out \
		    "PARAMETER channel $chan parameter $param setting $set"
	} program {
		set chan [lindex $event 2]
		set prog [lindex $event 3]
		append out "PROGRAM channel $chan program $prog"
	} channelpressure {
		set chan [lindex $event 2]
		set pres [lindex $event 3]
		append out "CHANNEL PRESSURE channel $chan pressure $pres"
	} pitchwheel {
		set chan [lindex $event 2]
		set val [lindex $event 3]
		append out "PITCH WHEEL channel $chan value $val"
	} metachanprefix {
		append out "METACHANPREFIX [lindex $event 2]"
	} metacpy {
		append out "METACPY [lindex $event 2]"
	} metacue {
		append out "METACUE [lindex $event 2]"
	} metaeot {
		append out "METAEOT"
	} metainstname {
		append out "METAINSTNAME [lindex $event 2]"
	} metakey {
		append out "METAKEY [lindex $event 2] [lindex $event 3]"
	} metalyric {
		append out "METALYRIC [lindex $event 2]"
	} metamarker {
		append out "METAMARKER [lindex $event 2]"
	} metaseqname {
		append out "METASEQNAME [lindex $event 2]"
	} metaseqnum {
		append out "METASEQNUM [lindex $event 2]"
	} metaseqspec {
		append out "METASEQSPEC"
	} metasmpte {
		set hr [lindex $event 2]
		set mi [lindex $event 3]
		set se [lindex $event 4]
		set fr [lindex $event 5]
		set ff [lindex $event 6]
		append out \
		    "METASMPTE Hour $hr, Min. $mi, Sec. $se, Frame $fr, Frac. Frame $ff"
	} metatempo {
		append out "METATEMPO [lindex $event 2] BPM"
	} metatext {
		append out "METATEXT [lindex $event 2]"
	} metatime {
		set num [lindex $event 2]
		set den [lindex $event 3]
		set cpm [lindex $event 4]
		set _32 [lindex $event 5]
		append out \
		    "METATIME $num/$den, $cpm clocks per met. beat, $_32 32nd notes per 1/4 note"
	} sysex {
		append out "SYSEX [lindex $event 2]"
		if {[llength $event] > 3} {
			append out " [lindex $event 3]"
		}
	}
	}

	return $out
}

if {[string length $midi_file_name] == 0} {
	# if no filename is specified use stdin
	set midi_file stdin
	set midi_file_name stdin
} else {
	# check to see if the specified file exists and open it
	if {![file exists $midi_file_name]} then {
		puts stderr "Bad file name: $midi_file_name"
		exit 1
	} else {
		set midi_file [open $midi_file_name]
	}
}

# read the midi file
# print out error if there is one
if {[catch {midiread $midi_file} mfile]} {
	puts stderr $mfile
	exit 1
}
puts stdout [format "%-16s = %s" "file name" $midi_file_name]
puts stdout [format "%-16s = %s" "format" [midiconfig $mfile format]]
puts stdout [format "%-16s = %s" "division" [midiconfig $mfile division]]
set num_trks [midiconfig $mfile tracks]
puts stdout [format "%-16s = %s" "number of tracks" $num_trks]

# print out all the tracks
for {set track 0} {$track < $num_trks} {incr track} {
	puts stdout "\nTrack $track"
	set pos 0
	while {[string compare [set event [midiget $mfile $track]] EOT] != 0} {
		set out [FormatEvent $event]
		puts stdout $out
	}
}
exit 0
