Pascal Keyboard

Unit KeyBoard;

{ ЋЎлз­® Є« ўЁ вга  Ї®бл« Ґв бЁ¬ў®«л ў Є®¬ЇмовҐа }
{ б ¬ ЄбЁ¬ «м­®© бЄ®а®бвмо 4 ивгЄЁ ў бҐЄг­¤г. }
{ —в®Ўл ЁЈагиЄ  ­Ґ Їа®бв Ёў «  ў ®¦Ё¤ ­ЁЁ ўў®¤  б Є« ўЁ вгал }
{ ­г¦­® аҐ «Ё§®ў вм б«Ґ¤гойЁ©  «Ј®аЁв¬: }
{ 1) ў ­ з «Ґ Їа®Ја ¬¬л ¤®ЇгбвЁвм, зв® ўбҐ Є« ўЁиЁ ®вЇг饭л }
{    ў жЁЄ«Ґ Їа®Ја ¬¬л: }
{ 2) бзЁв вм ­ ¦ вл¬Ё вҐ Є« ўЁиЁ, Є®в®а률­Ґ ®вЇг饭л }
{ 3) Ї®  ­ «®ЈЁЁ бзЁв вм ®вЇг饭­л¬Ё ­Ґ ­ ¦ в률}
{ ‘®Ўб⢥­­® нв®в ¬®¤г«м Ё Ї®¬®Ј Ґв аҐ «Ё§®ў вм бҐ©  «Ј®аЁв¬: }
{ Set_Handler -> 1) }
{ New_Handler -> 2), 3) }

Interface

{ ‡¤Ґбм бЄ ­Є®¤л Ї®звЁ ўбҐе Є« ўЁи }

