// KbdIOSubrs.bcpl
// 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
	CREATEMOUSEEVENT; ENABLEMOUSE; GETKEYS; BKSYSCHAR0; PEEKKEYS
	SetCursorPos
				// other procedures defined
	KBDinit; NWWInterrupt
				// statics defined
	keys; @LispKbd
				// procedures used
	FindInterruptMask; InitializeInterrupt; CallSwat; Block
	AllocVec; @AtomNotNIL; Max; Min; SetBlock; Zero
	Gets; Puts; Endofs; Resets; Timer; SmallUnbox; EqNIL; RAIDCode
	FlashScreen; MoveBlock; MkSmallPos; LockPages
	@XSetBR; @RRead; @RWrite; @APutBase32; @BGetBase; @BPutBase; IGetBase; IPutBase
				// statics used
	OsBuffer; @lvNIL; @RMSK; ScreenWidth; @InterruptEnable; @InterruptChar
	]

static  [
	@KBDFlg = false; @NewUS; @OldUS; keys; @LispKbd
	LockShift; @DownStrokes; @UpStrokes; ASCIImap
	@MEQLo; @MEQHi; @mouseEventCode; @mouseEnabled = false
	@InterruptEnable; @InterruptChar
	ScreenWidth= 1000	// to use for clipping until Init LispRegs
	]

manifest [
	LispKBLength = 128
	KBStackSize = 256			// stack depth for interrupts
	]

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

// Lisp gets its own keyboard stream
   LispKbd = AllocVec(lST)
   MoveBlock(LispKbd, keys, lST)		// just like keys
   let lbuf = AllocVec(size OsBUF/16)		// but with its own buffer
   lbuf>>OsBUF.First = AllocVec(LispKBLength)
   lbuf>>OsBUF.Last = lbuf>>OsBUF.First + LispKBLength - 1
   LispKbd>>ST.par1 = lbuf
   Resets(LispKbd)

   let WakeBit = FindInterruptMask(1 lshift (KeyboardLevel-1))
   InitializeInterrupt(AllocVec(KBStackSize),KBStackSize,WakeBit,KBDHandler)
   @displayInterrupt = @displayInterrupt % WakeBit	// arm the interrupt

  ]

and KBDHandler() be
  [
   MoveBlock(NewUS, Keys, USsize-1)
   NewUS!(USsize-1)=@buttons
   @mouseX = Max(0, Min(@mouseX, ScreenWidth))	// Clip and track mouse
   @cursorX = @mouseX
   @mouseY = Max(0, Min(@mouseY, cursorYmax))
   @cursorY = @mouseY
   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)
    ]
    if mouseEnabled then
    [ let i = USsize-1
      let old = OldUS ! i
      let new = NewUS ! i
      let x = old & not new & DownStrokes!i
      if x do DoMouseEvent(x)
      if not old & new & UpStrokes!i do DoMouseEvent((not new) & RMSK)
    ]
   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 loop	// 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 BKSYSCHAR0(lvCh) = Puts(keys, SmallUnbox(lvCh) & RMSK) ? lvCh, lvNIL

and GETKEYS() = valof
  [ NWWInterrupt()		// run interrupt to check arriving characters
    resultis Endofs(LispKbd) ? lvNIL, MkSmallPos(Gets(LispKbd)) ]

and PEEKKEYS() = 
    Endofs(LispKbd) ? lvNIL, MkSmallPos(@((LispKbd>>ST.par1)>>OsBUF.Out)) 

