// BKBD.SR derived from Lampson's KBD.C
// ATTEMPT TO FIX DROPPED CHARS IS HERE
// &< added UPDATETIMER() call
// Last modified October 20, 1979 4:31 PM by Taft
// outgoing procedures
external [
CreateKeyboard
GetFromRB
RBempty
]
get "AltoDefs.d"
get "mcur.df"
get "Char.Df";
// outgoing statics
external [
linkCursorToMouse
keyboardEnabled
oldKeys
vmcur
mcurReset
]
static [
linkCursorToMouse
keyboardEnabled
oldKeys
vmcur
mcurReset
]
// incoming procedures
external [
InitializeInterrupt
DisableInterrupts; EnableInterrupts;
MoveBlock
// UPDATETIMER // &< // **
// ENDOFS; KEYS; GETCHAR;
Endofs; keys; Gets;
ReadClock
move
uc
]
// incoming static
external [
tsread
OsBuffer;
vRtcVertInt
vfVertInt
]
structure BUF[
// readPointer word
// writePointer word
// bufferStart word
// bufferEnd word
First word // => first word of ring buffer
Last word // => last word of ring buffer+1
In word // => place to put next item
Out word // => next item to take
]
// structure RB[
// @ST
// ]
// manifest lRB = size RB/16
manifest msb = #100000
manifest [ mouseAddr = mouseX; cursorAddr = cursorX; OsKeyProcess = 13 ]
let CreateKeyboard(procNo, stackSpace, stackSize) be [
// tpinterrruptcode added by TJM
let maskInt = 1 lshift (procNo-1)
let maskIntOld = 1 lshift (OsKeyProcess-1)
DisableInterrupts()
rv activeInterrupts = rv activeInterrupts & (not maskIntOld)
rv displayInterrupt = rv displayInterrupt & (not maskIntOld)
EnableInterrupts()
InitializeInterrupt(stackSpace, stackSize, maskInt, KeyboardInterrupt)
DisableInterrupts()
rv displayInterrupt = rv displayInterrupt % maskInt
EnableInterrupts()
manifest [ nKeyWords = 4; keys = #177034 ]
let toldKeys = table [ 0; 0; 0; 0 ];
oldKeys = toldKeys
MoveBlock(oldKeys, keys, nKeyWords)
// let tpinterruptcode = KeyboardInterrupt(procNo, //JR
// stackSpace, stackSize)
// InitializeStream(stream)
// stream>>ST.gets = GetFromRB
// stream>>ST.endof = RBempty
// let t = stream+lRB
// stream>>RB.First = t
// stream>>RB.Last = stream+streamSize-1
// stream>>RB.In = t; stream>>RB.Out = t
// let intBit = 1 lshift (procNo-1) //JR
// let ringBuffer = stream
// until Endofs(keys) do
// [ let char = Gets(keys);
// let t = ringBuffer>>RB.In
// rv t = char; t = t+1
// if t ge ringBuffer>>RB.Last then
// t = ringBuffer>>RB.First
// if t ne ringBuffer>>RB.Out then
// ringBuffer>>RB.In = t
// ]
// DisableInterrupts()
// rv displayInterrupt = rv displayInterrupt % maskInt
// rv activeInterrupts = rv activeInterrupts % intBit
// rv displayInterrupt = rv displayInterrupt & (not ProcessBit(OsKeyProcess))
// interruptVector ! (procNo) = tpinterruptcode
// EnableInterrupts()
]
and KeyboardInterrupt() = valof [
// must have a static so that the new process can communicate
// with the old one
// static p
// p = BeginProcessInit(procNo, stackSpace, stackSize)
// control comes here in the new process right after it is created
// KeyboardInit:
manifest [ nKeyWords = 4; keys = #177034 ]
// let oldKeys = vec nKeyWords-1; MoveBlock(oldKeys, keys,
// nKeyWords)
let newKeys = vec nKeyWords-1; // ** FIX BUG
let keyMask = table [ #177777; #177777; #173676; #177560 ]
// ** GYPSY enabled top 2 spare keys
// the following table is for decoding keys which, when
// down, affect the interpretation of other keys. Each such
// key has three words in the table:
structure SKE[
index word // the index in the keys vector of the
// word in which it appears
mask word // a mask which picks off its bit
type word // a code which can be used in a case
// label to decide what
// to do when it appears
]
manifest lSKE = size SKE/16
manifest [ lsideshift = 1; lock = 2; control = 3; rsideshift = 4; skTab = 5 ]
let specialKeys = table [ // order important
3; #10; rsideshift // right shift key
2; #100; lsideshift // left shift key
2; #4000; control // control key
3; #200; lock // lock key
2; #20000; skTab // tab key
]
let endSpecialKeys = specialKeys+5*lSKE-1
manifest [ esc = #33; del = #177; bs = #10 ]
manifest [ topblk = #36; midblk = #34; botblk = #31 // GYPSY **
shtopblk = #36; shmidblk = #34; shbotblk = #31
shesc = #33; shdel = #177; shbs = #20;
shlf = #12; shtab = $*T; shcr = #15; shsp = #40 ]
// entries in the keyNoToChar table have the structure
structure KW[
[ letter bit; shiftedChar bit 7;
repeater bit ; unshiftedChar bit 7 ] // **
= [ blank bit 11; controlChar bit 5 ]
]
manifest [ l = #400; letter = #100000; rept = #200 ] // **
let keyNoToChar = table [
shbs*l+bs+rept // bit 15
shlf*l+$*L // +rept
$|*l+$\
$?*l+$/
$P*l+$p+letter
#140*l+$-
$K*l+$k+letter
$)*l+$0
$V*l+$v+letter
$U*l+$u+letter
$D*l+$d+letter
$&*l+$7
$E*l+$e+letter
$~*l+$6
$$*l+$4
$%*l+$5 // bit 0
shtopblk*l+topblk+rept // top spare
shmidblk*l+midblk // middle spare
$}*l+$]
$"*l+$'
$<*l+$,
$L*l+$l+letter
$O*l+$o+letter
$X*l+$x+letter
$I*l+$i+letter
$(*l+$9
$A*l+$a+letter
$S*l+$s+letter
$Q*l+$q+letter
$W*l+$w+letter
$@*l+$2
$#*l+$3
0 // not used
shdel*l+del // +rept
$↑*l+$←
shcr*l+$*N // carriage return
$:*l+$;
$>*l+$.
0 // shift
$Z*l+$z+letter
$B*l+$b+letter
$J*l+$j+letter
$C*l+$c+letter
0 // control
$F*l+$f+letter
shtab*l+$*T // tab
shesc*l+esc
$!*l+$1
0 // not used
0 // not used
0 // bottom spare
0 // shift
$+*l+$=
${*l+$[
shsp*l+$*S // space
0 // lock
$M*l+$m+letter
$N*l+$n+letter
$***l+$8 // *
$H*l+$h+letter
$Y*l+$y+letter
$G*l+$g+letter
$T*l+$t+letter
$R*l+$r+letter
]
let maxCoord = table [ 606-16; 808-16 ]
keyboardEnabled = true ; // **
// EndProcessInit(KeyboardIntEntry)
// resultis p
// interrupt entry point
// KeyboardIntEntry: [0
// UPDATETIMER() // &< // **
vfVertInt = true
ReadClock(vRtcVertInt)
for i = 1 by -1 to 0 do [
if mouseAddr ! i ls 1 then mouseAddr ! i = 1 //** 0->1
if mouseAddr ! i gr maxCoord ! i then
mouseAddr ! i = maxCoord ! i
]
if linkCursorToMouse & (tsread eq false)
then for i = 1 by -1 to 0 do
cursorAddr ! i = mouseAddr ! i
if vmcur then
[ let fDispLinked = vmcur >> MCUR.fDispLinked
let cmap = fDispLinked ? lv vmcur >> MCUR.acmapLinked,lv vmcur >> MCUR.acmapOther
move(cmap,cmapHwr,16)
// This is backwards 'cause the hardware already fetched the values from clocHwr
if fDispLinked then
move(lv vmcur >> MCUR.aclocOther,cursorAddr,2)
vmcur >> MCUR.fDispLinked = not fDispLinked
]
MoveBlock(newKeys, keys, nKeyWords) // ** FIX BUG
if keyboardEnabled then // ** GYPSY
[
for i = nKeyWords-1 by -1 to 0 do
[1
let keyTrans = (not newKeys ! i) & oldKeys ! i & keyMask ! i // **
if keyTrans eq 0 then loop
for j = 15 by -1 to 0 do
[2
if keyTrans ls 0 then
[3
let keyWord = keyNoToChar ! (i*16+j)
if keyWord ne 0 then
[4
let char = keyWord<<KW.unshiftedChar
for sk = specialKeys by lSKE to
endSpecialKeys do
[5
if (oldKeys ! (sk>>SKE.index) &
sk>>SKE.mask) ne 0 then loop
switchon sk>>SKE.type into
[6
case lock:
unless keyWord<<KW.letter do loop
// otherwise fall through
case rsideshift:
case lsideshift:
char = keyWord<<KW.shiftedChar
loop
case control:
char = #200+char
break
case skTab:
char = valof
[
let tch = uc(char)
let tc = nil;
test tch ge $1 & tch le $9 ifso
tc = tch - $0
ifnot test tch ge $A & tch le $F ifso
tc = tch - $A + 10
ifnot resultis 0
resultis chitbMin + tc - 1
]
loop
]6
]5
if char then [5
// now we have the character and can salt it away in the ring buffer
let tpw = OsBuffer>>BUF.In
rv tpw = char; tpw = tpw+1
if tpw eq OsBuffer>>BUF.Last then
tpw = OsBuffer>>BUF.First
if tpw ne OsBuffer>>BUF.Out then
OsBuffer>>BUF.In = tpw
]5
]4
]3
keyTrans = keyTrans lshift 1
]2
]1
MoveBlock(oldKeys, newKeys, nKeyWords)
]
// Block()
// ]0 repeat
]
// this routine waits for the RB to be non-empty
and GetFromRB() = valof [
// does not use RB any more ! !
[ let t = OsBuffer>>BUF.Out
if OsBuffer>>BUF.In ne t then
[
let v = rv t; t = t+1
if t eq OsBuffer>>BUF.Last then
t = OsBuffer>>BUF.First
OsBuffer>>BUF.Out = t
resultis v
]
] repeat
]
// does not use RB any more ! !
and RBempty() =
OsBuffer>>BUF.Out eq OsBuffer>>BUF.In
// and InitializeStream(s) be [
// external [
// prototypeStream
// ]
// for i = 0 to lST-1 do s ! i = rv (prototypeStream ! i)
// ]