Const
  sEsc          =       1;
  s1            =       2;
  s2            =       3;
  s3            =       4;
  s4            =       5;
  s5            =       6;
  s6            =       7;
  s7            =       8;
  s8            =       9;
  s9            =     $0A;
  s0            =     $0B;
  sMinus        =     $0C;              { - _ }
  sEqual        =     $0D;              { = + }
  sBackSpace    =     $0E;
  sTab          =     $0F;
  sQ            =     $10;
  sW            =     $11;
  sE            =     $12;
  sR            =     $13;
  sT            =     $14;
  sY            =     $15;
  sU            =     $16;
  sI            =     $17;
  sO            =     $18;
  sP            =     $19;
  sLBraket      =     $1A;             (* [ { *)
  sRBraket      =     $1B;             (* ] } *)
  sEnter        =     $1C;
  sCtrl         =     $1D;
  sA            =     $1E;
  sS            =     $1F;
  sD            =     $20;
  sF            =     $21;
  sG            =     $22;
  sH            =     $23;
  sJ            =     $24;
  sK            =     $25;
  sL            =     $26;
  sSemicolon    =     $27;              { ; :  }
  sQuote        =     $28;              { ' "  }
  sApostrophe   =     $29;              { ` ~  }
  sLShift       =     $2A;
  sSlash        =     $2B;              { \ |  }
  sZ            =     $2C;
  sX            =     $2D;
  sC            =     $2E;
  sV            =     $2F;
  sB            =     $30;
  sN            =     $31;
  sM            =     $32;
  sComma        =     $33;              { , <  }
  sPoint        =     $34;              { . >  }
  sBackSlash    =     $35;              { / ?  }
  sRShift       =     $36;
  sAsteriks     =     $37;              { *  ­  жЁда®ў®© Є« ўЁ вгॠ}
  sAlt          =     $38;
  sSpace        =     $39;              { Їа®ЎҐ« }
  sCapsLock     =     $3A;
  sF1           =     $3B;
  sF2           =     $3C;
  sF3           =     $3D;
  sF4           =     $3E;
  sF5           =     $3F;
  sF6           =     $40;
  sF7           =     $41;
  sF8           =     $42;
  sF9           =     $43;
  sF10          =     $44;
  sNumLock      =     $45;
  sScrollLock   =     $46;
  sHome         =     $47;
  sUp           =     $48;
  sPageUp       =     $49;
  sGrayMinus    =     $4A;              { -  ­  жЁда®ў®© Є« ўЁ вгॠ}
  sLeft         =     $4B;
  sFive         =     $4C;              { 5  ­  жЁда®ў®© Є« ўЁ вгॠ}
  sRight        =     $4D;
  sGrayPlus     =     $4E;              { +  ­  жЁда®ў®© Є« ўЁ вгॠ}
  sEnd          =     $4F;
  sDown         =     $50;
  sPageDown     =     $51;
  sInsert       =     $52;
  sDelete       =     $53;
  sF11          =     $57;
  sF12          =     $58;

Var
  KeyMap : Array [0..$7F] of Boolean;   { ‘¬ҐйҐ­ЁҐ-бЄ ­Є®¤ Є« ўЁиЁ, TRUE - }
                                        { ­ ¦ в  бҐ©з б, FALSE - ®вЇг饭  }
  SymMap : Array [0..$7F] of Char;      { ‘¬ҐйҐ­ЁҐ-бЄ ­Є®¤ Є« ўЁиЁ, }
                                        { б®¤Ґа¦Ё¬®Ґ - ASCII-бЁ¬ў®«л ¤«п Є« ўЁи }

Procedure Set_Handler;
{ “бв ­ ў«Ёў Ґв ­®ўл© ®Ўа Ў®взЁЄ Є« ўЁ вга­®Ј® ЇаҐалў ­Ёп, }
{ Є®Ј¤  ­®ўл© ®Ўа Ў®взЁЄ  ЄвЁўҐ­, в® Ќ…‚Ћ‡ЊЋ†ЌЋ Ї®«м§®ў вмбп }
{ KeyPressed, ReadKey Ё Read,   в Є¦Ґ ®бв ­ ў«Ёў вм Їа®Ја ¬¬г }
{ Ї® Ctrl+C (Ctrl+Break) Ё«Ё ҐҐ ®в« ¦Ёў вм. }
{ KeyPressed Ё ReadKey Ё¬Ґов  ­ «®ЈЁ - б¬®ваЁ ­Ё¦Ґ }

Procedure Remove_Handler;
{ ‚®§ўа й Ґв бв ал© ®Ўа Ў®взЁЄ Є« ўЁ вга­®Ј® }
{ ЇаҐалў ­Ёп ­  ҐЈ® § Є®­­®Ґ ¬Ґбв® }

Procedure WaitForACSReleased;
{ †¤Ґв ®вЇгбЄ ­Ёп Alt,Ctrl,Shift; ЁбЇ®«м§гҐвбп ’Ћ‹њЉЋ Џ…ђ…„ }
{ гбв ­®ўЄ®© ­®ў®Ј® ®Ўа Ў®взЁЄ  Є« ўЁ вга­®Ј® ЇаҐалў ­Ёп }

Function KeyPressedNow : Boolean;
{ ‚®§ўа й Ґв TRUE Ґб«Ё ў „ЂЌЌ›‰ ¬®¬Ґ­в ўаҐ¬Ґ­Ё }
{ ¤Ґ©б⢨⥫쭮 ­ ¦ в  е®впЎл ®¤­  Є« ўЁи , Ё­ зҐ ў®§ўа й Ґв FALSE. }
{ €бЇ®«м§гҐвбп ў¬Ґб⥠ᠬ ббЁў ¬Ё KeyMap Ё SymMap }

Function KeyPressed2 : Boolean;
{ Џ®«­л©  ­ «®Ј д-жЁЁ KeyPressed Ё§ ¬®¤г«п CRT. }

Function ReadScan : Byte;
{ Ђ­ «®Ј д-жЁЁ ReadKey (¬®¤г«м CRT). }
{ ђ §­Ёж  ў в®¬, зв® нв  д-жЁп ў®§ўа й Ґв }
{ ­Ґ бЁ¬ў®« Є« ўЁиЁ,   ҐҐ бЄ ­Є®¤, Ї®§ў®«пп }
{ ¤®Ўа вмбп ¤® Є ¦¤®© Є« ўЁиЁ. }
{ €бЇ®«м§гҐвбп ў¬Ґб⥠б KeyPressed2 }

Function ReadChar : Char;
{ Ђ­ «®Ј д-жЁЁ ReadKey (¬®¤г«м CRT). }
{ ђ §­Ёж  ў в®¬, зв® нв  д-жЁп ў®§ўа й Ґв }
{ бЁ¬ў®« Є« ўЁиЁ ЎҐ§ гзҐв  б®бв®п­Ё© Alt,Ctrl,Shift Ё Caps Lock. }
{ …б«Ё ­ ¦ в п Є« ўЁи  ­Ґ Ё¬ҐҐв ­  бҐЎҐ бЁ¬ў®« , в® ў®§ўа й Ґвбп }
{ ­г«Ґў®© бЁ¬ў®«, ­Ё ® Є ЄЁе а биЁаҐ­­ле Є®¤ е §¤Ґбм аҐзЁ Ўлвм ­Ґ }
{ ¬®¦Ґв. €бЇ®«м§гҐвбп ў¬Ґб⥠б KeyPressed2 }

Procedure ClearKeyboardBuf;
{ ЋзЁй Ґв Є®«м楢®© ЎгдҐа, ЁбЇ®«м§гҐ¬л© д-жЁп¬Ё KeyPressedNow, KeyPressed2, }
{ ReadScan Ё ReadChar }

Implementation

Uses DOS;

Const
  Old_Handler : Pointer = Nil;          { ‘о¤  б®еа ­Ё¬  ¤аҐб бв а®Ј® ®Ўа Ў®взЁЄ  }
  KeyBufSize            = 16;           { Љ« ўЁ вга­л© ЎгдҐа Ўг¤Ґв б®¤Ґа¦ вм }
                                        { ¬ ЄбЁ¬г¬ 16 бЄ ­Є®¤®ў }

  Symbs : Array [sEsc..sSpace] of Char =
    #27'1234567890-='#8#9'QWERTYUIOP[]'#13#0'ASDFGHJKL;''`'#0'\'+
    'ZXCVBNM,./'#0'*'#0' ';

Var
  KeyBuf : Array [0..KeyBufSize] of Byte;       { Љ®«м楢®© Є« ўЁ вга­л© ЎгдҐа }
  BufHead,                                      { ѓ®«®ў  ЎгдҐа  }
  BufTail : Word;                               { •ў®бв ЎгдҐа  }
  KeyCount : Byte;                              { Љ®«-ў® бЄ ­Є®¤®ў Є« ўЁи }
                                                { ў ЎгдҐаҐ }

Procedure New_Handler; Interrupt; Assembler;
{ Using assembler because we need a fast interrupt-handling routine }
Asm
  Push  AX
  Push  BX
  In    AL, 060h
  Mov   AH, AL
  And   AL, 07Fh                                { AL = ‘Є ­Є®¤ }
  LEA   BX, KeyMap
  Add   BL, AL
  AdC   BH, 0
  Test  AH, 080h
  JNZ   @released                               { ‘в аиЁ© ЎЁв - д« Ј ®вЇгбЄ ­Ёп }
  Mov   Byte Ptr [BX], TRUE                     { Љ« ўЁи  Ўл«  ­ ¦ в  }
  Cmp   KeyCount, KeyBufSize
  JE    @done                                   { ЃгдҐа ЎЁвЄ®¬ ­ ЎЁв }
  LEA   BX, KeyBuf
  Add   BX, BufTail
  Mov   [BX], AL                                { ‘®еа ­Ё«Ё бЄ ­Є®¤ ў KeyBuf }
  Inc   KeyCount                                { More keys avaible to read }
  Inc   BufTail                                 { ‘«Ґ¤гой п Ї®§ЁжЁп ¤«п б®еа ­Ґ­Ёп }
  Cmp   BufTail, KeyBufSize
  JNE   @done
  Mov   BufTail, 0                              { ‘Є®а४вЁа®ў «Ё Ї®§ЁжЁо }
  Jmp   @done
@released:
  Mov   Byte Ptr [BX], FALSE                    { Љ« ўЁи  Ўл«  ®вЇг饭  }
@done:
  Mov   AL, 020h                                { ‘®®ЎйЁ«Ё Є®­ва®««Ґаг }
  Out   020h, AL                                { ЇаҐалў ­Ё©, зв® ЇаҐалў ­ЁҐ }
                                                { ®Ўа Ў®в ­® }
  Pop   BX
  Pop   AX
End;

Procedure Set_Handler;
Begin
  If Old_Handler <> Nil then Exit;
  FillChar (KeyMap, $80, False);        { €§­ з «м­® бзЁв Ґ¬ ўбҐ Є« ўЁиЁ }
  KeyCount := 0;                        { ®вЇг饭­л¬Ё }
  BufHead := 0;                         { -//- }
  BufTail := 0;                         { -//- }
  GetIntVec (9, Old_Handler);
  SetIntVec (9, @New_Handler)
End;

Procedure Remove_Handler;
Begin
  If Old_Handler = Nil then Exit;
  SetIntVec (9, Old_Handler);
  Old_Handler := Nil
End;

Procedure WaitForACSReleased;
Begin
  While Mem[$40:$17] and $0F <> 0 do
End;

Function KeyPressedNow : Boolean; Assembler;
{ Ќ   бᥬЎ«ҐаҐ а Ў®в Ґв игбв॥, зҐ¬ ­  Џ бЄ «Ґ }
Asm
  Mov   AX, DS
  Mov   ES, AX
  LEA   DI, KeyMap+1                            { Ќ зЁ­ Ґ¬ б Escape }
  Mov   CX, 058h                                { ‚ᥠЄ« ўЁиЁ Ї«об F11 Ё F12 }
  Mov   AL, FALSE                               { ЏаҐ¤Ї®«®¦Ё«Ё, зв® Їгбв® }
  CLD
  RepE  ScaSB                                   { ‘Є ­­Ёа㥬 ¬ ббЁў KeyMap }
  JE    @end                                    { Џгбв® }
  Mov   AL, TRUE                                { —в®-в® ­ ¦ в® }
@end:
End;

Function KeyPressed2 : Boolean;
Begin
  KeyPressed2 := KeyCount<>0                    { ЃгдҐа ­Ґ Їгбв }
End;

Function ReadScan : Byte;
Begin
  While KeyCount=0 do;
  ReadScan := KeyBuf[BufHead];
  Inc (BufHead);                                { ‘¬ҐйҐ­ЁҐ б«Ґ¤го饩 Є« ўЁиЁ }
  If BufHead = KeyBufSize then BufHead := 0;
  Dec (KeyCount)                                { Ћ¤­г Є« ўЁиг ¤®«®© }
End;

Function ReadChar : Char;
Begin
  ReadChar := SymMap[ReadScan]
End;

Procedure ClearKeyboardBuf;
Begin
  Asm PushF; CLI End;
  BufHead := BufTail;
  KeyCount := 0;
  Asm PopF End
End;

Var I : Byte;

Begin
  { ‡ Ї®«­Ґ­ЁҐ ¬ ббЁў  бЁ¬ў®«®ў }
  FillChar (SymMap, $80, 0);
  For I := sEsc to sSpace do
    SymMap[I] := Symbs[I];
  SymMap[sGrayMinus] := '-';
  SymMap[sGrayPlus] := '+'
End.