language-Modula2-0.1: examples/Modula-2_Libraries/PMOS/sources/general/keyboard.mod
IMPLEMENTATION MODULE Keyboard;
(****************************************************************)
(* *)
(* Keyboard Input *)
(* *)
(* Programmer: P. Moylan *)
(* Last edited: 9 March 1995 *)
(* Status: *)
(* Basic operations are working. *)
(* Known shortcomings: *)
(* Some special combinations - e.g. break, printscreen, *)
(* scroll lock - not yet handled. *)
(* The F11 and F12 keys of the extended keyboard are not *)
(* yet handled. *)
(* Known faults: *)
(* When several keys are hit together, spurious characters *)
(* can result, e.g. the <shift>ER combination produces a *)
(* spurious "|". Tests so far suggest that this is a *)
(* fault in the keyboard controller rather than in my *)
(* software. *)
(* On some machines, get a spurious NMI (INT 2) on startup.*)
(* *)
(****************************************************************)
(************************************************************************)
(* *)
(* This module is rather more complicated than a typical keyboard *)
(* input routine, because the keyboard I'm using does not directly *)
(* return standard character codes. Rather, it returns codes known as *)
(* "scan codes", and each keypress generates two codes, one on *)
(* pressing the key and one on releasing it. Module KBdriver picks up *)
(* the scan codes, the present module translates scan codes to ASCII *)
(* codes. In principle we can detect things like several keys held *)
(* down together, but in fact this module does not bother dealing with *)
(* such cases except when one of the keys is a shift key or something *)
(* similar. (Software which wants to give special meanings to *)
(* multi-key combinations should bypass this module and call KBdriver *)
(* to get the scan codes directly). *)
(* *)
(* The code for a key release is the same as the code for a key press *)
(* except that the high order bit is set. (In fact, it's slightly *)
(* more complicated than that; the keyboard generates a two-byte code *)
(* for a key release, but the keyboard controller turns this into a *)
(* one-byte code before the software gets to see it.) We can *)
(* afford to ignore all key releases except for those for the shift, *)
(* alt, and control keys. The Caps Lock and Num Lock keys also *)
(* require special handling. *)
(* *)
(* To allow the keyboard user to type ahead, this module contains a *)
(* task which puts characters into a circular buffer, where they are *)
(* kept until picked up by a call to InKey. (There are already *)
(* type-ahead facilities in module KBdriver, and also in the keyboard *)
(* hardware itself; but we might as well be generous to the user, and *)
(* in any case having a separate keyboard task instead of doing the *)
(* scan code translations in the user task simplifies some aspects of *)
(* the software design, because of the way that getting one character *)
(* can involve looking at several successive scan codes). *)
(* *)
(* As a protection against deadlock, there is a timeout on the *)
(* "circular buffer full" condition. If the buffer remains full for *)
(* too long, the oldest character in the buffer is discarded to make *)
(* room for the newest character. *)
(* *)
(************************************************************************)
FROM SYSTEM IMPORT
(* type *) BYTE;
FROM LowLevel IMPORT
(* type *) IAND, IOR;
FROM CircularBuffers IMPORT
(* type *) CircularBuffer,
(* proc *) CreateBuffer, PutBufferImpatient, GetBuffer, BufferEmpty;
FROM KBdriver IMPORT
(* const *) ScrollLockLED, NumLockLED, CapsLockLED,
(* proc *) GetScanCode, ClearLED, ToggleLED;
(*FROM SoundEffects IMPORT
(* const *) Beep;
*)
FROM Semaphores IMPORT
(* proc *) CreateSemaphore, Wait, Signal;
FROM TaskControl IMPORT
(* proc *) CreateTask, NotUsingFloatingPoint;
FROM TerminationControl IMPORT
(* proc *) SetTerminationProcedure, Crash;
(************************************************************************)
(* TRANSLATION TABLES *)
(************************************************************************)
(* Note: in all of these tables a code of 0 means "no code". Some *)
(* of the keys in question are handled as special cases which do *)
(* not require table lookup. Others are simply cases where no *)
(* function has been assigned to the key in question. *)
CONST
F1code = BYTE(3BH); (* Scan code for F1 function key *)
Delcode = BYTE(53H); (* Scan code for Del on numeric keypad *)
TYPE
(* NormalCodeRange is the range of scan codes handled by our main *)
(* translation tables. Scan codes outside this range can in fact *)
(* occur, but they are treated separately. *)
NormalCodeRange = [BYTE(0)..BYTE(035H)];
Table1 = ARRAY NormalCodeRange OF BYTE;
Table2 = ARRAY [F1code..Delcode] OF BYTE;
(* Remark: the declarations below are not standard Modula-2. In *)
(* fact I'm not sure how to declare an array of constants in *)
(* standard Modula-2, but the compiler I use accepts this. *)
CONST LowerCase = Table1 (
(* Nul Esc 123456 *) 00, 27, 49, 50, 51, 52, 53, 54,
(* 7890-= Bsp Tab *) 55, 56, 57, 48, 45, 61, 08, 09,
(* qwertyui *) 113,119,101,114,116,121,117,105,
(* op[] Enter Ctrl as *) 111,112, 91, 93, 13, 00, 97,115,
(* dfghjkl; *) 100,102,103,104,106,107,108, 59,
(* '` Lshift \zxcv *) 39, 96, 0, 92,122,120, 99,118,
(* bnm,./ *) 98,110,109, 44, 46, 47 );
CONST UpperCase = Table1 (
(* Nul Esc !@#$%^ *) 00, 27, 33, 64, 35, 36, 37, 94,
(* &*()_+ Bsp Tab *) 38, 42, 40, 41, 95, 43, 08, 09,
(* QWERTYUI *) 81, 87, 69, 82, 84, 89, 85, 73,
(* OP{} Enter Ctrl AS *) 79, 80,123,125, 10, 00, 65, 83,
(* DFGHJKL: *) 68, 70, 71, 72, 74, 75, 76, 58,
(* "~ Lshift |ZXCV *) 34,126, 0,124, 90, 88, 67, 86,
(* BNM<>? *) 66, 78, 77, 60, 62, 63 );
(* The following three tables handle the function keys F1..F10 and *)
(* the numeric keypad keys. They do not cover F11 and F12, which *)
(* exist only on some keyboards. *)
CONST KeypadTable = Table2 (
(* F1F2F3F4F5 *) 59,60,61,62,63,
(* F6F7F8F9F10 Num Scr Home *) 64,65,66,67,68,00,00,71,
(* Up Pgup - Lft Mid Rgt + End *) 72,73,45,75,76,77,43,79,
(* Dn Pgdn Ins Del *) 80,81,82,83);
CONST ShiftedKeypadTable = Table2 (
(* F1F2F3F4F5 *) 84,85,86,87,88,
(* F6F7F8F9F10 Num Scr 7 *) 89,90,91,92,93,00,00,55,
(* 89-456+1 *) 56,57,45,52,53,54,43,49,
(* 230. *) 50,51,48,46);
CONST CtrlKeypadTable = Table2 (
(* F1F2F3F4F5 *) 94,95,96,97,98,
(* F6F7F8F9F10 Num Scr 7 *) 99,100,101,102,103,00,00,119,
(* 89-456+1 *) 00,132,45,115,00,116,43,117,
(* 230. *) 00,118,00,00);
(* Some of the entries in this last table are, I admit, somewhat *)
(* illogical. My only excuse is that I have tried to be compatible *)
(* with existing software for this machine. *)
(************************************************************************)
(* THE 'HOT KEY' TABLES *)
(************************************************************************)
TYPE CharSet = SET OF CHAR;
VAR HotKeys, HotFunctionKeys: CharSet;
HotKeySemaphore: ARRAY CHAR OF Semaphore;
HotFunctionKeySemaphore: ARRAY CHAR OF Semaphore;
(************************************************************************)
(* THE CHARACTER BUFFER *)
(************************************************************************)
CONST
CharBufferSize = 8;
VAR
(* CharBuffer is a circular buffer holding characters. *)
CharBuffer: CircularBuffer;
(* The state of the three "lock" conditions. *)
CapsLock, NumLock, ScrollLock: BOOLEAN;
(* A semaphore to signal the Ctrl/Alt/Del combination. *)
CtrlAltDel: Semaphore;
(************************************************************************)
(* THE TRANSLATION TASK *)
(************************************************************************)
PROCEDURE PutCode (FunctionKey: BOOLEAN; code: CHAR);
BEGIN
IF FunctionKey THEN
IF code IN HotFunctionKeys THEN
Signal (HotFunctionKeySemaphore[code]);
ELSE
PutBufferImpatient (CharBuffer, CHR(0), 2000);
PutBufferImpatient (CharBuffer, code, 2000);
END (*IF*);
ELSE
IF code IN HotKeys THEN
Signal (HotKeySemaphore[code]);
ELSE
PutBufferImpatient (CharBuffer, code, 2000);
END (*IF*);
END (*IF*);
END PutCode;
(************************************************************************)
PROCEDURE TranslationTask;
(* This procedure, which is run as a separate task, picks up the *)
(* scan codes and turns them into ASCII codes. *)
CONST
(* Scan codes for some special keys. *)
SpaceCode = BYTE(39H); (* space bar *)
KeypadStarCode = BYTE(37H); (* "*" on numeric keypad *)
LeftShiftCode = BYTE(2AH); (* left shift key *)
RightShiftCode = BYTE(36H); (* right shift key *)
LeftShiftRelease = BYTE(0AAH); (* left shift key release *)
RightShiftRelease = BYTE(0B6H); (* right shift key release *)
CtrlCode = BYTE(1DH); (* ctrl key *)
CtrlRelease = BYTE(9DH); (* ctrl key release *)
AltCode = BYTE(38H); (* alt key *)
AltRelease = BYTE(0B8H); (* alt key release *)
CapsLockCode = BYTE(3AH); (* caps lock key *)
CapsLockRelease = BYTE(0BAH); (* caps lock key release *)
NumLockCode = BYTE(45H); (* num lock key *)
NumLockRelease = BYTE(0C5H); (* num lock key release *)
InsCode = BYTE(52H); (* Ins key *)
LostCode = BYTE(0FFH); (* lost keypress *)
TYPE CharSet = SET OF CHAR;
VAR scancode: BYTE; result: CHAR;
ShiftKeyIsDown, CtrlKeyIsDown, AltKeyIsDown: BOOLEAN;
CapsLockKeyIsDown, NumLockKeyIsDown: BOOLEAN;
(********************************************************************)
(* The main body of TranslationTask starts here *)
(********************************************************************)
BEGIN
NotUsingFloatingPoint;
ShiftKeyIsDown := FALSE; CtrlKeyIsDown := FALSE;
AltKeyIsDown := FALSE; CapsLockKeyIsDown := FALSE;
NumLockKeyIsDown := FALSE;
LOOP (*FOREVER*)
scancode := GetScanCode();
IF scancode = LostCode THEN
(*Beep*);
(* Check for the shift, ctrl, and alt keys. *)
ELSIF (scancode = LeftShiftCode)
OR (scancode = RightShiftCode) THEN
ShiftKeyIsDown := TRUE;
ELSIF (scancode = LeftShiftRelease)
OR (scancode = RightShiftRelease) THEN
ShiftKeyIsDown := FALSE;
ELSIF scancode = CtrlCode THEN
CtrlKeyIsDown := TRUE;
ELSIF scancode = CtrlRelease THEN
CtrlKeyIsDown := FALSE;
ELSIF scancode = AltCode THEN
AltKeyIsDown := TRUE;
ELSIF scancode = AltRelease THEN
AltKeyIsDown := FALSE;
(* The Caps Lock key is a bit harder to deal with. If the *)
(* user holds it down it will auto-repeat, and we don't *)
(* want this repeating to toggle the Caps Lock state. *)
ELSIF scancode = CapsLockCode THEN
IF NOT CapsLockKeyIsDown THEN
CapsLock := NOT CapsLock;
CapsLockKeyIsDown := TRUE;
ToggleLED (CapsLockLED);
END (*IF*);
ELSIF scancode = CapsLockRelease THEN
CapsLockKeyIsDown := FALSE;
(* The Num Lock key is treated similarly to Caps Lock. *)
ELSIF scancode = NumLockCode THEN
IF NOT NumLockKeyIsDown THEN
NumLock := NOT NumLock;
NumLockKeyIsDown := TRUE;
ToggleLED (NumLockLED);
END (*IF*);
ELSIF scancode = NumLockRelease THEN
NumLockKeyIsDown := FALSE;
(* All other codes with the high order bit set can be *)
(* ignored, as they are either key releases which we don't *)
(* need to know about, or they are the "E0" or "E1" codes *)
(* for the extended keyboard, which are not given special *)
(* treatment in this version. *)
ELSIF scancode >= BYTE(80H) THEN
(* Do nothing *)
(* The space bar and the keypad "*" are treated separately, *)
(* because their scan codes fall outside the range of our *)
(* translation tables. *)
ELSIF scancode = SpaceCode THEN
PutCode (FALSE, " ");
ELSIF scancode = KeypadStarCode THEN
PutCode (FALSE, "*");
(* The "normal" case is where the scan code is within the *)
(* range of our translation tables. In this case we do a *)
(* table lookup, although the result will be affected by *)
(* the state of the various shift keys. *)
ELSIF scancode <= BYTE(MAX(NormalCodeRange)) THEN
IF ShiftKeyIsDown THEN
result := UpperCase[scancode];
IF CapsLock AND (result IN CharSet{"A".."Z"}) THEN
result := LowerCase[scancode];
END (*IF*);
ELSE
result := LowerCase[scancode];
IF CapsLock AND (result IN CharSet{"a".."z"}) THEN
result := UpperCase[scancode];
END (*IF*);
END (*IF*);
(* If the Ctrl key is pressed, strip off the three high *)
(* order bits of the character code. *)
IF CtrlKeyIsDown THEN
result := CHR (IAND(ORD(result), 1FH));
END (*IF*);
(* If the Alt key is pressed, set the high order bit of *)
(* the character code. In this we differ from the *)
(* convention used by other software for this machine; *)
(* but it seems to me to be a useful facility, in that *)
(* it gives a simple way of generating the extended *)
(* characters supported by the screen hardware. *)
IF AltKeyIsDown THEN
result := CHR (IOR(ORD(result), 80H));
END (*IF*);
PutCode (FALSE, result);
(* Check for the numeric keypad and function keys. In the *)
(* unshifted state, these produce a two-byte result, of *)
(* which the first byte is 0. However, the result is *)
(* affected by the Ctrl, Shift, and Num Lock keys. *)
(* Special case: the Ctrl/Alt/Del combination is a reset. *)
(* To make this work under OS/2 (which intercepts this *)
(* combination before we get to see it, and which uses it *)
(* to cause a total system crash), we allow Ctrl/Alt/Ins *)
(* as an alternative. *)
ELSIF (scancode >= F1code) AND (scancode <= Delcode) THEN
IF CtrlKeyIsDown THEN
IF ((scancode = Delcode) OR (scancode = InsCode))
AND AltKeyIsDown THEN
Signal (CtrlAltDel); result := CHR(0);
ELSE
result := CtrlKeypadTable[scancode]
END (*IF*);
ELSIF NumLock = ShiftKeyIsDown THEN
result := KeypadTable[scancode];
ELSE
result := ShiftedKeypadTable[scancode]
END (*IF*);
(* If the result is a numeric or punctuation character, *)
(* we produce a simple one-byte result. The keys which *)
(* give a two-byte code always have the second byte *)
(* greater than or equal to ";". Key combinations *)
(* which do not produce anything are given a code of 0 *)
(* in the tables. *)
IF result >= ";" THEN
PutCode (TRUE, result);
ELSIF result <> CHR(0) THEN
PutCode (FALSE, result);
END (*IF*);
(* In the case of a code not known to us, return a "?" to *)
(* indicate that something unexpected happened. *)
ELSIF scancode >= BYTE(MAX(NormalCodeRange)) THEN
PutCode (FALSE, "?");
END (*IF*);
END (*LOOP*);
END TranslationTask;
(************************************************************************)
(* THE PUTBACK BUFFER *)
(************************************************************************)
MODULE PutBackBuffer;
(* Implementation of the PutBack procedure poses some awkward *)
(* problems, to the point where it would not be worth implementing *)
(* if it were not such a useful operation. The obvious solution, *)
(* of stuffing characters back into the character buffer, creates *)
(* deadlock if we try to avoid losing characters, and creates some *)
(* critical section problems even if we accept the risk of losing *)
(* characters. The critical section problems can easily be solved, *)
(* but only at the cost of making input less efficient, and this *)
(* is hard to justify given that PutBack operations will typically *)
(* be infrequent. (That is, it is undesirable to cripple the *)
(* "normal" case just for the sake of supporting a special case *)
(* which accounts for just a small proportion of total operations). *)
(* The solution adopted in this version is to have a separate data *)
(* structure to hold the characters which are put back. These *)
(* characters are held in a "lossy stack" - we discard the oldest *)
(* datum whenever the stack is going to overflow. *)
EXPORT
(* var *) NoCharsSaved,
(* proc *) Push, Pop;
CONST
stacksize = 8;
VAR
NoCharsSaved: BOOLEAN;
stackptr: [0..stacksize];
stack: ARRAY [1..stacksize] OF CHAR;
(********************************************************************)
PROCEDURE Push (ch: CHAR);
(* Pushes ch onto the stack. If the stack is already full, the *)
(* character at the bottom of the stack is lost. *)
VAR j: [1..stacksize];
BEGIN
IF stackptr = stacksize THEN
FOR j := 1 TO stacksize-1 DO
stack[j] := stack[j+1];
END (*FOR*);
stack[stacksize] := ch;
ELSE
INC (stackptr); stack[stackptr] := ch;
NoCharsSaved := FALSE;
END (*IF*);
END Push;
(********************************************************************)
PROCEDURE Pop(): CHAR;
(* Returns the character from the top of the stack. *)
VAR result: CHAR;
BEGIN
result := stack[stackptr]; DEC(stackptr);
NoCharsSaved := stackptr = 0;
RETURN result;
END Pop;
(********************************************************************)
BEGIN
NoCharsSaved := TRUE;
stackptr := 0;
END PutBackBuffer;
(************************************************************************)
(* THE EXTERNALLY CALLABLE INPUT PROCEDURES *)
(************************************************************************)
PROCEDURE KeyPressed(): BOOLEAN;
(* Returns TRUE iff a character is available. *)
BEGIN
IF NoCharsSaved THEN RETURN NOT BufferEmpty (CharBuffer)
ELSE RETURN TRUE
END (*IF*);
END KeyPressed;
(************************************************************************)
PROCEDURE InKey(): CHAR;
(* Reads one key from the circular buffer, or from the putback *)
(* buffer if any characters have been put back. *)
BEGIN
IF NoCharsSaved THEN RETURN GetBuffer (CharBuffer)
ELSE RETURN Pop()
END (*IF*);
END InKey;
(************************************************************************)
PROCEDURE PutBack (ch: CHAR);
(* This is an "un-read" operation, i.e. the character ch will *)
(* re-appear on the next call to InKey. This facility is provided *)
(* for the use of software which can overshoot by one character *)
(* when reading its input - a situation which can often occur. *)
BEGIN
Push (ch);
END PutBack;
(************************************************************************)
PROCEDURE StuffKeyboardBuffer (ch: CHAR);
(* Stores ch as if it had come from the keyboard, so that a *)
(* subsequent InKey() will pick it up. *)
BEGIN
PutBufferImpatient (CharBuffer, ch, 2000);
END StuffKeyboardBuffer;
(************************************************************************)
PROCEDURE SetLocks (code: CARDINAL);
(* Set/clear the caps lock, num lock, and scroll lock conditions. *)
(* The code is defined in KBDRIVER.DEF. *)
BEGIN
CapsLock := ORD(IAND (code, CapsLockLED)) <> 0;
NumLock := ORD(IAND (code, NumLockLED)) <> 0;
ScrollLock := ORD(IAND (code, ScrollLockLED)) <> 0;
ClearLED (CapsLockLED+NumLockLED+ScrollLockLED);
ToggleLED (BYTE(code));
END SetLocks;
(************************************************************************)
PROCEDURE LockStatus (): CARDINAL;
(* Returns the current state of the caps lock, num lock, and scroll *)
(* lock conditions, using the code defined in KBDRIVER.DEF. *)
VAR result: CARDINAL;
BEGIN
result := 0;
IF CapsLock THEN INC (result, CapsLockLED) END(*IF*);
IF NumLock THEN INC (result, NumLockLED) END(*IF*);
IF ScrollLock THEN INC (result, ScrollLockLED) END(*IF*);
RETURN result;
END LockStatus;
(************************************************************************)
PROCEDURE HotKey (FunctionKey: BOOLEAN; code: CHAR; S: Semaphore);
(* After this procedure is called, typing the key combination for *)
(* 'code' will cause a Signal(S). Set FunctionKey=TRUE to trap one *)
(* of the two-character special function keys, and FALSE otherwise. *)
(* The character is consumed; if it should be passed on, then the *)
(* user's hot key handler can do a PutBack(). Note: there is no *)
(* provision for having multiple hot key handlers for the same key; *)
(* any existing hot key mapping will be overridden. *)
BEGIN
IF FunctionKey THEN
INCL (HotFunctionKeys, code);
HotFunctionKeySemaphore[code] := S;
ELSE
INCL (HotKeys, code);
HotKeySemaphore[code] := S;
END (*IF*);
END HotKey;
(************************************************************************)
(* SHUTDOWN *)
(************************************************************************)
PROCEDURE StopProgram;
(* This is a task whose only function is to execute a HALT when *)
(* the Ctrl/Alt/Del combination is pressed. We handle this in a *)
(* separate task, rather than in the code which detects the *)
(* Ctrl/Alt/Del, because we want to keep the keyboard software *)
(* alive until after higher-level modules have executed their *)
(* termination procedures. *)
BEGIN
NotUsingFloatingPoint;
Wait (CtrlAltDel);
Crash ("Ctrl/Alt/Del termination");
END StopProgram;
(************************************************************************)
PROCEDURE ShutDown;
(* Final cleanup of this module at program exit. *)
BEGIN
SetLocks (0);
END ShutDown;
(************************************************************************)
(* INITIALISATION *)
(************************************************************************)
BEGIN
SetLocks (0);
HotKeys := CharSet{};
HotFunctionKeys := CharSet{};
SetTerminationProcedure (ShutDown);
CreateBuffer (CharBuffer, CharBufferSize);
CreateTask (TranslationTask, 8, "Keyboard main");
CreateSemaphore (CtrlAltDel, 0);
CreateTask (StopProgram, 15, "CtrlAltDel check");
END Keyboard.