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