// DiExIO.bcpl
// Last modified April 23, 1982  12:25 AM by Boggs

//get "Streams.d"
get "DiEx.defs"

external Timer
static  [ @LastButtons=0; @ChangedButtons=0 ]
static  [ @UpperCaseOnly=true;@LastVal=0;@NeedConfirm=0 ]//local statics
static  [ @LastX = -1; @LastY = -1; @HintDly=200; @EnableHint ]  //local statics
static oldPacketCnt=0

manifest Buttons = #177030

structure String [ length byte; char↑1,1 byte ]


let Msg(string,p1,p2,p3,p4,p5,p6; numargs nargs) be 
	[
	if MsgS then PutTemplate(MsgS,string,p1,p2,p3,p4,p5,p6)
	]

and Wss(stream, string) be
   for i = 1 to string>>String.length do
      Puts(stream, string>>String.char↑i)

and Hint(string,p1,p2) be 
	[
	external ResetLine
	if not string then [ ResetLine(HintS); PutTemplate(HintS,"Message: "); return ]
	if string then PutTemplate(HintS,string,p1,p2)
	]

//and puts(chr) be 
//	[
//	if MsgS then Puts(MsgS,chr)
//	if disko then Puts(disko,chr)
//	]

and GetChar() =valof
	[
	let char1 = 0
		[
		if not Endofs(keys) then char1 =  Gets(keys)
		if char1 then break
		char1 = Button(Left%Middle%Right,Up)
		] repeat
	if UpperCaseOnly & char1 ge $a & char1 le $z then char1 = char1 & 137b
	resultis char1
	]

and CheckInput() = valof
	[
	if Button(Left%Middle%Right,Depressed,0) then resultis true
	if not Endofs(keys) then resultis true
	resultis false
	]

and NewBoolian(HintStr,confirm; numargs nargs) = valof
	[
	unless Active then resultis 0
	SendHint(HintStr)	//if Returns eq HintDly then Hint(str)
	if nargs ls 2 then confirm = false
	if not Returns then NeedConfirm = true
	if not confirm then NeedConfirm = false
	test Button(Left,Up) ifnot resultis 0
		ifso test NeedConfirm ifso [ NeedConfirm = false; Hint(" (Confirm)"); resultis 0 ]
			ifnot [ Active = false; resultis true ]
	resultis 0
	]

and NewNumber(HintStr,Val, str, rdx, maxChar; numargs nargs) = valof
	[ 
	unless Active then resultis Val
	SendHint(HintStr)	//if Returns eq HintDly then Hint(HintStr)
	if nargs ls 4 then rdx = 10; if nargs ls 5 then maxChar = 4
	let new = nil
	if Endofs(keys) then if not Button(Left%Middle%Right,Up,0) then resultis Val
	Active = 1
	PrintParam(str,true); new = GetNum(rdx, maxChar)
	if (char ne DEL) then resultis new
	resultis Val
	]

and SendHint(str) be
	[
	if Returns eq 0 then EnableHint = true
	if not EnableHint return
	if (Returns rem HintDly) eq 0 then
		[
		if @mouseX eq LastX & @mouseY eq LastY then [ Hint(str); EnableHint = false ]
		LastX = @mouseX; LastY = @mouseY 
		]
	]

and GetNum(rdx, maxCount; numargs nargs) = valof
	[
	let num,negative,charCount = 0,0,0
	if nargs ls 1 then rdx = 8
	if nargs ls 2 then maxCount = 4
	char = GetChar()
	if (char eq ESC)%(char eq Left) then resultis LastVal
	if char eq Middle then resultis 0
	if char eq Right then resultis MaxVal
	if char eq $- then [ Display(char); negative = true; char = GetChar() ]
	if char eq $# then [ Display(char); rdx = 8; char = GetChar() ]
	if char eq $D then [ Display(char); rdx = 10; char = GetChar() ]
	//main loop
		[
		if (char ls $0) % (char gr $0+rdx-1) then break
		if charCount ls maxCount then
			[ num = num*rdx + char - $0; Display(char); charCount=charCount+1 ]
		char = GetChar()
		] repeat
	if negative then num = -num
	if (char ne DEL) then LastVal = num
	resultis num
	]

and SetBounds(Val,min,max; numargs nargs) = valof
	[
	if nargs ge 2 then if Val ls min then resultis min
	if nargs ge 3 then if Val gr max then resultis max
	resultis Val
	]


