{ page 1 of 5 }

{ Copyright 1980 Oregon Software        }
{ 2340 SW Canyon Road                   }
{ Portland, Oregon  97201               }

{ Permission is hereby granted to republish this program        }
{ provided that this copyright notice is included.              }

{ The game of Life, by John Horton Conway,      }
{ as described in Scientific American magazine  }
{ October 1970, January 1971, February 1971.    }

const
  MaxR=22; MaxR1=23;                             { Maximum Row }
  MaxC=80; MaxC1=81;                             { Maximum Column }
  Esc=155;                                       { ASCII escape }

type
  Cell= (Empty, Dying, Pregnant, Living);

  GridType= packed array[0..MaxR1,0..MaxC1] of Cell;

var
  Grid: GridType;

  Store: file of GridType;

  Row, Column: integer;

  Command: char;

  StoreName: packed array[1..20] of char;


  procedure MarkVT100(Row, Column: integer; Ch: char);
  begin
    writeln(chr(Esc),'Y',chr(Row+31),chr(Column+31),Ch);
  end;

  procedure EraseVT100;
  begin
    writeln(chr(Esc),'Y  ',chr(Esc),'J');
  end;

  procedure Bell;
  const Bel=7;                                   { ASCII bell }
  begin
    write(chr(Bel));
  end;

{ page 2 of 5 }

  procedure ClearGrid;
  var Row, Column: integer;
  begin
    EraseVT100;
    for Row:= 0 to MaxR1 do
      for Column:= 0 to MaxC1 do
        Grid[Row,Column]:= Empty;
  end;

  procedure AddCell(Row,Column: integer);
  begin
    Grid[Row,Column]:= Living;
    MarkVT100(Row,Column,'*');
  end;

  procedure RemoveCell(Row,Column: integer);
  begin
    Grid[Row,Column]:= Empty;
    MarkVT100(Row,Column,' ');
  end;

  procedure DrawGrid;
  var Row,Column: integer;
  begin
    EraseVT100;
    for Row:= 1 to MaxR do
      for Column:= 1 to MaxC do
        if Grid[Row,Column] = Living then
          MarkVT100(Row,Column,'*');
  end;

  function InRange(Row,Column: integer): boolean;
  begin
    InRange:= (Row>=1) and (Row<=MaxR)
     and (Column>=1) and (Column<=MaxC);
  end;

  procedure GetCommand(var Command: char; var Row,Column: integer);
  begin
    write(chr(Esc),'Y6 ','command: ',chr(Esc),'J');
    read(Command);
    if eoln then readln
    else begin
      read(Row);
      if eoln then readln
      else readln(Column);
      end;
  end;

{ page 3 of 5 }

  procedure NextGeneration;
  var
    Row,Column: integer;
    I,J: integer;
    Neighbors: array[0..MaxR1,0..MaxC1] of 0..8;

  begin
    for Row:= 1 to MaxR do
      for Column:= 1 to MaxC do
        Neighbors[Row,Column]:= 0;

    for Row:= 1 to MaxR do
      for Column:= 1 to MaxC do
        if Grid[Row,Column] = Living then begin
          Neighbors[Row - 1,Column - 1] := Neighbors[Row - 1,Column - 1] + 1;
          Neighbors[Row - 1,Column    ] := Neighbors[Row - 1,Column    ] + 1;
          Neighbors[Row - 1,Column + 1] := Neighbors[Row - 1,Column + 1] + 1;
          Neighbors[Row    ,Column - 1] := Neighbors[Row    ,Column - 1] + 1;
          Neighbors[Row    ,Column + 1] := Neighbors[Row    ,Column + 1] + 1;
          Neighbors[Row + 1,Column - 1] := Neighbors[Row + 1,Column - 1] + 1;
          Neighbors[Row + 1,Column    ] := Neighbors[Row + 1,Column    ] + 1;
          Neighbors[Row + 1,Column + 1] := Neighbors[Row + 1,Column + 1] + 1;
          end;

    for Row:= 1 to MaxR do
      for Column:= 1 to MaxC do
        case Grid[Row,Column] of

          Living:
            if (Neighbors[Row,Column] < 2)
             or (Neighbors[Row,Column] > 3) then
              RemoveCell(Row,Column);

          Empty:
            if (Neighbors[Row,Column] = 3) then
              AddCell(Row,Column);

          end {case};
  end {NextGeneration};
{ page 4 of 5 }

{  procedure NextGeneration;                      { an alternative method }
{  var
    I,J,N: integer;

    function Neighbors(I,J: integer): integer;
    var
      M,N: integer;
      NB: integer;
    begin
      NB:= 0;
      for M:= I - 1 to I + 1 do
        for N:= J - 1 to J + 1 do
          case Grid[M,N] of
            Living,Dying: NB:= NB+1;
            Pregnant, Empty: ;
            end;

      if Grid[I,J] = Living then NB:= NB - 1;
      Neighbors:= NB;
    end;

  begin
    for I:= 1 to MaxR do
      for J:= 1 to MaxC do begin
        N:= Neighbors(I,J);
        case Grid[I,J] of
          Living:
            if (N < 2) or (N > 3) then
              Grid[I,J]:= Dying;
          Empty:
            if (N = 3) then
              Grid[I,J]:= Pregnant;
          end;
        end;

    for I:= 1 to MaxR do
      for J:= 1 to MaxC do
        case Grid[I,J] of
          Pregnant: Grid[I,J]:= Living;
          Dying:    Grid[I,J]:= Empty;
          end;
  end;
}
{ page 5 of 5 }

begin                                            { main }

  write('StoreName: '); readln(StoreName);
  reset(Store,StoreName,'.LIF/seek',Row);
  if Row = -1 then begin
    writeln('creating new file');
    rewrite(Store,StoreName,'.LIF/seek');
    end;

  ClearGrid;

  repeat
    GetCommand(Command,Row,Column);
    case Command of

      '*',' ':
        if InRange(Row,Column) then
          AddCell(Row,Column)
        else Bell;

      'X','x':
        if InRange(Row,Column) then
          RemoveCell(Row,Column)
        else Bell;

      'E','e': ClearGrid;

      'G','g': NextGeneration;

      'D','d': DrawGrid;

      'A','a':
        for Column:= 1 to Row do begin
          writeln(chr(Esc),'Y6 ',Column:1,chr(Esc),'J');
          NextGeneration;
          end;

      'R','r': begin
        seek(Store,Row);
        if eof(Store) then Bell
        else begin
          Grid:= Store^;
          DrawGrid;
          end;
        end;

      'W','w': begin
        seek(Store,Row);
        Store^:= Grid;
        put(Store);
        end;

      'Q','q': ;

      else Bell;
      end {case};

  until (Command='Q') or (Command='q');
  end.
                                                            