PROGRAM LIFE;
{ Simulation of Conway's game of Life on a bounded grid. }
{ From Data Structures and Program Design by Robert Kruse  Prentice Hall }
{ Typed in by: Malcolm McCorquodale. }
{ Modified by: Jeff Firestone. }
{ Version 1. Page 6. }
CONST
     MAXROW = 23;      { max # of rows allowed }
     MAXCOL = 80;      { max # of cols allowed }
TYPE
     ROW = 1..MAXROW;
     COL = 1..MAXCOL;
     STATUS = (DEAD,ALIVE);
     GRID = ARRAY[ROW,COL] OF STATUS;
VAR
     MAP, NEWMAP : GRID;
     I : ROW;
     J : COL;
     GENERATION, LASTGENERATION : INTEGER;


{--------------------------------------------}

PROCEDURE GENERATECOORDINATES;
VAR
     CNT, NUMBERCOORDINATES : INTEGER;
BEGIN
     WRITE ('How many coordinates would you like generated : ');
     READLN (NUMBERCOORDINATES);
     FOR CNT:= 1 TO NUMBERCOORDINATES DO
       MAP[(RANDOM(MAXROW-1)+1), (RANDOM(MAXCOL-1)+1)]:= ALIVE;
END;

{--------------------------------------------}

PROCEDURE INITIALIZE;
VAR
     X,Y : INTEGER;    { COORDINATES OF CELL }
     ANSWER : STRING [10];
BEGIN
     WRITELN ('This program is a simulation of the game of life.');
     WRITE ('Enter the number of generations to run : ');
     READLN (LASTGENERATION);
     IF LASTGENERATION <= 0 THEN WRITELN ('No output for 0 generations.');
     FOR X := 1 TO MAXROW DO
        FOR Y := 1 TO MAXCOL DO
           MAP[X,Y] := DEAD;
     WRITE ('Do you wish to have the coordinate pairs generated ');
     WRITE ('Automatically : ');
     READLN (ANSWER);
     IF UPCASE(ANSWER[1]) = 'Y' THEN
       GENERATECOORDINATES
     ELSE
     BEGIN
       WRITELN ('On each line give a pair of coordinates for a living cell.');
       WRITELN ('Terminate the list by entering a 0 for X and Y');
       READLN (X,Y);

       WHILE X <> 0 DO
       BEGIN
         IF (X>=1) AND (X<=MAXROW) AND (Y>=1) AND (Y<=MAXCOL)
             THEN MAP[X,Y] := ALIVE
             ELSE WRITELN ('Values out of range.');
         READLN (X,Y);
       END;  { WHILE }
     END; { ELSE }
END;

{--------------------------------------------}

PROCEDURE WRITEMAP;
VAR
     X : ROW;
     Y : COL;
     FULL : CHAR;
BEGIN
     FULL:= CHR(2);
     CLRSCR;
     WRITELN ('The map at generation',generation:5,' is  below');
     FOR X := 1 TO MAXROW DO
     BEGIN
        FOR Y := 1 TO MAXCOL DO
           IF MAP[X,Y] = ALIVE THEN BEGIN
                                      GOTOXY(Y,X+2);
                                      WRITE (FULL);
                                    END;
     END;      { Processing row X }
     GOTOXY(1,1);
END;

{--------------------------------------------}

FUNCTION NEIGHBORCOUNT (I:ROW;J:COL):INTEGER;
VAR
     X, XLOW, XHIGH : ROW;
     Y, YLOW, YHIGH : COL;
     COUNT : INTEGER;
BEGIN
     IF I = 1 THEN XLOW := 1
              ELSE XLOW := I - 1;
     IF I = MAXROW THEN XHIGH := 1
                   ELSE XHIGH := I + 1;
     IF J = 1 THEN YLOW := 1
              ELSE YLOW := J - 1;
     IF J = MAXCOL THEN YHIGH := J
                   ELSE YHIGH := J + 1;
     COUNT := 0;
     FOR X := XLOW TO XHIGH DO
        FOR Y := YLOW TO YHIGH DO
           IF MAP[X,Y] = ALIVE THEN COUNT := COUNT + 1;
     IF MAP [I,J] = ALIVE THEN COUNT := COUNT - 1;
     NEIGHBORCOUNT := COUNT;
END;

{--------------------------------------------}

BEGIN
     INITIALIZE;
     GENERATION := 0;
     WRITEMAP;
     FOR GENERATION := 1 TO LASTGENERATION DO
     BEGIN
        FOR I := 1 TO MAXROW DO FOR J := 1 TO MAXCOL DO
           CASE NEIGHBORCOUNT(I,J) OF
              0,1   : NEWMAP[I,J] := DEAD;
              2     : NEWMAP[I,J] := MAP[I,J];
              3     : NEWMAP[I,J] := ALIVE;
              4..8  : NEWMAP[I,J] := DEAD
              END;
        FOR I := 1 TO MAXROW DO FOR J := 1 TO MAXCOL DO
           MAP[I,J] := NEWMAP[I,J];
        WRITEMAP;
     END      { Processing one generation }
END.
2   32 _  1-8
  43 1-4  23 5-8 TransW   .40   1.3  11 1947 30 1-8 29 7-8 30 + 1-8
  45   28  UAL    .50d   1.1 7 3