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

# mseq,v 1.4 1993/04/08 04:16:05 durian Exp

set ScopeList ""
set CurrentScope ""
set ScopeDuration long

set TrackNumber 0
set CurrentTrack ""

set InFileName stdin
set OutFileName stdout
set LineNumber 0

set Division -1

proc ReadLine {file} {
	global LineNumber

	# we want to skip blank lines
	# and escape both curly braces
	if {[gets $file line0] == -1} {
		return ""
	}
	incr LineNumber
	if {![regsub -all \{ $line0 \\\{ line1]} {
		set line1 $line0
	}
	if {![regsub -all \} $line1 \\\} line2]} {
		set line2 $line1
	}
	while {[llength $line2] == 0} {
		if {[gets $file line0] == -1} {
			return ""
		}
		incr LineNumber
		if {![regsub -all \{ $line0 \\\{ line1]} {
			set line1 $line0
		}
		if {![regsub -all \{ $line2 \\\{ line1]} {
			set line2 $line1
		}
	}
	return $line2
}


proc CollapseAndAdd {outfile infilename outtimes} {
	global Division

	if {[catch {open $infilename "r"} file]} {
		puts stderr $file
		exit 1
	}
	set infile [midiread $file]
	set outtime0 [lindex $outtimes 0]
	set outtime1 [lindex $outtimes 1]

	set form [midiconfig $infile format]
	if {[midiconfig $infile format] != 1} {
		puts stderr "Sorry!  mseq only handles format 1 files currently."
		exit 1
	}
	if {$Division == -1} {
		set Division [midiconfig $infile division]
		set scalar 1
	} else {
		set scalar [expr {[midiconfig $infile division] / $Division}]
	}

	# copy over track 0
	set outtime0 [midimerge "$outfile 0" "\"$infile 0 $scalar\"" $outtime0]

	# now merge the other tracks to track 1
	set num_tracks [midiconfig $infile tracks]
	for {set i 1} {$i < $num_tracks} {incr i} {
		lappend inputs "$infile $i $scalar"
	}
	set outtime1 [midimerge "$outfile 1" $inputs $outtime1]

	midifree $infile
	close $file

	return "$outtime0 $outtime1"
}

# parse command line args
# mseq [input.seq [output.mid]]
if {[string compare [lindex $argv 0] -f] == 0} {
	set argv [lrange $argv 2 end]
	set argc [expr {$argc - 2}]
}
if {$argc > 2} {
	puts stderr "Usage: mseq [input.seq [output.mid]]"
	exit 1
}

set InFile stdin
set OutFile stdout
if {$argc > 0} {
	set InFileName [lindex $argv 0]
	if {[catch {open $InFileName "r"} InFile]} {
		puts stderr $InFile
		exit 1
	}
	if {$argc > 1} {
		set OutFileName [lindex $argv 1]
		set OutFile [open $OutFileName "w"]
		if {[catch {open $OutFileName "w"} OutFile]} {
			puts stderr $OutFile
			exit 1
		}
	}
}


# pretty ugly huh?
# get a line and stick it into the variable line
# also get the length of that same line
# and stick that result in the variable line_length
# then check to see if that is zero
while {[set line_length [llength [set line [ReadLine $InFile]]]] != 0} {
	set comment 0
	for {set i 0} {$i < $line_length} {incr i} {
		set word [lindex $line $i]
		case $word in {
		"*:" {
			# this is a label
			set ScopeList [linsert $ScopeList 0 $word]
			set CurrentScope $word
			set ScopeDuration short
		} "\{" {
			# this opens a block
			set ScopeDuration long
		} "\}" {
			# this closes a block
			set ScopeList [lrange $ScopeList 1 end]
			set CurrentScope [lindex $ScopeList 0]
		} "repeat" {
			if {[llength $ScopeList] == 0} {
				puts stderr "No track specified"
				puts stderr "Line $LineNumber File: $InFileName"
				exit 1
			}
			# our one and only command
			incr i
			if {$i == $line_length} {
				puts stderr [concat "Must follow \"repeat\" "\
				    "with a block name"]
				puts stderr "Line $LineNumber File: $InFileName"
				exit 1
			}
			set block [lindex $line $i]
			incr i
			if {$i < $line_length} {
				set num_repeats [lindex $line $i]
			} else {
				set num_repeats 1
			}
			for {set j 0} {$j < $num_repeats} {incr j} {
				# some major contortions to get
				# recursive variable names
				set var "\$${CurrentTrack}($block)"

				foreach scope $ScopeList {
					eval "append ${CurrentTrack}($scope) \
					    { } $var"
				}
			}
		} "track" {
			if {[llength $ScopeList] > 1} {
				puts stderr "No nesting tracks"
				puts stderr "Line $LineNumber File: $InFileName"
				exit 1
			}
			set ScopeList main:
			set CurrentScope main:
			set CurrentTrack track${TrackNumber}
			incr TrackNumber
		} "#" {
			set comment 1
		} default {
			# other wise we're a file name
			# we must append word to all scopes in ScopeList
			if {[llength $ScopeList] == 0} {
				puts stderr "No track specified"
				puts stderr "Line $LineNumber File: $InFileName"
				exit 1
			}
			foreach scope $ScopeList {
				lappend ${CurrentTrack}($scope) $word
			}
			if {[string compare $ScopeDuration short] == 0} {
				set ScopeList [lrange $ScopeList 1 end]
				set CurrentScope [lindex $ScopeList 0]
				set ScopeDuration long
			}
		}
		}
		if {$comment} {
			break
		}
	}
}

for {set i 0} {$i < $TrackNumber} {incr i} {
	puts stderr "Track [expr {$i + 1}]:"
	set var track${i}(main:)
	puts stderr [eval "set $var"]
	puts stderr ""

	# we want to collapse and concat each track to a mfile
	set mfile [midimake]
	midiconfig $mfile format 1
	midiconfig $mfile tracks 2
	lappend MFileList $mfile

	# initially we are at the begining of the track
	set track_time "0 0"
	foreach filename [eval "set $var"] {
		set track_time [CollapseAndAdd $mfile $filename $track_time]
	}

	# set the division to what was determined by CollapseAndAdd
	midiconfig $mfile division $Division

	# stick eot's on tracks 0 and 1
	midiput $mfile 0 [lindex $track_time 0] metaeot
	midiput $mfile 1 [lindex $track_time 1] metaeot

	# and rewind it for future use
	midirewind $mfile

}

# and then create one final mfile from each individual track mfile
# track 0's must merge - other tracks stay separate
set moutfile [midimake]
midiconfig $moutfile format 1
midiconfig $moutfile track [expr {$TrackNumber + 1}]
midiconfig $moutfile division $Division

# by now everything is in the same division so we can use tscalars of 1

puts stderr "Final Merge"

# make track 0 merge list
# and append other tracks
set track 1
foreach mfile $MFileList {
	lappend mlist "$mfile 0 1"
	set d [midimerge "$moutfile $track" "\"$mfile 1 1\"" 0]
	midiput $moutfile $track $d metaeot
	incr track
}

set delta0 [midimerge "$moutfile 0" $mlist 0]
midiput $moutfile 0 $delta0 metaeot

foreach mfile $MFileList {
	midifree $mfile
}

midiwrite $moutfile $OutFile
midifree $moutfile
close $OutFile
exit 0
