home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programming Unleashed / Delphi_Programming_Unleashed_SAMS_Publishing_1995.iso / misc / life / lifedef.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-21  |  4.2 KB  |  156 lines
  1. unit LifeDef;
  2.  
  3. { Program copyright (c) 1995 by Charles Calvert }
  4. { Project Name: LIFE }
  5.  
  6. {-------------------------------}
  7. {---}      Interface        {---}
  8. {-------------------------------}
  9.  
  10. uses
  11.   Forms,
  12.   Messages,
  13.   WinProcs,
  14.   WinTypes;
  15.  
  16. const
  17.   WM_InitGame    = WM_USER;      
  18.   WM_AllDone     = WM_USER + 1; 
  19.   WM_StartGame   = WM_USER + 2;
  20.   ESCape         = #27;
  21.   CarriageReturn = #13;
  22.   DownArrow      = #80;
  23.   UpArrow        = #72;
  24.   LeftArrow      = #75;
  25.   RightArrow     = #77;
  26.   F1Key          = #59;
  27.   F2Key          = #60;
  28.   F3Key          = #61;
  29.  
  30.   MaxSize        = 100;
  31.   YBAttr         = 14 + 1 * 16;
  32.   StatusLine     = 24;
  33.  
  34. type
  35.   CellState = (Empty, Occupied);
  36.   TGameType  = (Classic, ManyBirths, MuchSurvival);
  37.   Neighbor  = set of 0..8;
  38.  
  39.   PBoardType = ^TBoardType;
  40.   TBoardtype = array[1..2, 1..MaxSize, 1..MaxSize] of cellstate;
  41.  
  42.   PSaveBoard = ^TSaveBoard;
  43.   TSaveBoard = array[1..MaxSize, 1..MaxSize] of cellstate;
  44.  
  45.  
  46.  {1..2 holds the old and new boards. The third board, saveboard, is
  47.  used to detect alternating generations. The 1..MaxSize parts refer to
  48.  the actual board coordinates. When checking for alternating generations
  49.  I save the copy of the new board in the board called SaveSecond. }
  50.  
  51.    TState = (Dead, Stable, Growing, Double, UserTermination);
  52.  
  53.    TBoardInfo = record
  54.      LifeForm: TForm;
  55.      MicrobeSize: Byte;
  56.      Board : PBoardtype;
  57.      Generation : Integer;
  58.      New: Byte;
  59.      Old: Byte;
  60.      SizeX: 1..MaxSize;
  61.      SizeY: 1..MaxSize;
  62.      State: TState;
  63.      IsDouble: Boolean;      { False the moment we know its not a double  }
  64.      SaveSecond: PSaveBoard; { Save a copy of board to check for repeats  }
  65.      SaveThird: PSaveBoard; { Save to check for third generation repeats }
  66.    end;
  67.  
  68.   TGameInfo = Record
  69.     GameType: TGameType;
  70.     MaxGen: Integer;
  71.     Alivecount: Integer;
  72.     Change: Boolean;
  73.     Birth: Neighbor;
  74.     Death: Neighbor;
  75.     Survival: Neighbor;
  76.     NumNeighbors: Integer; { Number is number of neighbors, a key fact.}
  77.     CheckForAltGen: Boolean; { Check for alternating generations }
  78.     StopProg : boolean; {Make menu run}
  79.   end;
  80.  
  81.   TBoardFile = file of TBoardType;
  82.  
  83. procedure PaintFirstBoard(var BoardInfo: TBoardInfo; BoardToDraw: Byte);
  84. function GameOver(State: TState; Gen: Integer; MaxGen: Integer): Boolean;
  85. procedure ClearOldBoard(var BoardInfo: TBoardInfo);
  86. procedure SaveBoard(var BoardInfo: TBoardInfo);
  87. procedure SwapByte(var Old, New: Byte);
  88.  
  89. var
  90.   GameInfo: TGameInfo;
  91.   BoardInfo: TBoardInfo;
  92.  
  93. {-------------------------}
  94. {---}  implementation {---}
  95. {-------------------------}
  96.  
  97. procedure PaintFirstBoard(var BoardInfo: TBoardInfo; BoardToDraw: Byte);
  98.  var
  99.   i,j,x,y : integer;
  100.   B1,B2,SaveB: HBrush;
  101. begin
  102.   B1 := CreateSolidBrush(RGB(255,0,0));
  103.   B2 := CreateSolidBrush(RGB(0,0,255));
  104.   with BoardInfo do begin
  105.     for i:= 1 to SizeY do begin
  106.       for j:= 1 to sizeX do begin
  107.         x := j * MicrobeSize;
  108.         y := i * MicrobeSize;
  109.         if (Board^[BoardToDraw, i, j] = occupied) then begin
  110.           SaveB := SelectOBject(LifeForm.Canvas.Handle, B1);
  111.           Rectangle(LifeForm.Canvas.Handle, x, y, x + MicrobeSize, y + MicrobeSize);
  112.           SelectOBject(LifeForm.Canvas.Handle, SaveB);
  113.         end else begin
  114.           SaveB := SelectOBject(LifeForm.Canvas.Handle, B2);
  115.           Rectangle(LifeForm.Canvas.Handle, x, y, x + MicrobeSize, y + MicrobeSize);
  116.           SelectOBject(LifeForm.Canvas.Handle, SaveB);
  117.         end;
  118.       end;
  119.     end
  120.   end; { with }
  121.   DeleteObject(B1);
  122.   DeleteObject(B2);
  123. end;
  124.  
  125. function GameOver(State: TState; Gen: Integer; MaxGen: Integer): Boolean;
  126. begin
  127.   GameOver := False;
  128.   if (State in [Dead,Stable,Double,UserTermination]) or (Gen >= MaxGen) then
  129.     GameOver := True;
  130. end;
  131.  
  132. procedure ClearOldBoard(var BoardInfo: TBoardInfo);
  133. var
  134.   i,j : Integer;
  135. begin
  136.   with BoardInfo do
  137.     FillChar(Board^[BoardInfo.Old], SizeOf(Board^[BoardInfo.Old]), Empty);
  138. end;
  139.  
  140. procedure SaveBoard(var BoardInfo: TBoardInfo);
  141. begin
  142.   with BoardInfo do
  143.     move(Board^[new], SaveSecond^, SizeOf(SaveSecond^));
  144. end;
  145.  
  146. procedure SwapByte(var Old, New: Byte);
  147. var
  148.   Temp: Byte;
  149. begin
  150.   Temp := Old;
  151.   Old:= New;
  152.   New := Temp;
  153. end;
  154.  
  155. end.
  156.