{@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
The purchaser of these procedures and functions may include them in COMPILED
programs freely, but may not sell or give away the source text.

    This is a little game using the procedures in SCREEN.LIB.

}
{$I regpack.typ}
{$I cursor.lib}
{$I monitor.lib}
{$I screen.lib}
{$I getkeys.lib}
type
  charSet = set of char;
const
  arrows : charSet = [#24,#25,#26,#27];
var
  M, N, col, row, hitCol, hitRow : byte;
  C, D, mover    : char;
  DEAD, FOUND    : boolean;

begin
  sound(1000);
  delay(10);
  NoSound;
  WriteLn('This is a demonstration of the SCREEN procedures.  You will see ');
  WriteLn('an arrow on the screen, and a HORNED BEAST in reverse video.');
  WriteLn('As you press the cursor keys, the arrow is quickly written');
  WriteLn('across the screen.  If you move onto your own path (sensed by');
  WriteLn('READSCREEN), you die.  If you move onto the BEAST, you live.');
  WriteLn('Either way, the screen attribute then gets rapidly changed');
  WriteLn;
  WriteLn('When you are writing to the screen this way, it''s nice to turn');
  WriteLn('the cursor OFF.  Use procedure Cursor_control from CURSOR.LIB.');
  WriteLn('  Press a key');
  repeat until keypressed;
  Cursor_control(48,0);  { 48 is the magic number that sets bits
                           5 and 6, thus turning off the cursor}
  ClrScr;
  DEAD := false;
  FOUND := false;
  CheckColor;
  col := random(80)+1;
  row := random(25)+1;
  WriteScreen(col,row,#153,112);
  col := random(80)+1;
  row := random(25)+1;
  mover := chr(random(4)+24);
  repeat
    WriteScreen(col,row,mover,15);
    repeat
      GetKeys(C,D)
    until (C = #27) and (D in ['H','K','M','P']);
    case D of
      'H': if row > 1 then
             begin
               row := row - 1;
               mover := #24;
               if ReadScreen(col,row) in arrows then DEAD := true;
               if ReadScreen(col,row) = #153 then FOUND := true;
             end;
      'K': if col > 1 then
             begin
               col := col - 1;
               mover := #27;
               if ReadScreen(col,row) in arrows then DEAD := true;
               if ReadScreen(col,row) = #153 then FOUND := true;
             end;
      'P': if row < 25 then
             begin
               row := row + 1;
               mover := #25;
               if ReadScreen(col,row) in arrows then DEAD := true;
               if ReadScreen(col,row) = #153 then FOUND := true;
             end;
      'M': if col < 80 then
             begin
               col := col + 1;
               mover := #26;
               if ReadScreen(col,row) in arrows then DEAD := true;
               if ReadScreen(col,row) = #153 then FOUND := true;
             end;
    end; {case}
  until DEAD or FOUND;
  if found then
    begin
      hitCol := col;
      hitRow := row;
      for M := 1 to 5 do
       for N := 1 to 5 do
        for col := hitCol-2 to hitCol+2 do
         for row := hitRow-1 to hitRow+1 do
          begin
            WriteScreen(col,row,chr(((N+col) mod 2)+11),15+((M mod 2)*97));
            delay(5);
          end
    end
  else
    begin
      GotoXY(col,row);
      Write('  YOU ARE DEAD ');
    end;
  delay(1000);
  for col := 1 to 80 do
    for row := 1 to 25 do
      begin
        ScreenAttribute(col,row,112);
        sound(col*row*5);
      end;
  for col := 1 to 80 do
    for row := 1 to 25 do
      begin
        ScreenAttribute(col,row,1);
        sound(col*row*5+500);
      end;
  for col := 80 downto 1 do
    for row := 1 to 25 do
      begin
        ScreenAttribute(col,row,15);
        sound(col*row*5);
      end;
   nosound;
   if color then                { In monochrome mode, the normal cursor }
     cursor_control(6,7)        { consists of scan lines 12 and 13.  In }
   else cursor_control(12,13);  { color, it's 6 and 7.                  }
end.