// 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)&#4104) ne 0 &
	   ((not keys!3)&#40) ne 0 then
		swaton((p!10)+11,(not keys!1)&#4)
			// ** 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)
	]