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