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

# mrecord,v 1.1 1993/05/06 02:51:08 durian Exp

if {! [midiplayable]} {
	puts stderr [concat "Cannot record.  Tclm was not compiled with the " \
	    "record functionality turned on."]
	exit 1
}

set repeat {}
set tracks {}
set speed {}
set play ""
set reltempo ""
set rec_file_name ""
set play_file_name ""

proc parse_arg {args} {
	global repeat
	global tracks
	global speed
	global play_file_name
	global rec_file_name

	# strip away extra {}'s
	set argv [lindex $args 0]
	set argc [llength $argv]
	if {$argc > 1 && [string compare [lindex $argv 0] "-f"] == 0} {
		incr argc -2
		set argv [lrange $argv 2 end]
	}
	for {set i 0} {$i < $argc} {incr i} {

		set arg [lindex $argv $i]
		case $arg in \
		-repeat {
			set repeat repeat
		} -tracks {
			set tracks [lindex $argv [incr i]]
		} -speed {
			set speed [lindex $argv [incr i]]
		} -pfile {
			set play_file_name [lindex $argv [incr i]]
		} default {
			if {[string length $rec_file_name] != 0} {
				Usage
			} else {
				set rec_file_name [lindex $argv $i]
			}
		}
	}
}

proc Usage {} {
	puts stderr {Usage: mrecord [-pfile play_file [-repeat] \
[-tracks track_list] [-speed speed]] record_file}
	exit 1
}

parse_arg $argv

set background ""
set rmfile [midimake]
midiconfig $rmfile format 0
midiconfig $rmfile tracks 1

if {[string length $play_file_name] == 0} {
	if {[string length $repeat] != 0} {
		Usage
	}
	if {[string length $tracks] != 0} {
		Usage
	}
	if {[string length $speed] != 0} {
		Usage
	}
	set pfile ""
	set pmfile ""
	set background background
} else {
	if {[string length $repeat] != 0} {
		set background background
	}

	if {[llength $tracks] != 0} {
		set tracks "tracks \"$tracks\""
	} else {
		set tracks ""
	}

	if {[string length $speed] != 0} {
		set reltempo "reltempo $speed"
	} else {
		set reltempo ""
	}
	set pfile [open $play_file_name "r"]
	set pmfile [midiread $pfile]
	close $pfile

	set play "play $pmfile"

	midiconfig $rmfile division [midiconfig $pmfile division]
}

if {[string length $background] == 0} {
	eval "midirecord $background $play $repeat $tracks $reltempo $rmfile"
} else {
	set pid [eval \
	    "midirecord $background $play $repeat $tracks $reltempo $rmfile"]
	puts stdout "Press return to stop recording"
	gets stdin
	midistop $pid $rmfile
}

midiput $rmfile 0 0 metaeot

set rfile [open $rec_file_name "w"]
midiwrite $rmfile $rfile
close $rfile
if {[string length $pmfile] != 0} {
	midifree $pmfile
}
midifree $rmfile
exit 0
