Subversion Repositories forest

Rev

Blame | Last modification | View Log | RSS feed

  1. unit MapGenTestMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, ExtCtrls, StdCtrls, IniFiles, Spin, ShellAPI;
  8.  
  9. type
  10.   TDWordPoint = array[0..1] of DWord;
  11.  
  12.   TMainForm = class(TForm)
  13.     InitTimer: TTimer;
  14.     INIOpenDialog: TOpenDialog;
  15.     MapImage: TImage;
  16.     ControlPanel: TPanel;
  17.     ShowPathCheckbox: TCheckBox;
  18.     LoadINIButton: TButton;
  19.     GenMapButton: TButton;
  20.     SeedSpinEdit: TSpinEdit;
  21.     SeedLabel: TLabel;
  22.     PlayButton: TButton;
  23.     procedure GenMapButtonClick(Sender: TObject);
  24.     procedure InitTimerTimer(Sender: TObject);
  25.     procedure ShowPathCheckboxClick(Sender: TObject);
  26.     procedure LoadINIButtonClick(Sender: TObject);
  27.     procedure FormShow(Sender: TObject);
  28.     procedure SeedSpinEditChange(Sender: TObject);
  29.     procedure PlayButtonClick(Sender: TObject);
  30.   private
  31.     mbTrees, mbWayPoints: array of TDWordPoint;
  32.     treeradius, ntrees, nwaypoints, mapX, mapY: DWord;
  33.     miniatureFactor: DWord;
  34.     drawn: boolean;
  35.     loadedINI: string;
  36.     procedure DrawCircle(x, y, r: integer; color: TColor);
  37.     procedure RedrawMap;
  38.     procedure ResizeMapForm;
  39.     function LoadINI(filename: AnsiString): boolean;
  40.     function FindINIFile: string;
  41.     procedure GenMapSeed(seed: integer);
  42.   end;
  43.  
  44. var
  45.   MainForm: TMainForm;
  46.  
  47. implementation
  48.  
  49. {$R *.dfm}
  50.  
  51. const
  52.   DEFAULT_INI_PATH = '..\Forest.ini';
  53.  
  54. resourcestring
  55.   LNG_TITLE = '%s - Map Generation Test';
  56.   LNG_MAPGEN_LOAD_FAILED = 'Map generator initialization failed with code %d';
  57.   LNG_MAPGEN_GEN_FAILED = 'Map generator failed with code %d';
  58.   LNG_GAMEFILE_NOT_FOUND = 'Game file "%s" not found';
  59.  
  60. type
  61.   TDWordArray = array of DWord;
  62.   PDWordArray = ^TDWordArray;
  63.  
  64. function GenerateMap(nTrees, treeRadius, mapX, mapY: integer;
  65.   memblockTrees, memblockWayPoints: PDWordArray): DWORD; cdecl;
  66.   external 'MapGen32.dll';
  67.  
  68. function LoadParametersFromINI(filename: PAnsiChar): DWORD; cdecl;
  69.   external 'MapGen32.dll';
  70.  
  71. function RandomSeed: integer; cdecl;
  72.   external 'MapGen32.dll';
  73.  
  74. procedure UseSeed(seed: integer); cdecl;
  75.   external 'MapGen32.dll';
  76.  
  77. function GetWaypointArrayElements(nTrees: integer): DWORD; cdecl;
  78.   external 'MapGen32.dll';
  79.  
  80. { TMainForm }
  81.  
  82. procedure TMainForm.DrawCircle(x, y, r: integer; color: TColor);
  83. begin
  84.   MapImage.Canvas.Brush.Color := color;
  85.   MapImage.Canvas.Pen.Color := color;
  86.   MapImage.Canvas.Ellipse(X-r, Y-r, X+r, Y+r);
  87. end;
  88.  
  89. function TMainForm.LoadINI(filename: AnsiString): boolean;
  90. var
  91.   ini: TMemIniFile;
  92.   ec: DWORD;
  93. begin
  94.   result := false;
  95.  
  96.   ec := LoadParametersFromINI(PAnsiChar(filename));
  97.   if ec <> 0 then
  98.   begin
  99.     ShowMessageFmt(LNG_MAPGEN_LOAD_FAILED, [ec]);
  100.   end;
  101.  
  102.   ini := TMemIniFile.Create(filename);
  103.   try
  104.     treeradius := ini.ReadInteger('Forest', 'cTreeRadius', 100);
  105.     ntrees := ini.ReadInteger('Forest', 'cMaxTrees', 3000);
  106.     mapX := ini.ReadInteger('Forest', 'cMapSizeX', 10000);
  107.     mapY := ini.ReadInteger('Forest', 'cMapSizeZ', 10000);
  108.  
  109.     if not drawn then
  110.     begin
  111.       ShowPathCheckbox.Checked := ini.ReadBool('MapViewer', 'DefaultDrawWaypoints', true);
  112.     end;
  113.  
  114.     miniatureFactor := ini.ReadInteger('MapViewer', 'miniatureFactor', 20);
  115.  
  116.     Caption := Format(LNG_TITLE, [ini.ReadString('Game', 'Title', '')]);
  117.   finally
  118.     ini.Free;
  119.   end;
  120.  
  121.   loadedINI := filename;
  122.  
  123.   ResizeMapForm;
  124.  
  125.   if drawn then GenMapButton.Click;
  126.  
  127.   result := true;
  128. end;
  129.  
  130. procedure TMainForm.ResizeMapForm;
  131. begin
  132.   ClientWidth := mapX div miniatureFactor;
  133.   ClientHeight := mapY div miniatureFactor + Cardinal(ControlPanel.Height);
  134. end;
  135.  
  136. procedure TMainForm.GenMapSeed(seed: integer);
  137. var
  138.   ec: DWORD;
  139. begin
  140.   UseSeed(seed);
  141.  
  142.   nwaypoints := GetWaypointArrayElements(ntrees);
  143.  
  144.   SetLength(mbTrees, ntrees);
  145.   SetLength(mbWayPoints, nwaypoints);
  146.  
  147.   ec := GenerateMap(ntrees, treeradius, mapx, mapy, @mbTrees[0][0], @mbWayPoints[0][0]);
  148.   if ec <> 0 then
  149.   begin
  150.     ShowMessageFmt(LNG_MAPGEN_GEN_FAILED, [ec]);
  151.     MapImage.Picture := nil;
  152.     Exit;
  153.   end;
  154.  
  155.   RedrawMap;
  156.   drawn := true;
  157. end;
  158.  
  159. procedure TMainForm.GenMapButtonClick(Sender: TObject);
  160. begin
  161.   SeedSpinEdit.Value := RandomSeed;
  162. end;
  163.  
  164. procedure TMainForm.InitTimerTimer(Sender: TObject);
  165. begin
  166.   InitTimer.Enabled := False;
  167.   GenMapButton.Click;
  168. end;
  169.  
  170. procedure TMainForm.ShowPathCheckboxClick(Sender: TObject);
  171. begin
  172.   if drawn then
  173.   begin
  174.     RedrawMap;
  175.   end;
  176. end;
  177.  
  178. procedure TMainForm.RedrawMap;
  179. var
  180.   i: integer;
  181. begin
  182.   MapImage.Picture := nil;
  183.  
  184.   MapImage.Canvas.Brush.Color := clOlive;
  185.   MapImage.Canvas.Pen.Color := clBlack;
  186.   MapImage.Canvas.Rectangle(0, 0, mapx div miniatureFactor, mapy div miniatureFactor);
  187.  
  188.   if ShowPathCheckbox.Checked then
  189.   begin
  190.     for i := 0 to nwaypoints-1 do
  191.     begin
  192.       // Paths
  193.       // TODO: neue variable pathradius anstelle treeradius?
  194.       DrawCircle(mbWayPoints[i][0] div miniatureFactor, mbWayPoints[i][1] div miniatureFactor, treeradius div miniatureFactor, clGreen);
  195.     end;
  196.   end;
  197.  
  198.   for i := 0 to ntrees-1 do
  199.   begin
  200.     // Tree
  201.     DrawCircle(mbTrees[i][0] div miniatureFactor, mbTrees[i][1] div miniatureFactor, treeradius div miniatureFactor, clMaroon);
  202.   end;
  203.  
  204.   // Playef
  205.   DrawCircle(mapX div 2 div miniatureFactor, mapY div 2 div miniatureFactor, treeradius div miniatureFactor, clBlue);
  206. end;
  207.  
  208. procedure TMainForm.LoadINIButtonClick(Sender: TObject);
  209. begin
  210.   if INIOpenDialog.Execute then
  211.   begin
  212.     LoadINI(INIOpenDialog.FileName);
  213.   end;
  214. end;
  215.  
  216. function TMainForm.FindINIFile: string;
  217. begin
  218.   if FileExists('Forest.ini') then
  219.     result := 'Forest.ini'
  220.   else if FileExists('..\Forest.ini') then
  221.     result := '..\Forest.ini'
  222.   else if INIOpenDialog.Execute then
  223.     result := INIOpenDialog.FileName
  224.   else
  225.     result := '';
  226. end;
  227.  
  228. procedure TMainForm.FormShow(Sender: TObject);
  229. var
  230.   ok: boolean;
  231.   filename: string;
  232. begin
  233.   filename := FindINIFile;
  234.  
  235.   if filename <> '' then
  236.     ok := LoadINI(filename)
  237.   else
  238.     ok := false;
  239.  
  240.   if not ok then
  241.   begin
  242.     Close;
  243.   end;
  244. end;
  245.  
  246. procedure TMainForm.SeedSpinEditChange(Sender: TObject);
  247. begin
  248.   if SeedSpinEdit.Text <> '' then
  249.   begin
  250.     GenMapSeed(SeedSpinEdit.Value);
  251.   end;
  252. end;
  253.  
  254. procedure TMainForm.PlayButtonClick(Sender: TObject);
  255. var
  256.   ini: TMemIniFile;
  257.   seedfile, gamefile: string;
  258. begin
  259.   gamefile := IncludeTrailingPathDelimiter(ExtractFileDir(loadedINI))+'Forest.exe';
  260.   if not FileExists(gamefile) then
  261.   begin
  262.     ShowMessageFmt(LNG_GAMEFILE_NOT_FOUND, [gamefile]);
  263.     Exit;
  264.   end;
  265.  
  266.   seedfile := IncludeTrailingPathDelimiter(ExtractFileDir(loadedINI))+'Seed.ini';
  267.   ini := TMemIniFile.Create(seedfile);
  268.   try
  269.     ini.WriteInteger('Seed', 'onetime', 1);
  270.     ini.WriteInteger('Seed', 'active', 1);
  271.     ini.WriteInteger('Seed', 'seed', SeedSpinEdit.Value);
  272.     ini.UpdateFile;
  273.   finally
  274.     ini.Free;
  275.   end;
  276.  
  277.   ShellExecute(0, 'open', PChar(gamefile), '', '', SW_NORMAL);
  278.  
  279.   Close;
  280. end;
  281.  
  282. end.
  283.