home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programming Unleashed / Delphi_Programming_Unleashed_SAMS_Publishing_1995.iso / misc / life / setboard.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-21  |  4.3 KB  |  161 lines
  1. unit Setboard;
  2.  
  3. { Program copyright (c) 1995 by Charles Calvert }
  4. { Project Name: LIFE }
  5.  
  6. { This is where we set up the board to begin the game. Our
  7.   options are:
  8.       ReadBoard: The user picks coordinates ( Not Implemented )
  9.       FeedBoard: The machine picks random coordinates
  10.       FileMethod: An old board is read from disk
  11. }
  12.  
  13. interface
  14.  
  15. uses
  16.   WinTypes, WinProcs, Classes,
  17.   Graphics, Forms, Controls,
  18.   StdCtrls, Tabs, LifeDef,
  19.   Buttons, ExtCtrls, SysUtils, Dialogs;
  20.  
  21. type
  22.   TSetBrd = class(TForm)
  23.     OpenDialog1: TOpenDialog;
  24.   private
  25.     function OpenReadFile(var Infile: TBoardFile; FileName: String): Boolean;
  26.     function ReadFile(Var Target: TBoardType): Boolean;
  27.     procedure QuickWrite(FileName: String; Target: TBoardType);
  28.     procedure FeedBoard(var boardinfo: TBoardInfo; var GameInfo: TGameInfo);
  29.     function FileMethod(var BoardInfo: TBoardInfo; var GameInfo: TGameInfo): Boolean;
  30.   public
  31.     procedure StartMethod(var BoardInfo: TBoardInfo;
  32.                           var GameInfo: TGameInfo; Option: Char);
  33.   end;
  34.  
  35. var
  36.   SetBrd: TSetBrd;
  37.  
  38. implementation
  39.  
  40. {$R *.DFM}
  41.  
  42. function TSetBrd.OpenReadFile(var Infile: TBoardFile; FileName: String): Boolean;
  43. var
  44.   S: String;
  45. begin
  46.   OpenReadFile := True;
  47.   try
  48.     System.Assign(infile, filename); 
  49.     Reset(Infile);
  50.   except
  51.     S := 'Could not open file: ' + FileName;
  52.     MessageDlg(S, mtError, [mbOk], 0);
  53.     OpenReadFile := False;
  54.   end;
  55. end;
  56.  
  57.  
  58. function CreateFile(var OutFile: TBoardFile; FileName: String): Boolean;
  59. var
  60.   S: string;
  61. begin
  62.   CreateFile := True;
  63.   {$I-}
  64.   Assign(OutFile, FileName + '.lif'); { Extension identifies files. }
  65.   ReWrite(OutFile);
  66.   {$I+}
  67.   if IOResult <> 0 then begin
  68.     S := 'Could not create file: ' + UpperCase(FileName + '.lif ') +
  69.          #13'(Disk Full? Current directory a CD drive?)';
  70.     MessageDlg(S, mtError, [mbOk], 0);
  71.     CreateFile := False;
  72.   end; 
  73. end;
  74.  
  75. procedure TSetBrd.QuickWrite(FileName: String; Target: TBoardType);
  76. var
  77.   OutFile: TBoardFile;
  78. begin
  79.   if  CreateFile(OutFile, FileName) then begin
  80.     Write(OutFile, Target);
  81.     System.Close(OutFile);
  82.   end;
  83. end;
  84.  
  85. { This is an alternative to readboard which feeds to the box random
  86.   numbers specifying board coordinates. The key line here is for i := 1
  87.   to result, with result being the figure the user passes in. }
  88. procedure TSetBrd.FeedBoard(var Boardinfo: TBoardInfo; var GameInfo: TGameInfo);
  89. var
  90.   i,j : integer;
  91.   x,y : integer;
  92.   FooX, FooY : integer;
  93.   NumCoords: Integer;
  94.   S: string;
  95. begin
  96.   S := '';
  97.   if not InputQuery('Computer Generation', 'Number of Coordinates', S) then Exit;
  98.   NumCoords := StrToInt(S);
  99.   FooX := BoardInfo.SizeX;
  100.   FooY := BoardInfo.SizeY;
  101.   with boardinfo do begin
  102.     {initially set all elements in old board to empty}
  103.     ClearOldBoard(BoardInfo);
  104.     Randomize;
  105.     x := Random(FooX);
  106.     if x < 1 then x := 2;
  107.     y := Random(fooY);
  108.     if y < 1 then y := 2;
  109.     for i := 1 to NumCoords do begin
  110.       BoardInfo.board^[old,y,x]:= occupied;
  111.       x := Random(fooX);
  112.       if x < 1 then x := 5;
  113.       y := Random(fooY);
  114.       if y < 1 then y := 15;
  115.     end
  116.   end;
  117. end;
  118.  
  119. function TSetBrd.ReadFile(Var Target: TBoardType): Boolean;
  120. var
  121.   InFile: TBoardFile;
  122.   FileName: String;
  123.  
  124. begin
  125.   ReadFile := False;
  126.   if OpenDialog1.Execute then
  127.     if OpenReadFile(InFile, OpenDialog1.FileName) then begin
  128.       Read(Infile, Target);
  129.       System.Close(Infile);
  130.       ReadFile := True;
  131.   end;
  132. end; {read_File}
  133.  
  134. function TSetBrd.FileMethod(var BoardInfo: TBoardInfo;
  135.                     var GameInfo: TGameInfo): Boolean;
  136. begin
  137.   FileMethod := True;
  138.   with BoardInfo do begin
  139.     ClearOldBoard(BoardInfo);
  140.     if not ReadFile(Board^) then FileMethod := False;
  141.   end;
  142. end;
  143.  
  144. { Sort out whether computer or user chooses coordinates.
  145.    1. Computer chooses
  146.    2. User fills in coordinates
  147.    3. Get coordinates from file,
  148.       if we can't get file, then exit }
  149. procedure TSetBrd.StartMethod(var BoardInfo: TBoardInfo;
  150.                 var GameInfo: TGameInfo; Option: Char);
  151. begin
  152.   case option of
  153.     '1': SetBrd.FeedBoard(BoardInfo, GameInfo);
  154.     '2': MessageDlg('Not Implemented', mtInformation, [mbOk], 0);
  155.     '3': if not SetBrd.FileMethod(BoardInfo, GameInfo) then Exit;
  156.   end;
  157.   SetBrd.QuickWrite('BackUp', BoardInfo.Board^);
  158. end;
  159.  
  160. end.
  161.