''
'' bam2mid -- convert a .BAM file to a General Midi .MID file
''		2005-10-11 - 1.0 - Ignores final infinite loop point and
''		                   sets velocity to 64. Don't know if that
''		                   is good or bad.
''
'' usage: bam2mid <infile> [<outfile>]
'' <outfile> defaults to <infile>.mid if not specified.
''
'' To compile:
''        scons bam2mid
''

#include "util.bi"
#include "common_base.bi"
#include "banks.bi"
#include "crt/stddef.bi"
#include "lumpfile.bi"

#define LOG_BAM(msg)
'#define LOG_BAM(msg) ? msg

#define VELOCITY 		96

#define NOTE_OFF	&b10000000
#define NOTE_ON		&b10010000
#define PATCH_CHANGE 	&b11000000

declare sub setbigval(byval value as integer)
declare sub setsmallval(byval value as integer)
declare function setvarval(byval value as integer) as integer
declare function getvoice(bamvoice as voice) as integer
declare sub magicSysexStart(byval file as integer, byval length as integer)
declare sub magicSysexEnd(byval file as integer)

dim shared bignum(0 to 3) as ubyte => { 0, 0, 0, 0 }
dim shared smallnum(0 to 1) as ubyte => { 0, 0 }

sub bam2mid(infile as string, outfile as string)

	'fields for writing to midi file
	dim magic as string * 4

	dim tracklen as integer = 0
	dim lenpos as integer

	dim bamvoice as voice

	'need to remember the exact note pressed in mids, unlike bams
	dim tracknote(0 to 15) as integer
	'save file positions for loops
	dim labelpos(0 to 15) as integer
	dim loopcount(0 to 15) as integer
	dim returnpos as integer = -1

	dim as integer f1, f2, i, j

	'initialise shared vals
	setbigval(0)
	setsmallval(0)

	for i = 0 to 15
		labelpos(i) = -1
		loopcount(i) = -1
	next
	'Label 0 defaults to the beginning of the file, but it's only used for
	'looping from the end, and we stop instead of processing that loop.
	labelpos(0) = 5  'Past header

	if outfile = "" then
		outfile = infile + ".mid"
	end if

	'open both files
	if openfile(infile, for_binary + access_read, f1) then
		'debug "File " + infile + " could not be opened."
		exit sub
	end if

	get #f1, , magic
	if magic <> "CBMF" then
		debug "File " + infile + " is not a BAM."
		close #f1
		exit sub
	end if

	kill outfile

	if openfile(outfile, for_binary + access_write, f2) then
		'debug "Output file " + outfile + " could not be opened."
		close #f1
		exit sub
	end if

	'write the midi header
	magic = "MThd"
	put #f2, , magic			'chunk type
	bignum(3) = 6
	put #f2, , bignum()			'chunk length
	put #f2, , smallnum()		'file type (type 0 = single track)
	smallnum(1) = 1
	put #f2, , smallnum()		'number of tracks (always 1 for type 0)
	smallnum(1) = 37
	put #f2, , smallnum()		'ticks per 1/4 note (half second, by default)

	'write the track header
	magic = "MTrk"
	put #f2, , magic		'chunk type
	lenpos = seek(f2)		'remember where we are
	bignum(3) = 0
	put #f2, , bignum()		'chunk length - come back and fill this in later

	'process a bam
	dim ub as ubyte
	dim cmd as ubyte
	dim chan as ubyte
	dim delta as integer = 0
	dim bc as integer
	dim mb as ubyte

	'put the tempo in
	bc = setvarval(0)
	fput f2, , @bignum(0), bc	'variable length delta time
	tracklen = tracklen + bc
	mb = &hff
	put #f2, , mb				'metacommand
	mb = &h51
	put #f2, , mb				'end track
	mb = 3
	put #f2, , mb				'no further params
	tracklen = tracklen + 3
	bignum(0) = &h07
	bignum(1) = &hA1
	bignum(2) = &h20
	fput f2, , @bignum(0), 3
	tracklen = tracklen + 3


	get #f1, , ub
	do while not eof(f1)
		if ub < 128 then
			cmd = ub and &hf0
			chan = ub and &h0f
			LOG_BAM(seek(f1) & " cmd " &  cmd & " " & chan)
			select case cmd
				case 0: 'stop song
					'Command 0 is documented as stop song, and the Euphoria and
					'QB players in the BAM Dev Kit treat it that way, but
					'the asm implementation does not - it's unimplemented.
					'The final (2002-11-21) version of fm.asm added a bug where
					'it's misinterpreted as a "start note" command, but earlier
					'(<= 2000-12-12) versions properly ignored it.
					'testfiles/GURGU.BAM is an example of a BAM in the wild
					'(from Timestream Saga) that contains a cmd 0 at the beginning.
					'exit do
				case 16: 'start note
					get #f1, , ub 'get freq
					'write midi note on
					bc = setvarval(delta)
					fput f2, , @bignum(0), bc	'variable length delta time
					tracklen = tracklen + bc
					mb = NOTE_ON or chan
					put #f2, , mb				'command
					put #f2, , ub				'note
					tracknote(chan) = ub 		'remember note
					mb = VELOCITY
					put #f2, , mb				'velocity
					tracklen = tracklen + 3
					delta = 0
				case 32: 'stop note
					'write midi note on
					bc = setvarval(delta)
					fput f2, , @bignum(0), bc	'variable length delta time
					tracklen = tracklen + bc
					mb = NOTE_OFF or chan
					put #f2, , mb				'command
					mb = tracknote(chan)
					put #f2, , mb				'note
					mb = 64
					put #f2, , mb				'velocity
					tracklen = tracklen + 3
					delta = 0
				case 48: 'define instrument
					'write midi patch change
					bc = setvarval(delta)
					fput f2, , @bignum(0), bc	'variable length delta time
					tracklen = tracklen + bc
					get #f1, , bamvoice
					mb = PATCH_CHANGE or chan
					put #f2, , mb
					mb = getvoice(bamvoice)
					put #f2, , mb
					tracklen = tracklen + 2
					delta = 0
				case 80: 'set label
					'save file position
					if chan = 0 then
						'Label 0 is used for looping from the end of the BAM.
						'Its position defaults to the start, but many BAMs
						'explicitly place it at the beginning (after instrument
						'definitions), but it could be elsewhere.
						'BUG: actually, we might perform a jump to a label other
						'than 0. E.g. ARIEDUET.BAM jumps to label 2 at the end.
						'This is pretty annoying to support, though.

						'Set Controller 111: set loop point (RPG Maker-compatible
						'supported by music_native, music_native2 and SDL Mixer X).
						bc = setvarval(delta)
						fput f2, , @bignum(0), bc	'variable length delta time
						tracklen += bc
						mb = &HB0
						put #f2,,mb
						mb = 111
						put #f2,,mb
						mb = 127
						put #f2,,mb
						tracklen += 3
						delta = 0
					end if
					labelpos(chan) = seek(f1)
				case 96: 'jump
					get #f1, , ub 'loop control
					LOG_BAM("  loop " & ub & iif(ub=255, " chorus", iif(ub=254, " jump", " times")))
					if labelpos(chan) > 0 then
						if ub = 255 then
							'chorus loop, but only if not already
							'in a chorus
							if returnpos = -1 then
								returnpos = seek(f1)
								seek f1, labelpos(chan)
							end if
						end if
						if ub = 254 then
							'Infinite loop.
							'An infinite loop to marker 0 always appears at the
							'end of the file. It effectively marks the end of
							'the song. It could appear earlier (e.g. in ARIEDUET.BAM)
							exit do
						end if
						if ub < 254 then
							if loopcount(chan) = -1 then
								loopcount(chan) = ub
							end if
							if loopcount(chan) = 0 then
								loopcount(chan) = -1 'reset
							else
								loopcount(chan) = loopcount(chan) - 1
								seek f1, labelpos(chan)
							end if
						end if
					else
						LOG_BAM("bad loop!")
					end if
				case 112: 'end of chorus
					if returnpos > -1 then
						seek f1, returnpos
						returnpos = -1
					end if
				case else: 'reserved: ignore
					'nothing
			end select
		else
			'wait
			delta = delta + ((ub - 127) * 4)
			LOG_BAM(seek(f1) & " wait " &  (ub - 127))
		end if

		get #f1, , ub
	loop

	'write end track event
	bc = setvarval(delta)
	fput f2, , @bignum(0), bc	'variable length delta time
	tracklen = tracklen + bc
	mb = &hff
	put #f2, , mb				'metacommand
	mb = &h2f
	put #f2, , mb				'end track
	mb = 0
	put #f2, , mb				'no further params
	tracklen = tracklen + 3

	'skip back and write the track length
	setbigval(tracklen)
	put #f2, lenpos, bignum()

	close #f2
	close #f1

