// 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) = not bitmap!(oldPacketCnt)
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
// ]