asteroids/KEYBOARD.PAS

{
-----------------------------------------------------
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', '<27>', '?', 'Enter', 'Left Ctrl', 'A', 'S',
      { $20 } 'D', 'F', 'G', 'H', 'J', 'K', 'L', '<27>',
      { $28 } '<27>', '''', '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.