[Back to KEYBOARD SWAG index] [Back to Main SWAG index] [Original]

    {$X+,S-,R-,I-,L-,O-,B-,D-}
    {*****************************************}
    {*  Keyboard unit for BP 7.0             *}
    {*  Direct INT 9h support                *}
    {*  Written by Alex Grischenko           *}
    {*  Modified by Olaf Bartelt for DPMI    *}
    {*  (C) AntSoft Lab , 1994               *}
    {*  Version 1.0 30-06-94                 *}
    {*****************************************}

    Unit  Keyboard;

    interface

    type
      DoubleKey = object
        Left,Right : boolean;
        function Both : boolean;
        function Any  : boolean;
      end;

      LockKey = record
        Pressed,Locked : boolean;
      end;

      KeyEvent = record
        case Integer of
         0: (KeyCode : Word);
         1: (CharCode: Char; ScanCode: Byte);
      end;

    const
      SEG0000  : WORD = $0000;

      k_LShift = $2A00;
      k_RShift = $3600;
      k_LAlt   = $3800;
      k_RAlt   = $3800 or $8000;
      k_LCtrl  = $1D00;
      k_RCtrl  = $1D00 or $8000;

      k_PrtScr     = $F900;
      k_SysReg     = $F800;
      k_Pause      = $F700;
      k_Break      = $F600;
      k_CapsLock   = $3A00;
      k_NumLock    = $4500;
      k_ScrollLock = $4600;

      k_AltCtrlDel = $F200;

      WasKeybEvent : boolean = false;  { Was event from keyboard }
      Pressed  : boolean = false;      { TRUE - key pressed, FALSE - released }

      ESC    : boolean   = false;
      Alt    : DoubleKey = ( Left : false; Right : false );
      Ctrl   : DoubleKey = ( Left : false; Right : false );
      Shift  : DoubleKey = ( Left : false; Right : false );
      PrtScr    : boolean = false;
      CapsLock  : LockKey = ( Pressed : false; Locked : false );
      NumLock   : LockKey = ( Pressed : false; Locked : false );
      ScrollLock: LockKey = ( Pressed : false; Locked : false );
      Pause     : boolean = false;
      CtrlBreak : boolean = false;

      AltCtrlDel: boolean = false;

    procedure InitKeyboard;             { Initalize driver }
    procedure DoneKeyboard;             { Uninstall driver }
    function  ReadKeyboard : byte;      { Read current scancode from keyboard
                                          ( }
    function  KeyPressed  : boolean;    { Keys was pressed?             }
    function  ReadKey  : char;          { For using instead CRT.ReadKey }
    function  ReadChar : char;          { Converts scancode to ASC-key  }
    procedure GetKeyEvent(var KEvent : KeyEvent);

    procedure NullProc;
    {procedure KeybLights(On : boolean; Light : byte);}

    const
      AltCtrlDelproc : procedure = NullProc;
      { Alt-Ctrl-Del Handler }

    implementation

    function DoubleKey.Both : boolean;
    begin
      Both:=Right and Left;
    end;

    function DoubleKey.Any : boolean;
    begin
      Any:=Right or Left;
    end;

    const
      Key : byte = 0;
      KeyboardSet : boolean = false;

      KeyCodes : array [1..$58] of word = (

    {******** 85 - key **********}
           {ESC  1  2  3  4  5  6  7  8  9  0  -  =  BkSp}
     27, 49,50,51,52,53,54,55,56,57,48,45,61,    8,

           {TAB  Q  W  E  R  T  Y  U  I  O  P  [  ] Enter}
            9,  81,87,69,82,84,89,85,73,79,80,91,93,   13,

         {LCtrl  A  S  D  F  G  H  J  K  L  ;  '  `}
        k_LCtrl,65,83,68,70,71,72,74,75,76,59,39,96,

        {LShift  \  Z  X  C  V  B  N  M  ,  .  /  RShift}
       k_LShift,92,90,88,67,86,66,78,77,44,46,47, k_RShift,

           { *  LAlt   Space  CapsLock}
     42, k_LAlt,   32, k_CapsLock,

           {F1    F2    F3    F4    F5    F6    F7    F8    F9   F10}
         $3B00,$3C00,$3D00,$3E00,$3f00,$4000,$4100,$4200,$4300,$4400,

        {  NumLock    ScrollLock}
         k_NumLock, k_ScrollLock,

         {Home    Up  PgUp  K  -  Left  K  5 Right  K  +}
         $4700,$4800,$4900,$4A2D,$4b00,$4c00,$4d00,$4e2b,

         { End  Down  PgDn   Ins   Del}
         $4f00,$5000,$5100,$5200,$5300,

    {******** 101 - key **********}
        {AltPrtScr          F11     F12}
             $5400, 0, 0, $5700,  $5800);

        ExtCode    : byte    = 0;
        ExtExtCode : byte    = 0;
        Extent     : boolean = false;

    var
      oldint9seg,oldint9ofs : word;
      Lights : byte ;
    {  Queue : array[0..30] of byte;
    }  QHead,QTail : word;

    { - Wait keyboard }
    procedure WaitKeyb; near; assembler;
    asm
       push ax
    @@Wait:
       in   al,64h
       test al,02h
       loopnz @@Wait
       pop  ax
    end;

    { - Send byte to keyboard port }
    procedure SendIt; near; assembler;
    asm
      cli
      call WaitKeyb
      out 64h,al
      sti
    end;

    procedure SetLights; near; assembler;
    asm
    (*
      push ax
      mov  al,0EDh
    {  call SendIt}
      out  60h,al
      mov  cx,200h
    @loop:
      loop @loop
      mov  al,Lights
    {  call SendIt }
      out  60h,al
      pop  ax
    *)
    end;

    procedure MyInt9(Flags, CS, IP, AX, BX,
    CX, DX, SI, DI, DS, ES, BP: Word); interrupt;
    label IntEnd,SendEOI;
    begin
      asm
        mov  ax, seg @data
        mov  ds,ax

        mov  al,0adh   { Disable keyboard }
        call sendit
        cli

        call WaitKeyb  { Wait }

        in  al,60h     { Get keycode }
        sti
        mov key,al;

    push ax
    mov  al,0AEh
    call sendit
    mov  al,20h
    out  20h,al
    pop  ax

    @@keyEvent:
        mov WasKeybEvent,1    { Set event flag }

        mov ah,al
        and ah,0F0h      { Was extented keystroke ? }

        cmp ah,0E0h
        jne @NormalCode
    (*    jne  @CheckAA    { no, check next ext. code AAh }

        cmp ExtCode,0AAh { Was sequence E0 AA E0 ? }
        jne @ExtCode     { No, set as firts extent code }

        mov Extent,0     { yes, clear exten flags }
        mov ExtCode,0
    {    mov al,91        { Return as Shift key pressed }
        jmp IntEnd
    *)
      @ExtCode:
        mov Extent,1   { yes, set flag and store extented code }
        mov ExtCode,al
        mov WasKeybEvent,0
        jmp IntEnd     { finish interrupt }

      @NormalCode:
        mov ah,al
        and al,7Fh     { mask low 7 bits }

        cmp al,60h
        jb @@IsKey

        cmp al,0A0h
        jb IntEnd

    @@IsKey:
        and ah,80h     { check pressing  }
        je @@Pressed

        mov Pressed,0  { if higher bit set to 1, then key released }
        jmp @@1

      @@Pressed:
        mov Pressed,1

      @@1:
        mov key,al     { store key }
        mov ah,Pressed

    {------------------------}
        cmp al,1
        jne @PrtScr
        mov ESC,ah
        jmp IntEnd

    @PrtScr:
        cmp al,37h
        jne @next0
        cmp ExtCode,0E0h
        jne IntEnd
        mov PrtScr,ah

    @next0:
        cmp al,2ah
        jne @next1
        cmp ExtCode,0E0h
        jne @ShiftL
    @ExtShift:
        xor ax,ax
        mov WasKeybEvent,al
        mov ExtCode,al
        mov key,al
        jmp IntEnd
    @ShiftL:
        mov Shift.Left,ah
        jmp IntEnd

    @next1:
        cmp al,36h
        jne @next2
        cmp ExtCode,0E0h
        je  @ExtShift
        mov Shift.Right,ah
        jmp IntEnd

    @next2:
        cmp al,38h
        jne @next3
        cmp ExtCode,0E0h
        je  @RAlt
        mov Alt.Left,ah
        jmp IntEnd
      @Ralt:
        mov Alt.Right,ah
        jmp @@ResetExt

    @next3:
        cmp al,1Dh
        jne @next4
        cmp ExtCode,0E0h
        je  @RCtrl
        mov Ctrl.Left,ah
        jmp IntEnd
      @RCtrl:
        mov Ctrl.Right,ah
        jmp @@ResetExt

    @next4:
        cmp al,3ah
        jne @next5
        mov CapsLock.Pressed,ah
        cmp ah,1
        je  IntEnd
        xor CapsLock.Locked,1
        xor Lights,4
        mov ax,0AEh
    {    call SendIt}
        call SetLights
        jmp SendEOI

    @next5:
        cmp al,45h
        jne @next6
        mov NumLock.Pressed,ah
        cmp ah,1
        je  IntEnd
        xor NumLock.Locked,1
        xor Lights,2
        mov ax,0AEh
    {    call SendIt  }
        call SetLights
        jmp SendEOI

    @next6:
        cmp al,46h
        jne @next7
        mov ScrollLock.Pressed,ah
        cmp ah,1
        je  IntEnd
        xor ScrollLock.Locked,1
        xor Lights,1
        mov ax,0AEh
     {   call SendIt}
        call SetLights
        jmp SendEOI

    @@ResetExt:
        xor ax,ax
        mov ExtCode,al
        mov Extent,al
        jmp IntEnd

    @next7:
        cmp al,53h
        jne IntEnd
      end;

      AltCtrlDel:=pressed and Alt.Any and Ctrl.Any;

      if AltCtrlDel then AltCtrlDelProc;

    IntEnd:
    asm
    { Interrupt end }{
        mov  al,0aeh
        call sendit   }
    SendEOI:           {
        mov  al,20h
        out  20h,al     }
      end;
    end;

    procedure InitKeyboard; assembler;
    asm
       cmp KeyboardSet,0
       jne @@Quit

    @ClearBufferLoop:
       mov ah,1
       int 16h
       jz  @NoKeyb
       xor ax,ax
       int 16h
       jmp @ClearBufferLoop

    @NoKeyb:
       mov ax,3509h
       int 21h
       mov oldint9seg,es
       mov oldint9ofs,bx

       push ds

       push cs
       pop  ds
       mov  ax,2509h
       mov  dx,offset MyInt9
       int  21h
       pop  ds

       cli
       xor  ax,ax
       mov  QHead,ax
       mov  QTail,ax
       mov  Key,al

       xor  ax,ax
       mov  es,SEG0000
       mov  al,byte ptr es:[417h]
       mov  cl,4
       shr  al,cl
       mov  Lights,al

       mov  KeyboardSet,1
       sti
    @@Quit:
    end;

    procedure DoneKeyboard; assembler;
    asm
       cmp  KeyboardSet,0
       je   @@Quit
       xor  ax,ax
       mov  es,SEG0000
       mov  ax,word ptr es:[417h]
       mov  bl,Lights
       mov  cl,4
       shl  bl,cl
       and  al,10001111b  { Set Lights status }
       or   al,bl
       and  ax,111110011110000b
       mov  word ptr es:[417h],ax

       push ds
       mov  dx,oldint9ofs
       mov  ax,oldint9seg
       mov  ds,ax
       mov  ax,2509h
       int  21h
       pop  ds
    @@Quit:
    end;

    function ReadKeyboard : byte; Assembler;
    asm
      xor  ax,ax
      mov  al,Key;
      mov  Key,ah;
      mov  WasKeybEvent,ah
    end;

    function KeyPressed : boolean;
    begin
      KeyPressed:=WasKeybEvent and Pressed;
    end;

    function ReadKey : char;
    begin
      if KeyboardSet then
      begin

      end
      else begin
        Writeln(#7'KEYBOARD.TPU Error : use InitKeyboard first!');
        halt;
      end;
    end;

    function ReadChar : char; assembler;
    const
      scancode : char = #0;
    asm
      cmp ScanCode,0     { if were extented keystrokes }
      je  @@NoScanCode

      mov al,ScanCode    { then return scan code }
      mov ScanCode,0
      jmp @@Quit

    @@NoScanCode:
      mov al,0
      cmp Key,0
      je  @@Quit

      mov bh,al
      mov bl,Key
      dec bl
      shl bx,1
      mov ax,[offset KeyCodes + bx]

      cmp al,0
      jne @@Quit

      mov ScanCode,ah
    @@Quit:
      mov key,0
    end;

    procedure GetKeyEvent( var KEvent : KeyEvent); assembler;
    asm
      les di,KEvent
      mov word ptr es:[di],0
      cmp WasKeybEvent,0
      je  @Quit

      xor bx,bx
      mov bl,key
      dec bx
      shl bx,1
      mov ax,[offset KeyCodes + bx]

      cmp al,0
      je  @Store

      mov ah,key
    @Store:
      mov word ptr es:[di],ax
      mov WasKeybEvent,0
      mov Key,0
    @Quit:
    end;

    {-------------------------------}
    procedure KeybLights(On : boolean; Light : byte);
    var L : byte;
    begin
      if (Light>7) then exit;
      asm
        mov al,0EDh
        out 60h,al
        mov cx,2000h
      @loop:
        loop @loop
      end;
      if On then L := Lights or  Light
            else L := Lights and not Light;
      port[$60]:=L;
    end;

    {-------------------------------}
    procedure NullProc;
    begin
    end;

    var OldExitProc : pointer;

    procedure ExitProcedure; far;
    begin
      DoneKeyboard;
      ExitProc:=OldExitProc;
    end;

    FUNCTION  get_selector(segment : WORD) : WORD;
    VAR selector : WORD;
    BEGIN
      {$IFDEF DPMI}
      ASM
        MOV AX, $0002
        MOV BX, segment
        INT $31
        JNC @@1
        MOV AX, segment
    @@1:
        MOV selector, AX
      END;
      {$ELSE}
      selector := segment;
      {$ENDIF}

      get_selector := selector;
    END;

    begin
      SEG0000 := get_selector($0000);
      OldExitProc:=ExitProc;
      ExitProc:=@ExitProcedure;
    end.

    { ---------------------------  DEMO ------------------------------ }

    program KeybDemo;
    { Copyright (c) 1994 by Andrew Eigus   Fidonet: 2:5100/33 }

    uses Crt, Keyboard;

    const
      Status : array[Boolean] of String[11] = ('Not pressed', 'Pressed    ');
      Lock : array[Boolean] of String[10] = ('Not locked', 'Locked    ');

    var
      key : KeyEvent;
      ch : char;
      CursorShape : word;

    Procedure SetCursor(CursorOnOff : boolean); assembler;
    Asm
      CMP CursorOnOff,True
      JNE @@2
      CMP BYTE PTR [LastMode],Mono
      JE  @@1
      MOV CX,0607h
      JMP @@4
    @@1:
      MOV CX,0B0Ch
      JMP @@4
    @@2:
      CMP BYTE PTR [LastMode],Mono
      JE  @@3
      MOV CX,2000h
      JMP @@4
    @@3:
      XOR CX,CX
    @@4:
      MOV AH,01h
      XOR BH,BH
      INT 10h
    End; { SetCursor }

    procedure AltCtrlDelp; far;
    begin
      Writeln(#13#10#10'That was it. Not bad, eh?');
      SetCursor(True);
      Halt(1)
    end;

    Procedure WriteXY(X, Y : byte; S : string);
    Begin
      GotoXY(X, Y);
      Write(S)
    End; { WriteXY }

    Function Hex(W : Word) : string;
    const hexChars: array [0..$F] of Char = '0123456789ABCDEF';
    Begin
      Hex[0] := #4;
      Hex[1] := hexChars[Hi(W) shr 4];
      Hex[2] := hexChars[Hi(W) and $F];
      Hex[3] := hexChars[Lo(W) shr 4];
      Hex[4] := hexChars[Lo(W) and $F]
    End; { Hex }

    Begin
      InitKeyboard;
      AltCtrlDelproc:=AltCtrlDelp;
      SetCursor(False);
      TextAttr := LightGray;
      ClrScr;
      WriteLn('Keyboard unit demo  by Andrew Eigus (c) 1994   Fidonet: 2:5100/33');
      WriteLn('Hit any key to scan or Ctrl-Alt-Del to quit.');
      repeat
        GetKeyEvent(Key);

        WriteXY(1, 5, 'Left Shift state  : ' + Status[Shift.Left]);
        WriteXY(35, 5, 'Right Shift state  : ' + Status[Shift.Right]);
        WriteXY(1, 6, 'Left Alt state    : ' + Status[Alt.Left]);
        WriteXY(35, 6, 'Right Alt state    : ' + Status[Alt.Right]);
        WriteXY(1, 7, 'Left Ctrl state   : ' + Status[Ctrl.Left]);
        WriteXY(35, 7, 'Right Ctrl state   : ' + Status[Ctrl.Right]);
        WriteXY(1, 9, 'Scroll Lock state : ' + Status[ScrollLock.Pressed]);
        WriteXY(35, 9, 'Scroll Lock toggle : ' + Lock[ScrollLock.Locked]);
        WriteXY(1, 10, 'Num Lock state    : ' + Status[NumLock.Pressed]);
        WriteXY(35, 10, 'Num Lock toggle    : ' + Lock[NumLock.Locked]);
        WriteXY(1, 11, 'Caps Lock state   : ' + Status[CapsLock.Pressed]);
        WriteXY(35, 11, 'Caps Lock toggle   : ' + Lock[CapsLock.Locked]);
        WriteXY(1, 13, 'PrtScr key state : ' + Status[PrtScr]);
        if Key.ScanCode and $F0 = $E0 then
          WriteXY(1, 15, 'Key code        : ' + Hex(Key.ScanCode))
        else
        begin
          WriteXY(1, 16, 'Scan code       : ' +
            Hex(Key.ScanCode and $7F) + ',' + Hex(Key.ScanCode and $7F));
          WriteXY(35, 16, 'Key state      : ' + Status[Pressed])
        end;

        WriteXY(1, 17, 'Key ASCII code      : "' +
          Key.CharCode + '",' + Hex(Byte(Key.CharCode)));

        repeat until WasKeybEvent
      until False
    End.

[Back to KEYBOARD SWAG index] [Back to Main SWAG index] [Original]