CP/M/CPM_CDROM.iso/simtel/sigm/vols000/vol028/life.pas

Pascal/Delphi Source File | 1984-04-29 | 8.6 KB | 342 lines

Program GameOfLife;{INPUT,OUTPUT}
{
  Program to play the game of Life as developed by H.L. Conway
  at the University of Cambridge and introduced in the
  "Mathematical Games" section of the October 1970 "Scientific
  American" magazine.

SUMMARY:
  Life is played on a grid of squares.    A given square is either
  occupied or empty.  The program user specifies which squares are
  occupied initially.  The game of Life program produces new generations
  of the matrix by applying life's laws for birth, survival, and death
  to the present generation.  These laws are:

BIRTH:
  An unoccupied square becomes occupied if in the preceding generation
  exactly three of the eight neighboring squares were occupied
  (squares that touch horizontally, vertically or diagonally are said
  to be neighboring squares).

SURVIVAL:
  An occupied square remains occupied if in the preceding generation
  two or three neighboring squares were occupied.

DEATH:
  An occupied square becomes unoccupied if in the preceding generation
  fewer than two or more than three neighboring squares were occupied.


MODIFICATION RECORD:
     FEB 18, 1981 - Modified for Paascal/Z by Raymond E. Penley.
          - Any external routines may be obtained from the
            Pascal/Z Users' Group.
     FEB 21, 1981 - Added escape from data entry portion.
}

CONST

  {The following cursor controls work with a terminal
  such as the Lear Siegler ADM3A, SOROC 120, Televideo.}
       lf=10;        (* cursor down = ctrl/J *)
       uparrow=11;    (* cursor up   = ctrl/K *)
       bkspce=8;    (* cursor back = ctrl/H *)
       ff=12;        (* cursor fwd  = ctrl/L *)
       space=32;    (* ASCII space *)
       sub=26;        (* ASCII clear screen code *)
       esc = 27;    (* ASCII escape code *)
       maxboardsize = 22;
       widthmaxboard=77;

TYPE   state = (dead, stable, growing);
       neighbor = set of 0..8;
       boards = packed array [1..widthmaxboard,1..maxboardsize] of char;

VAR    survivepopulation:neighbor;
       boardstate    :state;
       newboard,
       oldboard     :boards;
       j        :1..maxboardsize;
       i        :1..widthmaxboard;
       firsttime       :boolean;
       numberofneighbors:0..8;
       alivecount,
       boardsize,
       changecount,
       generation,
       maxgeneration,
       boardwidth    :integer;
       left,right,
       up,down,
       horizoffset,
       vertoffset    :-1..+1;

{$M-}{ integer mult & divd error checking OFF }
{$F-}{ floating point error checking OFF }
{$R-}{ range checking OFF }
{$S-}{ stack checking OFF }

PROCEDURE GOTOXY(X,Y:INTEGER);
BEGIN
  IF X<0 THEN X :=  0;
  IF X>79 THEN X := 79;
  IF Y<0 THEN Y := 0;
  IF Y>23 THEN Y := 23;
  WRITE( CHR(27),'=',CHR(Y+32),CHR(X+32));
END;

PROCEDURE KEYIN(VAR C:CHAR); EXTERNAL;

procedure clearscreen;
begin
  write(chr(sub));
end;


procedure getanimals(VAR hit: boolean);
var    ch,
    escape,
    up,
    right,
    rght,
    left,
    down   :char;
begin
  escape := chr(esc);
  up := chr(uparrow);
  right := chr(space);
  rght := chr(ff);
  down := chr(lf);
  left := chr(bkspce);
  hit := false;
  repeat
    KEYIN(ch);
    (* read(keyboard,ch); *)
    if ( ch=escape ) then
      begin
        ch := 'D';
        hit := true;
      end
    else if ( ch=down ) then
      begin
        if ( (j+1)>boardsize ) then j := boardsize else j := j+1;
        gotoxy(i,j);
      end
    else if ( ch=up ) then
      begin
        if ( (j-1)<1 ) then j := 1 else j := j-1;
        gotoxy(i,j);
      end
    else if (ch=right) or (ch=rght) then
      begin
        if ( (i+1)>boardwidth ) then
          begin
        i := 1;
        if ( (j+1)>boardsize ) then j := boardsize else j := j+1;
          end
        else i := i+1;
        gotoxy(i,j);
      end
    else if ( ch=left ) then
      begin
        if ( (i-1)<1 ) then
          begin
        i := boardwidth;
        if ( (j-1)<1 ) then j := 1 else j := j-1;
          end
        else i := i-1;
        gotoxy(i,j);
      end
    else if ( ch='*' ) then
      begin
        write(ch);
        oldboard[i,j] := '*';
        alivecount := alivecount+1;
        if ( (i+1)>widthmaxboard ) then
          begin
        i := 1;
        if ( (j+1)>maxboardsize ) then
          j := maxboardsize
        else
          j := j+1;
        gotoxy(i,j);
          end
        else i := i+1;
      end;
  until (ch='d') or (ch='D');
