Program KeyDemo;
type
  BitType = 1..8;
var
  ToggleByte : byte absolute $40:$17;
  ScreenSeg  : integer;
  C, D       : char;
  done       : boolean;
{============================================================================}
procedure illumination(N: BitType;light : boolean);    {Here I am "poking"   }
var                                                    {an attribute byte    }
  LocationCode : integer;                              {into the screen      }
  Row,Col,Pos,LightLevel  : byte;                      {memory--15 is bright }
begin                                                  {and 112 is reverse.  }
  if light then LightLevel := 112 else LightLevel := 15;
  Row := ((N-1) div 4) + 1;
  Col := ((N-1) mod 4)*15;
  for Pos := Col + 2 to Col + 15 do
    begin
      LocationCode := (Pos-1)*2 + (row-1)*160 + 1;
      Mem[ScreenSeg:locationCode] := LightLevel;
    end;
end;
{=======================================================================}
procedure ToggleNames;
begin
  WriteLn('*   INSERT     *   CAPS LOCK  *    NUM LOCK  *  SCROLL LOCK *');
  WriteLn('*     ALT      *    CONTROL   *   LEFT SHIFT *  RIGHT SHIFT *');
end;
{=======================================================================}
procedure CheckStatus;             {ToggleByte is declared above at an }
var                                {absolute location that happens to  }
  N : BitType;                     {hold the status (on or off) of the }
  checker : byte;                  {eight keys shown in its eight bits.}
begin
  checker := 1;
  for N := 8 downto 1 do
    begin
      if ToggleByte and checker = checker then illumination(N,true)
        else illumination(N,false);
      checker := 2*checker;
    end;
  if ToggleByte and 10 = 10 then Done := true; {if left shift AND Alt are on}
end;
{=======================================================================}
procedure GetKeys(var choice, EscChoice:char);      { This is a handy      }
begin                                               { procedure.  It       }
  repeat CheckStatus until KeyPressed or Done;      { waits for a key      }
  EscChoice := chr(0);                              { to be pressed and    }
  if not Done then                                  { reads it.  If the    }
    begin                                           { keypressed function  }
      read(Kbd,choice);                             { is still TRUE, it    }
      if keypressed then read(Kbd,EscChoice);       { reads the Escape code}
    end;
end;
{=======================================================================}
procedure WhatKeys;
  begin
  GetKeys(C,D);
  if not Done then
    begin
      gotoXY(10,10);
      write('           ');
      gotoXY(11,10);
    if C = chr(27) then
      begin
        if D = chr(0) then write('Esc');
        Case D of
          ';': write('F1');
          '<': write('F2');
          '=': write('F3');
          '>': write('F4');
          '?': write('F5');
          '@': write('F6');
          'A': write('F7');
          'B': write('F8');
          'C': write('F9');
          'D': write('F10');
          'h': write('Alt-F1');
          'i': write('Alt-F2');
          'j': write('Alt-F3');
          'k': write('Alt-F4');
          'l': write('Alt-F5');
          'm': write('Alt-F6');
          'n': write('Alt-F7');
          'o': write('Alt-F8');
          'p': write('Alt-F9');
          'q': write('Alt-F10');
          'T': write('Shift-F1');
          'U': write('Shift-F2');
          'V': write('Shift-F3');
          'W': write('Shift-F4');
          'X': write('Shift-F5');
          'Y': write('Shift-F6');
          'Z': write('Shift-F7');
          '[': write('Shift-F8');
          '\': write('Shift-F9');
          ']': write('Shift-F10');
          '^': write('Ctrl-F1');
          '_': write('Ctrl-F2');
          '`': write('Ctrl-F3');
          'a': write('Ctrl-F4');
          'b': write('Ctrl-F5');
          'c': write('Ctrl-F6');
          'd': write('Ctrl-F7');
          'e': write('Ctrl-F8');
          'F': write('Ctrl-F9');
          'g': write('Ctrl-F10');
          'G': write('Home');
          'H': write('Up');
          'I': write('PgUp');
          'K': write('Left');
          'M': write('Right');
          'O': write('End');
          'P': write('Down');
          'Q': write('PgDn');
          'R': write('Ins');
          'S': write('Del');
          'w': write('Ctrl-Home');
          '„': write('Ctrl-PgUp');
          's': write('Ctrl-LeFt');
          't': write('Ctrl-Right');
          'u': write('Ctrl-End');
          'v': write('Ctrl-PgDn');
          'r': write('Ctrl-prtsc');
        end;  {case statement}
      end   {if C = chr(27)}
    else
      case ord(C) of
           9 : write('Tab');
           8 : write('BackSpace');
      else write(C);
      end;   {case}
    end;  {if not done}
end;  {procedure GetKeys}
{============================================================================}
begin
  IF (Mem[0000:1040] AND 48) <> 48 THEN ScreenSeg := $B800
   ELSE ScreenSeg := $B000; {set screen memory segment to color or mono}
  WriteLn('Play with the keys.  This program recognizes only SPECIAL');
  WriteLn('keystrokes, such as the function and arrow keys.  It also');
  WriteLn('tracks the toggles and shift keys.  Hit a key to start.');
  WriteLn;
  WriteLn('Press <Alt> and the left <shift> at once to quit.');
  done := false;
  repeat until KeyPressed;
  ClrScr;
  ToggleNames;
  GotoXY(5,6);
  Write('Press <Alt> and the left <shift> at once to quit.');
  GotoXY(1,10);
  Write('Key is->>> ');
  repeat
    WhatKeys
  until Done;
end.