//
// BCPL keyboard handler
// last edited August 25, 1980  1:47 PM
//
// Copyright Xerox Corporation 1979, 1980

	get "kbdDefs.d"
	get "sysdefs.d"	// for OsBUF structure
	get "altodefs.d"	// for mouse and cursor locations

external [				// procedures defined
	KBDHandler
	kbdState
	kbdGets
	kbdPuts
	kbdReset
	kbdEmpty
	]

external [				// statics defined
	kbdButtonsOn
	kbdTrapTable
	@OldUS; @NewUS
	kbdOverflowProc
	kbdTrapProc
	]

external [				// procedures used
	MoveBlock
	]

external [				// statics used
	OsBuffer
	lvCursorLink
	]

static [
	kbdButtonsOn	= false
	@NewUS
	@OldUS
	DownStrokes	
	UpStrokes	
	ASCIImap	
	LockShift
	kbdTrapTable
	kbdOverflowProc
	kbdTrapProc
	]

structure [	// shift keys
	blank word
	blank word
	blank bit 4; CtrlBit bit; blank bit 4; LShiftBit bit; blank bit 6
	blank bit 7; SwatBit bit; LockShiftBit bit; blank bit 3; RShiftBit bit; blank bit 3
	]

let kbdState() be
  [kbS

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

  ]kbS

and KBDHandler() be
  [kbH

	MoveBlock(NewUS, Keys, 4)
	NewUS!4=@buttons
	if @lvCursorLink then
	 [ test @mouseX ls 0
	    ifso @mouseX = 0
	    ifnot
	   if @mouseX gr cursorXmax then @mouseX = cursorXmax
	   @cursorX = @mouseX
	   test @mouseY ls 0
	    ifso @mouseY = 0
	    ifnot
	   if @mouseY gr cursorYmax then @mouseY = cursorYmax
	   @cursorY = @mouseY
	 ]
	for i = 0 to 4 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)
	   x = not old & new & UpStrokes!i
	   if x ne 0 then KeyAction(x, i, UpStroke)
	 ]
	let x=OldUS; OldUS=NewUS; NewUS=x
  ]kbH

and KeyAction (b, w, action) be
  [ka
	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
	  if ((w ls 4) % kbdButtonsOn) & (((kbdTrapTable!(c rshift 4) & 1 lshift (c&#17)) eq 0) % (kbdTrapProc(c) ne false)) then
	   unless kbdPuts(nil, c) do kbdOverflowProc(c)
	  ]
	m, x = m lshift 1, x+1
	] repeatwhile m ne 0
  ]ka

and kbdGets(nil) = valof
  [	let ch = RingGet(OsBuffer)
	if ch ne -1 resultis ch
  ] repeat

and kbdReset(nil) be
  [	let x = OsBuffer>>OsBUF.First
	OsBuffer>>OsBUF.In = x
	OsBuffer>>OsBUF.Out = x
  ]

and kbdEmpty(nil) = OsBuffer>>OsBUF.In eq OsBuffer>>OsBUF.Out

and kbdPuts(nil,x) =
  valof [
	let t = OsBuffer>>OsBUF.In + 1 
	if t eq OsBuffer>>OsBUF.Last then t = OsBuffer>>OsBUF.First
	if t eq OsBuffer>>OsBUF.Out then resultis false	//Overflow
	@(OsBuffer>>OsBUF.In) = x
	OsBuffer>>OsBUF.In = t
	resultis true
  ]

and RingGet(R,flg; numargs na) =
  valof [
	if R>>OsBUF.Out eq R>>OsBUF.In then resultis -1 
	let t = R>>OsBUF.Out + 1
	if t eq R>>OsBUF.Last then t = R>>OsBUF.First
	let x = @(R>>OsBUF.Out)
	if na eq 1 then R>>OsBUF.Out = t
	resultis x
  ]