home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol244 / life.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-02-13  |  12.5 KB  |  374 lines
  1. {PROGRAM AUTHOR: Mark Aldon Weiss  PROGRAM DONATED TO PUBLIC DOMAIN}
  2.  
  3. CONST
  4.  
  5. MaxNumRows = 105;   MaxNumCols = 92;   MaxLengthRowString = 125;
  6.  
  7. { MaxLengthRowString is greater than MaxNumCols to allow for spillover on  }
  8. { input so that user may use repeat key to, say, type alot of noncreatures }
  9. { without worrying about typing exactly enough to fill the row.            }
  10.  
  11.  
  12.  
  13. TYPE
  14.  
  15. Colony = Array[1..MaxNumRows,1..MaxNumCols] of Char;
  16.  
  17.  
  18.  
  19. VAR
  20.  
  21. again: Boolean;
  22.  
  23. GenCount,NumOcc1st,CreatureCount,HowManyMore,i: Integer;
  24.  
  25. creature,noncreature,how1st,HowRand,option,ch : Char;
  26.  
  27. NumRows: 0..MaxNumRows;    NumCols: 0..MaxNumCols;    SpaceRequired: Integer;
  28.  
  29. frac1st: Real;    field: 1..2;    GRID: Colony;    PrintFormat: 1..3;
  30.  
  31. RowString: String[MaxLengthRowString];
  32.  
  33.  
  34.  
  35. PROCEDURE  HELP;
  36.  
  37. Begin  {HELP}
  38. Writeln;
  39. Writeln(' N#--type an N and then any positive integer; the next');
  40. Writeln('     # generations are computed and displayed.');
  41. Writeln(' S#--type an S and then any positive integer; the next');
  42. Writeln('     # generations are computed and the last displayed.');
  43. Writeln(' Q#--type a Q and any integer in order to QUIT the current');
  44. Writeln('     grid.  You will then be able to start a new one.')
  45. End;   {HELP}
  46.  
  47.  
  48.  
  49. PROCEDURE  GetOptions;
  50.  
  51. Begin  {GetOptions}
  52. Writeln;
  53. Writeln(' You may have a maximum of ',MaxNumRows,' rows in your grid.');
  54. Writeln(' How many rows do you want for your grid (remember,');
  55. Write(' no creatures are allowed in the first or last row)?    ');
  56. Readln(NumRows);    Writeln;
  57. Writeln(' You may have a maximum of ',MaxNumCols,' columns in your grid.');
  58. Writeln(' How many columns do you want for your grid (remember,');
  59. Write(' no creatures are allowed in the first or last column)?    ');
  60. Readln(NumCols);
  61. Writeln;
  62. Write(' Type the character you want to represent a creature ------->  ');
  63. Readln(creature);
  64. Write(' Type the character you want to represent a NONcreature ---->  ');
  65. Readln(noncreature);
  66. Writeln;
  67. Writeln(' While the terminal display will have no spaces between the grid');
  68. Writeln(' characters, you may have a blank space between the grid characters');
  69. Write(' on the printout.  Do you want a blank separating characters?      ');
  70. Readln(ch);    Writeln;
  71. IF ch IN ['y','Y'] THEN Field := 2 ELSE Field := 1;
  72. SpaceRequired := NumCols * Field + 25;
  73. IF SpaceRequired <= 66 THEN PrintFormat := 1;
  74. IF (SpaceRequired > 66) AND (SpaceRequired <= 80) THEN PrintFormat := 2;
  75. IF (SpaceRequired > 80) AND (SpaceRequired <= 132) THEN PrintFormat := 3;
  76. IF SpaceRequired > 132 THEN
  77.    Begin
  78.    Field := 1;
  79.    PrintFormat := 3;
  80.    SpaceRequired := NumCols + 25;
  81.    If SpaceRequired > 132 Then
  82.       Begin
  83.       Writeln(#7,' WARNING:  Your grid will have too many columns to fit on');
  84.       Writeln('           one line of the printout.  You will therefore get');
  85.       Writeln('           wrap-arounds, but your grid will still print.');
  86.       Writeln
  87.       End
  88.    End;
  89. REPEAT
  90.   Writeln(' Do you want a random first generation (type r) or do you want to');
  91.   Write(' make your own first generation (type s)?     ');
  92.   Readln(how1st)
  93. UNTIL how1st IN ['r','R','s','S'];
  94. IF how1st IN ['r','R'] THEN
  95.    Begin
  96.    REPEAT
  97.      Writeln(' Do you want BOTH the number and the placement of creatures to');
  98.      Writeln(' be random (type b) or only the placement of creatures to be');
  99.      Write(' random (type p)?     ');    Readln(HowRand)
  100.    UNTIL HowRand IN ['b','B','p','P'];
  101.    If HowRand In ['p','P'] Then
  102.       Begin
  103.       Writeln(' What fraction (between 0 & 1) of your first generation grid');
  104.       Write(' do you want to be occupied (i.e., have creatures)?     ');
  105.       Readln(frac1st);
  106.       NumOcc1st := ROUND( frac1st * (NumRows-2) * (NumCols-2) )
  107.       End
  108.    End
  109. End;   {GetOptions}
  110.  
  111.  
  112.  
  113. PROCEDURE  PrintGrid;
  114.  
  115. Var  r,c,midpt: Integer;
  116.  
  117. Begin  {PrintGrid}
  118. IF GenCount = 1 THEN CreatureCount := NumOcc1st;
  119. midpt := NumRows DIV 2;
  120. FOR r := 1 to (midpt-1) DO
  121.     Begin
  122.     Write(lst,' ');  For c := 1 to NumCols Do Write(lst,GRID[r,c]:Field);
  123.     Writeln(lst)
  124.     End;
  125. Write(lst,' ');  For c := 1 to NumCols Do Write(lst,GRID[midpt,c]:Field);
  126. Writeln(lst,'   GENERATION ',GenCount);
  127. Write(lst,' ');  For c := 1 to NumCols Do Write(lst,GRID[midpt+1,c]:Field);
  128. Writeln(lst,'   Frac. Occ. = ',CreatureCount/( (NumRows-2)*(NumCols-2) ):8:6);
  129. FOR r := (midpt+2) to NumRows DO
  130.     Begin
  131.     Write(lst,' ');  For c := 1 to NumCols Do Write(lst,GRID[r,c]:Field);
  132.     Writeln(lst)
  133.     End
  134. End;   {PrintGrid}
  135.  
  136.  
  137.  
  138. PROCEDURE  WriteGridToTerminal;
  139.  
  140. Var  r,c,midpt: Integer;
  141.  
  142. Begin  {WriteGridToTerminal}
  143. IF GenCount = 1 THEN CreatureCount := NumOcc1st;
  144. midpt := NumRows DIV 2;
  145. FOR r := 1 to (midpt-1) DO
  146.     Begin
  147.     Write(' ');  For c := 1 to NumCols Do Write(GRID[r,c]);
  148.     Writeln
  149.     End;
  150. Write(' ');  For c := 1 to NumCols Do Write(GRID[midpt,c]);
  151. Writeln('   GENERATION ',GenCount);
  152. Write(' ');  For c := 1 to NumCols Do Write(GRID[midpt+1,c]);
  153. Writeln('   Frac. Occ. = ',CreatureCount/( (NumRows-2)*(NumCols-2) ):8:6);
  154. FOR r := (midpt+2) to NumRows DO
  155.     Begin
  156.     Write(' ');  For c := 1 to NumCols Do Write(GRID[r,c]);
  157.     Writeln
  158.     End
  159. End;   {WriteGridToTerminal}
  160.  
  161.  
  162.  
  163. PROCEDURE  FirstGen;
  164.  
  165. Var   c,r,midpt: Integer;   ch,correction: char;
  166.  
  167. Begin  {FirstGen}
  168. FOR r := 1 to NumRows DO FOR c := 1 to NumCols DO GRID[r,c] := noncreature;
  169. IF how1st IN ['s','S'] THEN
  170.    Begin
  171.    NumOcc1st := 0;
  172.    Writeln(' ':10,'C O L U M N');
  173.    Write(' ':10);
  174.    FOR c := 2 to (NumCols-1) DO Write( (10+c) MOD 10 );
  175.    Writeln;
  176.    FOR r := 2 to (NumRows-1) DO
  177.        Begin
  178.        Write(' row',r:3,':  ');
  179.        Readln(RowString);
  180.        For c := 2 to (NumCols-1) Do
  181.            Begin
  182.            GRID[r,c] := RowString[c-1];
  183.            IF GRID[r,c] = creature THEN NumOcc1st := NumOcc1st + 1
  184.            End
  185.        End;
  186.    midpt := NumRows DIV 2;
  187.    Writeln;  Writeln;
  188.    Writeln(' This is your first generation grid as it now stands:');
  189.    Writeln;
  190.    Writeln(' ':10,'C O L U M N');
  191.    Write(' ':10);
  192.    FOR c := 2 to (NumCols-1) DO Write( (10+c) MOD 10 );
  193.    Writeln;
  194.    FOR r := 2 to (midpt-1) DO
  195.        Begin
  196.        Writeln;
  197.        Write(' row',r:3,':  ');
  198.        For c := 2 to (NumCols-1) Do Write(GRID[r,c])
  199.        End;
  200.    Writeln;
  201.    Write(' row',midpt:3,':  ');
  202.    FOR c := 2 to (NumCols-1) Do Write(GRID[midpt,c]);
  203.    Writeln('   GENERATION 1');
  204.    Write(' row',(midpt+1):3,':  ');
  205.    FOR c := 2 to (NumCols-1) Do Write(GRID[midpt+1,c]);
  206.    Write('   Fraction Nonborder Occupied = ');
  207.    Write(NumOcc1st/( (NumRows-2)*(NumCols-2) ):8:6);
  208.    FOR r := (midpt+2) to (NumRows-1) DO
  209.        Begin
  210.        Writeln;
  211.        Write(' row',r:3,':  ');
  212.        For c := 2 to (NumCols-1) Do Write(GRID[r,c])
  213.        End;
  214.    Writeln;  Writeln;
  215.    Write(' Do you want to make any corrections?    ');
  216.    Readln(correction);
  217.    IF correction IN ['y','Y'] THEN WHILE correction IN ['y','Y'] DO
  218.       Begin
  219.       Write(' Row of mistake ----->   ');  Readln(r);
  220.       Write(' Column of mistake -->   ');  Readln(c);
  221.       Write(' Desired creature or non-creature character');
  222.       Write(' for this location ---->   ');  Readln(ch);
  223.       GRID[r,c] := ch;
  224.       Write(' Any more corrections?   ');
  225.       Readln(correction)
  226.       End
  227.    End;
  228. IF how1st IN ['r','R'] THEN
  229.    Begin
  230.    IF HowRand IN ['b','B'] THEN
  231.       NumOcc1st := ROUND( RANDOM*(NumRows-2)*(NumCols-2) );
  232.    CreatureCount := 0;
  233.    WHILE CreatureCount < NumOcc1st DO  {Place a creature randomly}
  234.          Begin
  235.          CreatureCount := CreatureCount + 1;
  236.          REPEAT
  237.             r := ROUND( ((NumRows-1)-2) * RANDOM + 2);
  238.             c := ROUND( ((NumCols-1)-2) * RANDOM + 2)
  239.          UNTIL GRID[r,c] <> creature;
  240.          GRID[r,c] := creature;
  241.          { The REPEAT loop is so that you don't put a creature where there   }
  242.          { already was one since this would not increase the number of ran-  }
  243.          { domly placed creatures.  Once a random grid postion is found that }
  244.          { is not already occupied, a creature is placed in that position.   }
  245.          { The assignments to r and c in the REPEAT loop may be confusing.   }
  246.          { Just keep in mind that for, say, an 11-row grid you want a random }
  247.          { number from 2 to 10.  The assignment accomplishes this.           }
  248.          End;
  249.    WriteGridToTerminal
  250.    End;
  251. PrintGrid
  252. End;   {FirstGen}
  253.  
  254.  
  255.  
  256. PROCEDURE  NextGen;
  257.  
  258. Var  r,c,NumNeighbors,occupations: Integer;   TempMat: Colony;
  259.  
  260.      MatNeighbors: Array[1..MaxNumRows,1..MaxNumCols] of Integer;
  261.  
  262. Begin  {NextGen}
  263. FOR r := 1 to NumRows DO FOR c := 1 to NumCols DO TempMat[r,c] := noncreature;
  264. FOR r := 2 to (NumRows-1) DO FOR c := 2 to (NumCols-1) DO
  265.     Begin
  266.     NumNeighbors := 0;
  267.     IF GRID[r+1,c+1] = creature THEN NumNeighbors := NumNeighbors + 1;
  268.     IF GRID[r+1,c  ] = creature THEN NumNeighbors := NumNeighbors + 1;
  269.     IF GRID[r+1,c-1] = creature THEN NumNeighbors := NumNeighbors + 1;
  270.     IF GRID[r  ,c+1] = creature THEN NumNeighbors := NumNeighbors + 1;
  271.     IF GRID[r  ,c-1] = creature THEN NumNeighbors := NumNeighbors + 1;
  272.     IF GRID[r-1,c+1] = creature THEN NumNeighbors := NumNeighbors + 1;
  273.     IF GRID[r-1,c  ] = creature THEN NumNeighbors := NumNeighbors + 1;
  274.     IF GRID[r-1,c-1] = creature THEN NumNeighbors := NumNeighbors + 1;
  275.     MatNeighbors[r,c] := NumNeighbors
  276.     End;
  277. FOR r := 2 to (NumRows-1) DO FOR c := 2 to (NumCols-1) DO
  278.     IF (MatNeighbors[r,c]<>2) AND (MatNeighbors[r,c]<>3) THEN
  279.        TempMat[r,c] := noncreature ELSE TempMat[r,c] := GRID[r,c];
  280. FOR r := 2 to (NumRows-1) DO FOR c := 2 to (NumCols-1) DO
  281.     IF GRID[r,c] = noncreature THEN
  282.        Begin
  283.        occupations := 0;
  284.        IF GRID[r+1,c+1] = creature THEN occupations := occupations + 1;
  285.        IF GRID[r+1,c  ] = creature THEN occupations := occupations + 1;
  286.        IF GRID[r+1,c-1] = creature THEN occupations := occupations + 1;
  287.        IF GRID[r  ,c+1] = creature THEN occupations := occupations + 1;
  288.        IF GRID[r  ,c-1] = creature THEN occupations := occupations + 1;
  289.        IF GRID[r-1,c+1] = creature THEN occupations := occupations + 1;
  290.        IF GRID[r-1,c  ] = creature THEN occupations := occupations + 1;
  291.        IF GRID[r-1,c-1] = creature THEN occupations := occupations + 1;
  292.        IF occupations = 3 THEN TempMat[r,c] := creature
  293.        End;
  294. CreatureCount := 0;
  295. FOR r := 1 to NumRows DO FOR c := 1 to NumCols DO
  296.     Begin
  297.     GRID[r,c] := TempMat[r,c];
  298.     IF GRID[r,c] = creature THEN CreatureCount := CreatureCount + 1
  299.     End
  300. End;   {NextGen}
  301.  
  302.  
  303.  
  304. BEGIN  { M A I N    P R O G R A M }
  305. Writeln;
  306. Writeln;
  307. Writeln(' This program is the game of life.  It has a great many extra ');
  308. Writeln(' features that will become apparent as the program is executed.');
  309. Writeln(' The rules of life are that a creature will survive in the next');
  310. Writeln(' generation only if there are exactly 2 or 3 neighboring creatures.');
  311. Writeln(' A creature is born in the next generation if there are exactly 3');
  312. Writeln(' creatures surrounding the non-creature grid space.  NO CREATURES');
  313. Writeln(' ARE PERMITTED IN THE BORDER OF THE GRID.');
  314. Writeln;
  315. Writeln(' Turn the printer off.  Turn the knob on the printer to set a page');
  316. Writeln(' so it''s at the top of a sheet.  Turn the printer ON.');
  317. Writeln;
  318. REPEAT
  319. Write(#7,' Did you follow the instructions?   '); Readln(ch)
  320. UNTIL ch IN ['y','Y'];
  321. Writeln(lst,#27'C'#0#11#27'N'#3);
  322. { codes to Epson printer for length of page = 11 in., skip over perf. 3 lines }
  323. again := TRUE;
  324. WHILE again DO
  325.    Begin
  326.    GenCount := 1;
  327.    GetOptions;
  328.    CASE PrintFormat OF
  329.      1: Writeln(lst,#27'W'#1#15#27'2'#27'U'#0);
  330.      2: Writeln(lst,#27'W'#0#18#27'U'#0#27'2');
  331.      3: IF Field = 1 THEN Writeln(lst,#15#27'U'#1#27'0'#27'W'#0)
  332.         ELSE Writeln(lst,#15#27'U'#0#27'2'#27'W'#0)
  333.      End;  {of CASE}
  334.      {These are various codes to the printer to turn on/off double width}
  335.      {or compressed print or unidirectional printing or 8 lines per inch, etc.}
  336.    Writeln;
  337.    FirstGen;
  338.    Writeln;
  339.    REPEAT
  340.       Writeln;
  341.       Write(' Type N# S# Q# or H4(for help) ---->    ');
  342.       Readln(option,HowManyMore);
  343.       IF option IN ['n','N'] THEN FOR i := 1 to HowManyMore DO
  344.          Begin
  345.          Writeln;  Writeln(lst);
  346.          GenCount := GenCount + 1;
  347.          NextGen;
  348.          WriteGridToTerminal;  PrintGrid
  349.          End;
  350.       IF option IN ['s','S'] THEN
  351.          Begin
  352.          FOR  i := 1 to HowManyMore DO
  353.             Begin
  354.             GenCount := GenCount + 1;
  355.             NextGen
  356.             End;
  357.          Writeln;
  358.          Writeln(lst);
  359.          WriteGridToTerminal;  PrintGrid
  360.          End;
  361.       IF option IN ['q','Q'] THEN
  362.          Begin
  363.          Writeln;  Writeln
  364.          End;
  365.       IF option IN ['h','H'] THEN HELP
  366.    UNTIL option IN ['q','Q'];
  367.    Writeln;
  368.    Write(' Do you want to start over with a new first generation?   ');
  369.    Readln(ch);
  370.    IF ch IN ['y','Y'] THEN again := TRUE ELSE again := FAlSE
  371.    End
  372. END.   { M A I N    P R O G R A M }
  373.  
  374.