home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
pmos2002.zip
/
SRC
/
keyboard.mod
< prev
next >
Wrap
Text File
|
1998-01-28
|
14KB
|
373 lines
IMPLEMENTATION MODULE Keyboard;
(****************************************************************)
(* *)
(* Keyboard Input *)
(* *)
(* Programmer: P. Moylan *)
(* Last edited: 19 December 1997 *)
(* Status: Working *)
(* *)
(****************************************************************)
(************************************************************************)
(* *)
(* 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 the operating system, and also in the *)
(* keyboard hardware itself; but doing things this way makes it *)
(* easier to provide a "hot key" facility.) *)
(* *)
(* 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. *)
(* *)
(************************************************************************)
IMPORT OS2;
FROM LowLevel IMPORT
(* proc *) IAND;
FROM Semaphores IMPORT
(* type *) Semaphore,
(* proc *) Signal;
FROM TaskControl IMPORT
(* proc *) CreateTask;
FROM CircularBuffers IMPORT
(* type *) CircularBuffer,
(* proc *) CreateBuffer, PutBufferImpatient, GetBuffer, BufferEmpty;
(************************************************************************)
(* GLOBALS *)
(************************************************************************)
CONST
(* Codes to specify the keyboard indicator lights. *)
ScrollLockLED = 1;
NumLockLED = 2;
CapsLockLED = 4;
(************************************************************************)
(* 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 variable that is set unless the process is detached. *)
ProcessIsNotDetached: BOOLEAN;
(************************************************************************)
(* PUTTING KEYBOARD CHARACTERS INTO THE CIRCULAR BUFFER *)
(************************************************************************)
PROCEDURE PutCode (FunctionKey: BOOLEAN; code: CHAR);
(* Puts a code into CharBuffer - unless it is a hot key, in which *)
(* case it is dealt with immediately. *)
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 InputTask;
(* This procedure, which is run as a separate task, picks up the *)
(* keyboard input and stores it in CharBuffer. *)
VAR KeyData: OS2.KBDKEYINFO;
result: CHAR;
BEGIN
LOOP
OS2.KbdCharIn (KeyData, 0, 0);
result := KeyData.chChar;
IF (result = CHR(0)) OR (result = CHR(224)) THEN
PutCode (TRUE, KeyData.chScan);
ELSE
PutCode (FALSE, result);
END (*IF*);
END (*LOOP*);
END InputTask;
(************************************************************************)
(* 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 *) SomeCharsSaved,
(* proc *) Push, Pop;
CONST
stacksize = 8;
VAR
SomeCharsSaved: 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;
SomeCharsSaved := TRUE;
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);
SomeCharsSaved := stackptr > 0;
RETURN result;
END Pop;
(********************************************************************)
BEGIN
SomeCharsSaved := FALSE;
stackptr := 0;
END PutBackBuffer;
(************************************************************************)
(* THE EXTERNALLY CALLABLE INPUT PROCEDURES *)
(************************************************************************)
PROCEDURE KeyPressed(): BOOLEAN;
(* Returns TRUE iff a character is available. *)
BEGIN
RETURN SomeCharsSaved OR NOT BufferEmpty(CharBuffer);
END KeyPressed;
(************************************************************************)
PROCEDURE InKey(): CHAR;
(* Reads one key from the keyboard, or from the putback *)
(* buffer if any characters have been put back. *)
BEGIN
IF SomeCharsSaved THEN
RETURN Pop()
ELSE
RETURN GetBuffer (CharBuffer);
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
PutCode (FALSE, ch);
END StuffKeyboardBuffer;
(************************************************************************)
PROCEDURE StuffKeyboardBuffer2 (ch: CHAR);
(* Like StuffKeyboardBuffer, but stores a two-byte sequence: Nul *)
(* followed by ch. *)
BEGIN
PutCode (TRUE, ch);
END StuffKeyboardBuffer2;
(************************************************************************)
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. *)
(* NOT YET IMPLEMENTED *)
VAR result: CARDINAL;
BEGIN
result := 0;
IF CapsLock THEN 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;
(************************************************************************)
(* CHECK FOR DETACHED MODE *)
(************************************************************************)
PROCEDURE NotDetached(): BOOLEAN;
(* Returns TRUE unless called by a process running detached. *)
(* (A detached process may not do keyboard, screen, or mouse I/O.) *)
BEGIN
RETURN ProcessIsNotDetached;
END NotDetached;
(************************************************************************)
PROCEDURE DetachCheck;
(* Sets the variable ProcessIsNotDetached. *)
VAR pPib: OS2.PPIB; pTib: OS2.PTIB;
BEGIN
OS2.DosGetInfoBlocks (pTib, pPib);
ProcessIsNotDetached := pPib^.pib_ultype <> 4;
END DetachCheck;
(************************************************************************)
(* INITIALISATION *)
(************************************************************************)
BEGIN
HotKeys := CharSet{};
HotFunctionKeys := CharSet{};
CreateBuffer (CharBuffer, CharBufferSize);
DetachCheck;
IF ProcessIsNotDetached THEN
(*SetLocks (0);*)
CreateTask (InputTask, 8, "Keyboard main");
END (*IF*);
END Keyboard.