DUzun's Web
Programare, proiecte personale, divertisment

{-----------------------------------------------------------------------|

|  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.

​

​