Oberon/ETH Oberon/Input.Mod

(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich. Refer to the license.txt file provided with this distribution. *) MODULE Input;	(** portable, except where noted *)	(* pjm *) (* 	Native Oberon Input, pjm 09.06.95 	Mouse protocol information from XFree in X11R6 distribution (Thomas Roell & David Dawes) 	PS/2 Aux port information from Linux (Johan Myreen et al.) 	Added support for 82C710 controller (QuickPort), pr 12.09.2000 	- information about 82C710 from Linux (qpmouse.c, 8-Sep-95) *) (** Module Input is responsible for event timing, mouse and keyboard input. *) IMPORT Files, Kernel, V24, SYSTEM; CONST TimeUnit* = 1000;	(** portable, but VAR on other ports *)	(** timer ticks per second (platform dependent). *) SHIFT* = 0; CTRL* = 1;  ALT* = 2;	(** for KeyState *) BufSize = 32;	(* keyboard buffer size *) AuxSize = 301;	(* PS/2 aux port buffer size (multiple of 3 + 1)*) ScrollLock = 0; NumLock = 1;  CapsLock = 2;  LAlt = 3;  RAlt = 4; LCtrl = 5; RCtrl = 6;  LShift = 7;  RShift = 8;  GreyEsc = 9; Resetting = 10; SetTypematic = 11;  SendingLEDs = 12; MenuShift = 13; DeadKey = 0; AUX = -1; NONE = -2; Trace = FALSE; (* mouse types *) MinType = 0; MaxType = 9; MS = 0; MSC1 = 1;  MM = 2;  Logi = 3;  MSC2 = 4;  LogiMan = 5;  PS2 = 6;  MSI = 7;  MSC3 = 8;  MSC4 = 9; (* Native.Install.Text & build tool 	0 Microsoft serial (2-button) 	1  Mouse Systems Corp serial type a (dtr on, rts on) 	2  Logitech serial Type a (old models) 	3  Logitech serial Type b (old models) 	4  Mouse Systems Corp serial type b (dtr off, rts off) 	5  Logitech serial Type c (new models) 	6  PS/2 mouse (default) 	7  Microsoft serial IntelliMouse 	8  Mouse Systems Corp serial type c (dtr off, rts on) 	9  Mouse Systems Corp serial type d (dtr on, rts off) 	MT=PS2  PS/2 or built-in 	MT=LM1  Logitech 1 	MT=LM2  Logitech 2 	MT=LM3  Logitech 3 	MT=MS1  Mouse Systems 1 	MT=MS2  Mouse Systems 2 	MT=MS3  Mouse Systems 3 	MT=MS4  Mouse Systems 4 	MT=MSM  Microsoft (2-button) 	MT=MSI  Microsoft IntelliMouse 	MP=1 	MP=2 *) (* 82C710 controller command and status bits *) QpDevIdle = 0; QpRxFull = 1; QpTxIdle = 2; QpReset = 3; QpIntsOn = 4; QpErrorFlag = 5; QpClear = 6; QpEnable = 7; TYPE PollMouse* = PROCEDURE (VAR keys: SET; VAR dx, dy, dz: INTEGER): BOOLEAN;	(** non-portable *) PollKeyboard* = PROCEDURE (VAR ch: CHAR; VAR keys: SET): BOOLEAN;	(** non-portable *) MousePoller = POINTER TO RECORD poll: PollMouse; next: MousePoller END; KeyboardPoller = POINTER TO RECORD poll: PollKeyboard; next: KeyboardPoller END; KeyTable = POINTER TO ARRAY OF CHAR; VAR mouseErrors, auxoverflows: LONGINT; (* mouse state *) mouse: MousePoller; minX, minY, maxX, maxY, mouseX, mouseY, height: LONGINT; port, oldport, newport, rate: INTEGER;	(* Serial mouse port, bps and report rate (if supported) *) bps: LONGINT; type: SHORTINT;	(* mouse type *) buttons: SHORTINT;	(* -2, -3, 2, 3 *) mapkeys: ARRAY 8 OF SET; mbufp, numb: SHORTINT;	(* buffer pointer & protocol bytes *) mbuf: ARRAY 5 OF SET;	(* protocol buffer *) mask0, val0, mask1, val1, lastkeys: SET;	(* protocol parameters *) auxbuf: ARRAY AuxSize OF CHAR;	(* aux port buffer *) auxhd, auxtl: INTEGER;	(* aux buffer pointers *) threshold: INTEGER;	(* speedup threshold *) speedup: LONGINT; auxinit: BOOLEAN; auxId: CHAR; (* 82C710 mouse port *) qp: BOOLEAN; qpStatusPort: LONGINT; qpDataPort: LONGINT; (* keyboard state *) keyboard: KeyboardPoller; buffer: ARRAY 1+BufSize OF CHAR;	(* first byte not used (System.State security) *) head, tail, dkey: SHORTINT; lastport: LONGINT; lastvalue: SYSTEM.BYTE; keyval: INTEGER; table: LONGINT; flags, pollkeys: SET; breakproc, timerproc: Kernel.Proc; keytable: KeyTable;	(* anchor for keyboard table loaded from file *) kpmap: SET; kdx, kdy, counter0, counter1: INTEGER; (* Keyboard Driver  *) (* Translation table format:  	table = { scancode unshifted-code shifted-code flags }  0FFX . 	scancode = &#60;scancode byte from keyboard, bit 7 set for "grey" extended keys> 	unshifted-code = &#60;CHAR produced by this scancode, without shift> 	shifted-code = &#60;CHAR produced by this scancode, with shift> 	flags = &#60;bit-mapped flag byte indicating special behaviour> 	flag bit	function 		0	01	DeadKey: Set dead key flag according to translated key code (1-7) 		1	02	NumLock: if set, the state of NumLock will reverse the action of shift (for num keypad) 		2	04	CapsLock: if set, the state of CapsLock will reverse the action of shift (for alpha keys) 		3	08	LAlt:  \ the state of these two flags in the table and the current state of the two... 		4	10	RAlt: / ...Alt keys must match exactly, otherwise the search is continued. 		5	20	\ 		6	40	 >  dead key number (0-7), must match current dead key flag 7	80	/ 	The table is scanned sequentially (speed not critical). Ctrl-Break, Ctrl-F10 and Ctrl-Alt-Del are always defined and are not in the table. The control keys are also always defined. *) (* TableUS - US keyboard translation table (dead keys: ^=1, '=2, `=3, ~=4, "=5) *) PROCEDURE TableUS: LONGINT; CODE {SYSTEM.i386} 	CALL L1 L1: 	POP EAX 	ADD EAX,8 	POP EBP 	RET 		(* alphabet *) 	DB 1EX, "a", "A", 4X,	30X, "b", "B", 4X,	2EX, "c", "C", 4X,	20X, "d", "D", 4X 	DB 12X, "e", "E", 4X,	21X, "f", "F", 4X,	22X, "g", "G", 4X,	23X, "h", "H", 4X 	DB 17X, "i", "I", 4X,	24X, "j", "J", 4X,	25X, "k", "K", 4X,	26X, "l", "L", 4X 	DB 32X, "m", "M", 4X,	31X, "n", "N", 4X,	18X, "o", "O", 4X,	19X, "p", "P", 4X 	DB 10X, "q", "Q", 4X,	13X, "r", "R", 4X,	1FX, "s", "S", 4X,	14X, "t", "T", 4X 	DB 16X, "u", "U", 4X,	2FX, "v", "V", 4X,	11X, "w", "W", 4X,	2DX, "x", "X", 4X 	DB 15X, "y", "Y", 4X,	2CX, "z", "Z", 4X 		(* Oberon accents (LAlt & RAlt) *) 	DB 1EX, "&#228;", "&#196;", 0CX,	12X, "&#235;", 0FFX, 0CX,	18X, "&#245;", "&#213;", 0CX,	16X, "&#252;", "&#220;", 0CX 	DB 17X, "&#239;", 0FFX, 0CX,	1FX, "&#223;", 0FFX, 0CX,	2EX, "&#231;", 0FFX, 0CX,	31X, "&#241;", 0FFX, 0CX DB 1EX, "&#228;", "&#196;", 14X,	12X, "&#235;", 0FFX, 14X,	18X, "&#245;", "&#213;", 14X,	16X, "&#252;", "&#220;", 14X DB 17X, "&#239;", 0FFX, 14X,	1FX, "&#223;", 0FFX, 14X,	2EX, "&#231;", 0FFX, 14X,	31X, "&#241;", 0FFX, 14X (* dead keys (LAlt & RAlt) *) DB 07X, 0FFX, 1X, 9X,	28X, 2X , 5X , 9X,	29X, 3X , 4X , 9X, DB 07X, 0FFX, 1X, 11X,	28X, 2X , 5X , 11X,	29X, 3X , 4X , 11X, (* following keys *) DB 1EX, "&#226;", 0FFX, 20X,	12X, "&#234;", 0FFX, 20X,	17X, "&#238;", 0FFX, 20X,	18X, "&#244;", 0FFX, 20X DB 16X, "&#251;", 0FFX, 20X,	1EX, "&#224;", 0FFX, 60X,	12X, "&#232;", 0FFX, 60X,	17X, "&#236;", 0FFX, 60X DB 18X, "&#242;", 0FFX, 60X,	16X, "&#249;", 0FFX, 60X,	1EX, "&#225;", 0FFX, 40X,	12X, "&#233;", 0FFX, 40X DB 1EX, "&#228;", "&#196;", 0A4X,	12X, "&#235;", 0FFX, 0A0X,	17X, "&#239;", 0FFX, 0A0X,	18X, "&#245;", "&#213;", 0A4X DB 16X, "&#252;", "&#220;", 0A4X,	31X, "&#241;", 0FFX, 80X (* numbers at top *) DB 0BX, "0", ")", 0X,	02X, "1", "!", 0X,	03X, "2", "@", 0X,	04X, "3", "#", 0X 	DB 05X, "4", "$", 0X,	06X, "5", "%", 0X,	07X, "6", "^", 0X,	08X, "7", "&", 0X 	DB 09X, "8", "*", 0X,	0AX, "9", "(", 0X (* symbol keys *) DB 28X, "'", 22X, 0X,	33X, ",", "&#60;", 0X,	0CX, "-", "_", 0X,	34X, ".", ">", 0X DB 35X, "/", "?", 0X,	27X, ";", ":", 0X,	0DX, "=", "+", 0X,	1AX, "&#91;", "{", 0X DB 2BX, "\", "|", 0X,	1BX, "]", "}", 0X,	29X, "`", "~", 0X (* control keys *) DB 0EX, 7FX, 7FX, 0X	(* backspace *) DB 0FX, 09X, 09X, 0X	(* tab *) DB 1CX, 0DX, 0DX, 0X	(* enter *) DB 39X, 20X, 20X, 0X	(* space *) DB 01X, 1BX, 1BX, 0X	(* esc *) (* keypad *) DB 4FX, 0A9X, "1", 2X	(* end/1 *) DB 50X, 0C2X, "2", 2X	(* down/2 *) DB 51X, 0A3X, "3", 2X	(* pgdn/3 *) DB 4BX, 0C4X, "4", 2X	(* left/4 *) DB 4CX, 0FFX, "5", 2X	(* center/5 *) DB 4DX, 0C3X, "6", 2X	(* right/6 *) DB 47X, 0A8X, "7", 2X	(* home/7 *) DB 48X, 0C1X, "8", 2X	(* up/8 *) DB 49X, 0A2X, "9", 2X	(* pgup/9 *) DB 52X, 0A0X, "0", 2X	(* insert/0 *) DB 53X, 0A1X, 2EX, 2X	(* del/. *) (* grey keys *) DB 4AX, "-", "-", 0X	(* grey - *) DB 4EX, "+", "+", 0X	(* grey + *) DB 0B5X, "/", "/", 0X	(* grey / *) DB 37X, "*", "*", 0X	(* grey * *) DB 0D0X, 0C2X, 0C2X, 0X	(* grey down *) DB 0CBX, 0C4X, 0C4X, 0X	(* grey left *) DB 0CDX, 0C3X, 0C3X, 0X	(* grey right *) DB 0C8X, 0C1X, 0C1X, 0X	(* grey up *) DB 09CX, 0DX, 0DX, 0X	(* grey enter *) DB 0D2X, 0A0X, 0A0X, 0X	(* grey ins *) DB 0D3X, 0A1X, 0A1X, 0X	(* grey del *) DB 0C9X, 0A2X, 0A2X, 0X	(* grey pgup *) DB 0D1X, 0A3X, 0A3X, 0X	(* grey pgdn *) DB 0C7X, 0A8X, 0A8X, 0X	(* grey home *) DB 0CFX, 0A9X, 0A9X, 0X	(* grey end *) (* function keys *) DB 3BX, 0A4X, 0FFX, 0X	(* F1 *) DB 3CX, 0A5X, 0FFX, 0X	(* F2 *) DB 3DX, 1BX, 0FFX, 0X	(* F3 *) DB 3EX, 0A7X, 0FFX, 0X	(* F4 *) DB 3FX, 0F5X, 0FFX, 0X	(* F5 *) DB 40X, 0F6X, 0FFX, 0X	(* F6 *) DB 41X, 0F7X, 0FFX, 0X	(* F7 *) DB 42X, 0F8X, 0FFX, 0X	(* F8 *) DB 43X, 0F9X, 0FFX, 0X	(* F9 *) DB 44X, 0FAX, 0FFX, 0X	(* F10 *) DB 57X, 0FBX, 0FFX, 0X	(* F11 *) DB 58X, 0FCX, 0FFX, 0X	(* F12 *) DB 0FFX END TableUS; PROCEDURE TableFromFile(name: ARRAY OF CHAR): KeyTable; VAR f: Files.File; r: Files.Rider;  len: LONGINT;  t: KeyTable; BEGIN Kernel.WriteString("Keyboard: "); Kernel.WriteString(name); f := Files.Old(name); IF f # NIL THEN len := Files.Length(f); IF len MOD 4 = 0 THEN NEW(t, len+1); Files.Set(r, f, 0); Files.ReadBytes(r, t^, len); IF r.res = 0 THEN Kernel.WriteLn; t&#91;len] := 0FFX; RETURN t 			END END END; Kernel.WriteString(" not used"); Kernel.WriteLn; RETURN NIL END TableFromFile; (* Translate - Translate scan code "c" to key. *) PROCEDURE Translate(flags: SET; c: CHAR): INTEGER; CONST Alt = {LAlt, RAlt}; Ctrl = {LCtrl, RCtrl};  Shift = {LShift, RShift}; VAR a: LONGINT; s1: CHAR;  s: SET;  k: INTEGER;  dkn: SHORTINT; BEGIN IF (c = 46X) & (flags * Ctrl # {}) THEN RETURN -2 END;	(* Ctrl-Break - break *) IF (c = 44X) & (flags * Ctrl # {}) THEN RETURN 0FFH END;	(* Ctrl-F10 - exit *) IF (c = 53X) & (flags * Ctrl # {}) & (flags * Alt # {}) THEN RETURN 0FFH END;	(* Ctrl-Alt-Del - exit *) IF GreyEsc IN flags THEN c := CHR(ORD(c)+80H) END; a := table; LOOP SYSTEM.GET(a, s1); IF s1 = 0FFX THEN	(* end of table, unmapped key *) k := -1; dkey := 0;  EXIT ELSIF s1 = c THEN	(* found scan code in table *) SYSTEM.GET(a+3, SYSTEM.VAL(CHAR, s));	(* flags from table *) dkn := SHORT(SHORT(SYSTEM.VAL(LONGINT, SYSTEM.LSH(s * {5..7}, -5)))); s := s * {DeadKey, NumLock, CapsLock, LAlt, RAlt, LCtrl, RCtrl}; k := 0; IF ((s * Alt = flags * Alt) OR (NumLock IN s)) & (dkn = dkey) THEN	(* Alt & dead keys match exactly *) IF flags * Shift # {} THEN INCL(s, LShift) END;	(* check if shift pressed *) (* handle CapsLock *) IF (CapsLock IN s) & (CapsLock IN flags) THEN s := s / {LShift} END; (* handle NumLock *) IF NumLock IN s THEN IF flags * Alt # {} THEN INCL(s, LShift) ELSIF NumLock IN flags THEN s := s / {LShift} END END; (* get key code *) IF LShift IN s THEN SYSTEM.GET(a+2, SYSTEM.VAL(CHAR, k))	(* shifted value *) ELSE SYSTEM.GET(a+1, SYSTEM.VAL(CHAR, k))	(* unshifted value *) END; IF (DeadKey IN s) & (k &#60;= 7) THEN	(* dead key *) dkey := SHORT(k); k := -1	(* set new dead key state *) ELSIF k = 0FFH THEN	(* unmapped key *) k := -1; dkey := 0	(* reset dead key state *) ELSE	(* mapped key *) IF flags * Ctrl # {} THEN IF ((k >= 64) & (k &#60;= 95)) OR ((k >= 97) & (k &#60;= 122)) THEN k := SHORT(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, k) * {0..4}))	(* control *) ELSIF k = 13 THEN	(* Ctrl-Enter *) k := 10 END END; IF flags * Alt # {} THEN	(* Alt-keypad *) IF (k >= ORD("0")) & (k &#60;= ORD("9")) & (NumLock IN s) THEN	(* keypad num *) IF keyval = -1 THEN keyval := k-ORD("0") ELSE keyval := (10*keyval + (k-ORD("0"))) MOD 1000 END; k := -1 END END; dkey := 0	(* reset dead key state *) END; EXIT END END; INC(a, 4) END; (* LOOP *) RETURN k END Translate; (* Wait - Wait for keyboard serial port to acknowledge byte. *) PROCEDURE Wait; VAR t: Kernel.MilliTimer; s: SET; BEGIN Kernel.SetTimer(t, Kernel.TimeUnit DIV 50);	(* wait up to 17 ms *) REPEAT SYSTEM.PORTIN(64H, SYSTEM.VAL(CHAR, s)) UNTIL ~(1 IN s) OR Kernel.Expired(t) END Wait; (* SendByte - Send a byte to the keyboard. *) PROCEDURE SendByte(port: LONGINT; value: SYSTEM.BYTE); BEGIN Wait; SYSTEM.PORTOUT(port, SYSTEM.VAL(CHAR, value)); lastport := port; lastvalue := value END SendByte; (* ShiftKey - Handle shift keys. *) PROCEDURE ShiftKey(left, right: SHORTINT; in: BOOLEAN); BEGIN IF in THEN IF GreyEsc IN flags THEN INCL(flags, right) ELSE INCL(flags, left) END ELSE IF GreyEsc IN flags THEN EXCL(flags, right) ELSE EXCL(flags, left) END END END ShiftKey; (* LedKey - Handle "lock" keys. *) PROCEDURE LedKey(VAR flags: SET; lock: SHORTINT;  c: CHAR; 		VAR k: INTEGER); BEGIN IF flags * {LAlt, RAlt, LCtrl, RCtrl, LShift, RShift} = {} THEN flags := flags / {lock} ELSE k := Translate(flags, c) 	END END LedKey; (* DisableInterrupts - Disable interrupts and return original flags state *) PROCEDURE -DisableInterrupts: SET; CODE {SYSTEM.i386} PUSHFD POP EAX CLI END DisableInterrupts; (* RestoreInterrupts - Set flags state to restore interrupts to previous state *) PROCEDURE -RestoreInterrupts(state: SET); CODE {SYSTEM.i386} POPFD END RestoreInterrupts; (* MapScanCode - Map a scan code "c" to a key code. *) PROCEDURE MapScanCode(c: CHAR): INTEGER; VAR k: INTEGER; oldleds, state: SET; BEGIN SendByte(64H, 0ADX); Wait;	(* disable keyboard *) k := -1; oldleds := flags * {ScrollLock, NumLock, CapsLock}; IF c = 0X THEN	(* overrun, ignore *) ELSIF c = 0FAX THEN	(* keyboard ack *) IF Resetting IN flags THEN EXCL(flags, Resetting); INCL(flags, SendingLEDs); SendByte(60H, 0EDX)	(* set keyboard LEDs *) ELSIF SendingLEDs IN flags THEN SendByte(60H, SYSTEM.VAL(CHAR, oldleds)); EXCL(flags, SendingLEDs) ELSIF SetTypematic IN flags THEN EXCL(flags, SetTypematic); INCL(flags, Resetting); SendByte(60H, 020X)	(* 30Hz, 500 ms *) ELSE (* assume ack was for something else *) END ELSIF c = 0FEX THEN	(* keyboard resend *) SendByte(lastport, lastvalue) ELSIF c = 038X THEN	(* Alt make *) ShiftKey(LAlt, RAlt, TRUE) ELSIF c = 01DX THEN	(* Ctrl make *) ShiftKey(LCtrl, RCtrl, TRUE) ELSIF c = 02AX THEN	(* LShift make *) INCL(flags, LShift) ELSIF c = 036X THEN	(* RShift make *) INCL(flags, RShift) ELSIF c = 05DX THEN	(* menu make *) INCL(flags, MenuShift) ELSIF c = 03AX THEN	(* Caps make *) LedKey(flags, CapsLock, c, k) 	ELSIF c = 046X THEN	(* Scroll make *) LedKey(flags, ScrollLock, c, k); state := DisableInterrupts; IF ScrollLock IN flags THEN IF Kernel.timer = NIL THEN Kernel.timer := timerproc END ELSE IF Kernel.timer = timerproc THEN Kernel.timer := NIL END END; RestoreInterrupts(state) ELSIF c = 045X THEN	(* Num make *) LedKey(flags, NumLock, c, k) 	ELSIF c = 0B8X THEN	(* Alt break *) ShiftKey(LAlt, RAlt, FALSE); IF (keyval >= 0) & (keyval &#60; 255) THEN k := keyval END;	(* exclude 255 - reboot *) keyval := -1 ELSIF c = 09DX THEN	(* Ctrl break *) ShiftKey(LCtrl, RCtrl, FALSE) ELSIF c = 0AAX THEN	(* LShift break *) EXCL(flags, LShift) ELSIF c = 0B6X THEN	(* RShift break *) EXCL(flags, RShift) ELSIF c = 0DDX THEN	(* menu break *) EXCL(flags, MenuShift) ELSIF (flags * {ScrollLock, GreyEsc} = {ScrollLock}) & (c >= 47X) & (c &#60;= 53X) & (c # 4AX) & (c # 4EX) THEN	(* key mouse *) INCL(kpmap, ORD(c)-47H) ELSIF c &#60; 080X THEN	(* Other make *) k := Translate(flags, c) 	ELSIF (flags * {ScrollLock, GreyEsc} = {ScrollLock}) & (c >= 0C7X) & (c &#60;= 0D3X) THEN	(* key mouse *) EXCL(kpmap, ORD(c)-0C7H) ELSE	(* ignore *) END; IF c = 0E0X THEN INCL(flags, GreyEsc) ELSE EXCL(flags, GreyEsc) END; IF flags * {ScrollLock, NumLock, CapsLock} # oldleds THEN INCL(flags, SendingLEDs); SendByte(60H, 0EDX)	(* set keyboard LEDs *) END; SendByte(64H, 0AEX);	(* enable keyboard *) RETURN k END MapScanCode; (* PROCEDURE -CS: LONGINT 	033H, 0C0H,	(* XOR EAX,EAX *) 	066H, 08CH, 0C8H;	(* MOV AX,CS *) *) PROCEDURE -CS: LONGINT; CODE {SYSTEM.i386} XOR EAX, EAX MOV AX, CS END CS; (* KeyboardInterrupt - Handle interrupts from keyboard *) PROCEDURE KeyboardInterrupt; VAR m: SET; c: CHAR;  k: INTEGER;  fp, esp, tmp, cs: LONGINT;  i: SHORTINT; BEGIN SYSTEM.PORTIN(060H, c);	(* get scan code *) SYSTEM.PORTIN(061H, SYSTEM.VAL(CHAR, m)); INCL(m, 7); SYSTEM.PORTOUT(061H, SYSTEM.VAL(CHAR, m)); EXCL(m, 7); SYSTEM.PORTOUT(061H, SYSTEM.VAL(CHAR, m));	(* ack *) SYSTEM.STI; k := MapScanCode(c); IF k = -2 THEN	(* break *) head := 0; tail := 0;	(* clear buffer *) IF ~Kernel.break THEN	(* first try: soft break *) Kernel.break := TRUE ELSIF ~Kernel.inGC THEN	(* second try: do hard break *) Kernel.break := FALSE;	(* cancel other break *) SYSTEM.GETREG(5, fp);	(* EBP *) SYSTEM.GET(fp+52, tmp);	(* get CS'&#39; *) cs := CS; IF tmp MOD 4 # cs MOD 4 THEN	(* we interrupted at different level *) (* assume we are currently on system stack *) (* simulate a CALL to breakproc *) SYSTEM.GET(fp+48, tmp);	(* save old EIP *) SYSTEM.PUT(fp+48, breakproc); SYSTEM.GET(fp+60, esp);	(* get outer ESP *) DEC(esp, 4); SYSTEM.PUT(fp+60, esp); SYSTEM.PUT(esp, tmp)	(* PUSH old EIP *) ELSE	(* we interrupted at same level *) (* simulate a JMP to breakproc *) SYSTEM.PUT(fp+48, breakproc) END END ELSIF k >= 0 THEN i := (tail+1) MOD BufSize; IF i # head THEN buffer&#91;1+tail] := CHR(k); tail := i 		END END END KeyboardInterrupt; (* InitKeyboard - Initialise the keyboard. *) PROCEDURE InitKeyboard; VAR s: SET; c: CHAR;  i: SHORTINT;  k: ARRAY 8 OF CHAR; BEGIN head := 0; tail := 0;  keyval := -1;  buffer&#91;0] := 0X; (* Get table *) Setting("Keyboard"); (* install interrupt *) flags := {}; Kernel.InstallIP(KeyboardInterrupt, Kernel.IRQ+1); (* clear the keyboard's internal buffer *) i := 8; LOOP SYSTEM.PORTIN(64H, SYSTEM.VAL(CHAR, s)); IF ~(0 IN s) OR (i = 0) THEN EXIT END; SYSTEM.PORTIN(60H, c);	(* read byte *) SYSTEM.PORTIN(61H, SYSTEM.VAL(CHAR, s)); INCL(s, 7); SYSTEM.PORTOUT(61H, SYSTEM.VAL(CHAR, s)); EXCL(s, 7); SYSTEM.PORTOUT(61H, SYSTEM.VAL(CHAR, s));	(* ack *) DEC(i) END; flags := {SetTypematic}; Kernel.GetConfig("NumLock", k); IF k&#91;0] = "1" THEN INCL(flags, NumLock) END; SendByte(60H, 0F3X)	(* settypedel, will cause Ack from keyboard *) END InitKeyboard; (* PS/2 aux port driver  *) PROCEDURE PollAux; VAR s: SET; t: Kernel.MilliTimer;  i: SHORTINT; BEGIN i := 10;	(* up to 0.2s! *) LOOP IF qp THEN SYSTEM.PORTIN(qpStatusPort, SYSTEM.VAL(CHAR, s)); IF (s * {QpRxFull, QpTxIdle, QpDevIdle} = {QpTxIdle, QpDevIdle}) OR (i = 0) THEN EXIT END; SYSTEM.PORTIN(qpStatusPort, SYSTEM.VAL(CHAR, s)); IF s * {QpRxFull} = {QpRxFull} THEN SYSTEM.PORTIN(qpDataPort, SYSTEM.VAL(CHAR, s)) END;	(* byte avail *) ELSE SYSTEM.PORTIN(64H, SYSTEM.VAL(CHAR, s)); IF (s * {0,1} = {}) OR (i = 0) THEN EXIT END; SYSTEM.PORTIN(64H, SYSTEM.VAL(CHAR, s)); IF s * {0,5} = {0,5} THEN SYSTEM.PORTIN(60H, SYSTEM.VAL(CHAR, s)) END;	(* byte avail *) END; Kernel.SetTimer(t, TimeUnit DIV 50);	(* 20ms *) REPEAT UNTIL Kernel.Expired(t); DEC(i) END END PollAux; PROCEDURE InAux: CHAR; VAR s: SET; ch: CHAR; t: Kernel.MilliTimer;  i: SHORTINT; BEGIN i := 10;	(* up to 0.2s! *) REPEAT IF qp THEN SYSTEM.PORTIN(qpStatusPort, SYSTEM.VAL(CHAR, s)); IF s * {QpRxFull} = {QpRxFull} THEN 	(* byte avail *) SYSTEM.PORTIN(qpDataPort, ch); RETURN ch 			END ELSE SYSTEM.PORTIN(64H, SYSTEM.VAL(CHAR, s)); IF s * {0,5} = {0,5} THEN 	(* byte avail *) SYSTEM.PORTIN(60H, ch); RETURN ch 			END END; Kernel.SetTimer(t, TimeUnit DIV 50);	(* 20ms *) REPEAT UNTIL Kernel.Expired(t); DEC(i); UNTIL i = 0; RETURN 0X END InAux; PROCEDURE WriteDev(b: CHAR); BEGIN IF qp THEN PollAux; SYSTEM.PORTOUT(qpDataPort, b) 	ELSE PollAux; SYSTEM.PORTOUT(64H, 0D4X);	(* aux data coming *) PollAux; SYSTEM.PORTOUT(60H, b) 	END END WriteDev; PROCEDURE WriteAck(b: CHAR); VAR s: SET; t: Kernel.MilliTimer;  i: SHORTINT; BEGIN WriteDev(b); i := 10;	(* up to 0.2s! *) LOOP IF qp THEN SYSTEM.PORTIN(qpStatusPort, SYSTEM.VAL(CHAR, s)); IF (s * {QpRxFull} = {QpRxFull}) OR (i = 0) THEN EXIT END; ELSE SYSTEM.PORTIN(64H, SYSTEM.VAL(CHAR, s)); IF (s * {0,5} = {0,5}) OR (i = 0) THEN EXIT END; END; Kernel.SetTimer(t, TimeUnit DIV 50);	(* 20ms *) REPEAT UNTIL Kernel.Expired(t); DEC(i) END; IF i # 0 THEN				(* byte avail *) IF qp THEN SYSTEM.PORTIN(qpDataPort, SYSTEM.VAL(CHAR, s)) ELSE SYSTEM.PORTIN(60H, SYSTEM.VAL(CHAR, s)) END END END WriteAck; PROCEDURE WriteCmd(b: CHAR); BEGIN ASSERT(~qp, 100); PollAux; SYSTEM.PORTOUT(64H, 60X); PollAux; SYSTEM.PORTOUT(60H, b) END WriteCmd; PROCEDURE AuxInterrupt; VAR c: CHAR; t: INTEGER; BEGIN IF qp THEN SYSTEM.PORTIN(qpDataPort, c);	(* read byte *) ELSE SYSTEM.PORTIN(60H, c);	(* read byte *) END; t := (auxtl+1) MOD AuxSize; IF t # auxhd THEN auxbuf&#91;auxtl] := c; auxtl := t 	ELSE INC(auxoverflows) END END AuxInterrupt; PROCEDURE SerialRead(port: LONGINT; VAR c: SYSTEM.BYTE); VAR state: SET; res: LONGINT; BEGIN IF port = AUX THEN REPEAT UNTIL auxhd # auxtl; state := DisableInterrupts; c := auxbuf&#91;auxhd]; auxhd := (auxhd+1) MOD AuxSize; RestoreInterrupts(state); res := 0 ELSE V24.Receive(port, c, res) END END SerialRead; PROCEDURE SerialWrite(port: LONGINT; c: SYSTEM.BYTE); VAR res: LONGINT; BEGIN IF port # AUX THEN V24.Send(port, c, res) END END SerialWrite; PROCEDURE SerialAvailable(port: LONGINT): LONGINT; VAR n: LONGINT; state: SET; BEGIN IF port = AUX THEN state := DisableInterrupts; n := auxtl-auxhd; RestoreInterrupts(state); IF n &#60; 0 THEN INC(n, AuxSize) END ELSIF port # NONE THEN n := V24.Available(port) ELSE n := 0 END; RETURN n END SerialAvailable; PROCEDURE StartAux; VAR state, status: SET; PROCEDURE SetRate(r: INTEGER); BEGIN WriteAck(0F3X); WriteAck(CHR(r)) END SetRate; BEGIN state := DisableInterrupts; auxhd := 0; auxtl := 0; RestoreInterrupts(state); IF ~auxinit THEN auxinit := TRUE; PollAux; IF qp THEN SYSTEM.PORTIN(qpStatusPort, SYSTEM.VAL(CHAR, status)); INCL(status, QpEnable + QpReset); SYSTEM.PORTOUT(qpStatusPort, SYSTEM.VAL(CHAR, status)); EXCL(status, QpReset); SYSTEM.PORTOUT(qpStatusPort, SYSTEM.VAL(CHAR, status)); ELSE SYSTEM.PORTOUT(64H, 0A8X);	(* enable aux *) END; (* enable MS Intellimouse 3rd button *) SetRate(200); SetRate(100); SetRate(80); SetRate(rate); WriteAck(0F2X); auxId := InAux; (*Ident*) WriteAck(0E8X); WriteAck(3X);	(* 8 counts/mm *) WriteAck(0E7X);	(* 2:1 scale *) PollAux; Kernel.InstallIP(AuxInterrupt, Kernel.IRQ+12); WriteDev(0F4X);	(* enable aux device *) IF qp THEN INCL(status, QpIntsOn); SYSTEM.PORTOUT(qpStatusPort, SYSTEM.VAL(CHAR, status)) ELSE WriteCmd(47X)	(* controller interrupts on *) END; PollAux END END StartAux; (* Mouse driver  *) (* SetSpeed - Set mouse speed *) PROCEDURE SetSpeed(old, new: LONGINT); VAR word, stop, par: INTEGER; c: CHAR;  res: LONGINT;  timer: Kernel.MilliTimer; BEGIN IF port # AUX THEN IF (oldport # NONE) & (oldport # AUX) THEN V24.Stop(oldport) END; oldport := port; CASE type OF 			MS: word := 7;  stop := V24.Stop1;  par := V24.ParNo | MSC1, MSC2, MSC3, MSC4: word := 8;  stop := V24.Stop2;  par := V24.ParNo | MM: word := 8;  stop := V24.Stop1;  par := V24.ParOdd | Logi: word := 8;  stop := V24.Stop2;  par := V24.ParNo | LogiMan: word := 7;  stop := V24.Stop1;  par := V24.ParNo | MSI: word := 7;  stop := V24.Stop1;  par := V24.ParNo END; IF (type = Logi) OR (type = LogiMan) THEN V24.Start(port, old, word, par, stop, res); IF res = V24.Ok THEN IF new = 9600 THEN c := "q" ELSIF new = 4800 THEN c := "p" ELSIF new = 2400 THEN c := "o" ELSE c := "n" END; SerialWrite(port, "*"); SerialWrite(port, c); Kernel.SetTimer(timer, TimeUnit DIV 10); REPEAT UNTIL Kernel.Expired(timer); V24.Stop(port) END END; V24.Start(port, new, word, par, stop, res); IF res = V24.Ok THEN V24.SetMC(port, {V24.DTR, V24.RTS}) END END END SetSpeed; (* InitMouse - Initialise mouse. 	"type" - mouse type from list 	"port" - V24.COM&#91;12], AUX 	"bps" - V24.BPS* 	"rate" - sample rate (not all mice support this) *) PROCEDURE InitMouse; VAR c: CHAR; timer: Kernel.MilliTimer; n: INTEGER; BEGIN port := newport; mouseErrors := 0; auxoverflows := 0; IF (oldport # NONE) & (oldport # AUX) THEN V24.Stop(oldport) END; oldport := NONE; IF port = AUX THEN StartAux; oldport := port ELSE IF type = LogiMan THEN SetSpeed(1200, 1200); SerialWrite(port, "*"); SerialWrite(port, "X"); SetSpeed(1200, bps) ELSE SetSpeed(9600, bps); SetSpeed(4800, bps); SetSpeed(2400, bps); SetSpeed(1200, bps); IF type = Logi THEN SerialWrite(port, "S"); type := MM;  SetSpeed(bps, bps);  type := Logi END; (* set sample rate *) IF rate &#60;= 0 THEN c := "O"	(* continuous - don't use *) ELSIF rate &#60;= 15 THEN c := "J"	(* 10 Hz *) ELSIF rate &#60;= 27 THEN c := "K"	(* 20 *) ELSIF rate &#60;= 42 THEN c := "L"	(* 35 *) ELSIF rate &#60;= 60 THEN c := "R"	(* 50 *) ELSIF rate &#60;= 85 THEN c := "M"	(* 70 *) ELSIF rate &#60;= 125 THEN c := "Q"	(* 100 *) ELSE c := "N"	(* 150 *) END; SerialWrite(port, c); IF type = MSC2 THEN V24.ClearMC(port, {V24.DTR, V24.RTS}) ELSIF type = MSC3 THEN V24.ClearMC(port, {V24.DTR}) ELSIF type = MSC4 THEN V24.ClearMC(port, {V24.RTS}) END END END; mbufp := 0; lastkeys := {}; (* protocol parameters *) CASE type OF 		MS: numb := 3;  mask0 := {6};  val0 := {6};  mask1 := {6};  val1 := {} | MSC1, MSC2, MSC3, MSC4: numb := 5;  mask0 := {3..7};  val0 := {7};  mask1 := {};  val1 := {} | MM: numb := 3;  mask0 := {5..7};  val0 := {7};  mask1 := {7};  val1 := {} | Logi: numb := 3;  mask0 := {5..7};  val0 := {7};  mask1 := {7};  val1 := {} | LogiMan: numb := 3;  mask0 := {6};  val0 := {6};  mask1 := {6};  val1 := {} | PS2: IF auxId # 0X THEN numb := 4 ELSE numb := 3 END; mask0 := {6,7}; val0 := {};  mask1 := {};  val1 := {} | MSI: numb := 4; mask0 := {6};  val0 := {6};  mask1 := {6};  val1 := {} END; (* ignore the first few bytes from the mouse (e.g. Logitech MouseMan Sensa) *) n := 4; REPEAT WHILE SerialAvailable(port) # 0 DO SerialRead(port, c) END; Kernel.SetTimer(timer, TimeUnit DIV n); DEC(n); (* wait 1/4s, 1/3s, 1/2s, 1s *) REPEAT UNTIL Kernel.Expired(timer); UNTIL (SerialAvailable(port) = 0) OR (n = 0); (* Lower/Raise DTR/RTS for autodetection, and to start an Intellimouse *) IF port # AUX THEN V24.ClearMC(port, {V24.DTR, V24.RTS}); Kernel.SetTimer(timer, TimeUnit DIV 4); REPEAT UNTIL Kernel.Expired(timer); V24.SetMC(port, {V24.DTR, V24.RTS}); Kernel.SetTimer(timer, TimeUnit DIV 4); REPEAT UNTIL Kernel.Expired(timer) END END InitMouse; (* GetMouseEvent - Read a mouse event *) PROCEDURE GetMouseEvent(VAR keys: SET; VAR dx, dy, dz: INTEGER): BOOLEAN; VAR b: SET; BEGIN WHILE SerialAvailable(port) > 0 DO 		b := {}; SerialRead(port, SYSTEM.VAL(CHAR, b)); (* check for resync *) IF (mbufp # 0) & (type # PS2) & ((b * mask1 # val1) OR (b = {7})) THEN mbufp := 0 END; IF (mbufp = 0) & (b * mask0 # val0) THEN (* skip package, unless it is a LogiMan middle button... *) IF ((type = MS) OR (type = LogiMan)) & (b * {2..4,6,7} = {}) THEN keys := lastkeys * {0,2}; IF 5 IN b THEN INCL(keys, 1) END; dx := 0; dy := 0; RETURN TRUE ELSE INC(mouseErrors) END ELSE mbuf&#91;mbufp] := b; INC(mbufp); IF mbufp = numb THEN CASE type OF 					MS, LogiMan: keys := lastkeys * {1}; IF 5 IN mbuf&#91;0] THEN INCL(keys, 2) END; IF 4 IN mbuf&#91;0] THEN INCL(keys, 0) END; dx := LONG(SYSTEM.VAL(SHORTINT, SYSTEM.LSH(mbuf&#91;0] * {0,1}, 6) + mbuf&#91;1] * {0..5})); dy := LONG(SYSTEM.VAL(SHORTINT, SYSTEM.LSH(mbuf&#91;0] * {2,3}, 4) + mbuf&#91;2] * {0..5})) | MSC1, MSC2, MSC3, MSC4: keys := {0..2} - (mbuf&#91;0] * {0..2}); dx := LONG(SYSTEM.VAL(SHORTINT, mbuf&#91;1])) + LONG(SYSTEM.VAL(SHORTINT, mbuf&#91;3])); dy := -(LONG(SYSTEM.VAL(SHORTINT, mbuf&#91;2])) + LONG(SYSTEM.VAL(SHORTINT, mbuf&#91;4]))) | MM, Logi: keys := mbuf&#91;0] * {0..2}; dx := SYSTEM.VAL(INTEGER, mbuf&#91;1]); IF ~(4 IN mbuf&#91;0]) THEN dx := -dx END; dy := SYSTEM.VAL(INTEGER, mbuf&#91;2]); IF 3 IN mbuf&#91;0] THEN dy := -dy END | PS2: keys := {}; IF 2 IN mbuf&#91;0] THEN INCL(keys, 1) END; IF 1 IN mbuf&#91;0] THEN INCL(keys, 0) END; IF 0 IN mbuf&#91;0] THEN INCL(keys, 2) END; dx := SYSTEM.VAL(INTEGER, mbuf&#91;1]); IF 4 IN mbuf&#91;0] THEN DEC(dx, 256) END; dy := -SYSTEM.VAL(INTEGER, mbuf&#91;2]); IF 5 IN mbuf&#91;0] THEN INC(dy, 256) END | MSI: keys := {}; IF 4 IN mbuf&#91;0] THEN INCL(keys, 0) END; IF 5 IN mbuf&#91;0] THEN INCL(keys, 2) END; IF 3 IN mbuf&#91;3] THEN INCL(keys, 3) END; IF 4 IN mbuf&#91;3] THEN INCL(keys, 1) END; IF ~(3 IN mbuf&#91;3]) & (mbuf&#91;3] * {0..2} # {}) THEN INCL(keys, 4) END; dx := LONG(SYSTEM.VAL(SHORTINT, SYSTEM.LSH(mbuf&#91;0] * {0,1}, 6) + mbuf&#91;1] * {0..7})); dy := LONG(SYSTEM.VAL(SHORTINT, SYSTEM.LSH(mbuf&#91;0] * {2,3}, 4) + mbuf&#91;2] * {0..7})) END; (* CASE *) mbufp := 0; RETURN TRUE END END END; keys := lastkeys; dx := 0;  dy := 0; RETURN FALSE END GetMouseEvent; (* Interface  *) (** Returns the number of keystrokes in the keyboard input buffer. *) PROCEDURE Available* : INTEGER; VAR state, keys: SET; p: KeyboardPoller; x: INTEGER; ch: CHAR; i: SHORTINT; BEGIN (* poll all extra keyboards *) p := keyboard; pollkeys := {}; WHILE p # NIL DO 		IF p.poll(ch, keys) THEN state := DisableInterrupts; i := (tail+1) MOD BufSize; IF i # head THEN buffer&#91;1+tail] := ch; tail := i 			END; RestoreInterrupts(state) END; pollkeys := pollkeys + keys; p := p.next END; (* check buffer *) state := DisableInterrupts; x := (tail-head) MOD BufSize; RestoreInterrupts(state); RETURN x END Available; (** Reads the current mouse position x, y and the key state of the mouse buttons (also called keys). The mouse buttons are numbered from the right to the left as  0, 1, 2 (i.e. 1 is the middle mouse button). For example, when the left and middle  buttons are pressed, keys will be set to {1, 2}. *) PROCEDURE Mouse*(VAR keys: SET; VAR x, y: INTEGER); VAR dx, dy, dz: INTEGER; ok: BOOLEAN;  mousekeys, rawkeys, state: SET; p: MousePoller; BEGIN IF Kernel.break THEN Kernel.break := FALSE; SYSTEM.HALT(13) END; IF ScrollLock IN flags THEN keys := {}; IF 11 IN kpmap THEN INCL(keys, 2) END; IF 5 IN kpmap THEN INCL(keys, 1) END; IF 12 IN kpmap THEN INCL(keys, 0) END; state := DisableInterrupts; INC(mouseX, LONG(kdx)); INC(mouseY, LONG(kdy)); kdx := 0; kdy := 0; RestoreInterrupts(state) ELSE REPEAT	(* get all available mouse events, or until keys change *) p := mouse; rawkeys := {}; ok := FALSE; WHILE p # NIL DO	(* poll all mice and sum keys and movements *) IF p.poll(mousekeys, dx, dy, dz) THEN ok := TRUE; rawkeys := rawkeys + mousekeys; IF (ABS(dx) > threshold) OR (ABS(dy) > threshold) THEN dx := SHORT(dx*speedup DIV 10); dy := SHORT(dy*speedup DIV 10) END; INC(mouseX, LONG(dx)); INC(mouseY, LONG(dy)) END; p := p.next END UNTIL ~ok OR (rawkeys # lastkeys); IF ok THEN IF ~(1 IN lastkeys) & (1 IN rawkeys) THEN	(* mouse generated middle button *) IF buttons = -3 THEN buttons := 3 END	(* switch off emulation *) END; lastkeys := rawkeys	(* save last known mouse key state *) ELSE rawkeys := lastkeys	(* restore last known mouse key state *) END; IF MenuShift IN flags THEN	(* menu key emulates middle button *) INCL(rawkeys, 1); IF buttons = -3 THEN buttons := 3 END	(* switch off emulation *) END; (* middle button emulation *) IF buttons # 3 THEN	(* -2, 2, -3 *) IF buttons = 2 THEN	(* 2 => Ctrl is middle button *) IF flags * {LCtrl, RCtrl} # {} THEN INCL(rawkeys, 1) ELSE EXCL(rawkeys, 1) END ELSE	(* -2 OR -3 => MM OR Ctrl is middle button *) IF flags * {LCtrl, RCtrl} # {} THEN INCL(rawkeys, 1) END END END; (* key mapping *) keys := mapkeys&#91;SYSTEM.VAL(LONGINT, rawkeys * {0,1,2})] END; IF mouseX &#60; minX THEN mouseX := minX ELSIF mouseX > maxX THEN mouseX := maxX END; IF mouseY &#60; minY THEN mouseY := minY ELSIF mouseY > maxY THEN mouseY := maxY END; x := SHORT(mouseX); y := SHORT(height-1-mouseY) END Mouse; (** Read a character from the keyboard buffer. Blocks if no character is available. *) PROCEDURE Read*(VAR ch: CHAR); VAR state: SET; BEGIN REPEAT (* skip *) UNTIL (Available # 0) OR Kernel.break; IF Kernel.break THEN Kernel.break := FALSE; SYSTEM.HALT(13) END; state := DisableInterrupts; ch := buffer&#91;1+head]; head := (head+1) MOD BufSize; RestoreInterrupts(state) END Read; (** Returns the elapsed number of timer ticks from Oberon startup. *) PROCEDURE Time*: LONGINT; BEGIN IF Kernel.break THEN Kernel.break := FALSE; SYSTEM.HALT(13) END; RETURN Kernel.GetTimer END Time; (** Return the state of the shift keys. *) PROCEDURE KeyState*(VAR keys: SET); BEGIN keys := pollkeys; IF flags * {LAlt, RAlt} # {} THEN INCL(keys, ALT) END; IF flags * {LCtrl, RCtrl} # {} THEN INCL(keys, CTRL) END; IF flags * {LShift, RShift} # {} THEN INCL(keys, SHIFT) END END KeyState; (** Restricts the extent of the mouse coordinates returned by Mouse. *) PROCEDURE SetMouseLimits*(x, y, w, h: INTEGER);	(** non-portable *) BEGIN IF height = 0 THEN height := h END; y := SHORT(height-1) - y; 	minX := x; maxY := y;  maxX := x + w-1;  minY := y - (h-1); mouseX := minX + (maxX-minX) DIV 2; mouseY := minY + (maxY-minY) DIV 2 END SetMouseLimits; PROCEDURE SetMouseType(s: ARRAY OF CHAR); BEGIN type := MinType-1; IF (s&#91;0] >= "0") & (s&#91;0] &#60;= "9") THEN	(* old style config *) type := SHORT(ORD(s&#91;0])-ORD("0")) ELSE	(* new style config *) IF s = "" THEN (* default if none specified *) ELSIF (CAP(s&#91;0]) = "L") & (CAP(s&#91;1]) = "M") THEN	(* Logitech *) CASE s&#91;2] OF 				"1": type := LogiMan |"2": type := MM 				|"3": type := Logi END ELSIF (CAP(s&#91;0]) = "M") & (CAP(s&#91;1]) = "S") THEN	(* Mouse Systems or Microsoft *) IF CAP(s&#91;2]) = "M" THEN type := MS 			ELSIF CAP(s&#91;2]) = "I" THEN type := MSI ELSE CASE s&#91;2] OF 					"1": type := MSC1 |"2": type := MSC2 |"3": type := MSC3 |"4": type := MSC4 END END ELSIF CAP(s&#91;0]) = "P" THEN	(* PS/2 *) type := PS2 END END; IF (type &#60; MinType) OR (type > MaxType) THEN type := PS2 END;	(* unknown mouse type *) IF type = PS2 THEN newport := AUX END; IF Trace THEN Kernel.WriteString("MouseType="); Kernel.WriteInt(type, 1); Kernel.WriteChar(" "); Kernel.WriteInt(newport, 1); Kernel.WriteLn END; InitMouse END SetMouseType; PROCEDURE Read710(adr: CHAR; VAR x: CHAR); BEGIN SYSTEM.PORTOUT(390H, adr); SYSTEM.PORTIN(391H, x) END Read710; PROCEDURE Detect82C710; VAR x: CHAR; BEGIN SYSTEM.PORTOUT(2FAH, 55X); SYSTEM.PORTOUT(3FAH, 0AAX); SYSTEM.PORTOUT(3FAH, 36X); SYSTEM.PORTOUT(3FAH, 0E4X); SYSTEM.PORTOUT(2FAH, 1BX); Read710(0FX, x); qp := x = 0E4X; IF qp THEN Read710(0DX, x); qpDataPort := ORD(x)*4; qpStatusPort := qpDataPort+1; SYSTEM.PORTOUT(390H, 0FX); SYSTEM.PORTOUT(391H, 0FX) END END Detect82C710; (* InitMouse lowered and raised DTR/RTS - place result in KBD buffer (ugh!) *) PROCEDURE DetectMouse; VAR state: SET; i: SHORTINT; res: LONGINT; ch: CHAR; BEGIN IF port = AUX THEN Detect82C710 ELSE LOOP IF V24.Available(port) = 0 THEN EXIT END; state := DisableInterrupts; i := (tail+1) MOD BufSize; IF i = head THEN RestoreInterrupts(state); EXIT END; V24.Receive(port, ch, res); IF ch >= 80X THEN ch := CHR(ORD(ch)-80H) END; buffer&#91;1+tail] := ch; tail := i; 			RestoreInterrupts(state) END END END DetectMouse; (** Configure input device parameters. Normally only used by installation program. *) PROCEDURE Configure*(config, value: ARRAY OF CHAR);	(** non-portable *) VAR mk: ARRAY 3 OF LONGINT; kt: KeyTable; state: SET; i: SHORTINT; BEGIN IF Trace THEN Kernel.WriteString("Input: "); Kernel.WriteString(config);  Kernel.WriteChar("="); Kernel.WriteString(value); Kernel.WriteLn END; IF config = "MT" THEN	(* mouse type *) SetMouseType(value); DetectMouse ELSIF config = "MTX" THEN	(* mouse type explicit *) SetMouseType(value) ELSIF config = "MP" THEN	(* mouse port *) IF (value&#91;0] >= "1") & (value&#91;0] &#60;= "4") THEN newport := V24.COM1 + (ORD(value&#91;0])-ORD("1")) ELSE newport := V24.COM1 END ELSIF config = "MB" THEN	(* mouse buttons *) IF value = "2" THEN buttons := 2 ELSIF value = "3" THEN buttons := 3 ELSIF value = "-2" THEN buttons := -2 ELSE buttons := -3	(* default MM and Ctrl *) END ELSIF config = "MM" THEN	(* mouse key remapping *) mk&#91;0] := 0; mk&#91;1] := 1;  mk&#91;2] := 2; IF value&#91;0] # 0X THEN mk&#91;0] := ORD(value&#91;0])-48; IF value&#91;1] # 0X THEN mk&#91;1] := ORD(value&#91;1])-48; IF value&#91;2] # 0X THEN mk&#91;2] := ORD(value&#91;2])-48 END END END; FOR i := 0 TO 7 DO 			mapkeys&#91;i] := {}; IF 0 IN SYSTEM.VAL(SET, i) THEN INCL(mapkeys&#91;i], mk&#91;0]) END; IF 1 IN SYSTEM.VAL(SET, i) THEN INCL(mapkeys&#91;i], mk&#91;1]) END; IF 2 IN SYSTEM.VAL(SET, i) THEN INCL(mapkeys&#91;i], mk&#91;2]) END END ELSIF config = "Keyboard" THEN i := 0; WHILE (value&#91;i] # 0X) & (value&#91;i] # ".") DO INC(i) END; IF value&#91;i] = "." THEN kt := TableFromFile(value) ELSE kt := NIL END; (* atomically set the table *) state := DisableInterrupts; IF kt = NIL THEN table := TableUS ELSE keytable := kt; table := SYSTEM.ADR(kt&#91;0]) END; dkey := 0; RestoreInterrupts(state) ELSE IF Trace THEN Kernel.WriteString("Unknown setting"); Kernel.WriteLn END END END Configure; (** Add a mouse driver. The poll procedure will be called from Mouse and should return the next mouse event, including the current key state.  It returns TRUE iff a mouse event is available. *) PROCEDURE AddMouse*(poll: PollMouse);	(** non-portable *) VAR n: MousePoller; BEGIN NEW(n); n.poll := poll; n.next := mouse; mouse := n END AddMouse; (** Remove a mouse driver. *) PROCEDURE RemoveMouse*(poll: PollMouse);	(** non-portable *) VAR p, n: MousePoller; BEGIN p := NIL; n := mouse; WHILE (n # NIL) & (n.poll # poll) DO p := n; n := n.next END; IF n # NIL THEN IF p = NIL THEN mouse := n.next ELSE p.next := n.next END END END RemoveMouse; (** Add a keyboard driver. The poll procedure will be called from Available and Read and should return the next ASCII character.  It returns TRUE iff a key is available.  The current shift state (SHIFT, CTRL, ALT) should always be returned, and will be added to KeyState. *) PROCEDURE AddKeyboard*(poll: PollKeyboard);	(** non-portable *) VAR n: KeyboardPoller; BEGIN NEW(n); n.poll := poll; n.next := keyboard; keyboard := n END AddKeyboard; (** Remove a keyboard driver. *) PROCEDURE RemoveKeyboard*(poll: PollKeyboard);	(** non-portable *) VAR p, n: KeyboardPoller; BEGIN p := NIL; n := keyboard; WHILE (n # NIL) & (n.poll # poll) DO p := n; n := n.next END; IF n # NIL THEN IF p = NIL THEN keyboard := n.next ELSE p.next := n.next END END END RemoveKeyboard; PROCEDURE Setting(name: ARRAY OF CHAR); VAR s: ARRAY 32 OF CHAR; BEGIN Kernel.GetConfig(name, s); Configure(name, s) END Setting; PROCEDURE ConfigMouse; VAR s: ARRAY 16 OF CHAR; i: SHORTINT; BEGIN (* boot-time settings *) Kernel.GetConfig("MouseBPS", s); IF s = "9600" THEN bps := 9600 ELSE bps := 1200 END; (* rate *) Kernel.GetConfig("MouseRate", s); rate := 0; i := 0; WHILE s&#91;i] # 0X DO rate := rate*10+ORD(s&#91;i])-48; INC(i) END; IF (rate &#60;= 0) OR (rate > 150) THEN rate := 100 END; (* threshold *) Kernel.GetConfig("Threshold", s); threshold := 0; i := 0; WHILE s&#91;i] # 0X DO threshold := threshold*10+ORD(s&#91;i])-48; INC(i) END; IF threshold &#60;= 0 THEN threshold := 5 END; (* speedup *) Kernel.GetConfig("Speedup", s); speedup := 0; i := 0; WHILE s&#91;i] # 0X DO speedup := speedup*10+ORD(s&#91;i])-48; INC(i) END; IF speedup &#60;= 0 THEN speedup := 15 END; Setting("MP"); Setting("MB");  Setting("MM"); Setting("MT")	(* also calls InitMouse *) END ConfigMouse; PROCEDURE *UnsafeBreak; VAR note1, note2, note3: ARRAY 32 OF CHAR; BEGIN note1 := "Warning: Interrupting a module"; note2 := "may invalidate its invariants"; note3 := "and make it unstable."; SYSTEM.HALT(13) END UnsafeBreak; PROCEDURE *Timer; VAR i: INTEGER; BEGIN IF counter1 = TimeUnit DIV 100 THEN counter1 := 0; IF kpmap * {0..2, 4, 6, 8..10} = {} THEN counter0 := 0 ELSIF counter0 &#60; 100 THEN INC(counter0) END; i := counter0 DIV (100 DIV 12)+1; IF kpmap * {0,4,8} # {} THEN DEC(kdx, i) END; IF kpmap * {0,1,2} # {} THEN DEC(kdy, i) END; IF kpmap * {2,6,10} # {} THEN INC(kdx, i) END; IF kpmap * {8,9,10} # {} THEN INC(kdy, i) END ELSE INC(counter1) END END Timer; BEGIN mouse := NIL; keyboard := NIL; pollkeys := {}; AddMouse(GetMouseEvent); timerproc := Timer; kpmap := {};  kdx := 0;  kdy := 0;  counter0 := 0; maxX := 0; height := 0; breakproc := UnsafeBreak; InitKeyboard; (* initialise mouse state *) oldport := NONE; auxinit := FALSE; ConfigMouse END Input. (** Remarks: 1. Keyboard character codes correspond to the ASCII character set. Some other important codes are: 	F1, SETUP	0A4X 	F2, NEUTRALISE	0A5X 	F3, SCRL	0A6X	(used in Draw) 	F4, NOSCRL	0A7X	(used in Draw) 	UP ARROW	0C1X 	RIGHT ARROW	0C3X 	DOWN ARROW	0C2X 	LEFT ARROW	0C4X 	INSERT	0A0X 	DELETE	0A1X 	PAGE-UP	0A2X 	PAGE-DOWN	0A3X 	&#228;, &#196;	131, 128 	&#245;, &#213;	132, 129 	&#252;, &#220;	133, 130 	&#223;	150 The module EditKeys allows you to determine the keyboard code of any key pressed.  For cross-platform portability, Oberon does not normally support all keys available  on your keyboard. *)