#!/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.
#

# infom,v 1.2 1993/05/06 21:42:20 durian Exp

# get filename arg
if {[string compare [lindex $argv 0] "-f"] == 0} {
	incr argc -2
	set argv [lrange $argv 2 end]
}

case $argc in {
	0 {
		set infile_name stdin
		set outfile_name stdout
	} 1 {
		set infile_name [lindex $argv 0]
		set outfile_name stdout
	} 2 {
		set infile_name [lindex $argv 0]
		set outfile_name [lindex $argv 1]
	} default {
		puts stderr "Usage: infom [info_file [midi_file]]"
		exit 1
	}
}

proc PutEvent {event mfile track_num last_timing} {

	# get the timing part of the event
	set timing [lindex $event 0]
	# minus :
	set timing [string trimright $timing :]

	#determine time since last event
	set delta [expr {$timing - $last_timing}]

	case [lindex $event 1] in {
	NOTEOFF {
		set chan [lindex $event 3]
		set pitch [lindex $event 5]
		set vel [lindex $event 7]
		midiput $mfile $track_num $delta noteoff $chan $pitch $vel
	} NOTEON {
		set chan [lindex $event 3]
		set pitch [lindex $event 5]
		set vel [lindex $event 7]
		midiput $mfile $track_num $delta noteon $chan $pitch $vel
	} KEY {
		set chan [lindex $event 4]
		set pitch [lindex $event 6]
		set pres [lindex $event 8]
		midiput $mfile $track_num $delta keypressure $chan $pitch $pres
	} PARAMETER {
		set chan [lindex $event 3]
		set param [lindex $event 5]
		set set [lindex $event 7]
		midiput $mfile $track_num $delta parameter $chan $param $set
	} PROGRAM {
		set chan [lindex $event 3]
		set prog [lindex $event 5]
		midiput $mfile $track_num $delta program $chan $prog
	} CHANNEL {
		set chan [lindex $event 4]
		set pres [lindex $event 6]
		midiput $mfile $track_num $delta channelpressure $chan $pres
	} PITCH {
		set chan [lindex $event 4]
		set val [lindex $event 6]
		midiput $mfile $track_num $delta pitchwheel $chan $val
	} METACHANPREFIX {
		midiput $mfile $track_num $delta metachanprefix \
		    [lrange $event 2 end]
	} METACPY {
		midiput $mfile $track_num $delta metacpy [lrange $event 2 end]
	} METACUE {
		midiput $mfile $track_num $delta metacue [lrange $event 2 end]
	} METAEOT {
		midiput $mfile $track_num $delta metaeot
	} METAINSTNAME {
		midiput $mfile $track_num $delta metainstname \
		    [lrange $event 2 end]
	} METAKEY {
		midiput $mfile $track_num $delta metakey [lindex $event 2] \
		    [lindex $event 3]
	} METALYRIC {
		midiput $mfile $track_num $delta metalyric \
		    [lrange $event 2 end]
	} METAMARKER {
		midiput $mfile $track_num $delta metamarker \
		    [lrange $event 2 end]
	} METASEQNAME {
		midiput $mfile $track_num $delta metaseqname \
		    [lrange $event 2 end]
	} METASEQNUM {
		midiput $mfile $track_num $delta metaseqnum [lindex $event 2]
	} METASEQSPEC {
		# no idea, so we skip it
		return $last_timing
	} METASMPTE {
		set hr [string trimright [lindex $event 3] ,]
		set mi [string trimright [lindex $event 5] ,]
		set se [string trimright [lindex $event 7] ,]
		set fr [string trimright [lindex $event 9] ,]
		set ff [lindex $event 12]
		midiput $mfile $track_num $delta metasmpte $hr $mi $se $fr $ff
	} METATEMPO {
		midiput $mfile $track_num $delta metatempo [lindex $event 2]
	} METATEXT {
		midiput $mfile $track_num $delta metatext [lrange $event 2 end]
	} METATIME {
		set fraction [split [lindex $event 2] /]
		set num [lindex $fraction 0]
		set den [lindex $fraction 1]
		set cpm [lindex $event 3]
		set _32 [lindex $event 8]
		midiput $mfile $track_num $delta metatime $num $den $cpm $_32
	} SYSEX {
		if {[string compare [lindex $event 2] cont] == 0} {
			midiput $mfile $track_num $delta sysex cont \
			    [lrange $event 3 end]
		} else {
			midiput $mfile $track_num $delta sysex \
			    [lrange $event 2 end]
		}
	}
	}

	return $timing
}

if {[string compare $infile_name stdin] == 0} {
	set infile stdin
} else {
	if {![file exists $infile_name]} then {
		puts stderr "Bad file name: $infile_name"
		exit 1
	} else {
		set infile [open $infile_name "r"]
	}
}

if {[string compare $outfile_name stdout] == 0} {
	set outfile stdout
} else {
	# check to see if the specified file exists and open it
	if {[catch {open $outfile_name "w"} outfile]} {
		puts stderr "Couldn't open $midi_file_name for writing"
		puts stderr $outfile
	}
}

# make an empty mfile
set mfile [midimake]

# skip over filename since we use the command line
if {[gets $infile line] == -1} {
	puts stderr "bad input line: $junk"
	exit 1
}

# get format
if {[gets $infile line] == -1} {
	puts stderr "bad input line: $junk"
	exit 1
}
set format [lindex $line 2]
midiconfig $mfile format $format

# get division
if {[gets $infile line] == -1} {
	puts stderr "bad input line: $junk"
	exit 1
}
set division [lindex $line 2]
midiconfig $mfile division $division

# get num_trks
if {[gets $infile line] == -1} {
	puts stderr "bad input line: $junk"
	exit 1
}
set num_trks [lindex $line 4]
midiconfig $mfile tracks $num_trks

# generate all the tracks
set track 0
while {1} {
	if {[gets $infile line] == -1} {
		if {[expr {$num_trks - 1}] != $track} {
			puts stderr "bad input line: $junk"
			exit 1
		} else {
			break
		}
	}
	if {[string compare [lindex $line 0] Track] == 0} {
		set timing 0
		set track [lindex $line 1]
		continue
	}
	if {[string length $line] == 0} {
		continue
	}
	set timing [PutEvent $line $mfile $track $timing]
}
midiwrite $mfile $outfile
midifree $mfile
close $outfile
close $infile
exit 0
