{-----------------------------------------------------------------------|
|  Author: Dumitru Uzun (DUzun)                                         |
|  Date: 20 dec. 2008                                                   |
|-----------------------------------------------------------------------}
Unit Keyboard;
INTERFACE
{-----------------------------------------------------------------------}
CONST
  ESC_Scan:  Byte = $01;      Ent_Scan:   Byte = $1C;
  Back_Scan: Byte = $0E;      Rsh_Scan:   Byte = $36;
  Ctrl_Scan: Byte = $1D;      Prt_Scan:   Byte = $37;
  Lsh_Scan:  Byte = $2A;      Alt_Scan:   Byte = $38;
  Caps_Scan: Byte = $3A;      Home_Scan:  Byte = $47;
  F1_Scan:   Byte = $3B;      Up_Scan:    Byte = $48;
  F2_Scan:   Byte = $3C;      PgUp_Scan:  Byte = $49;
  F3_Scan:   Byte = $3D;      Min_Scan:   Byte = $4A;
  F4_Scan:   Byte = $3E;      Left_Scan:  Byte = $4B;
  F5_Scan:   Byte = $3F;      Mid_Scan:   Byte = $4C;
  F6_Scan:   Byte = $40;      Right_Scan: Byte = $4D;
  F7_Scan:   Byte = $41;      Plus_Scan:  Byte = $4E;
  F8_Scan:   Byte = $42;      End_Scan:   Byte = $4F;
  F9_Scan:   Byte = $43;      Down_Scan:  Byte = $50;
  F10_Scan:  Byte = $44;      PgDn_Scan:  Byte = $51;
  F11_Scan:  Byte = $D9;      Ins_Scan:   Byte = $52;
  F12_Scan:  Byte = $DA;      Del_Scan:   Byte = $53;
  Scrl_Scan: Byte = $46;      Num_Scan:   Byte = $45;
  Tab_Scan:  Byte = $0F;      Space_Scan: Byte = $39;

VAR
  Keys_State: Byte absolute $40:$17;

{-----------------------------------------------------------------------}
{ Multikeys mode functions }
procedure MultikeysInit;
procedure MultikeysDone;
function TestKey(Scan: Byte): Boolean;

{Non-Multikeys mode functions}
function GetKey: WORD; { ~ readkey }
function TestAlt        : Boolean;
function TestCapsLock   : Boolean;
function TestCtrl       : Boolean;
function TestNumLock    : Boolean;
function TestScrollLock : Boolean;
function TestShift      : Boolean;
function TestLeftShift  : Boolean;
function TestRightShift : Boolean;
{-----------------------------------------------------------------------}
function AsciiToScan(AsciiChar: Char): Byte; {???}
function ScanToAscii(ScanCode: Word): Char;  {???}
{-----------------------------------------------------------------------}
procedure HideCursor;
procedure ShowCursor;
{-----------------------------------------------------------------------}
IMPLEMENTATION
USES CRT, DOS;
VAR
  ScanBuf: set of 1..88;
  OldKbd: Procedure;
{-----------------------------------------------------------------------}
{$F+}
Procedure NewKbd; Interrupt;
Var  SC: byte;
Begin
  SC := Port[$60];  {read the keyboard input}
  If SC and $80 <> 0 then ScanBuf := ScanBuf - [SC and $7F]
                     else ScanBuf := ScanBuf + [SC and $7F];
  Port[$20] := $20; {Tell that I handle the interupt}
end;
{$F-}
{-----------------------------------------------------------------------}
function GetIntVec(N: byte): Pointer; assembler; { Get the interrupt vector }
asm
        push    es
        { Use the MS-DOS function 35h to read the vector }
        mov     ah, 35h
        mov     al, N
        int     21h
        { Move the vector from es:bx to dx:ax }
        mov     ax, bx
        mov     dx, es
        pop     es
