418 lines
12 KiB
Plaintext
418 lines
12 KiB
Plaintext
{ GDlib Keyboard Handler
|
|
Gered King, 2018 }
|
|
|
|
{$A+,B-,F-,G+,I-,N+,P-,Q-,R-,S-,T-,V-,X+}
|
|
|
|
unit GDKeybrd;
|
|
|
|
interface
|
|
|
|
const
|
|
KEY_ESC = $01;
|
|
KEY_1 = $02;
|
|
KEY_2 = $03;
|
|
KEY_3 = $04;
|
|
KEY_4 = $05;
|
|
KEY_5 = $06;
|
|
KEY_6 = $07;
|
|
KEY_7 = $08;
|
|
KEY_8 = $09;
|
|
KEY_9 = $0a;
|
|
KEY_0 = $0b;
|
|
KEY_MINUS = $0c;
|
|
KEY_EQUALS = $0d;
|
|
KEY_BACKSPACE = $0e;
|
|
KEY_TAB = $0f;
|
|
KEY_Q = $10;
|
|
KEY_W = $11;
|
|
KEY_E = $12;
|
|
KEY_R = $13;
|
|
KEY_T = $14;
|
|
KEY_Y = $15;
|
|
KEY_U = $16;
|
|
KEY_I = $17;
|
|
KEY_O = $18;
|
|
KEY_P = $19;
|
|
KEY_LEFT_BRACKET = $1a;
|
|
KEY_RIGHT_BRACKET = $1b;
|
|
KEY_ENTER = $1c;
|
|
KEY_CTRL = $1d;
|
|
KEY_A = $1e;
|
|
KEY_S = $1f;
|
|
KEY_D = $20;
|
|
KEY_F = $21;
|
|
KEY_G = $22;
|
|
KEY_H = $23;
|
|
KEY_J = $24;
|
|
KEY_K = $25;
|
|
KEY_L = $26;
|
|
KEY_SEMICOLON = $27;
|
|
KEY_APOSTROPHE = $28;
|
|
KEY_TILDE = $29;
|
|
KEY_LEFT_SHIFT = $2a;
|
|
KEY_BACKSLASH = $2b;
|
|
KEY_Z = $2c;
|
|
KEY_X = $2d;
|
|
KEY_C = $2e;
|
|
KEY_V = $2f;
|
|
KEY_B = $30;
|
|
KEY_N = $31;
|
|
KEY_M = $32;
|
|
KEY_COMMA = $33;
|
|
KEY_PERIOD = $34;
|
|
KEY_FORWARDSLASH = $35;
|
|
KEY_RIGHT_SHIFT = $36;
|
|
KEY_ASTERISK = $37;
|
|
KEY_ALT = $38;
|
|
KEY_SPACE = $39;
|
|
KEY_CAPS_LOCK = $3a;
|
|
KEY_F1 = $3b;
|
|
KEY_F2 = $3c;
|
|
KEY_F3 = $3d;
|
|
KEY_F4 = $3e;
|
|
KEY_F5 = $3f;
|
|
KEY_F6 = $40;
|
|
KEY_F7 = $41;
|
|
KEY_F8 = $42;
|
|
KEY_F9 = $43;
|
|
KEY_F10 = $44;
|
|
KEY_NUM_LOCK = $45;
|
|
KEY_SCROLL_LOCK = $46;
|
|
KEY_HOME = $47;
|
|
KEY_UP = $48;
|
|
KEY_PAGE_UP = $49;
|
|
KEY_NUM_MINUS = $4a;
|
|
KEY_LEFT = $4b;
|
|
KEY_NUM_5 = $4c;
|
|
KEY_RIGHT = $4d;
|
|
KEY_NUM_PLUS = $4e;
|
|
KEY_END = $4f;
|
|
KEY_DOWN = $50;
|
|
KEY_PAGE_DOWN = $51;
|
|
KEY_INSERT = $52;
|
|
KEY_DELETE = $53;
|
|
KEY_F11 = $57;
|
|
KEY_F12 = $58;
|
|
|
|
KB_FLAGS_SCROLL_LOCK = $10;
|
|
KB_FLAGS_NUM_LOCK = $20;
|
|
KB_FLAGS_CAPS_LOCK = $40;
|
|
|
|
KB_MOD_EXTENDED = $01;
|
|
KB_MOD_SHIFT = $02;
|
|
KB_MOD_NUM_LOCK = $04;
|
|
KB_MOD_CAPS_LOCK = $08;
|
|
|
|
type
|
|
Key = byte;
|
|
|
|
var
|
|
Keys : array[0..127] of bytebool;
|
|
KeybrdFlags : word absolute $0040:$0017;
|
|
KeyFlags : word;
|
|
KeyMod : word;
|
|
|
|
function InitKeyboard : boolean;
|
|
function CloseKeyboard : boolean;
|
|
function IsKeyboardInitialized : boolean;
|
|
function WaitForAnyKey : Key;
|
|
procedure WaitForNoKeys;
|
|
procedure WaitForKey(k: Key);
|
|
procedure WaitUntilKeyNotPressed(k: Key);
|
|
|
|
implementation
|
|
|
|
uses Dos, GDEvents, Toolbox;
|
|
|
|
const
|
|
PIC_CTRL_PORT = $20;
|
|
KBRD_DATA_PORT = $60;
|
|
KBRD_CTRL_PORT = $61;
|
|
KBRD_STATUS_PORT = $64;
|
|
KBRD_CMD_SET_LED = $ed;
|
|
KBRD_LED_SCROLL_LOCK = $01;
|
|
KBRD_LED_NUM_LOCK = $02;
|
|
KBRD_LED_CAPS_LOCK = $04;
|
|
KEY_EXTENDED = $e0;
|
|
|
|
_KeyboardInstalled : boolean = false;
|
|
|
|
var
|
|
_keyLastScan : Key;
|
|
_keyScan : Key;
|
|
_oldKeybrdInterrupt : pointer;
|
|
_keyboardEvent : PInputEvent;
|
|
|
|
procedure ResetKeyState;
|
|
begin
|
|
_keyLastScan := 0;
|
|
_keyScan := 0;
|
|
KeyFlags := 0;
|
|
KeyMod := 0;
|
|
MemFill(@Keys, 0, 128);
|
|
end;
|
|
|
|
procedure WaitKeybrdDataRead;
|
|
{ waits until the keyboard status port indicates the data port can be
|
|
read from once again }
|
|
begin
|
|
while (port[KBRD_STATUS_PORT] and 1) = 0 do begin
|
|
end;
|
|
end;
|
|
|
|
procedure WaitKeybrdDataWrite;
|
|
{ waits until the keyboard status port indicates the data port can be
|
|
written to once again }
|
|
begin
|
|
while (port[KBRD_STATUS_PORT] and 2) <> 0 do begin
|
|
end;
|
|
end;
|
|
|
|
function SendKeybrdData(data: byte) : boolean;
|
|
{ sends data to the keyboard data port. checks for success and returns
|
|
true if the data write succeeded }
|
|
var
|
|
result: byte;
|
|
begin
|
|
WaitKeybrdDataWrite;
|
|
port[KBRD_DATA_PORT] := data;
|
|
|
|
WaitKeybrdDataRead;
|
|
result := port[KBRD_DATA_PORT];
|
|
|
|
SendKeybrdData := (result = $fa);
|
|
end;
|
|
|
|
function UpdateKeybrdLED(flags: byte) : boolean;
|
|
{ updates the keyboard indicator LEDs from the num/caps/scroll lock flags
|
|
provided. returns false if the LEDs could not be updated (if the writes
|
|
to the keyboard data port fail for any reason). }
|
|
var
|
|
data: byte;
|
|
begin
|
|
UpdateKeybrdLED := false;
|
|
|
|
if not SendKeybrdData(KBRD_CMD_SET_LED) then
|
|
exit;
|
|
|
|
data := (flags shr 4) and 7; { restrict to only the 3 led flags }
|
|
if not SendKeybrdData(data) then
|
|
exit;
|
|
|
|
UpdateKeybrdLED := true;
|
|
end;
|
|
|
|
procedure PushKeyboardEvent(key: Key; action: EventAction);
|
|
begin
|
|
if not IsEventsInitialized then
|
|
exit;
|
|
|
|
_keyboardEvent := PushEvent;
|
|
|
|
with _keyboardEvent^ do begin
|
|
Event := EVENT_TYPE_KEYBOARD;
|
|
KB_Key := key;
|
|
KB_Action := action;
|
|
KB_Modifier := KeyMod;
|
|
end;
|
|
end;
|
|
|
|
function HandlerFilterKeys : boolean;
|
|
{ returns true if the key interrupt event should not be handled (at least
|
|
as far as updating key state is concerned) }
|
|
begin
|
|
HandlerFilterKeys := false;
|
|
|
|
if (KeyMod and KB_MOD_EXTENDED) <> 0 then begin
|
|
{ extended key + leftshift comes with cursor key presses when
|
|
numlock is enabled ... }
|
|
if (_keyScan and $7f) = KEY_LEFT_SHIFT then
|
|
HandlerFilterKeys := true;
|
|
end;
|
|
end;
|
|
|
|
procedure HandlerUpdateFlagsAndLEDs;
|
|
{ maintains BIOS keyboard flags/led toggle states (caps/num/scroll lock) }
|
|
begin
|
|
case _keyScan of
|
|
KEY_CAPS_LOCK: begin
|
|
KeyFlags := KeyFlags xor KB_FLAGS_CAPS_LOCK;
|
|
UpdateKeybrdLED(KeyFlags);
|
|
KeybrdFlags := KeyFlags;
|
|
end;
|
|
KEY_NUM_LOCK: begin
|
|
KeyFlags := KeyFlags xor KB_FLAGS_NUM_LOCK;
|
|
UpdateKeybrdLED(KeyFlags);
|
|
KeybrdFlags := KeyFlags;
|
|
end;
|
|
KEY_SCROLL_LOCK: begin
|
|
KeyFlags := KeyFlags xor KB_FLAGS_SCROLL_LOCK;
|
|
UpdateKeybrdLED(KeyFlags);
|
|
KeybrdFlags := KeyFlags;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure HandlerUpdateModifiers;
|
|
begin
|
|
if (KeyFlags and KB_FLAGS_NUM_LOCK) <> 0 then
|
|
KeyMod := KeyMod or KB_MOD_NUM_LOCK
|
|
else
|
|
KeyMod := KeyMod and not KB_MOD_NUM_LOCK;
|
|
|
|
if (KeyFlags and KB_FLAGS_CAPS_LOCK) <> 0 then
|
|
KeyMod := KeyMod or KB_MOD_CAPS_LOCK
|
|
else
|
|
KeyMod := KeyMod and not KB_MOD_CAPS_LOCK;
|
|
|
|
if Keys[KEY_LEFT_SHIFT] or Keys[KEY_RIGHT_SHIFT] then
|
|
KeyMod := KeyMod or KB_MOD_SHIFT
|
|
else
|
|
KeyMod := KeyMod and not KB_MOD_SHIFT;
|
|
end;
|
|
|
|
procedure KeybrdHandler;
|
|
{ custom keyboard interrupt handler. called on every keyboard event }
|
|
interrupt;
|
|
begin
|
|
{ read scan code of key that was just pressed (or released) }
|
|
_keyScan := port[KBRD_DATA_PORT];
|
|
|
|
{ handle updating key state and flags/modifiers }
|
|
if _keyScan = KEY_EXTENDED then begin
|
|
KeyMod := KeyMod or KB_MOD_EXTENDED;
|
|
|
|
end else begin
|
|
if not HandlerFilterKeys then begin
|
|
if (_keyScan and $80) <> 0 then begin
|
|
{ high bit set indicates key was released. clear high bit to get
|
|
the actual key scan code }
|
|
_keyScan := _keyScan and $7f;
|
|
Keys[_keyScan] := false;
|
|
HandlerUpdateModifiers;
|
|
PushKeyboardEvent(_keyScan, EVENT_ACTION_RELEASED);
|
|
|
|
end else begin
|
|
if Keys[_keyScan] then begin
|
|
PushKeyboardEvent(_keyScan, EVENT_ACTION_HELD);
|
|
|
|
end else begin
|
|
Keys[_keyScan] := true;
|
|
{ toggling of states only needs to be done for a key down event }
|
|
HandlerUpdateFlagsAndLEDs;
|
|
HandlerUpdateModifiers;
|
|
|
|
PushKeyboardEvent(_keyScan, EVENT_ACTION_PRESSED);
|
|
end;
|
|
|
|
end;
|
|
|
|
_keyLastScan := _keyScan;
|
|
end;
|
|
|
|
{ clear extended modifier for the following event(s) in any case }
|
|
KeyMod := KeyMod and not KB_MOD_EXTENDED;
|
|
|
|
end;
|
|
|
|
{ indicate key event was processed to the keyboard controller }
|
|
_keyScan := (port[KBRD_CTRL_PORT] or $80);
|
|
port[KBRD_CTRL_PORT] := _keyScan;
|
|
port[KBRD_CTRL_PORT] := (_keyScan and $7f);
|
|
port[PIC_CTRL_PORT] := $20;
|
|
end;
|
|
|
|
function InitKeyboard : boolean;
|
|
{ installs a custom keyboard interrupt handler. returns false if the
|
|
keyboard interrupt handler could not be installed for some reason, or if
|
|
the custom handler was already installed. }
|
|
begin
|
|
if _keyboardInstalled then begin
|
|
InitKeyboard := false;
|
|
exit;
|
|
end;
|
|
|
|
ResetKeyState;
|
|
|
|
KeyFlags := KeybrdFlags;
|
|
{ bad hacky way to maybe-sortof-possibly not get into weird states
|
|
depending on what keys are held down as this executes.
|
|
a proper fix would involve updating our key handler to handle ALL
|
|
of the bios key flag bits. }
|
|
KeyFlags := KeyFlags and not $f38f;
|
|
HandlerUpdateModifiers;
|
|
GetIntVec(9, _oldKeybrdInterrupt);
|
|
SetIntVec(9, @KeybrdHandler);
|
|
KeybrdFlags := KeyFlags;
|
|
|
|
_keyboardInstalled := true;
|
|
InitKeyboard := true;
|
|
end;
|
|
|
|
function CloseKeyboard : boolean;
|
|
{ removes a previously installed custom keyboard interrupt handler. }
|
|
begin
|
|
if not _keyboardInstalled then begin
|
|
CloseKeyboard := true;
|
|
exit;
|
|
end;
|
|
|
|
SetIntVec(9, _oldKeybrdInterrupt);
|
|
ResetKeyState;
|
|
|
|
_keyboardInstalled := false;
|
|
CloseKeyboard := true;
|
|
end;
|
|
|
|
function IsKeyboardInitialized : boolean;
|
|
{ returns true if our custom keyboard handler has been initialized }
|
|
begin
|
|
IsKeyboardInitialized := _keyboardInstalled;
|
|
end;
|
|
|
|
function WaitForAnyKey : Key;
|
|
{ waits indefinitely until any key is pressed, and returns the key scan code
|
|
of the key that was pressed. }
|
|
begin
|
|
_keyLastScan := 0;
|
|
while _keyLastScan = 0 do begin
|
|
end;
|
|
WaitForAnyKey := _keyLastScan;
|
|
end;
|
|
|
|
procedure WaitForNoKeys;
|
|
{ waits indefinitely until there are no keys pressed. }
|
|
var
|
|
i : word;
|
|
foundPressed : boolean;
|
|
begin
|
|
repeat
|
|
foundPressed := false;
|
|
for i := 0 to 127 do begin
|
|
if Keys[i] then begin
|
|
foundPressed := true;
|
|
break;
|
|
end;
|
|
end;
|
|
until (not foundPressed);
|
|
end;
|
|
|
|
procedure WaitForKey(k: Key);
|
|
{ waits indefinitely until the specified key is pressed }
|
|
begin
|
|
_keyLastScan := 0;
|
|
while _keyLastScan <> k do begin
|
|
end;
|
|
end;
|
|
|
|
procedure WaitUntilKeyNotPressed(k: Key);
|
|
{ waits indefinitely until the specified key is not pressed }
|
|
begin
|
|
while Keys[k] do begin
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
MemFill(@Keys, 0, SizeOf(Keys));
|
|
end.
|