*! wmm version 1.0.0 04jul2016
* http://www.wmatsuoka.com

program define composer
	cap syntax varlist using/ [, play replace instrument(string) bpm(real 60)]
	if _rc {
		syntax anything using/ [, play replace instrument(string) bpm(real 60)]

		* Delete file if exists
		cap confirm file `"`using'"'
		if !_rc {
			if "`replace'" != "" erase `"`using'"'
			else {
				di as err `"file `using' already exists, specify replace"'
				exit 602
			}
		}

		composer_cmd `anything'

		/*mata: composer_cmd*/
		if "`instrument'" == "" local instrument = "Piano"
		mata:midi_write_single(composer_cmd, `"`using'"', "`instrument'", `bpm')
		if "`play'" != "" {
			shell `using'
		}
	}
	else {
		* Delete file if exists
		cap confirm file `"`using'"'
		if !_rc {
			if "`replace'" != "" erase `"`using'"'
			else {
				di as err `"file `using' already exists, specify replace"'
				exit 602
			}
		}

		if wordcount("`varlist'") < 3 {
			di as err "at least 3 variables must be specified"
			exit 198
		}
		if mod(wordcount("`varlist'"), 3) != 0 {
			di as err "variables must be in multiples of 3
			exit 198
		}

		local numtrack = int(wordcount("`varlist'")/3)
		composer_data `varlist', instrument(`instrument') numtrack(`numtrack') bpm(`bpm')
		mata: midi_write(composer_data_write, "`using'")
		if "`play'" != "" {
			shell `using'
		}
	}
end

program define composer_data
	syntax varlist , numtrack(integer) [instrument(string) bpm(real 60)]
	tokenize "`varlist'"

	mata: composer_data_write = J(1, `numtrack', "")

	local iC = 0
	while "`1'" != "" {
		local ins = word("`instrument'", `=`iC'+1')
		composer_data_make `1' `2' `3', instrument(`ins') voice(`iC') bpm(`bpm')
		mata: composer_data_write[`=`iC'+1'] = composer_data_output

		macro shift
		macro shift
		macro shift
		local ++iC
	}
end

program define composer_data_make
	syntax varlist [, instrument(string) voice(integer 0) bpm(real 60)]

	if "`instrument'" == "" local instrument = "Piano"
	tokenize "`varlist'"

	tempvar dura note octa voi
	gen `voi' = string(`voice')

	cap confirm string var `1'
	if _rc gen `dura' = string(`1')
	else gen `dura' = `1'

	cap confirm string var `2'
	if _rc gen `note' = string(`2')
	else gen `note' = `2'

	cap confirm string var `3'
	if _rc gen `octa' = string(`3')
	else gen `octa' = `3'

	mata: composer_data = st_sdata(., "`note' `octa' `dura' `voi'")
	mata: composer_data_output = midi_writetrack(composer_data, instr_dict("`instrument'"), `voice', `bpm')
end

program define composer_cmd
	version 14.0

	tokenize `"`1'"', parse(",")

	mata: composer_cmd = J(0, 3, "")

	while `"`1'"' != "" {

		if `"`1'"' == "," {
			macro shift
			continue
		}

		* Time
		local notes = strtrim(`"`1'"')
		if substr(`"`notes'"', 1, 1) == "*" {
			qui di regexm(`"`notes'"', "^\*([0-9\.]+)")
			local multi = regexs(1)
			local notes = subinstr(`"`notes'"', "*`multi'", "", 1)
			local ntime = round(384 * `multi')
		}
		else if uisdigit(substr(`"`notes'"', 1, 1)) {
			qui di regexm(`"`notes'"', "^[0-9]+")
			local ntime = regexs(0)
			local notes = subinstr(`"`notes'"', "`ntime'", "", 1)
		}
		else if uisletter(substr(`"`notes'"', 1, 1)) {
			local ntime = 384
		}
		else {
			di as err `"Invalid duration value in `1'"'
			exit 111
		}

		* Octave
		if  uisdigit(substr("`notes'", -1, 1)) {
			qui di regexm("`notes'", "[0-9]")
			local noct = regexs(0)
			local notes = subinstr(`"`notes'"', "`noct'", "", 1)
		}
		else local noct "5"

		* Note
		if regexm(`"`notes'"', "[A-Za-z ][#b]*") local note = regexs(0)
		else if `"`notes'"' == `""' local note = "r"
		else {
			di as err `"Invalid note value: `notes'"
			exit 111
		}

		mata: composer_cmd = composer_cmd \ ("`note'","`noct'","`ntime'")

		macro shift
	}
end

mata:
void midi_write(string matrix input, string scalar filename, |real scalar ts)
{
	num = cols(input)
	midi_header = tokens("4d 54 68 64 0 0 0 6 0 2 0 "+strofreal(num)+" 1 80")
	track = tokens(invtokens(input, " "))

	fh = fopen(filename, "w")
	fwrite(fh, char(frombase(16, midi_header)))
	fwrite(fh, char(frombase(16, track)))
	fclose(fh)
}
void midi_write_single(string matrix input, string scalar filename,
	string scalar instrument, real scalar ts, | string scalar trackname)
{
	midi_header = tokens("4d 54 68 64 0 0 0 6 0 0 0 1 1 80")

	ins = instr_dict(instrument)

	if (args()==4) {
		track = tokens(midi_writetrack(input, ins, 0, ts))
	}
	else {
		track = tokens(midi_writetrack(input, ins, 0, ts, trackname))
	}

	fh = fopen(filename, "w")
	fwrite(fh, char(frombase(16, midi_header)))
	fwrite(fh, char(frombase(16, track)))
	fclose(fh)
}
string scalar midi_writetrack(string matrix input, real scalar instrument,
	real scalar voice, real scalar ts, |string scalar trackname)
{
	if (args()==4) trackname = "wm-midi" + strofreal(voice)

	open = "0 ff 2 2 77 6d"
	tn = writetrackname(trackname)
	/* Some Sound Option */
	dyn = "0 b0 7 7f"

	/* FF 51 03 00 00 00 Tempo (microseconds per quarter note)*/
	bpm = bpmtomicroseconds(ts)
	temp = "0 ff 51 3 " + bpm

	/* Instrument */
	inst = "0" + " " + inbase(16, 192+voice) + " " + inbase(16, instrument-1)
	notes = writesong(input)
	end_track = "0 ff 2f 0"

	body = tokens(open), tokens(tn), tokens(dyn), tokens(temp),
		tokens(inst), tokens(invtokens(notes')), tokens(end_track)

	sum = cols(body)

	/*head = J(1, 4-cols(sevenbit(sum, 16)'), "0") , sevenbit(sum, 16)'*/
	head = "00000000" + inbase(16, sum)
	h1 = substr(head, -2, 2)
	h2 = substr(head, -4, 2)
	h3 = substr(head, -6, 2)
	h4 = substr(head, -8, 2)
	head = h4, h3, h2, h1
	head = inbase(16, frombase(16, head))

	head = tokens("4d 54 72 6b"), head

	return(invtokens((head, body)))
}
string scalar bpmtomicroseconds(real scalar ts)
{
	if (ts <= 0) {
		 errprintf("Beats Per Min must be greater than 0, used 60 instead\n")
		 ts = 60
	}
	if (ts >16777215) {
		errprintf("Beats Per Min must be less than 16777215, used 60 instead\n")
		ts = 60
	}
	bpm = inbase(16, round(60/ts * 1000000))
	bpm = (6-strlen(bpm))*"0" + bpm
	bpm = substr(bpm, -6, 2), substr(bpm, -4, 2), substr(bpm, -2, 2)
	bpm = ((2:-strlen(bpm)):*"0") :+ bpm
	bpm = invtokens(inbase(16, frombase(16, bpm)), " ")
	return(bpm)
}
string scalar writetrackname(string scalar trackname)
{
	/*"ff 3 7 6d 65 6f 6c 64 79 79 0 b0 7 7f 0"*/
	if (strlen(trackname) > 127) trackname = substr(trackname, 1, 127)
	output = "ff", "3", inbase(16, strlen(trackname)),
		inbase(16, ascii(trackname))
	return("0 " + invtokens(output)')
}
string matrix writesong(string matrix input)
{
	fin = J(rows(input), 1, "")
	col = cols(input)

	/* Handle Rest Offsets */
	rest = 0
	for (i=1; i<=rows(input); i++) {
		a = input[i, 1]; b = strtoreal(input[i, 2]); c = strtoreal(input[i, 3])

		if (a=="r" | a=="" | a==" ") {
			rest = rest + c
			continue
		}

		if (col==3) fin[i] = makenote(a, b, c, rest)
		if (col==4) {
			d = input[i, 4]
			fin[i] = makenote(a, b, c, rest, strtoreal(d))
		}
		rest = 0
	}
	return(fin)
}
string scalar makenote(string scalar note, real scalar octave, real scalar t,
	real scalar offset, |real scalar voice)
{
	if (args()==4) voice = 0

	v1 = inbase(16, 144 + voice)
	v2 = inbase(16, 128 + voice)
	/* 0 90 36 7f 83 0 80 36 0 */
	/* 384 is optimal for quarter note */

	to = inbase(16, strtoreal(sevenbit(offset)'))
	nv = noteval(note, octave)
	tt = inbase(16, strtoreal(sevenbit((t))'))
	final = to, v1, nv, "7f", tt, v2, nv, "0"

	return(invtokens(final))
}
string scalar noteval(string scalar note, real scalar octave)
{
	real scalar final
	note = strproper(note)

	if (octave < 0 | octave > 10) errprintf("octave out of bounds (0-10)\n")

	if (note=="C")       final = 0
	else if (note=="C#") final = 1
	else if (note=="Db") final = 1
	else if (note=="D")  final = 2
	else if (note=="D#") final = 3
	else if (note=="Eb") final = 3
	else if (note=="E")  final = 4
	else if (note=="F")  final = 5
	else if (note=="F#") final = 6
	else if (note=="Gb") final = 6
	else if (note=="G")  final = 7
	else if (note=="G#") final = 8
	else if (note=="Ab") final = 8
	else if (note=="A")  final = 9
	else if (note=="A#") final = 10
	else if (note=="Bb") final = 10
	else if (note=="B")  final = 11
	else errprintf(note + " is not a valid note\n")

	if ((final=final + octave * 12) > 127) errprintf("Note out of bounds\n")

	return(inbase(16, final))
}
string matrix sevenbit(real scalar input, | real scalar base)
{
	if (args()==1) base = 10

	bitstr = inbase(2, input)
	group  = trunc((strlen(bitstr)/7-.1)) + 1
	bitstr = ((group * 7)-strlen(bitstr)) * "0" + bitstr

	grid = J(group, 1, "")
	for(i=1; i<=group; i++) {
		j = (i==group ? "0" : "1")
		grid[i] = j + substr(bitstr, (i-1)*7 + 1, 7)
	}

	return (inbase(base, frombase(2, grid)))
}

/* Dictionaries */
real scalar is_number(string scalar ins)
{
	inscheck = (ascii(ins) :>= 48) :& (ascii(ins) :<= 57)
	inscheck = inscheck :| (ascii(ins):==32)
	return(allof(inscheck, 1))
}
real scalar instr_dict(string scalar strIns)
{
	if (strIns=="Piano") return(1)
	else if (strIns=="Harpsichord") return(7)
	else if (strIns=="Glockenspiel") return(10)
	else if (strIns=="Marimba") return(13)
	else if (strIns=="Xylophone") return(14)
	else if (strIns=="Bells") return(15)
	else if (strIns=="Organ") return(17)
	else if (strIns=="Harmonica") return(23)
	else if (strIns=="Accordion") return(24)
	else if (strIns=="Guitar") return(25)
	else if (strIns=="ElectricGuitar") return(27)
	else if (strIns=="AcousticBass") return(33)
	else if (strIns=="ElectricBass") return(34)
	else if (strIns=="SynthBass") return(39)
	else if (strIns=="Violin") return(41)
	else if (strIns=="Viola") return(42)
	else if (strIns=="Cello") return(43)
	else if (strIns=="Contrabass") return(44)
	else if (strIns=="Strings") return(45)
	else if (strIns=="Pizzicato") return(46)
	else if (strIns=="Harp") return(47)
	else if (strIns=="Timpani") return(48)
	else if (strIns=="ChoirA") return(53)
	else if (strIns=="ChoirO") return(54)
	else if (strIns=="Voice") return(55)
	else if (strIns=="Trumpet") return(57)
	else if (strIns=="Trombone") return(58)
	else if (strIns=="Tuba") return(59)
	else if (strIns=="FrenchHorn") return(61)
	else if (strIns=="Brass") return(62)
	else if (strIns=="Sax") return(65)
	else if (strIns=="Oboe") return(69)
	else if (strIns=="Bassoon") return(71)
	else if (strIns=="Clarinet") return(72)
	else if (strIns=="Flute") return(74)
	else {
		if (is_number(strIns)) return(strtoreal(strIns))
		printf("Instrument " + strIns + " not found, used Piano as default\n")
		return(1)
	}
}
end