end;
{-----------------------------------------------------------------------}
procedure MultikeysInit;
begin
  ScanBuf := [];
  if @OldKbd <> nil then Exit;
  @OldKbd := GetIntVec(9);
  SetIntVec(9, @newKbd);
end;
{-----------------------------------------------------------------------}
procedure MultikeysDone;
begin
  if @OldKbd = nil then Exit;
  SetIntVec(9, @OldKbd);
  @OldKbd := nil;
  ScanBuf := [];
end;
{-----------------------------------------------------------------------}
function TestKey(Scan: Byte): Boolean; begin TestKey := Scan in ScanBuf; end;
{-----------------------------------------------------------------------}
function GetKey: WORD; begin GetKey := (Port[$60] shl 8) or ord(readkey); end;
function TestRightShift : Boolean; begin TestRightShift := Keys_State and $01 <> 0 end;
function TestLeftShift  : Boolean; begin TestLeftShift  := Keys_State and $02 <> 0 end;
function TestShift      : Boolean; begin TestShift      := Keys_State and $03 <> 0 end;
function TestCtrl       : Boolean; begin TestCtrl       := Keys_State and $04 <> 0 end;
function TestAlt        : Boolean; begin TestAlt        := Keys_State and $08 <> 0 end;
function TestScrollLock : Boolean; begin TestScrollLock := Keys_State and $10 <> 0 end;
function TestNumLock    : Boolean; begin TestNumLock    := Keys_State and $20 <> 0 end;
function TestCapsLock   : Boolean; begin TestCapsLock   := Keys_State and $40 <> 0 end;
{-----------------------------------------------------------------------}
function AsciiToScan(AsciiChar: Char): Byte;
begin
end;

function ScanToAscii(ScanCode: Word): Char;
begin
  if(2<=ScanCode)and(ScanCode<=10) then inc(ScanCode, ord('1')) else
  case ScanCode of
    11: ScanCode := ord('0');
    12, 74: ScanCode := ord('-');
    78: ScanCode := ord('+');
    13: ScanCode := ord('=');
    14: ScanCode := 8;
    15: ScanCode := 9;
    16: ScanCode := ord('Q');  30: ScanCode := ord('A');  43: ScanCode := ord('\');
    17: ScanCode := ord('W');  31: ScanCode := ord('S');  48: ScanCode := ord('B');
    18: ScanCode := ord('E');  32: ScanCode := ord('D');  49: ScanCode := ord('N');
    19: ScanCode := ord('R');  33: ScanCode := ord('F');  50: ScanCode := ord('M');
    20: ScanCode := ord('T');  34: ScanCode := ord('G');  51: ScanCode := ord(',');
    21: ScanCode := ord('Y');  35: ScanCode := ord('H');  52: ScanCode := ord('.');
    22: ScanCode := ord('U');  36: ScanCode := ord('J');  53: ScanCode := ord('/');
    23: ScanCode := ord('I');  37: ScanCode := ord('K');  57: ScanCode := ord(' ');
    24: ScanCode := ord('O');  38: ScanCode := ord('L');  44: ScanCode := ord('Z');
    25: ScanCode := ord('P');  39: ScanCode := ord(';');  45: ScanCode := ord('X');
    26: ScanCode := ord('[');  40: ScanCode := ord(''''); 46: ScanCode := ord('C');
    27: ScanCode := ord(']');  41: ScanCode := ord('`');  47: ScanCode := ord('V');
    59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 72, 75, 80, 77: ;
  end;
  ScanToAscii := chr(ScanCode);
end;
{-----------------------------------------------------------------------}
procedure SetCursor(Cursor: Word); assembler;
asm
    mov     ax,$0100
    xor     bx,bx
    mov     cx,[Cursor]
    int     $10
end;
{-----------------------------------------------------------------------}
procedure HideCursor; begin SetCursor($2000); end;
procedure ShowCursor; begin SetCursor($0607); end;
{-----------------------------------------------------------------------}
begin
  @OldKbd := nil;
end.