// GKBD.SR derived from Lampson's KBD.C
// ATTEMPT TO FIX DROPPED CHARS IS HERE
get "OSSTRUCTURES"
// outgoing procedures
external [
CreateKeyboard
]
// temporarily outgoing procedures, later to be moved elsewhere
external [
InitializeStream
]
// outgoing statics
external [
linkCursorToMouse
keyboardEnabled
]
static [
linkCursorToMouse
keyboardEnabled
vRepeatKeys // **
vLRepeatKeys // **
]
// incoming procedures
external [
BeginProcessInit; EndProcessInit
DisableInterrupts; EnableInterrupts; Block
MoveBlock
swaton // **
]
structure RB[
@ST
readPointer word
writePointer word
bufferStart word
bufferEnd word
]
manifest lRB=size RB/16
manifest msb=#100000
manifest [ mouseAddr=mouseX; cursorAddr=cursorX ]
// ** GYPSY ADDED:
// the vRepeatKeys table is for decoding keys which, when
// held down a long time, repeat. Each such
// key has five words in the table:
structure RKE:
[
index word // the index in the keys vector of the
// word in which it appears
bitnum word // the bit number (15=sign bit)
mask word // a mask which picks off said bit
count word // meaning dependent on STATE
state word // nowup = COUNT presses queued, key up
// stilldown = same but key down
// timing = will repeat after COUNT ticks
]
manifest [ nowup=0; stilldown=1; timing=2 ]
manifest lRKE=size RKE/16
manifest [ longdelay=30; shortdelay=6 ] // ** tenths secs.
structure [
repeatIndex byte
charCode byte
]
// ** end GYPSY addition
let CreateKeyboard(procNo, stackSpace, stackSize, stream,
streamSize, repeatKeys, lRepeatKeys) be [
vRepeatKeys = repeatKeys ; // ** table in RKE form
vLRepeatKeys = lRepeatKeys ; // ** length of table
interruptVector!(procNo+1)=KeyboardInterrupt(procNo,
stackSpace, stackSize, stream)
InitializeStream(stream)
stream>>ST.gets=GetFromRB
stream>>ST.endof=RBempty
let t=stream+lRB
stream>>RB.bufferStart=t
stream>>RB.bufferEnd=stream+streamSize-1
stream>>RB.readPointer=t; stream>>RB.writePointer=t
let intBit=1 lshift procNo
DisableInterrupts()
rv verticalFieldInterrupt=rv verticalFieldInterrupt % intBit
rv activeInterrupts=rv activeInterrupts % intBit
EnableInterrupts()
]
and KeyboardInterrupt(procNo, stackSpace, stackSize, ringBuffer)=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 ]
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
]
let endSpecialKeys=specialKeys+4*lSKE-1
manifest [ esc=#33; del=#177; bs=#10 ]
manifest [ topblk=#36; midblk=#34; botblk=#31 // GYPSY **
shtopblk=#37; shmidblk=#35; shbotblk=#32
shesc=#23; shdel=#27; shbs=#20;
shlf=#22; shtab=#21; shcr=#25; shsp=#30 ]
// 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
$-*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
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
then for i=1 by -1 to 0 do cursorAddr!i=mouseAddr!i
if ((not keys!2)ဈ) ne 0 &
((not keys!3)() ne 0 then
swaton((p!10)+11,(not keys!1))
// ** GYPSY CTRL-LSHIFT-{-↑ and maybe }
// PCB structure Interrupted PCB word offset=12-2
// PCB structure ActiveInterrupts-Save3 word offset=11
MoveBlock(newKeys, keys, nKeyWords) // ** FIX BUG
if keyboardEnabled then // ** GYPSY
for i=nKeyWords-1 by -1 to 0 do [1
let t=(not newKeys!i) & oldKeys!i & keyMask!i // **
oldKeys!i=newKeys!i
if t eq 0 then loop
for j=15 by -1 to 0 do [2
if t 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 //
]6
]5
if char then [5
if keyWord<<KW.repeater then // **
for sr=vRepeatKeys by lRKE
to vRepeatKeys-1+vLRepeatKeys do
if sr>>RKE.index eq i &
sr>>RKE.bitnum eq j then [6
char << repeatIndex= sr+1-vRepeatKeys;
if sr>>RKE.state ne timing then [7
sr>>RKE.count=sr>>RKE.count+1
sr>>RKE.state=stilldown;
]7
]6
// now we have the character and can salt it away in the ring buffer
let t=ringBuffer>>RB.writePointer
rv t=char; t=t+1
if t ge ringBuffer>>RB.bufferEnd then
t=ringBuffer>>RB.bufferStart
if t ne ringBuffer>>RB.readPointer then
ringBuffer>>RB.writePointer=t
]5
]4
]3
t=t lshift 1
]2
]1
let cnt = nil ; // **
if keyboardEnabled then // ** Repeat Keys
for sr=vRepeatKeys by lRKE to
vRepeatKeys-1+vLRepeatKeys do
switchon sr>>RKE.state into
[1
case timing:
cnt = sr>>RKE.count ;
if (newKeys!(sr>>RKE.index) & sr>>RKE.mask) ne 0 // **
then [2
sr>>RKE.state = nowup;
sr>>RKE.count = 0 ;
endcase
]2
if cnt then
[2
cnt = cnt-1 ;
if cnt eq 0 then // pretend up **
oldKeys!(sr>>RKE.index) =
oldKeys!(sr>>RKE.index) % sr>>RKE.mask
sr>>RKE.count=cnt ;
]2
endcase
case stilldown:
if(newKeys!(sr>>RKE.index)&sr>>RKE.mask)ne 0 then // **
sr>>RKE.state=nowup;
case nowup: endcase
]1
Block()
]0 repeat
]
// this routine waits for the RB to be non-empty
and GetFromRB(ringBuffer)=valof [
[ let t=ringBuffer>>RB.readPointer
if ringBuffer>>RB.writePointer ne t then
[
let v=rv t; t=t+1
if t ge ringBuffer>>RB.bufferEnd then
t=ringBuffer>>RB.bufferStart
ringBuffer>>RB.readPointer=t
if v << repeatIndex then // ** repeating key
[
let sr = vRepeatKeys - 1 + v << repeatIndex ;
keyboardEnabled = false ;
v = v << charCode ;
switchon sr>>RKE.state into
[
case stilldown:
if sr>>RKE.count eq 1 then
[ // only one in RB: schedule rpt
sr>>RKE.state=timing;
sr>>RKE.count=longdelay ;
endcase
] // else fall through
case nowup: if sr>>RKE.count then
sr>>RKE.count=sr>>RKE.count-1;
endcase;
case timing: sr>>RKE.count=shortdelay;
];
keyboardEnabled = true ;
];
resultis v
]
] repeat
]
and RBempty(ringBuffer)=
ringBuffer>>RB.readPointer eq ringBuffer>>RB.writePointer
and InitializeStream(s) be [
external [
prototypeStream
]
for i=0 to lST-1 do s!i=rv (prototypeStream!i)
]