home *** CD-ROM | disk | FTP | other *** search
/ Sunny 1,000 Collection / SUNNY1000.iso / Files / Dos / Boardak / G_O_LIFE.ZIP / LIFE.PAS < prev    next >
Pascal/Delphi Source File  |  1994-11-07  |  18KB  |  391 lines
  1. (**************************************************************************\
  2. |                                                                          |
  3. |  Scott Dudley     This program simulates life on a 20x20 grid. Life on   |
  4. |  CS 1053          the grid obeys the following rules:                    |
  5. |  9-24-94          a) a being stays alive only with two or three neigbors |
  6. |  Program 3        b) a new Begin is born with three neigbors             |
  7. |                   c) life cycles through 10 generations or death, wich-  |
  8. |                      ever happens first.                                 |
  9. |                                                                          |
  10. \**************************************************************************)
  11.  
  12. (**************************************************************************\
  13. |                                                                          |
  14. | Extra stuff       1) Create, save, and load various data.                |
  15. |                   2) Graphic interface.                                  |
  16. |                   3) Setup the number of generations. 1 to 20            |
  17. |                   4) Toggle weather or not the program halts when        |
  18. |                      all the being are dead.                             |
  19. |                   5) It's user friendly also!                            |
  20. |                                                                          |
  21. \**************************************************************************)
  22.  
  23. Program CSProg3;                   {Computer Science Program 3}
  24.  
  25. Uses Printer,Crt,Graph,Aids;       {Aids is my graphic aid unit}
  26.  
  27. Type
  28.  LifeArray=Array[0..21,0..21] of boolean;
  29.  FileName1=String[12];             {My 20x20 grid is expanded in each      }
  30.  FileName2=String[8];              {direction. This make it easy to count  }
  31.                                    {neighbors. All I have to do is make    }
  32.                                    {sure the outter area stays empty.      }
  33.                                    {I also work with file names that can   }
  34.                                    {only be 12 characters long, four of    }
  35.                                    {wich must be the extention ".DAT".     }
  36. Var
  37.  Prtr,Death           :Boolean;    {My toggles.                            }
  38.  GenLoop              :Word;       {The number of generation it runs.      }
  39.  MainGrid             :LifeArray;  {The main grid.                         }
  40.  Gr,Gd                :Integer;    {These integers are used in opening     }
  41.                                    {graphics mode.                         }
  42. {$I-}
  43.  
  44. Procedure ChkPrt;                  {Checks for printer and toggles Prtr.   }
  45.  Begin                             {If the printer is toggled on, this will}
  46.   If Prtr then Prtr:=false else    {also toggle it off.                    }
  47.    Begin
  48.     WriteLn(Lst,' ');
  49.     If IOResult <> 0 then Prtr:=false else prtr:=true;
  50.    End;
  51.  End;
  52.  
  53. Function Neighbors(X,Y:Word):Word; {This counts the number of neighbors a  }
  54.  Var                               {life form has.                         }
  55.   Total:Word;
  56.  Begin
  57.   Total:=0;
  58.   If (X>0) and (X<21) and (Y>0) and (Y<21) then
  59.    Begin
  60.     If MainGrid[X-1,Y-1] then Total:=Total+1;
  61.     If MainGrid[X+1,Y+1] then Total:=Total+1;
  62.     If MainGrid[X+1,Y-1] then Total:=Total+1;
  63.     If MainGrid[X-1,Y+1] then Total:=Total+1;
  64.     If MainGrid[X-1,Y]   then Total:=Total+1;
  65.     If MainGrid[X,Y-1]   then Total:=Total+1;
  66.     If MainGrid[X+1,Y]   then Total:=Total+1;
  67.     If MainGrid[X,Y+1]   then Total:=Total+1;
  68.    End;
  69.   Neighbors:=Total;
  70.  End;
  71.  
  72. Procedure Generate;                {Everytime this procedure is called,   }
  73.  Var                               {one generation passes.                }
  74.   BufGrid       :LifeArray;
  75.   Count1,Count2 :Integer;
  76.  Begin
  77.   For Count1:=0 to 21 do
  78.   For Count2:=0 to 21 do
  79.    BufGrid[count2,count1]:=false;
  80.   For Count1:=1 to 20 do           {The fate of each being is filtered    }
  81.   For Count2:=1 to 20 do           {into BufGrid.                         }
  82.    Begin
  83.     If MainGrid[count2,count1] then
  84.      Begin
  85.       If (neighbors(count2,count1)=2) or (neighbors(count2,count1)=3) then
  86.        BufGrid[count2,count1]:=True;
  87.      End
  88.     else
  89.      Begin
  90.       If neighbors(count2,count1)=3 then
  91.        BufGrid[count2,count1]:=True;
  92.      End;
  93.    End;
  94.   MainGrid:=BufGrid;               {The MainGrid is set to the BufGrid    }
  95.  End;
  96.  
  97. Procedure Writefile(files:FileName1);
  98.  Var                               {This is the physical action of writing}
  99.   Data,Count1,Count2 :Word;        {a file. Also contains error checking. }
  100.   DatFile  :Text;
  101.  Begin
  102.   Assign(DatFile,Files);
  103.   rewrite(DatFile);
  104.   If IOResult=0 then               {This loop only runs if there are no   }
  105.   Begin                            {I/O errors.                           }
  106.    For Count1:=1 to 20 do          {This loop writes my boolean array to a}
  107.    Begin                           {file with the same binary grid as your}
  108.    For Count2:=1 to 20 do          {file, LIFE.DAT.                       }
  109.     Begin
  110.      If MainGrid[count2,count1] then Data:=1 else Data:=0;
  111.      Write(DatFile,Data);
  112.      Write(DatFile,' ');           {The spaces and lines are to keep the  }
  113.     End;                           {same standard format as you flile.    }
  114.    WriteLn(DatFile);
  115.    End;
  116.     Close(DatFile);
  117.     TextColor(LightGreen);
  118.     WriteLn('File Saved. Press any key to continue');
  119.    End
  120.   else                             {If there was an error, ie. an invalid }
  121.    Begin                           {file name, the program doesn't attempt}
  122.     TextColor(Red);                {to write a file.                      }
  123.     WriteLn('Error saveing file!!!!');
  124.    End;
  125.  End;
  126.  
  127. Procedure Readfile(files:FileName1);
  128.  Var                               {This procedure is very much like the  }
  129.   Data,Count1,Count2 :Word;        {WriteFile procedure.                  }
  130.   DatFile  :Text;
  131.  Begin
  132.   Assign(DatFile,Files);
  133.   Reset(DatFile);
  134.   If IOResult=0 then              {The same I/O checking.                 }
  135.   Begin
  136.    For Count1:=1 to 20 do         {This loop reads a binary file and sets }
  137.    For Count2:=1 to 20 do         {up the boolean grid.                   }
  138.     Begin
  139.      Read(DatFile,Data);
  140.      If Data=1 then MainGrid[count2,count1]:=true else
  141.       MainGrid[count2,count1]:=false;
  142.     End;
  143.    Close(DatFile);
  144.    TextColor(LightGreen);
  145.    WriteLn('File Loaded. Press any key to continue');
  146.   End
  147.   else
  148.    Begin
  149.     TextColor(Red);
  150.     WriteLn('Error loading file!!!!');
  151.    End;
  152.  End;
  153.  
  154. Procedure LoadFile;               {This procedure is the user interface   }
  155.  Var                              {for loading a file.                    }
  156.   Input    :FileName2;
  157.  Begin
  158.   Closegraph;                     {It is much easier to enter a file name }
  159.   TextColor(green);               {while in Text Mode.                    }
  160.   WriteLn('Enter the file to load. You do not need to include the file extention.');
  161.   Write('>');
  162.   TextColor(LightGreen);
  163.   ReadLn(Input);
  164.   Readfile(Input+'.dat');         {ReadFile is the procedure to actually  }
  165.   pause;                          {load the file.                         }
  166.   initgraph(gr,gd,'');            {Going back into GraphMode.             }
  167.  End;
  168.  
  169. Procedure SaveFile;               {This procedure is the user interface   }
  170.  Var                              {for saveing a file.                    }
  171.   Input    :FileName2;
  172.  Begin
  173.   Closegraph;                     {It is much easier to enter a file name }
  174.   TextColor(Cyan);                {while in Text Mode.                    }
  175.   WriteLn('Name the file to save. You do not need to include the file extention.');
  176.   Write('>');
  177.   TextColor(LightCyan);
  178.   ReadLn(Input);
  179.   Writefile(Input+'.dat');        {WriteFile is the procedure to actually }
  180.   pause;                          {save the file.                         }
  181.   initgraph(gr,gd,'');            {Going back into GraphMode.             }
  182.  End;
  183.  
  184. Procedure EditFile;               {A built in option to seed the 0th      }
  185.  Var                              {generation.                            }
  186.   InKey :Char;
  187.   Count1,Count2:Integer;
  188.   CurrentX,CurrentY:Word;
  189.  Begin
  190.   CurrentX:=1;
  191.   CurrentY:=1;                    {This procedure sets up a graphic grid. }
  192.   Drawgrid;
  193.   For Count1:=1 to 20 do          {This loop just draws the beings.       }
  194.   For Count2:=1 to 20 do
  195.    If MainGrid[count2,count1] then LifeForm(Count1*20+180,Count2*20+20);
  196.   SetTextStyle(2,0,5);            {These are instuctions for user.        }
  197.   Txtout('  Make sure the Num',10,80,Blue,black,white);
  198.   Txtout('  Lock is togled on.',10,100,Blue,black,white);
  199.   Txtout('  Press 5 to change',10,140,Blue,black,white);
  200.   TxtOut('  a square.',10,160,Blue,black,white);
  201.   Txtout('     8-=UP=-',10,200,Blue,black,white);
  202.   Txtout('4-=LEFT=- 6-=RIGHT=-',10,220,Blue,black,white);
  203.   Txtout('     2-=DOWN=-',10,240,Blue,black,white);
  204.   Box3D(181+CurrentX*20,21+CurrentY*20,199+CurrentX*20,39+CurrentY*20,White,Darkgray);
  205.   Repeat                          {This repeat-until loop won't generate an}
  206.    Inkey:=readkey;                {error.                                  }
  207.    If Inkey=('5') then            {"5" changes the status.                 }
  208.     If MainGrid[CurrentX,CurrentY] then
  209.      Begin
  210.       MainGrid[CurrentX,CurrentY]:=false;
  211.       BlankForm(Currentx*20+180,Currenty*20+20);
  212.      End else
  213.      Begin
  214.       MainGrid[CurrentX,CurrentY]:=true;
  215.       LifeForm(Currentx*20+180,Currenty*20+20);
  216.      End;
  217.    Box3D(181+CurrentX*20,21+CurrentY*20,199+CurrentX*20,39+CurrentY*20,Darkgray,White);
  218.    If Inkey=('8') then CurrentY:=CurrentY-1;  {Move up}
  219.    If Inkey=('4') then CurrentX:=CurrentX-1;  {Move left}
  220.    If Inkey=('6') then CurrentX:=CurrentX+1;  {Move right}
  221.    If Inkey=('2') then CurrentY:=CurrentY+1;  {Move down}
  222.    If CurrentX<1 then CurrentX:=20;  {I have to keep the current position}
  223.    If CurrentY<1 then CurrentY:=20;  {withing the grid.                  }
  224.    If CurrentX>20 then CurrentX:=1;
  225.    If CurrentY>20 then CurrentY:=1;
  226.    Box3D(181+CurrentX*20,21+CurrentY*20,199+CurrentX*20,39+CurrentY*20,White,Darkgray);
  227.   until (InKey=#27);                 {This 3DBox is an inverse of the      }
  228.  End;                                {normal box around a being. It lets   }
  229.                                      {the user know where the current      }
  230.                                      {position is.                         }
  231.                                      {BTW #27 is the escape key            }
  232.  
  233. Procedure Results(FinalStage:Word);  {This procedure writes the status of  }
  234.  Var                                 {MainGrid to the printer.             }
  235.   InKey:Char;
  236.   Count1,Count2:integer;
  237.   Data:String;
  238.  Begin                               {It promps the user as well.          }
  239.   Txtout('Would you like to',10,50,Blue,black,white);
  240.   Txtout('print the grid?',10,60,Blue,black,white);
  241.   InKey:=ReadKey;
  242.   setfillstyle(solidfill,lightgray);
  243.   bar(5,45,190,80);
  244.   If (Inkey=('y')) or (Inkey=('Y')) then
  245.    Begin
  246.     Str(FinalStage,Data);
  247.     If prtr then WriteLn(lst,'At generation ',Data,', the data looked as follows:');
  248.     For Count1:=1 to 3 do
  249.     If prtr then WriteLn(lst,'');
  250.     For Count1:=1 to 20 do           {I have to build a string to represent}
  251.      Begin                           {a row before I can print it.         }
  252.       Data:=('');
  253.       For Count2:=1 to 20 do
  254.        If MainGrid[count2,count1] then Data:=Data+('[@]') else Data:=Data+('[ ]');
  255.       If prtr then WriteLn(lst,Data);
  256.      End;
  257.     For Count1:=1 to 5 do
  258.     If prtr then WriteLn(lst,'');
  259.    End;
  260.  End;
  261.  
  262. Procedure RunLoop;                   {This is the most important loop. It  }
  263.  Var                                 {runs each generation, checks if all  }
  264.   Count1,Count2,Count3:Word;         {the beings are dead, and displays it }
  265.   Dead        :Boolean;              {all to the screen.                   }
  266.   Data        :String;
  267.  Begin
  268.   Drawgrid;                          {Just the graphic grid and life forms.}
  269.   For Count2:=1 to 20 do
  270.   For Count1:=1 to 20 do
  271.    If MainGrid[count2,count1] then LifeForm(Count1*20+180,Count2*20+20);
  272.   SetTextStyle(2,0,5);
  273.   If Prtr then results(0);           {Lets you print the 0th generation.   }
  274.   Txtout('Press anykey to Begin.',10,80,Blue,black,white);
  275.   pause;
  276.   setfillstyle(solidfill,lightgray);
  277.   bar(5,75,190,105);
  278.   Count3:=0;                         {Sets the counter to 0.               }
  279.   bar(105,80,150,100);
  280.   txtout('1',110,80,Blue,Black,White);
  281.   dead:=false;                      {Dead is set to false for the first run.}
  282.   While not (Count3>=GenLoop) and not Dead do
  283.    Begin
  284.     Generate;
  285.     If Death then Dead:=true else Dead:=false;  {This looks complicated but }
  286.     For Count1:=1 to 20 do           {its not. Dead is set to false before  }
  287.     For Count2:=1 to 20 do           {each generation if Death is toggled   }
  288.     If MainGrid[count2,count1] then  {off. Death is the global boolean for  }
  289.      Begin                           {weather or not the loop ends if every-}
  290.       Dead:=false;                   {thing is dead. If death is on, it sets}
  291.       LifeForm(Count1*20+180,Count2*20+20){dead to false as soon as it finds}
  292.      End                                                {a life form.       }
  293.      else BlankForm(Count1*20+180,Count2*20+20);
  294.     Count3:=Count3+1;
  295.     bar(105,80,150,100);
  296.     str(Count3,Data);
  297.     txtout(Data,110,80,Blue,Black,White);
  298.     For Count1:=1 to 50 do           {A short pause with some noise to    }
  299.      Begin                           {signify a generation passed.        }
  300.       sound(random(4000));
  301.       delay(2);
  302.       nosound;
  303.       delay(2);
  304.      End;
  305.    End;
  306.   If Prtr then results(Count3);      {Lets you print the results.         }
  307.   Txtout('Press anykey to End.',10,50,Blue,black,white);
  308.   pause;
  309.  End;
  310.                                      {This is the functionality of the    }
  311. Procedure MainLoop;                  {Main Menu.                          }
  312.  Var
  313.   InKey    :Char;
  314.  Begin
  315.   Repeat
  316.    MenuScreen(Prtr,Death,GenLoop);   {This draws the graphic Main Menu.   }
  317.    Inkey:=readkey;
  318.    If Inkey=('1') then               {You can load a *.DAT file.          }
  319.     LoadFile;
  320.    If Inkey=('2') then               {You can save a *.DAT file.          }
  321.     SaveFile;
  322.    If Inkey=('3') then               {You can edit MainGrid.              }
  323.     EditFile;
  324.    If Inkey=('4') then               {This runs the actual generation.    }
  325.     RunLoop;
  326.    If Inkey=('5') then               {This allows you to change the number}
  327.     Begin                            {of times the loop runs.             }
  328.      GenLoop:=GenLoop+1;
  329.      If GenLoop>20 then GenLoop:=1;
  330.     End;                             {This allows you to toggle if the    }
  331.    If Inkey=('6') then               {loop stops when everything is dead. }
  332.     If death then death:=false else death:=true;
  333.    If Inkey=('7') then               {This allows you to toggle the printer}
  334.     ChkPrt;
  335.   Until Inkey=#27;                   {#27 is the escape key}
  336.  End;
  337.  
  338. Procedure Default;                   {This procedure loads some default   }
  339.  Var                                 {values and stuff.                   }
  340.   Count1:integer;
  341.  Begin
  342.   SetBKColor(LightGray);             {All the graphic stuff has a lightgray}
  343.   Death:=true;                       {background.}
  344.   Prtr:=false;
  345.   ChkPrt;
  346.   GenLoop:=10;
  347.   For Count1:=0 to 21 do             {This loop assures that the outter   }
  348.    Begin                             {bounds are empty to start with.     }
  349.     MainGrid[0,Count1]:=false;
  350.     MainGrid[21,Count1]:=false;
  351.     MainGrid[Count1,0]:=false;
  352.     MainGrid[Count1,21]:=false;
  353.    End;
  354.  End;
  355.  
  356. Begin
  357.  Gr:=Detect;                         {This puts you in Graph Mode useing  }
  358.  Initgraph(gr,gd,'');                {a Borland Graphic Interface file.   }
  359.  
  360.  Default;                            {Sets the default values for the     }
  361.                                      {program.                            }
  362.  
  363.  TitleScreen;                        {Just identifies the program to the  }
  364.                                      {user.                               }
  365.  
  366.  MainLoop;                           {The loop for the Main Menu itself.  }
  367.  
  368.  
  369.  Closegraph;                         {Close the graph before you exit or  }
  370.                                      {DOS looks really goofy. <grin>      }
  371.  
  372.  ClrScr;                             {Just a little after message to the  }
  373.  TextColor(Green);                   {user.                               }
  374.  Write('I hope you enjoyed ');
  375.  TextColor(LightGreen);
  376.  WriteLn('The Game of Life');
  377.  
  378. End.
  379.  
  380. {Note from the author:
  381.  
  382.   I woulda used the little smiley faces when printing the data, but my printer
  383. wouldn't support it. I ran this on tons of data cuz data is so easy to make
  384. with my built in editor. Any of the specs in the instructions can easily be
  385. set up from the main menu. You can force it to run with everything being dead,
  386. one to twenty times, and save the grid as a *.DAT file.
  387.  
  388.                                           Zaskoda
  389. }
  390.  
  391.