{*
 * @(#) keyboard.pas - Keyboard event handler routines library.
 * (c) 1994 Ivan Maidanski <ivmai@chat.ru> http://ivmai.chat.ru
 * Freeware function library source. All rights reserved.
 **
 * Language: Turbo Pascal
 * Tested with: Turbo Pascal v5.5
 * Last modified: 1994-08-09 17:20:00 GMT+04:00
 *}

unit Keyboard;

{$A-,B-,D-,E-,F+,I-,L-,N-,O-,R-,S-,V-}
{$M 2048,0,0}

interface {Keyboard}

 const {Special Chars}
   NullChar= #0;
   BackSpChar= #8;
   EnterChar= #13;
   ExitChar= #27;
   SpaceChar= ' ';
   StarChar= '*';
   TabChar= #9;
   QuitChar= #3;

 const {Special Char Keys}
   NullKey= 0;
   BackSpKey= 3592;
   EnterKey= 7181;
   ExitKey= 283;
   SpaceKey= 14624;
   StarKey= 57386;
   TabKey= 3849;
   QuitKey= 11779;

 const {Cursor Keys}
   CenterKey= 19456;
   DelKey= 21248;
   DownKey= 20480;
   EndKey= 20224;
   GrayMinusKey= 18989;
   GrayPlusKey= 20011;
   HomeKey= 18176;
   InfoKey= 40960;
   LeftKey= 19200;
   PageDownKey= 20736;
   PageUpKey= 18688;
   RightKey= 19712;
   UpKey= 18432;

 const {Status Keys}
   KeyAlt= 2048;
   KeyCaps= 64;
   KeyCapsOn= 16384;
   KeyCtrl= 1024;
   KeyHold= 8;
   KeyIns= 128;
   KeyInsOn= 32768;
   KeyLat= 4;
   KeyLatFix= 2;
   KeyLatOn= 1;
   KeyLeftShift= 512;
   KeyNum= 32;
   KeyNumOn= 8192;
   KeyRightShift= 256;
   KeyScroll= 16;
   KeyScrollOn= 4096;

 var {global}
   UseOldKeyProc: Boolean;
   UserBreakProc: Procedure;
   UserKeyProc: Procedure;

 procedure ClearKeyBuffer;
 procedure ClearKeyBufferFull;
 procedure ClearStatusKey (StatusKey: Word);
 procedure DoneBreakProc;
 procedure DoneKeyboard;
 procedure DoneKeyProc;
 procedure DoneStatusKey;
 function GetAltKey (Key: Word): Byte;
 function GetBreakStatus: Boolean;
 function GetCharKey (Key: Word): Char;
 function GetCharKeyFull (Key: Word): Char;
 procedure GetEventChar (var Ch: Char);
 procedure GetEventDos (var Ch: Char);
 procedure GetEventFull (var Key: Word);
 function GetFuncKey (Key: Word): Byte;
 function GetKeyDirect: Byte;
 function GetKeyNumber (Key: Word): Byte;
 function GetStatusKey: Word;
 procedure InitBreakProc;
 procedure InitKeyProc;
 procedure InitStatusKey;
 function InKey: Char;
 function InKeyFull: Word;
 function IsOrdinaryKey (Key: Word): Boolean;
 function IsSpecialKey (Key: Word): Boolean;
 function KeyPressed: Boolean;
 function KeyPressedFull: Boolean;
 procedure PutBreakStatus (BreakStatus: Boolean);
 procedure PutStatusKey (Status: Word);
 function ReadKey: Char;
 function ReadKeyC: Char;
 function ReadKeyFull: Word;
 procedure SetStatusKey (StatusKey: Word);
 function TestKeyFull: Word;
 function TestStatusKey (StatusKey: Word): Boolean;

implementation {Keyboard}

 uses
   Dos;

 const {untyped}
   BiosKeyInt= 22;
   BreakInt= 35;
   KeyInt= 9;
   KeyPort= 96;

 const {typed}
   BreakInstalled: Boolean= False;
   KeyInstalled: Boolean= False;
   StatusInstalled: Boolean= False;

 var {global}
   OldBreakPtr: Pointer;
   OldBreakStatus: Boolean;
   OldKeyPtr: Pointer;
   OldStatusKey: Word;

 procedure BreakProc; interrupt;
  begin {BreakProc}
    if @UserBreakProc<>Nil
      then UserBreakProc
  end {BreakProc};

 procedure ClearKeyBuffer;
  var
    Ch: Char;
  begin {ClearKeyBuffer}
    while KeyPressed
      do Ch:=ReadKey
  end {ClearKeyBuffer};

 procedure ClearKeyBufferFull;
  var
    Key: Word;
  begin {ClearKeyBufferFull}
    Key:=NullKey;
    while KeyPressedFull
      do Key:=ReadKeyFull
  end {ClearKeyBufferFull};

 procedure ClearStatusKey;
  begin {ClearStatusKey}
    PutStatusKey(GetStatusKey and not StatusKey)
  end {ClearStatusKey};

 function CompNum(N,L,H: Byte): Boolean;
  begin {CompNum}
    CompNum:=(N>=L) and (N<=H)
  end {CompNum};

 procedure DoneBreakProc;
  begin {DoneBreakProc}
    if BreakInstalled
      then begin {then}
             PutBreakStatus(OldBreakStatus);
             SetIntVec(BreakInt,OldBreakPtr);
             BreakInstalled:=False
           end {then}
  end {DoneBreakProc};

 procedure DoneKeyProc;
  begin {DoneKeyProc}
    if KeyInstalled
      then SetIntVec(KeyInt,OldKeyPtr);
    KeyInstalled:=False
  end {DoneKeyProc};

 procedure DoneKeyboard;
  begin {DoneKeyboard}
    DoneBreakProc;
    DoneKeyProc;
    DoneStatusKey
  end {DoneKeyboard};

 procedure DoneStatusKey;
  begin {DoneStatusKey}
    if StatusInstalled
      then PutStatusKey(OldStatusKey);
    StatusInstalled:=False
  end {DoneStatusKey};

 function GetAltKey;
  var
    N: Byte;
  begin {GetAltKey}
    GetAltKey:=0;
    if Lo(Key)=0
      then begin {then}
             N:=Hi(Key);
             if CompNum(N,120,131)
               then GetAltKey:=N-119;
             if CompNum(N,16,25)
               then GetAltKey:=N-3;
             if CompNum(N,30,38)
               then GetAltKey:=N-7;
             if CompNum(N,44,50)
               then GetAltKey:=N-12
           end {then}
  end {GetAltKey};

 function GetBreakStatus;
  var
    CBreak: Boolean;
  begin {GetBreakStatus}
    GetCBreak(CBreak);
    GetBreakStatus:=CBreak
  end {GetBreakStatus};

 function GetCharKey;
  begin {GetCharKey}
    GetCharKey:=Chr(Lo(Key))
  end {GetCharKey};

 function GetCharKeyFull;
  var
    Ch: Char;
  begin {GetCharKeyFull}
    Ch:=Chr(Lo(Key));
    if (Ch=NullChar) and (Key>NullKey)
      then Inc(Ch);
    GetCharKeyFull:=Ch
  end {GetCharKeyFull};

 procedure GetEventChar;
  begin {GetEventChar}
    if KeyPressedFull and (Ch=NullChar)
      then Ch:=Chr(Lo(ReadKeyFull))
  end {GetEventChar};

 procedure GetEventDos;
  begin {GetEventDos}
    if KeyPressed and (Ch=NullChar)
      then Ch:=ReadKey
  end {GetEventDos};

 procedure GetEventFull;
  begin {GetEventFull}
    if KeyPressedFull and (Key=NullKey)
      then Key:=ReadKeyFull
  end {GetEventFull};

 function GetFuncKey;
  var
    N: Byte;
  begin {GetFuncKey}
    GetFuncKey:=0;
    if Lo(Key)=0
      then begin {then}
             N:=Hi(Key);
             if CompNum(N,59,68)
               then GetFuncKey:=N-58;
             if CompNum(N,104,113)
               then GetFuncKey:=N-93;
             if CompNum(N,94,103)
               then GetFuncKey:=N-73;
             if CompNum(N,84,93)
               then GetFuncKey:=N-53
           end {then}
  end {GetFuncKey};

 function GetKeyDirect;
  begin {GetKeyDirect}
    GetKeyDirect:=Port[KeyPort]
  end {GetKeyDirect};

 function GetKeyNumber;
  begin {GetKeyNumber}
    GetKeyNumber:=Hi(Key)
  end {GetKeyNumber};

 function GetStatusKey;
  begin {GetStatusKey}
    GetStatusKey:=Mem[0:1048]+Mem[0:1047] shl 8
  end {GetStatusKey};

 function IsOrdinaryKey;
  begin {IsOrdinaryKey}
    IsOrdinaryKey:=Lo(Key)>0
  end {IsOrdinaryKey};

 function IsSpecialKey;
  begin {IsSpecialKey}
    IsSpecialKey:=(Hi(Key)>0) and (Lo(Key)=0)
  end {IsSpecialKey};

 procedure InitBreakProc;
  begin {InitBreakProc}
    if not BreakInstalled
      then begin {then}
             OldBreakStatus:=GetBreakStatus;
             PutBreakStatus(False);
             GetIntVec(BreakInt,OldBreakPtr);
             SetIntVec(BreakInt,@BreakProc);
             BreakInstalled:=True;
             @UserBreakProc:=Nil
           end {then}
  end {InitBreakProc};

 procedure KeyProc; interrupt;
  var
    Proc: Procedure;
  begin {KeyProc}
    if @UserKeyProc<>Nil
       then UserKeyProc;
    @Proc:=OldKeyPtr;
    if UseOldKeyProc
      then Proc
  end {KeyProc};

 procedure InitKeyProc;
  begin {InitKeyProc}
    if not KeyInstalled
      then begin {then}
             GetIntVec(KeyInt,OldKeyPtr);
             SetIntVec(KeyInt,@KeyProc);
             KeyInstalled:=True;
             @UserKeyProc:=Nil;
             UseOldKeyProc:=True
           end {then}
  end {InitKeyProc};

 procedure InitStatusKey;
  begin {InitStatusKey}
    if not StatusInstalled
      then OldStatusKey:=GetStatusKey;
    StatusInstalled:=True;
    PutStatusKey(NullKey)
  end {InitStatusKey};

 function InKey;
  begin {InKey}
    InKey:=NullChar;
    if KeyPressed
      then InKey:=ReadKey
  end {InKey};

 function InKeyFull;
  begin {InKeyFull}
    InKeyFull:=NullKey;
    if KeyPressedFull
      then InKeyFull:=ReadKeyFull
  end {InKeyFull};

 function KeyPressed;
  var
    Reg: Registers;
  begin {KeyPressed}
    Reg.ah:=11;
    MsDos(Reg);
    KeyPressed:=Reg.al>Ord(NullChar)
  end {KeyPressed};

 function KeyPressedFull;
  var
    Reg: Registers;
  begin {KeyPressedFull}
    Reg.ah:=1;
    Intr(BiosKeyInt,Reg);
    KeyPressedFull:=(Reg.Flags and 64)=0
  end {KeyPressedFull};

 procedure PutBreakStatus;
  begin {PutBreakStatus}
    SetCBreak(BreakStatus)
  end {PutBreakStatus};

 procedure PutStatusKey;
  begin {PutStatusKey}
    MemW[0:1047]:=Swap(Status)
  end {PutStatusKey};

 function ReadKey;
  var
    Reg: Registers;
  begin {ReadKey}
    Reg.ah:=7;
    MsDos(Reg);
    ReadKey:=Chr(Reg.al)
  end {ReadKey};

 function ReadKeyC;
  var
    Reg: Registers;
  begin {ReadKeyC}
    Reg.ah:=8;
    MsDos(Reg);
    ReadKeyC:=Chr(Reg.al)
  end {ReadKeyC};

 function ReadKeyFull;
  var
    Reg: Registers;
  begin {ReadKeyFull}
    Reg.ax:=0;
    Intr(BiosKeyInt,Reg);
    ReadKeyFull:=Reg.ax
  end {ReadKeyFull};

 procedure SetStatusKey;
  begin {SetStatusKey}
    PutStatusKey(GetStatusKey or StatusKey)
  end {SetStatusKey};

 function TestKeyFull;
  var
    Reg: Registers;
  begin {TestKeyFull}
    Reg.ah:=1;
    Intr(BiosKeyInt,Reg);
    if (Reg.Flags and 64)=0
      then TestKeyFull:=Reg.ax
      else TestKeyFull:=0
  end {TestKeyFull};

 function TestStatusKey;
  begin {TestStatusKey}
    TestStatusKey:=(GetStatusKey and StatusKey)=StatusKey
  end {TestStatusKey};

end {Keyboard}.