end;  (* get animals *)


Procedure PrintHeader;
begin
  writeln('Generation #',generation:3, '     Population =',alivecount:3);
end;{ of PrintHeader }


procedure initialize;
{ Here is the input section.  It initializes all necessary parameters
  and creates the initial board}
label    1;
const    s1 = 'Please enter the ';
var    hit : boolean;
begin
1:{ here if hit }
  generation := 0;
  If firsttime then
    clearscreen
  else
    gotoxy(0,0);
  writeln(s1, 'maximum number of generations');
  write  ('     you would like for this game: ->');
  readln(maxgeneration);
  write  (s1, 'board width for this game: ->');
  readln(boardwidth);
  write  (s1, 'board heighth for this game: ->');
  readln(boardsize);
  if ( boardsize>maxboardsize ) then
     boardsize := maxboardsize;
  if ( boardwidth>widthmaxboard ) then
     boardwidth := widthmaxboard;
  clearscreen;
  writeln;
  for j := 1 to boardsize do
    begin
      write(' ');
      for i := 1 to boardwidth do
    begin
      oldboard[i,j] := ' ';
      write('-');
    end;
      if ( j<boardsize ) then writeln;
    end;
  gotoxy(0,0);
  writeln('"*"=organism, cursor control keys move cursor,',
      ' D for done, ESC start over');
  alivecount := 0;
  i := 1;
  j := 1;
  gotoxy(i,j);
  getanimals(hit);
  clearscreen;
  If hit then goto 1;
  printheader;
  for j := 1 to boardsize do
    begin
      for i := 1 to boardwidth do
    write (oldboard[i,j]);
      if ( j<boardsize ) then writeln;
    end;
end {initialize};


procedure processboard;
{ The actual board processing begins here}
begin
{$C-}{ control-c cheking OFF }
  alivecount := 0;
  changecount := 0;
  for i := 1 to boardwidth do
    begin
      for j := 1 to boardsize do
    begin
    {first we must compute the number of neighbors for
     a cell at coordinate i,j  We must make sure that the
     cell is not on an edge}
      if ( i>1 )
        then left := -1
        else left := 0;
      if ( i<boardwidth )
        then right := +1
        else right := 0;
      if ( j>1 )
        then up := -1
        else up := 0;
      if ( j<boardsize )
        then down := +1
        else down := 0;
      numberofneighbors := 0;
      for horizoffset :=  left to right do
        begin
          for vertoffset := up to down do
        if (oldboard[i+horizoffset,j+vertoffset] ='*') and
           ((horizoffset<>0) or (vertoffset<>0))
           then numberofneighbors := numberofneighbors+1;
        end;
       {The last test prevents counting a cell as a
        neighbor of itself.
        Now see which cells should be alive in the
        next generation.}
       newboard[i,j] := ' ';
       if ((oldboard[i,j]=' ') and (numberofneighbors = 3))
         or ((oldboard[i,j] = '*')
         and (numberofneighbors in survivepopulation))
           then begin
              newboard[i,j] := '*';
              alivecount := alivecount +1
              end;
    end {j loop};
      end{i loop};  {of the processing of each individual cell}
end; {of processboard}

{$C+}{ Control-C checking ON }

procedure printgeneration;
{ We have now completed a new generation. Print it out
  and copy it back into the oldboard to get ready for the
  next cycle}
begin
  generation := generation +1;
  clearscreen;
  PrintHeader;
  for j := 1 to boardsize do
    begin
      for i := 1 to boardwidth do
    begin
      write (newboard[i,j]);
      {see if anything has changed during this generation}
      if ( newboard[i,j]<>oldboard[i,j] ) then
        begin
          changecount := changecount+1;
          oldboard[i,j] := newboard[i,j]
        end
    end;
      if ( j<boardsize ) then writeln;
    end;
  {set a flag indicating the state of the board at the end of this
   generation}
 if ( alivecount=0 ) then
   boardstate := dead
 else
   if ( changecount=0 ) then
     boardstate := stable
   else boardstate := growing
end {processboard};

procedure printresults;
{ print why we stopped }
begin
  case boardstate of
    dead      :writeln('Colony died');
    stable    :writeln('Colony is stable');
    growing   :writeln('Maximum generation number has been exceeded')
  end {of case statement}
end {printresults};


begin{ MAIN PROGRAM }
  firsttime := true;
  While true do
    begin
      survivepopulation := [2,3];
      initialize;
      firsttime := false;
      repeat
    processboard;
    printgeneration;
      until (boardstate = dead)
       or (boardstate = stable)
         or (generation >= maxgeneration);
      printresults;
    end;
end.{Game of Life}