home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programming Unleashed / Delphi_Programming_Unleashed_SAMS_Publishing_1995.iso / misc / life / genlaws.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-21  |  4.6 KB  |  145 lines
  1. unit GenLaws;
  2.  
  3. { Program copyright (c) 1995 by Charles Calvert }
  4. { Project Name: LIFE }
  5.  
  6. { This is where the basic genetic laws are actually calculated. Using
  7.   a double loop structure, the program counts through each square in
  8.   the matrix, comparing the state of the old and new squares.
  9.  
  10.   The first law is implemented by asking if the position in question
  11.   on the old board is empty and if number is in birth.
  12.   Number is calculated in countneighbors. The only number in birth is 3.
  13.   If these conditions are met the position on the new board is occupied.
  14.   Alivecount is incremented. The board has been changed.
  15.  
  16.   The second law asks if the position on the old board was occupied and
  17.   if number is now in Death. The numbers for Death are 0 1 4 5 6 7 and 8.
  18.   If these conditions are met the position on the new board is empty.
  19.   The board has been changed.
  20.  
  21.   The third law asks if the old board position was occupied and if the
  22.   number is in survival. The numbers for survival are two and three.
  23.   If these conditions are met the position on the new board is occupied.
  24.   Alivecount is incremented. But board does not change. }
  25.  
  26. interface
  27.  
  28. uses
  29.   Dialogs,
  30.   LifeDef;
  31.  
  32. procedure GeneticLaws (var boardinfo : TBoardInfo; var GameInfo: TGameInfo);
  33. function CheckForDouble(i,j: Integer; var BoardInfo: TBoardInfo;
  34.                         var GameInfo: TGameInfo): Boolean;
  35. implementation
  36.  
  37. { Look for the edges of the Board. Size is BoardInfo.Size }
  38. procedure CheckLocation(var Up, Down, Left, Right: Integer;
  39.                         x, y, SizeX, SizeY: Integer);
  40. begin
  41.   if x > 1 then Left := -1
  42.   else Left := 0;
  43.  
  44.   if x < SizeX then Right := 1
  45.   else Right := 0;
  46.  
  47.   if y > 1 then Up := -1
  48.   else Up := 0;
  49.  
  50.   if y < SizeY then Down := 1
  51.   else Down := 0;
  52. end;
  53.  
  54. { Determine the number of neighbors. }
  55. procedure CountNeighbor(Boardinfo: TBoardInfo;
  56.                         x, y:Integer; var Count: Integer);
  57. var
  58.   Down, Left, Right, Up: Integer;
  59.   i,j: Integer;
  60. begin
  61.   Count := 0;
  62.   with BoardInfo do begin
  63.     CheckLocation(Up, Down, Left, Right, X, Y, BoardInfo.SizeX, BoardInfo.SizeY);
  64.     for i := Left to Right do
  65.       for j := Up to Down do
  66.         if (BoardInfo.board^[BoardInfo.old, y + j, x + i] = Occupied) and
  67.           not((i = 0) and (j = 0)) then
  68.             count := count + 1
  69.   end 
  70. end; 
  71.  
  72. { See if they are born }
  73. procedure LawNumberOne(i, j: Integer; var BoardInfo: TBoardInfo;
  74.                        var GameInfo: TGameInfo);
  75. begin
  76.   with BoardInfo do begin
  77.     if (Board^[old,i,j] = Empty) and
  78.        (GameInfo.NumNeighbors in GameInfo.Birth) then begin
  79.       Board^[New,i,j] := Occupied;
  80.       GameInfo.Change := true;
  81.       Inc(GameInfo.AliveCount);
  82.     end;
  83.   end;
  84. end;
  85.  
  86. { See if they've died }
  87. procedure LawNumberTwo(i, j: Integer; var BoardInfo: TBoardInfo;
  88.                         var GameInfo: TGameInfo);
  89. begin
  90.   if (BoardInfo.Board^[BoardInfo.Old,i,j] = Occupied) and
  91.      (GameInfo.NumNeighbors in GameInfo.Death) then
  92.        GameInfo.Change := true
  93. end;
  94.  
  95. { See if they Survive }
  96. procedure LawNumberThree(i, j: Integer; var BoardInfo: TBoardInfo;
  97.                          var GameInfo: TGameInfo);
  98. begin
  99.   with BoardInfo do begin
  100.     if (Board^[Old,i,j] = Occupied) and
  101.        (GameInfo.NumNeighbors in GameInfo.Survival) then begin
  102.       Board^[New,i,j] := Occupied;
  103.       Inc(GameInfo.AliveCount);
  104.     end;
  105.   end;
  106. end;
  107.  
  108. { Check for Alternating Generations }
  109. function CheckForDouble(i,j: Integer; var BoardInfo: TBoardInfo;
  110.                         var GameInfo: TGameInfo): Boolean;
  111. begin
  112.   with BoardInfo do begin
  113.     if BoardInfo.IsDouble then State := Double; { Double til proven otherwise}
  114.     if Board^[New,i,j] = SaveSecond^[i,j] then    { do nothing                 }
  115.     else begin
  116.       State := Growing;   {Can't be a double so for now its growing}
  117.       IsDouble := False;  {Can't change back automatically}
  118.     end;
  119.   end;
  120. end;
  121.  
  122. procedure GeneticLaws (var BoardInfo : TBoardInfo; var GameInfo: TGameInfo);
  123. var
  124.   i,j: Integer;
  125. begin
  126.   with BoardInfo do begin
  127.     GameInfo.AliveCount := 0;
  128.     GameInfo.Change := False;
  129.     if GameInfo.CheckForAltGen then IsDouble := True;
  130.     for i:= 1 to SizeY do begin
  131.       for j:= 1 to SizeX do begin
  132.         CountNeighbor(BoardInfo, j, i, GameInfo.NumNeighbors);
  133.         Board^[New, i, j] := Empty;
  134.         LawNumberOne(i, j, BoardInfo, GameInfo); 
  135.         LawNumberTwo(i, j, BoardInfo, GameInfo);  
  136.         LawNumberThree(i, j, BoardInfo, GameInfo); 
  137.         if GameInfo.CheckForAltGen then
  138.           CheckForDouble(i, j, BoardInfo, GameInfo);
  139.       end;
  140.     end;
  141.   end; {with}
  142. end; { GeneticLaws}
  143.  
  144. end.
  145.