// 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 // ]