// KbdIOSubrs.bcpl
// Last change October 1, 1981 12:03 PM by Bill van Melle
// Last change May 14, 1981 12:51 AM by Beau Sheil
// Patched Tone change April 2, 1981 1:26 AM by Beau Sheil
// Last change February 6, 1981 2:01 PM by Beau Sheil
// Last change December 11, 1980 10:21 PM by Beau Sheil
// Chord change November 19, 1980 8:48 PM by Beau Sheil
get "AltoDefs.d"
get "LispBcpl.decl"
get "KbdDefs.d"
get "Streams.d"
get "SysDefs.d"
external [ // SUBRS defined
CREATEMOUSEEVENT; ENABLEMOUSE; GETKEYS; BKSYSCHAR0; PEEKKEYS
SetCursorPos
// other procedures defined
KBDinit; NWWInterrupt
// statics defined
keys; @LispKbd
// procedures used
FindInterruptMask; InitializeInterrupt; CallSwat; Block
AllocVec; @AtomNotNIL; Max; Min; SetBlock; Zero
Gets; Puts; Endofs; Resets; Timer; SmallUnbox; EqNIL; RAIDCode
FlashScreen; MoveBlock; MkSmallPos; LockPages
@XSetBR; @RRead; @RWrite; @APutBase32; @BGetBase; @BPutBase; IGetBase; IPutBase
// statics used
OsBuffer; @lvNIL; @RMSK; ScreenWidth; @InterruptEnable; @InterruptChar
]
static [
@KBDFlg = false; @NewUS; @OldUS; keys; @LispKbd
LockShift; @DownStrokes; @UpStrokes; ASCIImap
@MEQLo; @MEQHi; @mouseEventCode; @mouseEnabled = false
@InterruptEnable; @InterruptChar
ScreenWidth= 1000 // to use for clipping until Init LispRegs
]
manifest [
LispKBLength = 128
KBStackSize = 256 // stack depth for interrupts
]
structure [ // function keys
blank word 2
blank bit 4; CtrlBit bit; blank bit 4; LShiftBit bit; blank bit 6
blank byte; LockShiftBit bit; blank bit 3; RShiftBit bit; SwatBit bit; blank bit 2
]
// Normally init code like KBDinit would be in a separate file so its code
// space could be reclaimed, but most of it is constants that have to be
// around at run time anyway, so we dont bother.
let KBDinit() be
[
DownStrokes = table [ #177777; #177777; #173676; #177564; #377 ]
UpStrokes = table [ #000000; #000000; #000000; #000000; #377 ]
LockShift = table [ #013520; #036740; #013600; #175400; #000 ]
ASCIImap = table [
// Unshifted characters, word 0
bs*S+lf; $\*S+$/; $p*S+$-; $k*S+$0;
$v*S+$u; $d*S+$7; $e*S+$6; $4*S+$5;
// word 1
spr1*S+spr2; $]*S+$'; $,*S+$l; $o*S+$x;
$i*S+$9; $a*S+$s; $q*S+$w; $2*S+$3;
// word 2
xxx*S+del; $←*S+rtn; $;*S+$.; lshft*S+$z;
$b*S+$j; $c*S+ctrl; $f*S+tab; esc*S+$1;
// word 3
xxx*S+xxx; spr3*S+rshft; $=*S+$[; space*S+lock;
$m*S+$n; $8*S+$h; $y*S+$g; $t*S+$r
// Buttons
mb2*S+mb3; mb1*S+hs5; hs4*S+hs3; hs2*S+hs1;
// Shifted characters, word 0
BS*S+LF; $|*S+$?; $P*S+$-; $K*S+$);
$V*S+$U; $D*S+$&; $E*S+$~; $$*S+$%;
// word 1
SPR1*S+SPR2; $}*S+$"; $<*S+$L; $O*S+$X;
$I*S+$(; $A*S+$S; $Q*S+$W; $@*S+$#;
// word 2
xxx*S+DEL; $↑*S+RTN; $:*S+$>; LSHFT*S+$Z;
$B*S+$J; $C*S+CTRL; $F*S+TAB; ESC*S+$!;
// word 3
xxx*S+xxx; SPR3*S+RSHFT; $+*S+${; SPACE*S+LOCK;
$M*S+$N; $***S+$H; $Y*S+$G; $T*S+$R
// buttons
MB2*S+MB3; MB1*S+HS5; HS4*S+HS3; HS2*S+HS1;
]
OldUS = AllocVec(USsize) // Fill in from Keys = #177034
MoveBlock(OldUS, Keys, USsize-1); OldUS!(USsize-1)=@buttons
NewUS = AllocVec(USsize)
// system keyboard buffer
keys = AllocVec(lST); SetBlock(keys, CallSwat, lST)
keys>>ST.par1 = OsBuffer
keys>>ST.gets = kbdGets
keys>>ST.puts = kbdPuts
keys>>ST.endof = kbdEmpty
keys>>ST.reset = kbdReset
// Lisp gets its own keyboard stream
LispKbd = AllocVec(lST)
MoveBlock(LispKbd, keys, lST) // just like keys
let lbuf = AllocVec(size OsBUF/16) // but with its own buffer
lbuf>>OsBUF.First = AllocVec(LispKBLength)
lbuf>>OsBUF.Last = lbuf>>OsBUF.First + LispKBLength - 1
LispKbd>>ST.par1 = lbuf
Resets(LispKbd)
let WakeBit = FindInterruptMask(1 lshift (KeyboardLevel-1))
InitializeInterrupt(AllocVec(KBStackSize),KBStackSize,WakeBit,KBDHandler)
@displayInterrupt = @displayInterrupt % WakeBit // arm the interrupt
]
and KBDHandler() be
[
MoveBlock(NewUS, Keys, USsize-1)
NewUS!(USsize-1)=@buttons
@mouseX = Max(0, Min(@mouseX, ScreenWidth)) // Clip and track mouse
@cursorX = @mouseX
@mouseY = Max(0, Min(@mouseY, cursorYmax))
@cursorY = @mouseY
for i = 0 to USsize-2 do
[ let old = OldUS ! i
let new = NewUS ! i
let x = old & not new & DownStrokes!i
if x ne 0 then KeyAction(x, i, DownStroke)
// next two lines not needed as Upstroke[1-4]=0
// x = not old & new & UpStrokes!i
// if x ne 0 then KeyAction(x, i, UpStroke)
]
if mouseEnabled then
[ let i = USsize-1
let old = OldUS ! i
let new = NewUS ! i
let x = old & not new & DownStrokes!i
if x do DoMouseEvent(x)
if not old & new & UpStrokes!i do DoMouseEvent((not new) & RMSK)
]
KBDFlg=OldUS; OldUS=NewUS; NewUS=KBDFlg
// KBDFlg is used by NWWInterrupt to decide when a 60hz interrupt has
// taken place. If so, NWWInterrupt will Block() and zero KBDFlg
]
and KeyAction (b, w, action) be
[
let shm = (NewUS>>LShiftBit eq 0? -1, NewUS>>RShiftBit eq 0? -1,
NewUS>>LockShiftBit eq 0? LockShift!w, 0)
let m, x = 1, w lshift 4
[
if (b&m) ne 0 then
[
// "+ action" below only affects buttons
let c = ASCIImap>>InputDatumMap.code↑((shm&m) eq 0? x, x+NoOfKeys) + action
if (NewUS>>CtrlBit eq 0) & (c ge #100) then c = c & #237
unless Puts(keys, c) do FlashScreen()
]
m, x = m lshift 1, x+1
] repeatwhile m ne 0
]
and kbdGets(st) = valof // get with wait for input; for Raid
[
let R=st>>ST.par1
while R>>OsBUF.Out eq R>>OsBUF.In do loop // loop while st empty
let x = @(R>>OsBUF.Out)
let t = R>>OsBUF.Out + 1
if t eq R>>OsBUF.Last then t = R>>OsBUF.First
R>>OsBUF.Out = t
resultis x
]
and kbdReset(st) be
[ let buf = st>>ST.par1
let x = buf>>OsBUF.First
buf>>OsBUF.In = x
buf>>OsBUF.Out = x
]
and kbdEmpty(st) = valof [ let R=st>>ST.par1
resultis R>>OsBUF.Out eq R>>OsBUF.In ]
and kbdPuts(st, x) = valof
[
let buf = st>>ST.par1
let t = buf>>OsBUF.In + 1
if t eq buf>>OsBUF.Last then t = buf>>OsBUF.First
if t eq buf>>OsBUF.Out then resultis false //Overflow
@(buf>>OsBUF.In) = x
buf>>OsBUF.In = t
resultis true
]
and BKSYSCHAR0(lvCh) = Puts(keys, SmallUnbox(lvCh) & RMSK) ? lvCh, lvNIL
and GETKEYS() = valof
[ NWWInterrupt() // run interrupt to check arriving characters
resultis Endofs(LispKbd) ? lvNIL, MkSmallPos(Gets(LispKbd)) ]
and PEEKKEYS() =
Endofs(LispKbd) ? lvNIL, MkSmallPos(@((LispKbd>>ST.par1)>>OsBUF.Out))
and NWWInterrupt() = valof // Run whenever an interrupt occurs (>60hz).
[
// moves chars from keys => LispKbd, filtering out interrupt chars
unless Endofs(keys) do // keys => LispKbd, handling interrupt chars
[
let c = Gets(keys)
test (BGetBase(STATSspace, InterruptTBLbase+(c rshift 4)) & 1 lshift (c)) ne 0 %
c eq 3 // make sure we take ↑C anyway
ifso APutBase32(InterruptChar, MkSmallPos(c))
ifnot unless Puts(LispKbd, c) do FlashScreen()
]
// check interrupt char (not necessarily from immediately prior code!)
let c = AtomNotNIL(InterruptChar) // AtomNotNIL returns second word
if c & (AtomNotNIL(InterruptEnable) % c eq 3) then
[ APutBase32(InterruptEnable, lvNIL)
let newCFXP = IGetBase(IFPCurrentFXP+IFPKbdFXP)
// Switch to Kbd context to handle the interrupt
IPutBase(IFPCurrentFXP+IFPKbdFXP, IGetBase(IFPCurrentFXP))
IPutBase(IFPCurrentFXP, newCFXP)
]
// KBDFlg is set as a side effect of KBDHandler. If set, 16ms has
// passed so it is time to block and let the others run.
if KBDFlg then [ KBDFlg=false; Block() ]
resultis lvNIL
]
and DoMouseEvent(mbk) be
[
// Mouse queue is locked down, so BxBases do not fault. Logically, we could
// fault but there isn't enough interrupt stack space for fault handling.
let mIn = BGetBase(MEQHi, MEQLo); let mOut = BGetBase(MEQHi, MEQLo+1)
let mfin = mIn + 5 // events are five words
let mt = vec 1
if mfin ge BGetBase(MEQHi, MEQLo+3) then mfin = BGetBase(MEQHi, MEQLo+2)
test mfin eq mOut ? false, // queue space, mouse char, kbd space?
(mouseEventCode eq -1 ? true, Puts(keys, mouseEventCode))
ifso [ mIn = mIn + MEQLo
BPutBase(MEQHi, mIn, @mouseX)
BPutBase(MEQHi, mIn+1, cursorYmax - @mouseY)
BPutBase(MEQHi, mIn+2, mbk)
BPutBase(MEQHi, mIn+3, Timer(mt))
BPutBase(MEQHi, mIn+4, BlankKeys())
BPutBase(MEQHi, MEQLo, mfin)
]
ifnot FlashScreen()
]
and BlankKeys() = valof // packs fn keys into 8 bits
[
let k2 = not @(Keys + 2)
resultis ((not @(Keys + 1)) & #3) + // b1, b2
(k2 & #100) + // lft-shft
((not @(Keys + 3)) & #214) + // lock,rt-shft,b3
((k2 & #4000) eq 0 ? 0, #40) // cntrl
]
and CREATEMOUSEEVENT(lvMptr) = valof
[
let mt = vec 1
XSetBR(lvMptr) // Mptr is a raw pointer
RWrite(0, @mouseX)
RWrite(1, cursorYmax - @mouseY)
RWrite(2, (not @utilIn) & RMSK)
RWrite(3, Timer(mt))
RWrite(4, BlankKeys())
resultis lvMptr
]
// enable/disable mouse events
and ENABLEMOUSE(lvMptr, lvCCode) = valof
[
test EqNIL(lvMptr)
ifso mouseEnabled = false
ifnot [
MEQHi = lvMptr!0
MEQLo = lvMptr!1
if BGetBase(MEQHi, MEQLo+3) ls 6
then RAIDCode("Mouse q too small", lvMptr)
LockPages(MEQHi, MEQLo, 1)
mouseEventCode = EqNIL(lvCCode) ? -1, SmallUnbox(lvCCode)
mouseEnabled = true
]
resultis lvMptr
]
// SetCursorPos is called with smallp arguments - can be negative
and SetCursorPos(lvcurX, lvcurY) = valof
// Sets the cursor position. Arguments constrained to [0..cursorMax]
// Reflects the y value because of different Lisp/Alto origins
[
@mouseX = Bound(lvcurX, ScreenWidth)
@mouseY = cursorYmax - Bound(lvcurY, cursorYmax)
resultis lvNIL
]
and Bound(a, b) = // limits a to the interval [0..b]
selecton a>>VA.vahi into
[ case SMALLNEGspace: 0 // a<0 hence 0
case SMALLPOSspace: valof [ let v=a!1
resultis v gr b ? b , v]
default: RAIDCode("Invalid cursor pos", a) ]