//and GetStr(str) =valof
//	[
//	//structure STRING[ length byte; body ↑ 1,255 byte ]
//	for count = 0 to 254 do
//		[
//		let xchar = Gets(keys)
//		if xchar eq $*n then
//			[
//			if count then str>>str.length = count
//			resultis count
//			] 
//		str>>str.char↑(count+1) = xchar
//		Puts(MsgS,xchar)
//		] 
//	]

and Wait(time,inittime; numargs nargs) = valof
	[
	let sink = vec 1
	if (nargs ls 2) % not inittime then inittime = Timer(sink)
	time = time + inittime
		[
		if Timer(sink) ge time then resultis Timer(sink)
		] repeat
	]

and Button(mask,function,update; numargs nargs) = valof
	[
	let CurrentButtons = not @Buttons
	let reslt = 0;
	if nargs ls 3 then update = true
	let last = LastButtons & mask
	let current = CurrentButtons & mask
	let changed = ChangedButtons & mask
	switchon function into
		[
		case Open:
			test current eq 0
				ifso reslt = mask
				ifnot if changed ne 0 then reslt = changed
			endcase
		case Depressed:
			test current ne 0
				ifso reslt = current
				ifnot if changed ne 0 then reslt = changed
			endcase
		case Up:
			if current eq 0 then
				[
				if last ne 0 then reslt=last
				if changed ne 0 then reslt=changed
				]
			endcase
		case Down:
			test current ne 0
				ifso if last eq 0 then reslt = current
				ifnot if changed ne 0 then reslt=changed
			endcase
		]
	if reslt then [ while not Endofs(keys) do Gets(keys); Wait(10) ]
	if update % not reslt then [ LastButtons = CurrentButtons; ChangedButtons = 0 ]
	resultis reslt
	]

and ButtonTrap() =valof  //this proceedure is called through the keyboard interrupts
	[ external etherStatVec
	let current = not @Buttons
	if current ne LastButtons then
		ChangedButtons = ChangedButtons % (current xor LastButtons)
	let packetCnt = etherStatVec!1
		[
		if oldPacketCnt eq packetCnt then break
		let bitmap = cursorBitMap+8
		bitmap!(oldPacketCnt&#7) = not bitmap!(oldPacketCnt&#7)
		oldPacketCnt = oldPacketCnt+1
		] repeat
	resultis true
	]

and SetCursor(pattern) be  //this proceedure is called through the keyboard interrupts
	[ external etherStatVec
	let Arrow = table
		[ #100000;#140000;#160000;#170000;#174000;#176000;#177000;#170000
		#154000;#114000;#6000;#6000;#3000;#3000;#1400;#1400
		]
	let W = table
		[ #401;#401;#603;#222;#272;#154;#104;0
		#1777;#776;#374;#1770;#7560;#36140;#170100;#140000
		]
	let R = table
		[ #160000;#110000;#110000;#160000;#120000;#110000;#104000;0
		#177700;#77600;#37400;#17700;#7360;#3074;#1017;#3
		]
	let ptr = selecton pattern into
		[
		case $W: W
		case $R: R
		default: Arrow
		]
	external [ DisableInterrupts; EnableInterrupts ]
	DisableInterrupts()
	MoveBlock(cursorBitMap,ptr,16)
	oldPacketCnt = 0
	etherStatVec!1 = 0
	EnableInterrupts()
	]

//and CreatDisplayArea(buff,nlines,width,background,indent,resolution; numargs nargs) = valof
//	[
//	if nargs ls 5 then indent = 0
//	if nargs ls 4 then background = 0
//	if nargs ls 3 then width = 0
//	if nargs ls 4 then nlines = 2
//	if nargs ls 5 then resolution = 0
//	external GetBlock		//This is used in loo of GetFixed (lost by Junta)
//	let stream = (GetBlock(lStreamCB+1) + 1) & #177776
//	//let stream = (GetFixed(lStreamCB+1) + 1) & #177776
//	Zero(stream,lStreamCB); Zero(buff,nlines*width)
//	stream>>StreamCB.fdcb = lv stream>>StreamCB.next
//	stream>>StreamCB.ldcb = lv stream>>StreamCB.next
//	stream>>StreamCB.width = width
//	stream>>StreamCB.indentation = indent
//	stream>>StreamCB.background = background
//	stream>>StreamCB.resolution = resolution
//	stream>>StreamCB.bitmap = buff
//	stream>>StreamCB.height = nlines/2
//	resultis stream
//	]