home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol028 / life.pas < prev    next >
Pascal/Delphi Source File  |  1984-04-29  |  9KB  |  342 lines
  1. Program GameOfLife;{INPUT,OUTPUT}
  2. {
  3.   Program to play the game of Life as developed by H.L. Conway
  4.   at the University of Cambridge and introduced in the
  5.   "Mathematical Games" section of the October 1970 "Scientific
  6.   American" magazine.
  7.  
  8. SUMMARY:
  9.   Life is played on a grid of squares.    A given square is either
  10.   occupied or empty.  The program user specifies which squares are
  11.   occupied initially.  The game of Life program produces new generations
  12.   of the matrix by applying life's laws for birth, survival, and death
  13.   to the present generation.  These laws are:
  14.  
  15. BIRTH:
  16.   An unoccupied square becomes occupied if in the preceding generation
  17.   exactly three of the eight neighboring squares were occupied
  18.   (squares that touch horizontally, vertically or diagonally are said
  19.   to be neighboring squares).
  20.  
  21. SURVIVAL:
  22.   An occupied square remains occupied if in the preceding generation
  23.   two or three neighboring squares were occupied.
  24.  
  25. DEATH:
  26.   An occupied square becomes unoccupied if in the preceding generation
  27.   fewer than two or more than three neighboring squares were occupied.
  28.  
  29.  
  30. MODIFICATION RECORD:
  31.      FEB 18, 1981 - Modified for Paascal/Z by Raymond E. Penley.
  32.           - Any external routines may be obtained from the
  33.             Pascal/Z Users' Group.
  34.      FEB 21, 1981 - Added escape from data entry portion.
  35. }
  36.  
  37. CONST
  38.  
  39.   {The following cursor controls work with a terminal
  40.   such as the Lear Siegler ADM3A, SOROC 120, Televideo.}
  41.        lf=10;        (* cursor down = ctrl/J *)
  42.        uparrow=11;    (* cursor up   = ctrl/K *)
  43.        bkspce=8;    (* cursor back = ctrl/H *)
  44.        ff=12;        (* cursor fwd  = ctrl/L *)
  45.        space=32;    (* ASCII space *)
  46.        sub=26;        (* ASCII clear screen code *)
  47.        esc = 27;    (* ASCII escape code *)
  48.        maxboardsize = 22;
  49.        widthmaxboard=77; 
  50.  
  51. TYPE   state = (dead, stable, growing);
  52.        neighbor = set of 0..8;
  53.        boards = packed array [1..widthmaxboard,1..maxboardsize] of char;
  54.  
  55. VAR    survivepopulation:neighbor;
  56.        boardstate    :state;
  57.        newboard,
  58.        oldboard     :boards;
  59.        j        :1..maxboardsize;
  60.        i        :1..widthmaxboard;
  61.        firsttime       :boolean;
  62.        numberofneighbors:0..8;
  63.        alivecount,
  64.        boardsize,
  65.        changecount,
  66.        generation,
  67.        maxgeneration,
  68.        boardwidth    :integer;
  69.        left,right,
  70.        up,down,
  71.        horizoffset,
  72.        vertoffset    :-1..+1;
  73.  
  74. {$M-}{ integer mult & divd error checking OFF }
  75. {$F-}{ floating point error checking OFF }
  76. {$R-}{ range checking OFF }
  77. {$S-}{ stack checking OFF }
  78.  
  79. PROCEDURE GOTOXY(X,Y:INTEGER);
  80. BEGIN
  81.   IF X<0 THEN X :=  0;
  82.   IF X>79 THEN X := 79;
  83.   IF Y<0 THEN Y := 0;
  84.   IF Y>23 THEN Y := 23;
  85.   WRITE( CHR(27),'=',CHR(Y+32),CHR(X+32));
  86. END;
  87.  
  88. PROCEDURE KEYIN(VAR C:CHAR); EXTERNAL;
  89.  
  90. procedure clearscreen;
  91. begin
  92.   write(chr(sub));
  93. end;
  94.  
  95.  
  96. procedure getanimals(VAR hit: boolean);
  97. var    ch,
  98.     escape,
  99.     up,
  100.     right,
  101.     rght,
  102.     left,
  103.     down   :char;
  104. begin
  105.   escape := chr(esc);
  106.   up := chr(uparrow);
  107.   right := chr(space);
  108.   rght := chr(ff);
  109.   down := chr(lf);
  110.   left := chr(bkspce);
  111.   hit := false;
  112.   repeat
  113.     KEYIN(ch);
  114.     (* read(keyboard,ch); *)
  115.     if ( ch=escape ) then
  116.       begin
  117.         ch := 'D';
  118.         hit := true;
  119.       end
  120.     else if ( ch=down ) then 
  121.       begin
  122.         if ( (j+1)>boardsize ) then j := boardsize else j := j+1;
  123.         gotoxy(i,j);
  124.       end
  125.     else if ( ch=up ) then 
  126.       begin
  127.         if ( (j-1)<1 ) then j := 1 else j := j-1;
  128.         gotoxy(i,j);
  129.       end
  130.     else if (ch=right) or (ch=rght) then 
  131.       begin
  132.         if ( (i+1)>boardwidth ) then 
  133.           begin
  134.         i := 1;
  135.         if ( (j+1)>boardsize ) then j := boardsize else j := j+1;
  136.           end
  137.         else i := i+1;
  138.         gotoxy(i,j);
  139.       end
  140.     else if ( ch=left ) then 
  141.       begin
  142.         if ( (i-1)<1 ) then 
  143.           begin
  144.         i := boardwidth;
  145.         if ( (j-1)<1 ) then j := 1 else j := j-1;
  146.           end
  147.         else i := i-1;
  148.         gotoxy(i,j);
  149.       end
  150.     else if ( ch='*' ) then 
  151.       begin
  152.         write(ch);
  153.         oldboard[i,j] := '*';
  154.         alivecount := alivecount+1;
  155.         if ( (i+1)>widthmaxboard ) then 
  156.           begin
  157.         i := 1;
  158.         if ( (j+1)>maxboardsize ) then
  159.           j := maxboardsize
  160.         else
  161.           j := j+1;
  162.         gotoxy(i,j);
  163.           end
  164.         else i := i+1;
  165.       end;
  166.   until (ch='d') or (ch='D');
  167. end;  (* get animals *)
  168.  
  169.  
  170. Procedure PrintHeader;
  171. begin
  172.   writeln('Generation #',generation:3, '     Population =',alivecount:3);
  173. end;{ of PrintHeader }
  174.  
  175.  
  176. procedure initialize;
  177. { Here is the input section.  It initializes all necessary parameters
  178.   and creates the initial board}
  179. label    1;
  180. const    s1 = 'Please enter the ';
  181. var    hit : boolean;
  182. begin
  183. 1:{ here if hit }
  184.   generation := 0;
  185.   If firsttime then
  186.     clearscreen
  187.   else
  188.     gotoxy(0,0);
  189.   writeln(s1, 'maximum number of generations'); 
  190.   write  ('     you would like for this game: ->');
  191.   readln(maxgeneration);
  192.   write  (s1, 'board width for this game: ->');
  193.   readln(boardwidth);
  194.   write  (s1, 'board heighth for this game: ->');
  195.   readln(boardsize);
  196.   if ( boardsize>maxboardsize ) then
  197.      boardsize := maxboardsize;
  198.   if ( boardwidth>widthmaxboard ) then
  199.      boardwidth := widthmaxboard;
  200.   clearscreen;
  201.   writeln;
  202.   for j := 1 to boardsize do
  203.     begin
  204.       write(' ');
  205.       for i := 1 to boardwidth do
  206.     begin
  207.       oldboard[i,j] := ' ';
  208.       write('-');
  209.     end;
  210.       if ( j<boardsize ) then writeln;
  211.     end;
  212.   gotoxy(0,0);
  213.   writeln('"*"=organism, cursor control keys move cursor,',
  214.       ' D for done, ESC start over');
  215.   alivecount := 0;
  216.   i := 1;
  217.   j := 1;
  218.   gotoxy(i,j);
  219.   getanimals(hit);
  220.   clearscreen;
  221.   If hit then goto 1;
  222.   printheader;
  223.   for j := 1 to boardsize do
  224.     begin
  225.       for i := 1 to boardwidth do
  226.     write (oldboard[i,j]);
  227.       if ( j<boardsize ) then writeln;
  228.     end;
  229. end {initialize};
  230.        
  231.  
  232. procedure processboard;
  233. { The actual board processing begins here}
  234. begin
  235. {$C-}{ control-c cheking OFF }
  236.   alivecount := 0;
  237.   changecount := 0;
  238.   for i := 1 to boardwidth do
  239.     begin
  240.       for j := 1 to boardsize do
  241.     begin
  242.     {first we must compute the number of neighbors for
  243.      a cell at coordinate i,j  We must make sure that the
  244.      cell is not on an edge}
  245.       if ( i>1 )
  246.         then left := -1
  247.         else left := 0;
  248.       if ( i<boardwidth )
  249.         then right := +1
  250.         else right := 0;
  251.       if ( j>1 )
  252.         then up := -1
  253.         else up := 0;
  254.       if ( j<boardsize )
  255.         then down := +1
  256.         else down := 0;
  257.       numberofneighbors := 0;
  258.       for horizoffset :=  left to right do
  259.         begin
  260.           for vertoffset := up to down do
  261.         if (oldboard[i+horizoffset,j+vertoffset] ='*') and
  262.            ((horizoffset<>0) or (vertoffset<>0))
  263.            then numberofneighbors := numberofneighbors+1;
  264.         end;
  265.        {The last test prevents counting a cell as a
  266.         neighbor of itself.
  267.         Now see which cells should be alive in the 
  268.         next generation.}
  269.        newboard[i,j] := ' ';
  270.        if ((oldboard[i,j]=' ') and (numberofneighbors = 3)) 
  271.          or ((oldboard[i,j] = '*')
  272.          and (numberofneighbors in survivepopulation))
  273.            then begin
  274.               newboard[i,j] := '*';
  275.               alivecount := alivecount +1
  276.               end;
  277.     end {j loop};
  278.       end{i loop};  {of the processing of each individual cell}
  279. end; {of processboard}
  280.  
  281. {$C+}{ Control-C checking ON }
  282.  
  283. procedure printgeneration;
  284. { We have now completed a new generation. Print it out
  285.   and copy it back into the oldboard to get ready for the
  286.   next cycle}
  287. begin
  288.   generation := generation +1;
  289.   clearscreen;
  290.   PrintHeader;
  291.   for j := 1 to boardsize do
  292.     begin
  293.       for i := 1 to boardwidth do
  294.     begin
  295.       write (newboard[i,j]);
  296.       {see if anything has changed during this generation}
  297.       if ( newboard[i,j]<>oldboard[i,j] ) then
  298.         begin
  299.           changecount := changecount+1;
  300.           oldboard[i,j] := newboard[i,j]
  301.         end
  302.     end;
  303.       if ( j<boardsize ) then writeln;
  304.     end;
  305.   {set a flag indicating the state of the board at the end of this
  306.    generation}
  307.  if ( alivecount=0 ) then
  308.    boardstate := dead
  309.  else 
  310.    if ( changecount=0 ) then
  311.      boardstate := stable
  312.    else boardstate := growing
  313. end {processboard};
  314.       
  315. procedure printresults;
  316. { print why we stopped }
  317. begin
  318.   case boardstate of
  319.     dead      :writeln('Colony died');
  320.     stable    :writeln('Colony is stable');
  321.     growing   :writeln('Maximum generation number has been exceeded')
  322.   end {of case statement}
  323. end {printresults};
  324.  
  325.  
  326. begin{ MAIN PROGRAM }
  327.   firsttime := true;
  328.   While true do
  329.     begin
  330.       survivepopulation := [2,3];
  331.       initialize;
  332.       firsttime := false;
  333.       repeat
  334.     processboard;
  335.     printgeneration;
  336.       until (boardstate = dead)
  337.        or (boardstate = stable)
  338.          or (generation >= maxgeneration);
  339.       printresults;
  340.     end;
  341. end.{Game of Life}
  342.