276 lines
7.5 KiB
ObjectPascal
Executable File
276 lines
7.5 KiB
ObjectPascal
Executable File
{
|
|
-----------------------------------------------------
|
|
File: Keyboard.Pas
|
|
By: Ronny Wester, ronny@rat.se
|
|
|
|
Unit to check up/down status of individual key flags.
|
|
Written from code I got off rec.games.programmer.
|
|
Sorry, I lost the name of the poster.
|
|
As most of this code is scancode-dependent some keys
|
|
may not be where they "should" on your keyboard.
|
|
-----------------------------------------------------
|
|
}
|
|
unit Keyboard;
|
|
|
|
|
|
interface
|
|
|
|
uses Dos;
|
|
|
|
|
|
const
|
|
|
|
keySysReq = $54;
|
|
keyCapsLock = $3A;
|
|
keyNumLock = $45;
|
|
keyScrollLock = $46;
|
|
keyLeftCtrl = $1D;
|
|
keyLeftAlt = $38;
|
|
keyLeftShift = $2A;
|
|
keyRightCtrl = $9D;
|
|
keyAltGr = $B8;
|
|
keyRightShift = $36;
|
|
keyEsc = $01;
|
|
keyBackspace = $0E;
|
|
keyEnter = $1C;
|
|
keySpace = $39;
|
|
keyTab = $0F;
|
|
keyF1 = $3B;
|
|
keyF2 = $3C;
|
|
keyF3 = $3D;
|
|
keyF4 = $3E;
|
|
keyF5 = $3F;
|
|
keyF6 = $40;
|
|
keyF7 = $41;
|
|
keyF8 = $42;
|
|
keyF9 = $43;
|
|
keyF10 = $44;
|
|
keyF11 = $57;
|
|
keyF12 = $58;
|
|
keyA = $1E;
|
|
keyB = $30;
|
|
keyC = $2E;
|
|
keyD = $20;
|
|
keyE = $12;
|
|
keyF = $21;
|
|
keyG = $22;
|
|
keyH = $23;
|
|
keyI = $17;
|
|
keyJ = $24;
|
|
keyK = $25;
|
|
keyL = $26;
|
|
keyM = $32;
|
|
keyN = $31;
|
|
keyO = $18;
|
|
keyP = $19;
|
|
keyQ = $10;
|
|
keyR = $13;
|
|
keyS = $1F;
|
|
keyT = $14;
|
|
keyU = $16;
|
|
keyV = $2F;
|
|
keyW = $11;
|
|
keyX = $2D;
|
|
keyY = $15;
|
|
keyZ = $2C;
|
|
key1 = $02;
|
|
key2 = $03;
|
|
key3 = $04;
|
|
key4 = $05;
|
|
key5 = $06;
|
|
key6 = $07;
|
|
key7 = $08;
|
|
key8 = $09;
|
|
key9 = $0A;
|
|
key0 = $0B;
|
|
keyMinus = $0C;
|
|
keyEqual = $0D;
|
|
keyLBracket = $1A;
|
|
keyRBracket = $1B;
|
|
keySemicolon = $27;
|
|
keyTick = $28;
|
|
keyApostrophe = $29;
|
|
keyBackslash = $2B;
|
|
keyComma = $33;
|
|
keyPeriod = $34;
|
|
keySlash = $35;
|
|
keyInsert = $D2;
|
|
keyDelete = $D3;
|
|
keyHome = $C7;
|
|
keyEnd = $CF;
|
|
keyPageUp = $C9;
|
|
keyArrowLeft = $CB;
|
|
keyArrowRight = $CD;
|
|
keyArrowUp = $C8;
|
|
keyArrowDown = $D0;
|
|
keyKeypad0 = $52;
|
|
keyKeypad1 = $4F;
|
|
keyKeypad2 = $50;
|
|
keyKeypad3 = $51;
|
|
keyKeypad4 = $4B;
|
|
keyKeypad5 = $4C;
|
|
keyKeypad6 = $4D;
|
|
keyKeypad7 = $47;
|
|
keyKeypad8 = $48;
|
|
keyKeypad9 = $49;
|
|
keyKeypadComma = $53;
|
|
keyKeypadStar = $37;
|
|
keyKeypadMinus = $4A;
|
|
keyKeypadPlus = $4E;
|
|
keyKeypadEnter = $9C;
|
|
keyCtrlPrtScr = $B7;
|
|
keyShiftPrtScr = $B7;
|
|
keyKeypadSlash = $B5;
|
|
keyNames : array [0..255] of PChar =
|
|
( { $00 } nil, 'Esc', '1', '2', '3', '4', '5', '6',
|
|
{ $08 } '7', '8', '9', '0', '+', 'Apostrophe', 'Backspace', 'Tab',
|
|
{ $10 } 'Q', 'W', 'E', 'R', 'T', 'Y', 'U', 'I',
|
|
{ $18 } 'O', 'P', '�', '?', 'Enter', 'Left Ctrl', 'A', 'S',
|
|
{ $20 } 'D', 'F', 'G', 'H', 'J', 'K', 'L', '™',
|
|
{ $28 } 'Ž', '''', 'Left shift', '<', 'Z', 'X', 'C', 'V',
|
|
{ $30 } 'B', 'N', 'M', ',', '.', '-', 'Right shift', '* (pad)',
|
|
{ $38 } 'Alt', 'Space', 'Caps Lock', 'F1', 'F2', 'F3', 'F4', 'F5',
|
|
{ $40 } 'F6', 'F7', 'F8', 'F9', 'F10', 'Num Lock', 'Scroll Lock', '7 (pad)',
|
|
{ $48 } '8 (pad)', '9 (pad)', '- (pad)', '4 (pad)', '5 (pad)', '6 (pad)', '+ (pad)', '1 (pad)',
|
|
{ $50 } '2 (pad)', '3 (pad)', '0 (pad)', ', (pad)', 'SysRq', nil, nil, 'F11', 'F12',
|
|
{ $59 } nil, nil, nil, nil, nil, nil, nil,
|
|
{ $60 } nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil,
|
|
{ $70 } nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil,
|
|
{ $80 } nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil,
|
|
{ $90 } nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, 'Enter (pad)', 'Right Ctrl', nil, nil,
|
|
{ $A0 } nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil,
|
|
{ $B0 } nil, nil, nil, nil, nil, '/ (pad)', nil, 'PrtScr', 'Alt Gr', nil, nil, nil, nil, nil, nil, nil,
|
|
{ $C0 } nil, nil, nil, nil, nil, nil, nil, 'Home',
|
|
{ $C8 } 'Up arrow', 'Page Up', nil, 'Left arrow', nil, 'Right arrow', nil, 'End',
|
|
{ $D0 } 'Down arrow', nil, 'Insert', 'Delete', nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil,
|
|
{ $E0 } nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil,
|
|
{ $F0 } nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil
|
|
);
|
|
|
|
|
|
procedure InstalarKb;
|
|
procedure DesinstalarKb;
|
|
function TeclaPuls( b : byte ) : Boolean;
|
|
function QTeclaPuls : Boolean;
|
|
function AgarrarTecla : Byte;
|
|
procedure BorrarKb;
|
|
procedure EscriuKb;
|
|
|
|
|
|
implementation
|
|
|
|
|
|
var
|
|
|
|
uOldInt9 : Pointer; { saves location of old OldInt9 vector }
|
|
uKeys : array [0..255] of Boolean; { array that holds key values }
|
|
e0Flag : Byte;
|
|
uExitProc : Pointer;
|
|
|
|
|
|
{$F+}
|
|
procedure NewInt9; interrupt; assembler;
|
|
asm
|
|
cli
|
|
in al, $60 { get scan code from keyboard port }
|
|
cmp al, $E0 { al = $E0 key ? }
|
|
jne @@SetScanCode
|
|
mov [e0Flag], 128
|
|
mov al, 20h { Send 'generic' EOI to PIC }
|
|
out 20h, al
|
|
jmp @@exit
|
|
@@SetScanCode:
|
|
mov bl, al { Save scancode in BL }
|
|
and bl, 01111111b
|
|
add bl, [e0Flag]
|
|
xor bh, bh
|
|
and al, 10000000b { keep break bit, if set }
|
|
xor al, 10000000b { flip bit, 1 means pressed, 0 no }
|
|
rol al, 1 { move breakbit to bit 0 }
|
|
mov [offset uKeys + bx], al
|
|
mov [e0Flag], 0
|
|
mov al, 20h { send EOI to PIC }
|
|
out 20h, al
|
|
@@exit:
|
|
sti
|
|
end;
|
|
{$F-}
|
|
|
|
|
|
procedure InstalarKb;
|
|
begin
|
|
GetIntVec( $09, uOldInt9); { save old location of INT 09 handler }
|
|
SetIntVec( $09, Addr( NewInt9)); { point to new routine }
|
|
FillChar( uKeys, SizeOf( uKeys), 0); { clear the keys array }
|
|
end;
|
|
|
|
|
|
procedure DesinstalarKb;
|
|
begin
|
|
SetIntVec( $09, uOldInt9); { point back to original routine }
|
|
uOldInt9 := nil;
|
|
end;
|
|
|
|
|
|
function TeclaPuls( b : byte ) : Boolean;
|
|
begin
|
|
TeclaPuls := uKeys[b];
|
|
end;
|
|
|
|
|
|
function QTeclaPuls : Boolean;
|
|
var b : Integer;
|
|
begin
|
|
QTeclaPuls := True;
|
|
for b := 0 to 255 do
|
|
if uKeys[b] and (keyNames[b] <> nil) then
|
|
Exit;
|
|
QTeclaPuls := False;
|
|
end;
|
|
|
|
|
|
function AgarrarTecla : Byte;
|
|
var b : Integer;
|
|
begin
|
|
AgarrarTecla := 0;
|
|
for b := 1 to 255 do
|
|
if uKeys[b] and (keyNames[b] <> nil) then
|
|
begin
|
|
AgarrarTecla := b;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure BorrarKb;
|
|
begin
|
|
FillChar( uKeys, SizeOf( uKeys), 0); { clear the keys array }
|
|
end;
|
|
|
|
|
|
{$F+}
|
|
procedure CleanUp;
|
|
begin
|
|
ExitProc := uExitProc;
|
|
if uOldInt9 <> nil then
|
|
DesinstalarKb;
|
|
end;
|
|
|
|
procedure EscriuKb;
|
|
var b:byte;
|
|
begin
|
|
for b := 0 to 255 do
|
|
if uKeys[b] and (keyNames[b] <> nil) then
|
|
write(keyNames[b],' | ');
|
|
writeln;
|
|
end;
|
|
|
|
{$F-}
|
|
|
|
|
|
begin
|
|
uExitProc := ExitProc;
|
|
ExitProc := @CleanUp;
|
|
uOldInt9 := nil;
|
|
end.
|