Delphi Programming Unleashed/Delphi_Programming_Unleashed_SAMS_Publishing_1995.iso/misc/life/gamebrd.pas

Pascal/Delphi Source File | 1995-03-21 | 5.0 KB | 180 lines

unit Gamebrd;

{ Program copyright (c) 1995 by Charles Calvert }
{ Project Name: LIFE }

interface

uses
  SysUtils, WinTypes, WinProcs,
  Messages, Classes, Graphics,
  Controls, Forms, Dialogs,
  LifeDef, LifeMain;

type
  TBoard = class(TForm)
  private
    procedure StartGame(var Msg: TMessage);
      message wm_StartGame;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    procedure CleanUp(var BoardInfo: TBoardInfo);
    procedure Initialize(var BoardInfo: TBoardInfo;
                         var GameInfo: TGameInfo;
                         FormInit: TForm);
  end;

var
  Board: TBoard;

implementation

uses
  ChsDlg,
  GenLaws,
  SetBoard,
  Setting;

{$R *.DFM}

procedure PaintIt(var BoardInfo: TBoardInfo; GameInfo: TGameInfo; BoardToDraw: Byte);
var
  i,j,x,y : integer;
  B1,B2,SaveB: HBrush;
procedure DoDraw;
begin
  with BoardInfo do begin
    if (Board^[BoardToDraw, i, j] = occupied) then begin
      SaveB := SelectOBject(GameBrd.Board.Canvas.Handle, B1);
      Rectangle(GameBrd.Board.Canvas.Handle, x, y, x + MicrobeSize, y + MicrobeSize);
      SelectOBject(GameBrd.Board.Canvas.Handle, SaveB);
    end else begin
      SaveB := SelectOBject(GameBrd.Board.Canvas.Handle, B2);
      Rectangle(GameBrd.Board.Canvas.Handle, x, y, x + MicrobeSize, y + MicrobeSize);
      SelectOBject(GameBrd.Board.Canvas.Handle, SaveB);
    end;
  end;
end;

begin
  B1 := CreateSolidBrush(RGB(255,0,0));
  B2 := CreateSolidBrush(RGB(0,0,255));
  with BoardInfo do begin
    for i:= 1 to SizeY do begin
      for j:= 1 to SizeX do begin
        x := j * MicrobeSize;
        y := i * MicrobeSize;
        if GameInfo.CheckForAltGen then CheckForDouble(i, j, BoardInfo, GameInfo);
        if BoardInfo.Board^[New, i, j] <> BoardInfo.Board^[Old, i, j] then
          DoDraw
      end;
    end
  end; { with }
  DeleteObject(B1);
  DeleteObject(B2);
end;

procedure Writeboard(var BoardInfo: TBoardInfo;
                     GameInfo: TGameInfo; BoardToDraw: Byte);
var
  S: String;
begin
  S := ' Generation = ' + IntToStr(boardinfo.generation) + ' ';
  PaintIt(BoardInfo, GameInfo, BoardToDraw);
end; {Procedure WriteBoard}

procedure RunGame(var BoardInfo: TBoardInfo; var GameInfo: TGameInfo);
begin
  GameInfo.Change := True;
  PaintFirstBoard(BoardInfo, BoardInfo.Old);
  with boardinfo do begin
    Generation := 1;
    repeat
      GeneticLaws(BoardInfo, GameInfo);  { Find out who lives and who dies }
      WriteBoard(BoardInfo, GameInfo, New); { Draw to the screen           }
      Inc(Generation);
      SwapByte(Old, New);
      { Save copy of board, alternate generations testing in GeniticLaws}
      if GameInfo.Change = True then SaveBoard(BoardInfo);
      if (State <> Double) and (State <> UserTermination) then State:= Growing;
      if GameInfo.Alivecount = 0 then State := Dead;
      if not GameInfo.Change then State:= Stable;
      Application.ProcessMessages;
      LifeMainForm.NumGens := Generation;
      LifeMainForm.GameState := State;
    until GameOver(State, Generation, GameInfo.MaxGen);
  end; {with}
end;

procedure MakeRules(var GameInfo: TGameInfo);
begin
  case GameInfo.GameType of
    Classic: begin
      GameInfo.Survival := [2, 3];
      GameInfo.Death := [0, 1, 4, 5, 6, 7, 8];
      GameInfo.Birth := [3];
    end;

    ManyBirths: begin
      GameInfo.Survival := [2, 3, 4];
      GameInfo.Death := [0, 1, 5, 6,7, 8];
      GameInfo.Birth := [3, 4];
    end;

    MuchSurvival: begin
      GameInfo.Survival := [2, 3, 4];
      GameInfo.Death := [0, 1, 5, 6, 7, 8];
      GameInfo.Birth := [3];
    end;
  end;
end;

procedure TBoard.StartGame(var Msg: TMessage);
var
  Choice: Char;
begin
  if not ChooseDlg.ShowYourself(Choice) then Exit;
  Initialize(BoardInfo, GameInfo, Self);
  try
    SetBrd.StartMethod(BoardInfo, GameInfo, Choice);
  except
    BoardInfo.State := Dead;     { Tell the program it didn't work }
    raise;                       { ReRaise the error for default handling }
  end;
  RunGame(BoardInfo, GameInfo);
  CleanUp(BoardInfo);
end;

procedure TBoard.Initialize(var BoardInfo: TBoardInfo; var GameInfo: TGameInfo; FormInit: TForm);
begin
  BoardInfo.LifeForm := FormInit;
  New(BoardInfo.Board);
  New(BoardInfo.SaveSecond);
  New(BoardInfo.SaveThird);
  MakeRules(GameInfo);
  GameInfo.StopProg := True;
  BoardInfo.IsDouble := False;      { Generations not alternating.}
  Boardinfo.State := Growing;
  Boardinfo.Generation := 1;
  BoardInfo.Old := 1;
  BoardInfo.New := 2;
end;

procedure TBoard.CleanUp(var BoardInfo: TBoardInfo);
begin
  Dispose(BoardInfo.Board);
  Dispose(BoardInfo.SaveSecond);
  Dispose(BoardInfo.SaveThird);
end;

procedure TBoard.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style and not ws_Caption;
  Params.Style := Params.Style and not ws_ThickFrame;
  Params.Style := Params.Style or ws_Border;
end;

end.