// KbdIOSubrs.bcpl
// Last change July 23, 1983 9:45 PM by Bill van Melle
// Major pruning December 14, 1982 2:55 PM by Bill van Melle
// Last change July 21, 1982 9:51 PM by Bill van Melle
// Wind change April 29, 1982 12:47 PM by Bill van Melle
// Last change January 14, 1982 6:32 PM by Bill van Melle
// 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
NWWInterrupt
// other procedures defined
KBDinit
// statics defined
keys
// OS procedures used
FindInterruptMask; InitializeInterrupt; CallSwat; Block
Gets; Puts; Endofs; Resets; Max; Min; SetBlock; Zero; MoveBlock
// other procs
AllocVec; RAIDCode; FlashScreen
// statics used
OsBuffer; @lvNIL; @RMSK; ScreenWidth
lispStarted; insideRaid
]
static [
@KBDFlg = false
@NewUS; @OldUS
keys
LockShift
@DownStrokes; @UpStrokes
ASCIImap
@MEQLo; @MEQHi
ScreenWidth= 1000 // to use for clipping until Init LispRegs
]
manifest [
KBStackSize = 256 // stack depth for interrupts
TrackMouse = true
]
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
let WakeBit = FindInterruptMask(1 lshift (KeyboardLevel-1))
InitializeInterrupt(AllocVec(KBStackSize),KBStackSize,WakeBit,KBDHandler)
@displayInterrupt = @displayInterrupt % WakeBit // arm the interrupt
]
and KBDHandler() be
[ // clip and track mouse
compileif not TrackMouse
then [
unless (insideRaid % not lispStarted) do return
]
@mouseX = @mouseX le -16? -16,
@mouseX gr ScreenWidth? ScreenWidth, @mouseX
// let mouse get a cursor width's off left and top
@cursorX = @mouseX
@mouseY = @mouseY le -16? -16,
@mouseY gr cursorYmax? cursorYmax, @mouseY
@cursorY = @mouseY
unless (insideRaid % not lispStarted) do return
MoveBlock(NewUS, Keys, USsize-1)
NewUS!(USsize-1)=@buttons
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)
]
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 Block() // 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 NWWInterrupt() = valof // Run whenever an interrupt occurs (>60hz).
[
if (@(kbdAd+2) & #4102) eq 0 // CTRL-SHIFT-DEL
then RAIDCode ("Ctrl-Shift-Del emergency interrupt", lvNIL)
resultis lvNIL
]