home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / KEYWATCH / KEYWATCH.PAS
Encoding:
Pascal/Delphi Source File  |  1992-01-24  |  2.9 KB  |  106 lines

  1. (* keywatch.pas 12-13-91 Robert Mashlan, Public Domain
  2.  
  3.    This program monitors the keyboard interrupt, and stores the
  4.    status of each key as to whether it is pressed or released.
  5.  
  6.    This is done by capturing interrupt 9, and watching the make/break
  7.    codes.  The status is updated in the keys array, where nonzero means
  8.    that the key is pressed, while 0 means the key is released.  The
  9.    key array is uses the scan code for an index instead of the ascii
  10.    character.  It is simple enough to find the scan code for a key,
  11.    just run this program and watch the display.
  12.  
  13.    Since this program installs an interrupt handler, it should be
  14.    terminated normally, such the keyboard handler can be removed.
  15.  
  16.                                                                    *)
  17.  
  18. Uses
  19.    Dos, Crt;
  20.  
  21. var
  22.    keys : array[0..127] of boolean;  (* array of key states *)
  23.    OldKBIsr : Procedure;             (* address of previous keyboard ISR *)
  24.  
  25.  
  26. Procedure NewKBIsr; interrupt;
  27. const
  28.    keyport = $60;
  29. var
  30.    scancode : byte;
  31.  
  32. Procedure PushF; inline($9c);
  33.  
  34. begin
  35.    scancode := port[keyport];            (* read keyboard scan code *)
  36.    if ( scancode <> $e0 ) and ( scancode <> $e1 ) then
  37.       if ( scancode and $80 ) = $80 then        (* key released? *)
  38.          keys[scancode and $7f] := false    (* it's released *)
  39.       else
  40.          keys[scancode] := true;            (* it's pressed *)
  41.    pushf;
  42.    oldkbisr;  (* chain to previous keyboard ISR *)
  43. end;
  44.  
  45. Function KeysPressed : integer;
  46. (* returns number of keys being held down *)
  47. var
  48.    result, i : integer;
  49. begin
  50.    result := 0;
  51.    for i := 0 to 127 do
  52.       if keys[i] then
  53.          inc(result);
  54.    KeysPressed := result;
  55. end;
  56.  
  57. Function HexStr( b : byte ) : string;
  58. (* form a string of b represented in hex *)
  59. type
  60.    nibble = 0..$f;
  61. var
  62.    result : string;
  63.  
  64.    Function NibCh( n : nibble ) : char;
  65.    (* returns hex char given a nibble *)
  66.    begin
  67.       case n of
  68.         0..9 : NibCh := char( n + ord('0') );
  69.         else   NibCh := char( n - $a + ord('a') );
  70.       end;
  71.    end;
  72.  
  73. begin
  74.    result := '$00';
  75.    result[2] := NibCh( b shr 4 );
  76.    result[3] := NibCh( b and $f );
  77.    HexStr := result;
  78. end;
  79.  
  80. Procedure Main;
  81. var
  82.    LastKeyCount, i : integer;
  83. begin
  84.    LastKeyCount := 0;
  85.    for i := 0 to 127 do  (* intialize array *)
  86.       Keys[i] := false;
  87.    CheckBreak := FALSE; (* ignore ^C and ^Break *)
  88.    GetIntVec($9,@OldKBIsr);
  89.    SetIntVec($9,@NewKBIsr); (* install interrupt handler *)
  90.    repeat
  91.       if KeysPressed <> LastKeyCount then (* change in keystatus? *)
  92.       begin
  93.          clrscr;
  94.          for i := 0 to 127 do
  95.             if keys[i] then
  96.                Writeln('key with scan code ',HexStr(i),' has been pressed');
  97.          lastkeycount := KeysPressed;
  98.       end;
  99.   until KeyPressed and ( ReadKey = #27 ); (* terminate loop when esc pressed *)
  100.   SetIntVec($9,@OldKBIsr); (* remove interrupt handler *)
  101. end;
  102.  
  103. begin
  104.   Main;
  105. end.
  106.