and NWWInterrupt() = valof	// Run whenever an interrupt occurs (>60hz).
  [ 
   // moves chars from keys => LispKbd, filtering out interrupt chars
   unless Endofs(keys) do	// keys => LispKbd, handling interrupt chars
    [
    let c = Gets(keys)
    test (BGetBase(STATSspace, InterruptTBLbase+(c rshift 4)) & 1 lshift (c&#17)) ne 0 %
      c eq 3			// make sure we take ^C anyway
      ifso  APutBase32(InterruptChar, MkSmallPos(c))
      ifnot unless Puts(LispKbd, c) do FlashScreen()
    ]
   // check interrupt char (not necessarily from immediately prior code!)
   let c = AtomNotNIL(InterruptChar) 	// AtomNotNIL returns second word
   if c & (AtomNotNIL(InterruptEnable) % c eq 3) then
       [ APutBase32(InterruptEnable, lvNIL)
	let newCFXP = IGetBase(IFPCurrentFXP+IFPKbdFXP)
		// Switch to Kbd context to handle the interrupt
	IPutBase(IFPCurrentFXP+IFPKbdFXP, IGetBase(IFPCurrentFXP))
	IPutBase(IFPCurrentFXP, newCFXP)
       ]
   // KBDFlg is set as a side effect of KBDHandler. If set, 16ms has
   // passed so it is time to block and let the others run.
   if KBDFlg then [ KBDFlg=false; Block() ]
   resultis lvNIL
  ]

and DoMouseEvent(mbk) be
  [
   // Mouse queue is locked down, so BxBases do not fault. Logically, we could
   // fault but there isn't enough interrupt stack space for fault handling.
   let mIn = BGetBase(MEQHi, MEQLo); let mOut = BGetBase(MEQHi, MEQLo+1)
   let mfin = mIn + 5			// events are five words
   let mt = vec 1
   if mfin ge BGetBase(MEQHi, MEQLo+3) then mfin = BGetBase(MEQHi, MEQLo+2)
   test mfin eq mOut ? false,		// queue space, mouse char, kbd space?
              (mouseEventCode eq -1 ? true, Puts(keys, mouseEventCode))
     ifso  [ mIn = mIn + MEQLo
             BPutBase(MEQHi, mIn, @mouseX)
             BPutBase(MEQHi, mIn+1, cursorYmax - @mouseY)
             BPutBase(MEQHi, mIn+2, mbk)
             BPutBase(MEQHi, mIn+3, Timer(mt))
             BPutBase(MEQHi, mIn+4, BlankKeys())
             BPutBase(MEQHi, MEQLo, mfin)
           ]
     ifnot FlashScreen()
  ]

and BlankKeys() = valof				// packs fn keys into 8 bits
  [
   let k2 =  not @(Keys + 2)
   resultis ((not @(Keys + 1)) & #3) +		// b1, b2
            (k2 & #100) +			// lft-shft
            ((not @(Keys + 3)) & #214) +	// lock,rt-shft,b3
            ((k2 & #4000) eq 0 ? 0, #40)	// cntrl
  ]

and CREATEMOUSEEVENT(lvMptr) = valof
   [
   let mt = vec 1
   XSetBR(lvMptr)			// Mptr is a raw pointer
   RWrite(0, @mouseX)
   RWrite(1, cursorYmax - @mouseY)
   RWrite(2, (not @utilIn) & RMSK)
   RWrite(3, Timer(mt))
   RWrite(4, BlankKeys())
   resultis lvMptr
   ]

// enable/disable mouse events

and ENABLEMOUSE(lvMptr, lvCCode) = valof
   [
   test EqNIL(lvMptr)
    ifso  mouseEnabled = false
    ifnot [
          MEQHi = lvMptr!0
          MEQLo = lvMptr!1
          if BGetBase(MEQHi, MEQLo+3) ls 6
             then RAIDCode("Mouse q too small", lvMptr)
          LockPages(MEQHi, MEQLo, 1)
          mouseEventCode = EqNIL(lvCCode) ? -1, SmallUnbox(lvCCode)
          mouseEnabled = true
          ]
   resultis lvMptr
   ]

// SetCursorPos is called with smallp arguments - can be negative

and SetCursorPos(lvcurX, lvcurY) = valof
   // Sets the cursor position. Arguments constrained to [0..cursorMax]
   // Reflects the y value because of different Lisp/Alto origins
   [
   @mouseX = Bound(lvcurX, ScreenWidth)
   @mouseY = cursorYmax - Bound(lvcurY, cursorYmax)
   resultis lvNIL
   ]

and Bound(a, b) = 		// limits a to the interval [0..b]
   selecton a>>VA.vahi into
     [ case SMALLNEGspace: 0			// a<0 hence 0 
       case SMALLPOSspace: valof [ let v=a!1 
                                   resultis v gr b ? b , v]
       default: RAIDCode("Invalid cursor pos", a) ]