// Menu.bcpl

get "Streams.d"

external // Outgoing procedures
	[ InitParam; DisplayParam; PrintParam; Display; FindActiveParam ]

external // incoming procedures
	[ 
	Hint; CheckInput; GetChar
	GetFixed; Zero; PutTemplate; CreateDisplayStream; ShowDisplayStream
	SetLinePos; SetBitPos; GetBitPos; GetScanLinePos; Ws; Puts; EraseBits; SetRmarg
	]

external // incoming statics
	[ @Mtable; @PointerTable ]

external // Outgoing statics
	[ @Returns; @Active ]

static [ Returns=0; Active=0 ]
static [ @Current; @selected = 0 ]  //local statics

structure str[ length byte; char ↑ 1,255 byte ]
manifest [ mouseY = #425; mouseX = #424 ]  

structure MF:
	[
	MinY word
	MaxY word
	MinX word
	MaxX word
	Line byte; Inverted byte
	Routine word
	]

external lMF
static lMF = size MF/16

let DisplayParam(proceedure,line,xposn; numargs nargs) = valof
	[
	let S = Mtable!-1
	let save = Current
	Current = Mtable
	let EndOfTable = Mtable + lMF*6*Mtable!-2
		[
		if Current>>MF.Routine eq proceedure then break
		if Current>>MF.Routine eq 0 then break
		Current = Current+lMF
		if Current ge EndOfTable then resultis 0
		] repeat
	if not Current>>MF.MinY then		//ie this is a new entry
		[ Current>>MF.Line = line
		Current>>MF.MinY = GetScanLinePos(S,line)
		Current>>MF.MaxY = GetScanLinePos(S,line+1)-1
		Current>>MF.MinX = xposn; Current>>MF.MaxX = xposn
		Current>>MF.Routine = proceedure
		]
	if not SetLinePos(S,Current>>MF.Line) do [ Ws("*nline posn err. line"); resultis 0 ]
	if not SetBitPos(S,Current>>MF.MaxX) do
		[ if not SetBitPos(S,37*16) do [ Ws("*nbit posn err."); resultis 0 ]
		PutTemplate(S,"    ")
		]
	//Current>>MF.Inverted = false
	proceedure(1)
	if save then [ SetLinePos(S,save>>MF.Line); SetBitPos(S,save>>MF.MaxX) ]
	let MaxX = Current>>MF.MaxX
	Current = save
	resultis MaxX
	]

and GetScanLinePos(stream,line) = valof
	[
	let DCB = stream>>DS.fdcb
	let fontheight = 2*(DCB>>DCB.height)
	let initY = 0
	DCB = @#420
	until DCB eq stream>>DS.fdcb do [ initY=initY+DCB>>DCB.height; DCB=DCB>>DCB.next ] 
	resultis initY*2 + fontheight*line
	]

and PrintParam(str,p1,p2,p3,p4) be
	[
	if Active eq true then return
	let S = Mtable!-1
	let Inverted = Current>>MF.Inverted
	//SetLinePos(S,Current>>MF.Line)
	//SetBitPos(S,Current>>MF.MaxX)
	EraseBits(S,Current>>MF.MinX-GetBitPos(S),0); Current>>MF.Inverted = 0
	if str>>str.char↑1 ne #40 then Puts(S,#40)
	PutTemplate(S,str,p1,p2,p3,p4)
	if str>>str.char↑(str>>str.length) ne #40 then Puts(S,#40)
	Current>>MF.MaxX = GetBitPos(S) 
	if (Current>>MF.MaxX-Current>>MF.MinX) ls 16 then
		Current>>MF.MaxX = Current>>MF.MinX + 16
	MarkParam(Inverted ne 0) 
	]

and Display(char) be [ Puts(Mtable!-1,char); Current>>MF.MaxX = GetBitPos(Mtable!-1) ]

and FindActiveParam() be
	[
	let X = @mouseX; let Y = @mouseY
	if Current then  //see if it is still valid
		[
		if Y gr Current>>MF.MinY & Y ls Current>>MF.MaxY & X gr Current>>MF.MinX & X ls Current>>MF.MaxX then
			[ Active = true; Returns = Returns+1; Current>>MF.Routine(); return ]
		]
	//if not Button(Left,Depressed) then return
	MarkParam(false)  //un-invert the old parameter 
	Current = 0; Active = false
	let ptr = Mtable
	let i = 0
		[
		i=i+1
		if (not ptr>>MF.MinY) % (i eq 6*Mtable!-2) then
			[ if CheckInput() then GetChar(); return ]  //flush out any input & return 
		if Y gr ptr>>MF.MinY & Y ls ptr>>MF.MaxY & X gr ptr>>MF.MinX & X ls ptr>>MF.MaxX then break
		ptr = ptr+lMF
		] repeat
	Current = ptr; Active = true
	MarkParam(true) 
	Returns = 0
	Current>>MF.Routine(false,Returns)
	]

and MarkParam(mode) be
	[
	if not Current then return
	unless mode eq true xor Current>>MF.Inverted then return
	if mode eq false then Hint(0)
	let S = Mtable!-1
	SetLinePos(S,Current>>MF.Line)
	SetBitPos(S,Current>>MF.MinX)
	EraseBits(S,Current>>MF.MaxX-Current>>MF.MinX,-1)
	Current>>MF.Inverted = mode
	]


//The following proceedure is used only once during initialization
//so it can be copied to an "init" file and discarded here
//and InitParam(lines,AboveStream,Font) = valof
//	[
//	let DCB = @#420
//	let fontheight = 2*(DCB>>DCB.height)//get height of sysfont
//	if Font then fontheight = Font!-2
//	external CreatDisplayArea
//	let stream,Mbuff = nil,nil
//	if AboveStream then
//		[
//		Mbuff = GetFixed(lMF*lines*6+2)+2;Zero(Mbuff,lMF*lines*6)
//		let DispBuffLength = (38*FontHeight + 6)*lines
//		let DispBuff = GetFixed(DispBuffLength)
//		stream = CreateDisplayStream(lines, DispBuff, DispBuffLength, Font, 0, DSstopright+DSstopbottom)
//		ShowDisplayStream(stream,DSbelow,AboveStream)
//		let Dstream = CreatDisplayArea(0,2,0,1)
//		ShowDisplayStream(Dstream,DSabove,stream)
//		Mbuff!-1 = stream
//		Mbuff!-2 = lines
//		]
//	stream = Mbuff!-1
//	for i=1 to lines do		//Send enough char's to fill each line in the stream 
//		[ for c=0 to 120 do Puts(stream,#40)
//		if i ne lines do Puts(stream,$*n)
//		]
//	SetLinePos(stream,0)
//	Current = 0
//	resultis Mbuff
//	]