CP/M/CPM_CDROM.iso/cpm/turbopas/tp/utl2/life.pzs/LIFE.PAS

Pascal/Delphi Source File | 1994-07-23 | 20KB | 692 lines

Program Life;
  {[A+,T=3] Instructions to PasMat.}

  {$C-  <-- These are instructions   }
  {$I-  <-- from me to optimize the  }
  {$W2  <-- compiler and trap ^C,    }
  {$X+  <-- for Turbo Pascal.        }

{
                                L   I   F   E
                                 Version 2.0

    This program is a simulation of cell life on a 2 dimensional board.
 This version is written in Turbo Pascal, for either the IBM-PC, and
 compatables, or CP/M-80 mathines, and will run on both without any
 changes, other than re-compiling the source.  It is highly revised
 version of another public domain LIFE program also written in Turbo
 Pascal for CP/M-80 machines.  Some parts of the source code are Turbo
 Pascal specific, like the KeyPressed, Kbd, GotoXY(), and ClrScr, but
 can easily be changed to any other Pascal compiler.  I have ported
 version from an IBM main frame to a DEC Rainbow, so it shouldn't be
 difficult.  If you have any questions or comments, please feel free
 to call my RCP/M at [phone].

                                                  Thank you,


                                                  Cyrus Patel
                                          SYSOP - The Master Silicone
}

   Const
      Height = 23;
      Width = 60;
      MinBound = - 1;
      Lively = '+';
      Deadly = ' ';

   Type
      State = (Alive, Dead);
      Cell =
         Record
            LooksLikeItIs: State;
            Nearby: Integer;
         End;
      Edges =
         Record
            Left, Right, Top, Bottom: Integer
         End;
      ScreenLine = String [80];

   Var
      Ch: Char;
      Edge: Edges;
      Births, Deaths, Generation, Pause, Population: Integer;
      Board: Array [MinBound..Width, MinBound..Height] of Cell;


   Function Yes(Line: ScreenLine): Boolean;

      Var
         Ch: Char;

      Begin
         Write(Line, '? ');
         Repeat
            Read(Kbd, Ch)
         Until UpCase(Ch) in ['Y', 'N'];
         Yes := UpCase(Ch) = 'Y'
      End;


   Function Min(a, b: Integer): Integer;

      Begin
         If a <= b then
            Min := a
         else
            Min := b
      End;


   Function Max(a, b: Integer): Integer;

      Begin
         If a >= b then
            Max := a
         else
            Max := b
      End;


   Procedure ResetEdges;

      Begin
         With Edge do
            Begin
            Top := Height - 1;
            Right := MinBound + 1;
            Left := Width - 1;
            Bottom := MinBound + 1
            End

      End;


   Procedure Instructions;

      Var
         Ch: Char;


      Procedure Lecture_On_Life;

         Begin
            ClrScr;
            GotoXY(29, 2);
            WriteLn('Instructions for LIFE.');
            WriteLn;
            WriteLn;
            Write(
                 'LIFE simulates the growth of a colony of animalcules in a "'
                  );
            WriteLn(Width: 1, ' by ', Height: 1, ' World".');
            WriteLn;
            WriteLn(
       'Whether a cell is born, lives or dies depends on the number of living'
                    );
            WriteLn(
    'animalcules near by.  If a cell is empty and has exactly 3 neighbors, it'
                    );
            WriteLn(
         'will be born in the next generation.  If it is alive and has 2 or 3'
                    );
            WriteLn(
     'neighbors, it will stay alive.  Otherwise, it either dies of loneliness'
                    );
            WriteLn('or suffocates from overcrowding.');
            WriteLn;
            WriteLn(
        'You type in the starting pattern, going to the location of where you'
                    );
            WriteLn(
       'want to place a cell.  Then press either the SPACE bar, or 5 to place'
                    );
            WriteLn(
        'or take away a seed. To begin the generations press the ESC key. You'
                    );
            WriteLn(
     'can also save and load ''Life'' files from disk.  Press ^L to Load, and'
                    );
            WriteLn(
         '^S to Save. You can also interupt the generations by hitting RETURN'
                    );
            WriteLn('and changing the screen, loading and also saving it.');
            WriteLn;
            WriteLn(
   'The ''<'' key speeds things up a bit, the ''>'' key slows things down. If'
                    );
            WriteLn(
       'the good old days at M.I.T., this game was played with pencil & graph'
                    );
            WriteLn('paper.');
            GotoXY(27, 24);
            Write('Press any key to continue.');
            While KeyPressed do
               Read(Kbd, Ch);
            Read(Kbd, Ch)
         End;

      Begin
         ClrScr;
         GotoXY(35, 3);
         Write('The Game of');
         GotoXY(34, 5);
         Write('L   I   F   E');
         GotoXY(35, 7);
         Write('Version 2.0');
         GotoXY(21, 10);
         If Yes('Would you like instructions for Life') then
            Lecture_On_Life;
         ClrScr
      End;


   Procedure Initialize;

      Var
         Across, Down: Integer;

      Begin
         For Across := MinBound to Width do
            For Down := MinBound to Height do
               With Board[Across, Down] do
                  Begin
                  LooksLikeItIs := Dead;
                  Nearby := 0
                  End;

         ResetEdges
      End;


   Procedure Limits(Across, Down: Integer);

      Begin
         With Edge do
            Begin
            Left := Min(Left, Across);
            Right := Max(Right, Across);
            Top := Min(Top, Down);
            Bottom := Max(Bottom, Down)
            End

      End;


   Procedure ClearNearby;

      Var
         Across, Down: Integer;

      Begin
         With Edge do
            For Across := Left - 1 to Right + 1 do
               For Down := Top - 1 to Bottom + 1 do
                  Board[Across, Down].Nearby := 0

      End;


   Procedure CountNeighbors;

      Var
         Across, DeltAcross, DeltaDown, Down: Integer;

      Begin
         ClearNearby;
         With Edge do
            For Across := Left - 1 to Right + 1 do
               For Down := Top - 1 to Bottom + 1 do
                  If Board[Across, Down].LooksLikeItIs = Alive then
                     For DeltAcross := - 1 to 1 do
                        For DeltaDown := - 1 to 1 do
                           With Board[Across + DeltAcross, Down +
                                DeltaDown] do
                              Nearby := Succ(Nearby)

      End;


   Procedure UpDate;

      Var
         LocalEdge: Edges;
         Across, Down: Integer;

      Begin
         Births := 0;
         Deaths := 0;
         LocalEdge := Edge;
         ResetEdges;
         For Across := Max(MinBound + 1, LocalEdge.Left - 1) to Min(Width - 1,
           LocalEdge.Right + 1) do
            For Down := Max(MinBound + 1,
              LocalEdge.Top - 1) to Min(Height - 1, LocalEdge.Bottom + 1) do
               With Board[Across, Down] do
                  Case LooksLikeItIs of
                     Dead:
                        If Nearby = 3 then
                           Begin
                           LooksLikeItIs := Alive;
                           GotoXY(Across + 1, Down + 1);
                           Write(Lively);
                           Limits(Across, Down);
                           Births := Births + 1
                           End;
                     Alive:
                        If (Nearby = 3) or (Nearby = 4) then
                           Limits(Across, Down)
                        else
                           Begin
                           LooksLikeItIs := Dead;
                           GotoXY(Across + 1, Down + 1);
                           Write(Deadly);
                           Deaths := Deaths + 1
                           End
                     End;

         Generation := Generation + 1;
         Population := Population + Births - Deaths;
         GotoXY(Width + 15, 16);
         Write(Generation: 5);
         GotoXY(Width + 15, 17);
         Write(Population: 5);
         GotoXY(Width + 15, 18);
         Write(Births: 5);
         GotoXY(Width + 15, 19);
         Write(Deaths: 5)
      End;


   Procedure DrawScreen;

      Var
         Index: Integer;

      Begin
         GotoXY(Width + 1, 1);
         Write('+');
         For Index := 2 to Height do
            Begin
            GotoXY(Width + 1, Index);
            Write('|')
            End;
         GotoXY(1, Height + 1);
         For Index := 1 to Width do
            Write('-');
         Write('+');
         GotoXY(Width + 4, 1);
         Write('The Game of Life.');
         GotoXY(Width + 7, 2);
         Write('Version 2.0');
         GotoXY(Width + 11, 3);
         Write('by');
         GotoXY(Width + 7, 4);
         Write('Cyrus Patel');
         GotoXY(Width + 6, 6);
         Write('^     ^     ^');
         GotoXY(Width + 7, 7);
         Write('\    |    /');
         GotoXY(Width + 8, 8);
         Write('\   |   /');
         GotoXY(Width + 9, 9);
         Write('7  8  9');
         GotoXY(Width + 4, 10);
         Write('<--- 4  *  6 --->');
         GotoXY(Width + 9, 11);
         Write('1  2  3');
         GotoXY(Width + 8, 12);
         Write('/   |   \');
         GotoXY(Width + 7, 13);
         Write('/    |    \');
         GotoXY(Width + 6, 14);
         Write('v     v     v');
         GotoXY(Width + 4, 16);
         Write('Generation:');
         GotoXY(Width + 15, 16);
         Write(0: 5);
         GotoXY(Width + 4, 17);
         Write('Population:');
         GotoXY(Width + 15, 17);
         Write(0: 5);
         GotoXY(Width + 8, 18);
         Write('Births:');
         GotoXY(Width + 15, 18);
         Write(0: 5);
         GotoXY(Width + 8, 19);
         Write('Deaths:');
         GotoXY(Width + 15, 19);
         Write(0: 5);
         GotoXY(Width + 9, 20);
         Write('Speed:');
         GotoXY(Width + 15, 20);
         Write(0: 5);
         GotoXY(Width + 5, 23);
         Write('ESC to     t.')
      End;


   Procedure LoadScreen;

      Var
         InFile: Text;
         Error: Boolean;
         FileName: String [14];
         Across, Down: Integer;

      Begin
         GotoXY(Width + 3, 21);
         If Yes('Reset screen') then
            Begin
            For Across := MinBound to Width do
               For Down := MinBound to Height do
                  With Board[Across, Down] do
                     If LooksLikeItIs = Alive then
                        Begin
                        GotoXY(Across + 1, Down + 1);
                        Write(' ');
                        LooksLikeItIs := Dead;
                        Nearby := 0
                        End;

            ResetEdges;
            Population := 0;
            GotoXY(Width + 15, 17);
            Write(Population: 5)
            End;
         GotoXY(Width + 3, 21);
         Write('File name to load:');
         GotoXY(Width + 5, 22);
         BufLen := 14;
         ReadLn(FileName);
         GotoXY(Width + 3, 21);
         ClrEol;
         GotoXY(Width + 5, 22);
         ClrEol;
         If FileName <> '' then
            Begin
            GotoXY(Width + 6, 22);
            Write('Loading...');
            Assign(InFile, FileName);
            Error := IOResult <> 0;
            If Not Error then
               begin
               Reset(InFile);
               Error := IOResult <> 0
               End;
            If Not Error then
               Repeat
                  ReadLn(InFile, Across, Down);
                  If (Across >= MinBound) and (Down >= MinBound) and
                     (Down <= Height) and (Across <= Width) then
                     With Board[Across, Down] do
                        Begin
                        Limits(Across, Down);
                        If LooksLikeItIs = Dead then
                           Begin
                           GotoXY(Across + 1, Down + 1);
                           Write(Lively);
                           LooksLikeItIs := Alive;
                           Population := Population + 1;
                           GotoXY(Width + 15, 17);
                           Write(Population: 5)
                           End
                        End;

                  Error := IOResult <> 0
               Until (Eof(InFile)) or (Error);
            Close(InFile);
            If Not Error then
               Error := IOResult <> 0;
            GotoXY(Width + 6, 22);
            If Error then
               Write('Loading Error!', Chr(7))
            else
               ClrEol
            End
      End;


   Procedure SaveScreen;

      Var
         OutFile: Text;
         Error: Boolean;
         FileName: String [14];
         Across, Down: Integer;

      Begin
         GotoXY(Width + 3, 21);
         Write('File name to save:');
         GotoXY(Width + 5, 22);
         BufLen := 14;
         ReadLn(FileName);
         GotoXY(Width + 3, 21);
         ClrEol;
         GotoXY(Width + 5, 22);
         ClrEol;
         If FileName <> '' then
            Begin
            GotoXY(Width + 6, 22);
            Write('Saving...');
            Assign(OutFile, FileName);
            Error := IOResult <> 0;
            If Not Error then
               Begin
               ReWrite(OutFile);
               Error := IOResult <> 0
               End;
            If Not Error then
               For Across := MinBound to Width do
                  For Down := MinBound to Height do
                     With Board[Across, Down] do
                        If LooksLikeItIs = Alive then
                           If Not Error then
                              Begin
                              WriteLn(OutFile, Across: 1, ' ', Down: 1);
                              Error := IOResult <> 0
                              End;

            Close(OutFile);
            If Not Error then
               Error := IOResult <> 0;
            If Error then
               Erase(OutFile);
            GotoXY(Width + 6, 22);
            ClrEol
            End
      End;


   Procedure GetPositions;

      Var
         Ch: Char;
         Across, Down, Index: Integer;

      Begin
         Down := 0;
         Across := 0;
         GotoXY(Width + 12, 23);
         Write('star');
         Repeat
            GotoXY(Across + 1, Down + 1);
            Index := - 15000;
            If Not KeyPressed then
               Repeat
                  If Index <= 32767 then
                     Index := Index + 1;
                  If Index = 0 then
                     Begin
                     GotoXY(Width + 6, 22);
                     ClrEol;
                     GotoXY(Across + 1, Down + 1)
                     End
                  else If Index = 32767 then
                     Begin
                     GotoXY(Width + 6, 22);
                     Write(Chr(7), 'Hurry up!!');
                     GotoXY(Across + 1, Down + 1);
                     Index := - 30000
                     End
               Until KeyPressed;
            Read(Kbd, Ch);
            If (Ch = Chr(27)) and (KeyPressed) then
               Begin
               Read(Kbd, Ch);
               Case Ord(Ch) of
                  71:
                     Ch := '7';
                  72:
                     Ch := '8';
                  73:
                     Ch := '9';
                  75:
                     Ch := '4';
                  77:
                     Ch := '6';
                  79:
                     Ch := '1';
                  80:
                     Ch := '2';
                  81:
                     Ch := '3'
                  end
               End;
            If Ch = ' ' then
               Ch := '5';
            If Index < 1 then
               Begin
               GotoXY(Width + 6, 22);
               ClrEol;
               GotoXY(Across + 1, Down + 1)
               End;
            Case Ch of
               ^L:
                  LoadScreen;
               ^S:
                  SaveScreen;
               '1':
                  Begin
                  Across := Pred(Across);
                  Down := Succ(Down)
                  End;
               '2':
                  Down := Succ(Down);
               '3':
                  Begin
                  Across := Succ(Across);
                  Down := Succ(Down)
                  End;
               '4':
                  Across := Pred(Across);
               '5':
                  With Board[Across, Down] do
                     Begin
                     Limits(Across, Down);
                     If LooksLikeItIs = Alive then
                        Begin
                        Write(Deadly);
                        LooksLikeItIs := Dead;
                        Population := Population - 1
                        End
                     else
                        Begin
                        Write(Lively);
                        LooksLikeItIs := Alive;
                        Population := Population + 1
                        End;
                     GotoXY(Width + 15, 17);
                     Write(Population: 5)
                     End;

               '6':
                  Across := Succ(Across);
               '7':
                  Begin
                  Across := Pred(Across);
                  Down := Pred(Down)
                  End;
               '8':
                  Down := Pred(Down);
               '9':
                  Begin
                  Across := Succ(Across);
                  Down := Pred(Down)
                  End
               End;
            If Across > Width - 1 then
               Begin
               Across := 0;
               Down := Succ(Down)
               End
            else If Across < 0 then
               Begin
               Across := Width - 1;
               Down := Pred(Down)
               End;
            If Down > Height - 1 then
               Down := 0
            else If Down < 0 then
               Down := Height - 1
         Until Ch = Chr(27);
         GotoXY(Width + 12, 23);
         Write('abor')
      End;

   Begin
      Initialize;
      Instructions;
      DrawScreen;
      Population := 0;
      Generation := 0;
      Pause := 32;
      GetPositions;
      GotoXY(Width + 15, 20);
      Write(Pause Div 16: 5);
      Repeat
         CountNeighbors;
         UpDate;
         If Pause <> 0 then
            For Ch := 'A' to 'Z' do
               Delay(Pause);
         If KeyPressed then
            Begin
            Read(Kbd, Ch);
            Case Ch of
               ^M:
                  GetPositions;
               ^[:
                  If Not KeyPressed then
                     Population := 0;
               '>', '.':
                  Pause := Min(Pause + 16, 255);
               '<', ',':
                  Pause := Max(Pause - 16, 0)
               End;
            If Ch in ['>', '.', '<', ','] then
               Begin
               GotoXY(Width + 15, 20);
               If Pause = 0 then
                  Write(Pause: 5)
               else
                  Write(Pause Div 16: 5)
               End
            End
      Until (Population = 0) or ((Births = 0) and (Deaths = 0));
      GotoXY(Width + 5, 23);
      ClrEol;
      If Ch = Chr(27) then
         Write('   Aborted!!')
      else If Population = 0 then
         Begin
         GotoXY(Width + 3, 22);
         Write('This colony has');
         GotoXY(Width + 6, 23);
         Write('died out.')
         End;
      GotoXY(1, 24)
   End.