end sub

'Convert int32 to big-endian
sub setbigval(byval value as integer)
	bignum(3) = value and &hff
	bignum(2) = (value shr 8) and &hff
	bignum(1) = (value shr 16) and &hff
	bignum(0) = (value shr 24) and &hff
end sub

'Convert int16 to big-endian
sub setsmallval(byval value as integer)
	smallnum(1) = value and &hff
	smallnum(0) = (value shr 8) and &hff
end sub

function setvarval(byval value as integer) as integer
	dim bytes as integer = 0
	dim tmp as integer
	dim b as integer
	dim flag as ubyte = 0

	if value = 0 then
		bignum(0) = 0
		return 1
	end if

	tmp = value
	while tmp > 0
		bytes = bytes + 1
		tmp = tmp \ 128
	wend

	tmp = value
	for b = bytes - 1 to 0 step -1
		bignum(b) = (tmp mod 128) or flag
		flag = &h80
		tmp = tmp \ 128
	next

	return bytes
end function

function getvoice(bamvoice as voice) as integer
'returns GM program number for this instrument
	dim as integer i, j

	'check gm voices
	for i = 0 to 127
		for j = 0 to 10
			if gm_voice(i,j) <> bamvoice.vbyte(j) then
				continue for, for
			end if
		next
		return i
	next

	'check ibank voices
	for i = 0 to 127
		for j = 0 to 10
			if ibank_voice(i,j) <> bamvoice.vbyte(j) then
				continue for, for
			end if
		next
		return ibank_map(i)
	next

	return 0	'default = acoustic grand piano
end function


#ifdef __FB_MAIN__

dim infile as string, outfile as string

if command(1) <> "" then infile = command(1)
if command(2) <> "" then outfile = command(2)

if infile = "" then
	PRINT "Usage: bam2mid filename"
	PRINT "Converts a BAM file into MIDI format"
	system
end if

if outfile = "" then
	outfile = infile
	if right(lcase(outfile), 4) = ".bam" then
		outfile = left(outfile, len(outfile)-4)
	end if
	outfile = outfile & ".mid"
end if


bam2mid(infile, outfile)

#endif