Play N STop23

-- Reusable code is mostly inside this do-block
do-- Reusable code is mostly inside this do-block
do
	local baseWords, javaWords, immedWords = {}, {}, {}

	speaker = {}

	baseWords.WORDS = 1
	baseWords.PAGE = 2
	baseWords["."] = 3
	baseWords["(lit)"] = 4
	baseWords["(lit2)"] = 5
	baseWords.RETURN = 6
	baseWords.CR = 7
	baseWords.DUP = 8
	baseWords["?DUP"] = 9
	baseWords["2DUP"] = 10
	baseWords.DROP = 11
	baseWords["2DROP"] = 12
	baseWords.SWAP = 13
	baseWords["2SWAP"] = 14
	baseWords.OVER = 16
	baseWords["2OVER"] = 17
	baseWords.ROT = 18
	baseWords["-ROT"] = 19
	baseWords.NIP = 20
	baseWords.TUCK = 21
	baseWords.DO = 22
	baseWords.LOOP = 24
	baseWords["+LOOP"] = 25
	function immedWords.BEGIN(t)
		t.push(t.here())
	end
	function immedWords.UNTIL(t)
		t.compileWord("(!?branch)")
		table.insert(t.code, t.pop())
	end
	function immedWords.WHILE(t)
		local BEGIN = t.pop()
		t.compileWord("(!?branch)")
		local WHILE = t.here()
		table.insert(t.code, 0)
		t.push(WHILE)
		t.push(BEGIN)
	end
	function immedWords.REPEAT(t)
		t.compileWord("(branch)")
		table.insert(t.code, t.pop())
		t.code[t.pop()] = t.here()
	end
	function immedWords.AGAIN(t)
		t.compileWord("(branch)")
		table.insert(t.code, t.pop())
	end
	baseWords.UNLOOP = 32
	function immedWords.IF(t)
		t.compileWord("(!?branch)")
		t.push(t.here())
		table.insert(t.code, 0)
	end
	function immedWords.THEN(t)
		t.code[t.pop()] = t.here()
	end
	function immedWords.ELSE(t)
		local IF = t.pop()
		t.compileWord("(branch)")
		t.push(t.here())
		table.insert(t.code, 0)
		t.code[IF] = t.here()
	end
	baseWords["0="] = 36
	baseWords["0<>"] = 37
	baseWords["0<"] = 38
	baseWords["0>"] = 39
	baseWords["<>"] = 40
	baseWords[">"] = 41
	baseWords["<"] = 42
	baseWords[">="] = 43
	baseWords["<="] = 44
	baseWords["="] = 45
	baseWords["+"] = 46
	baseWords["-"] = 47
	baseWords["/"] = 48
	baseWords["MOD"] = 49
	baseWords["1+"] = 50
	baseWords["1-"] = 51
	baseWords.NEGATE = 52
	baseWords.MAX = 53
	baseWords.MIN = 54
	baseWords.AND = 55
	baseWords.OR = 56
	baseWords.XOR = 57
	baseWords.INVERT = 58
	baseWords.TRUE = 59
	baseWords.FALSE = 60
	baseWords["2*"] = 61
	baseWords["2/"] = 62
	baseWords.I = 63
	baseWords.J = 64
	baseWords["*"] = 67
	baseWords["(branch)"] = 68
	baseWords["(?branch)"] = 69
	baseWords["(!?branch)"] = 70
	function immedWords.VARIABLE(t)
		t.forthWords[t.nextWord()] = t.here()
		t.compileWord("(lit)")
		table.insert(t.code, t.here() + 2)
		t.compileWord("RETURN")
	end
	baseWords["@"] = 72
	baseWords["!"] = 73
	baseWords.TICK = 74

	javaWords.PLAY = 1
	javaWords.STOP = 2

	function speaker.compileForth(sourcecode)
		local code = {}
		local forthWords = {}
		local input = {}

		local definingWord = nil

		local compileStack = {}

		local immedContext = {
			code = code,
			here = function()
				return #code
			end,
			push = function(v)
				-- if #compileStack > 128 then error("Compile stack overflow", 0) end
				table.insert(compileStack, v)
			end,
			pop = function()
				return table.remove(compileStack, #compileStack) or error("Compile stack empty", 0)
			end,
			forthWords = forthWords,
		}

		local function compileWord(word)
			if baseWords[word] then
				table.insert(code, 0xC000 + baseWords[word])
			elseif javaWords[word] then
				table.insert(code, 0x8000 + javaWords[word])
			elseif forthWords[word] then
				table.insert(code, forthWords[word])
			elseif immedWords[word] then
				immedWords[word](immedContext)
			elseif tonumber(word) then
				local n = math.floor(tonumber(word))
				if n < -2^31 or n >= 2^31 then
					error("number out of range: "..n)
				end
				if n >= -32768 and n < 32768 then
					if n < 0 then n = n + 65536 end

					compileWord("(lit)")
					table.insert(code, n)
				else
					if n < 0 then n = n + 2^32 end

					compileWord("(lit2)")
					table.insert(code, n % 65536)
					table.insert(code, math.floor(n / 65536))
				end
			else
				error("unknown word: "..word)
			end
		end

		immedContext.compileWord = compileWord

		for word in string.gmatch(sourcecode, "[^ ]+") do
			table.insert(input, word)
		end

		compileWord("(branch)")
		table.insert(code, 0)

		local pos = 1

		function immedContext.nextWord()
			pos = pos + 1
			return input[pos - 1] or "EOF"
		end
		while pos <= #input do
			if input[pos] == ":" then
				if definingWord then
					error(": inside word definition")
				end

				local name = input[pos + 1] or "EOF"
				definingWord = {name, #code}
				pos = pos + 2
			elseif input[pos] == ";" then
				if definingWord == nil then
					error("; outside of word definition")
				end
				compileWord("RETURN")

				forthWords[definingWord[1]] = definingWord[2]

				definingWord = nil
				pos = pos + 1
			elseif input[pos] == "RECURSE" then
				if not definingWord then
					error("RECURSE outside of word definition")
				end
				table.insert(code, definingWord[2])
				pos = pos + 1
			else
				compileWord(input[pos])
				pos = pos + 1
			end
		end

		if definingWord then
			error("unfinished word definition")
		end

		if forthWords.MAIN then
			code[2] = forthWords.MAIN
		else
			error("No MAIN word")
		end


		return code
	end

	function speaker.uploadForth(code, side, hot)
		assert(peripheral.getType(side) == "speaker", "No speaker on "..side.." side")
		if not hot then peripheral.call(side, "shutdown") end
		local pos = 1
		local addr = 0
		while pos <= #code do
			local _end = math.min(#code, pos + 100)
			repeat
				local err = peripheral.call(side, "write", addr, unpack(code, pos, _end))
				if err == "Buffer full" then
					sleep(0.05)
				elseif err then
					error(err, 0)
				end
			until err == nil
			addr = addr + _end + 1 - pos
			pos = _end + 1
		end
		if not hot then peripheral.call(side, "reboot")
		else peripheral.call(side, "execute", 0)
		end
	end

	function speaker.streamTuneUsingForth(tune, side)
		local ticks = 0
		local size = 0 -- approximate shorts used

		local fcode

		peripheral.call(side, "shutdown")

		local function play()
			local cf = speaker.compileForth(fcode .. " ;")
			speaker.uploadForth(cf, side, true)
			sleep(math.max(1, ticks) * 0.05)
		end
		local function start()
			fcode = ": TICKS 0 DO TICK LOOP ; : MAIN ";
			size = 0
			ticks = 0
		end

		start()
		for _,v in ipairs(tune) do
			if v[1] == "p" then
				fcode = fcode .. v[3] .. " " .. v[2] .. " PLAY "
				size = size + 5
			elseif v[1] == "s" then
				fcode = fcode .. v[2] .. " STOP "
				size = size + 3
			elseif v[1] == "w" then
				fcode = fcode .. v[2] .. " TICKS "
				size = size + 3
				ticks = ticks + v[2]
			end

			if size > 10000 then
				play()
				start()
			end
		end

		if size > 0 then
			play()
		end

		peripheral.call(side, "shutdown")
	end

	function speaker.streamTuneDirectly(tune, side)
		peripheral.call(side, "shutdown")
		for _,v in ipairs(tune) do
			if v[1] == "p" then
				peripheral.call(side, "start", v[2], v[3])
			elseif v[1] == "s" then
				peripheral.call(side, "stop", v[2])
			elseif v[1] == "w" then
				sleep(v[2] * 0.05)
			end
		end
		peripheral.call(side, "shutdown")
	end
end

local function words(s)
	local pos = 1
	local function f()
		if pos == 0 then return nil end

		local start, next = pos, s:find(" ", pos)
		if not next then
			pos = 0
			if start > #s then
				return nil
			end
			return s:sub(start)
		end

		pos = next + 1
		if start == next then
			return f()
		end
		return s:sub(start, next-1)
	end
	return f
end

local function compileTune(src)
	local stack = {}
	local rv = {}
	local function pop() return table.remove(stack, #stack) end
	for word in words(src) do
		if tonumber(word) then
			stack[#stack+1] = tonumber(word)
		elseif word == "TICKS" then
			rv[#rv+1] = {"w", pop()} -- w, ticks
		elseif word == "PLAY" then
			rv[#rv+1] = {"p", pop()} -- p, ch, freq
			rv[#rv][3] = pop()
		elseif word == "STOP" then
			rv[#rv+1] = {"s", pop()}
		else
			error("unknown word: "..word,0)
		end
	end
	return rv
end

term.clear()
for k=1,#names do
	term.setCursorPos(1, k)
	term.write("   " .. names[k])
end

local speakerSide
function findSide()
	for _,side in ipairs(redstone.getSides()) do
		if peripheral.getType(side) == "speaker" then
			speakerSide = side
			break
		end
	end

	if not speakerSide then
		error("No attached speakers!")
	end
end

local ok, err = pcall(function()
	findSide() -- error early if no speakers attached

	local sel = 1
	term.setCursorPos(2, sel)
	term.write("*")
	while true do
		local _, key = os.pullEvent("key")
		if key == 208 then
			-- down
			if sel < #names then
				term.setCursorPos(2, sel)
				term.write(" ")
				sel = sel + 1
				term.setCursorPos(2, sel)
				term.write("*")
			end
		elseif key == 200 then
			-- up
			if sel > 1 then
				term.setCursorPos(2, sel)
				term.write(" ")
				sel = sel - 1
				term.setCursorPos(2, sel)
				term.write("*")
			end
		elseif key == 28 then
			-- enter
			break
		end
	end

	local w, h = term.getSize()

	local function centre(y, str)
		term.setCursorPos(math.ceil((w - #str) / 2), y)
		term.clearLine(y)
		term.write(str)
	end
	local y = math.floor(h/2-1.5)
	term.clear()
	centre(y, names[sel])
	local useDirect = false
	centre(y+2, "[Forth streaming]")
	centre(y+3, "Direct streaming")
	while true do
		local _, key = os.pullEvent("key")
		if key == 200 then
			-- up
			useDirect = false
			centre(y+2, "[Forth streaming]")
			centre(y+3, "Direct streaming")
		elseif key == 208 then
			-- down
			useDirect = true
			centre(y+2, "Forth streaming")
			centre(y+3, "[Direct streaming]")
		elseif key == 28 then
			-- enter
			break
		end
	end

	term.clearLine(y+2)
	term.clearLine(y+3)
	centre(y+2, useDirect and "Direct streaming" or "Forth streaming")

	findSide()

	local tune = compileTune(tunesrc[sel])
	peripheral.call(speakerSide, "setAttenuation", 20)

	local func = useDirect and speaker.streamTuneDirectly or speaker.streamTuneUsingForth
	func(tune, speakerSide)
end)

term.clear()
term.setCursorPos(1, 1)

pcall(peripheral.call, speakerSide, "shutdown")

if not ok then error(err, 0) end

--[[peripheral.call("right", "debugOff")
forth.sendToSpeaker(forth.compile(": MAIN 2 1 . . ;"), "right")
sleep(0.5)
peripheral.call("right", "debugOn")
forth.sendToSpeaker(forth.compile(": MAIN 4 3 . . ;"), "right")
sleep(0.5)]]