Subversion Repositories forest

Compare Revisions

No changes between revisions

Regard whitespace Rev 1 → Rev 2

/trunk/mapgen/MapGen32.bdsproj
0,0 → 1,175
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
<PersonalityInfo>
<Option>
<Option Name="Personality">Delphi.Personality</Option>
<Option Name="ProjectType">VCLApplication</Option>
<Option Name="Version">1.0</Option>
<Option Name="GUID">{A7F7EAC6-AD13-4A21-93D5-1EE37294C112}</Option>
</Option>
</PersonalityInfo>
<Delphi.Personality>
<Source>
<Source Name="MainSource">MapGen32.dpr</Source>
</Source>
<FileVersion>
<FileVersion Name="Version">7.0</FileVersion>
</FileVersion>
<Compiler>
<Compiler Name="A">8</Compiler>
<Compiler Name="B">0</Compiler>
<Compiler Name="C">1</Compiler>
<Compiler Name="D">1</Compiler>
<Compiler Name="E">0</Compiler>
<Compiler Name="F">0</Compiler>
<Compiler Name="G">1</Compiler>
<Compiler Name="H">1</Compiler>
<Compiler Name="I">1</Compiler>
<Compiler Name="J">0</Compiler>
<Compiler Name="K">0</Compiler>
<Compiler Name="L">1</Compiler>
<Compiler Name="M">0</Compiler>
<Compiler Name="N">1</Compiler>
<Compiler Name="O">1</Compiler>
<Compiler Name="P">1</Compiler>
<Compiler Name="Q">0</Compiler>
<Compiler Name="R">0</Compiler>
<Compiler Name="S">0</Compiler>
<Compiler Name="T">0</Compiler>
<Compiler Name="U">0</Compiler>
<Compiler Name="V">1</Compiler>
<Compiler Name="W">0</Compiler>
<Compiler Name="X">1</Compiler>
<Compiler Name="Y">1</Compiler>
<Compiler Name="Z">1</Compiler>
<Compiler Name="ShowHints">True</Compiler>
<Compiler Name="ShowWarnings">True</Compiler>
<Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler>
<Compiler Name="NamespacePrefix"></Compiler>
<Compiler Name="GenerateDocumentation">False</Compiler>
<Compiler Name="DefaultNamespace"></Compiler>
<Compiler Name="SymbolDeprecated">True</Compiler>
<Compiler Name="SymbolLibrary">True</Compiler>
<Compiler Name="SymbolPlatform">True</Compiler>
<Compiler Name="SymbolExperimental">True</Compiler>
<Compiler Name="UnitLibrary">True</Compiler>
<Compiler Name="UnitPlatform">True</Compiler>
<Compiler Name="UnitDeprecated">True</Compiler>
<Compiler Name="UnitExperimental">True</Compiler>
<Compiler Name="HResultCompat">True</Compiler>
<Compiler Name="HidingMember">True</Compiler>
<Compiler Name="HiddenVirtual">True</Compiler>
<Compiler Name="Garbage">True</Compiler>
<Compiler Name="BoundsError">True</Compiler>
<Compiler Name="ZeroNilCompat">True</Compiler>
<Compiler Name="StringConstTruncated">True</Compiler>
<Compiler Name="ForLoopVarVarPar">True</Compiler>
<Compiler Name="TypedConstVarPar">True</Compiler>
<Compiler Name="AsgToTypedConst">True</Compiler>
<Compiler Name="CaseLabelRange">True</Compiler>
<Compiler Name="ForVariable">True</Compiler>
<Compiler Name="ConstructingAbstract">True</Compiler>
<Compiler Name="ComparisonFalse">True</Compiler>
<Compiler Name="ComparisonTrue">True</Compiler>
<Compiler Name="ComparingSignedUnsigned">True</Compiler>
<Compiler Name="CombiningSignedUnsigned">True</Compiler>
<Compiler Name="UnsupportedConstruct">True</Compiler>
<Compiler Name="FileOpen">True</Compiler>
<Compiler Name="FileOpenUnitSrc">True</Compiler>
<Compiler Name="BadGlobalSymbol">True</Compiler>
<Compiler Name="DuplicateConstructorDestructor">True</Compiler>
<Compiler Name="InvalidDirective">True</Compiler>
<Compiler Name="PackageNoLink">True</Compiler>
<Compiler Name="PackageThreadVar">True</Compiler>
<Compiler Name="ImplicitImport">True</Compiler>
<Compiler Name="HPPEMITIgnored">True</Compiler>
<Compiler Name="NoRetVal">True</Compiler>
<Compiler Name="UseBeforeDef">True</Compiler>
<Compiler Name="ForLoopVarUndef">True</Compiler>
<Compiler Name="UnitNameMismatch">True</Compiler>
<Compiler Name="NoCFGFileFound">True</Compiler>
<Compiler Name="ImplicitVariants">True</Compiler>
<Compiler Name="UnicodeToLocale">True</Compiler>
<Compiler Name="LocaleToUnicode">True</Compiler>
<Compiler Name="ImagebaseMultiple">True</Compiler>
<Compiler Name="SuspiciousTypecast">True</Compiler>
<Compiler Name="PrivatePropAccessor">True</Compiler>
<Compiler Name="UnsafeType">False</Compiler>
<Compiler Name="UnsafeCode">False</Compiler>
<Compiler Name="UnsafeCast">False</Compiler>
<Compiler Name="OptionTruncated">True</Compiler>
<Compiler Name="WideCharReduced">True</Compiler>
<Compiler Name="DuplicatesIgnored">True</Compiler>
<Compiler Name="UnitInitSeq">True</Compiler>
<Compiler Name="LocalPInvoke">True</Compiler>
<Compiler Name="MessageDirective">True</Compiler>
<Compiler Name="CodePage"></Compiler>
</Compiler>
<Linker>
<Linker Name="MapFile">0</Linker>
<Linker Name="OutputObjs">0</Linker>
<Linker Name="GenerateHpps">False</Linker>
<Linker Name="ConsoleApp">1</Linker>
<Linker Name="DebugInfo">False</Linker>
<Linker Name="RemoteSymbols">False</Linker>
<Linker Name="GenerateDRC">False</Linker>
<Linker Name="MinStackSize">16384</Linker>
<Linker Name="MaxStackSize">1048576</Linker>
<Linker Name="ImageBase">4194304</Linker>
<Linker Name="ExeDescription"></Linker>
</Linker>
<Directories>
<Directories Name="OutputDir"></Directories>
<Directories Name="UnitOutputDir"></Directories>
<Directories Name="PackageDLLOutputDir"></Directories>
<Directories Name="PackageDCPOutputDir"></Directories>
<Directories Name="SearchPath"></Directories>
<Directories Name="Packages">vcl;rtl;vclx;VclSmp;vclshlctrls</Directories>
<Directories Name="Conditionals"></Directories>
<Directories Name="DebugSourceDirs"></Directories>
<Directories Name="UsePackages">False</Directories>
</Directories>
<Parameters>
<Parameters Name="RunParams"></Parameters>
<Parameters Name="HostApplication">D:\tdn\mapgen\MapGenTest.exe</Parameters>
<Parameters Name="Launcher"></Parameters>
<Parameters Name="UseLauncher">False</Parameters>
<Parameters Name="DebugCWD"></Parameters>
<Parameters Name="Debug Symbols Search Path"></Parameters>
<Parameters Name="LoadAllSymbols">True</Parameters>
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
</Parameters>
<Language>
<Language Name="ActiveLang"></Language>
<Language Name="ProjectLang">$00000000</Language>
<Language Name="RootDir"></Language>
</Language>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">1031</VersionInfo>
<VersionInfo Name="CodePage">1252</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName">ViaThinkSoft</VersionInfoKeys>
<VersionInfoKeys Name="FileDescription">Nightmare Forest Map Generation DLL</VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName">MapGen32</VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright">(C) 2015 ViaThinkSoft</VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename">MapGen32.dll</VersionInfoKeys>
<VersionInfoKeys Name="ProductName">Nightmare Forest</VersionInfoKeys>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments">www.daniel-marschall.de</VersionInfoKeys>
</VersionInfoKeys>
</Delphi.Personality>
</BorlandProject>
/trunk/mapgen/MapGen32.bdsproj.local
0,0 → 1,2
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject/>
/trunk/mapgen/MapGen32.cfg
0,0 → 1,38
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-LE"C:\Users\DELL User\Documents\Borland Studio-Projekte\Bpl"
-LN"C:\Users\DELL User\Documents\Borland Studio-Projekte\Bpl"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST
/trunk/mapgen/MapGen32.dll
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/mapgen/MapGen32.dof
0,0 → 1,83
[FileVersion]
Version=6.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=vcl;rtl;vclx;VclSmp;vclshlctrls
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=D:\tdn\mapgen\MapGenTest.exe
Launcher=
UseLauncher=0
DebugCWD=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1031
CodePage=1252
[Version Info Keys]
CompanyName=ViaThinkSoft
FileDescription=Nightmare Forest Map Generation DLL
FileVersion=1.0.0.0
InternalName=MapGen32
LegalCopyright=(C) 2015 ViaThinkSoft
LegalTrademarks=
OriginalFilename=MapGen32.dll
ProductName=Nightmare Forest
ProductVersion=1.0.0.0
Comments=www.daniel-marschall.de
/trunk/mapgen/MapGen32.dpr
0,0 → 1,339
library MapGen32;
 
uses
SysUtils,
Classes,
Windows,
IniFiles;
 
{$R *.res}
 
type
TFreeSpot = record
X: integer;
Y: integer;
A: integer;
end;
 
var
FreeSpots: array of TFreeSpot;
 
var
cMaxBranchLength: integer = 200;
cPathFlexibility: integer = 15;
cMapBorderSize: single = 5;
cPathWidthFactor: single = 1;
cPathLength: single = 0.20;
cTreePlacementMaxAttempts: integer = 1000;
iniLoaded: boolean = false;
cPathAcceptCheckCornerCircle: boolean = false;
cPathAcceptCheckCornerCircleRadius: integer = 500;
cPathAcceptCheckSquares: boolean = true;
cPathAcceptCheckSquaresHorizontal: integer = 5;
cPathAcceptCheckSquaresVertical: integer = 5;
cPathBuildMaxAttempts: integer = 100;
 
const
ERR_OK = 0;
ERR_NO_INI_LOADED = 2;
 
function LoadParametersFromINI(filename: PAnsiChar): DWORD; cdecl;
var
ini: TMemIniFile;
begin
ini := TMemIniFile.Create(filename);
try
DecimalSeparator := '.';
 
cMaxBranchLength := ini.ReadInteger('MapGen32', 'MaxBranchLength', 200 );
cPathFlexibility := ini.ReadInteger('MapGen32', 'PathFlexibility', 15 );
cMapBorderSize := ini.ReadFloat ('MapGen32', 'MapBorderSize', 5 );
cPathWidthFactor := ini.ReadFloat ('MapGen32', 'PathWidthFactor', 1 );
cPathLength := ini.ReadFloat ('MapGen32', 'PathLength', 0.20);
cTreePlacementMaxAttempts := ini.ReadInteger('MapGen32', 'TreePlacementMaxAttempts', 1000 );
 
cPathAcceptCheckCornerCircle := ini.ReadBool ('MapGen32', 'PathAcceptCheckCornerCircle', false);
cPathAcceptCheckCornerCircleRadius := ini.ReadInteger('MapGen32', 'PathAcceptCheckCornerCircleRadius', 500);
 
cPathAcceptCheckSquares := ini.readBool ('MapGen32', 'PathAcceptCheckSquares', true);
cPathAcceptCheckSquaresHorizontal := ini.ReadInteger('MapGen32', 'PathAcceptCheckSquaresHorizontal', 5);
cPathAcceptCheckSquaresVertical := ini.ReadInteger('MapGen32', 'PathAcceptCheckSquaresVertical', 5);
 
cPathBuildMaxAttempts := ini.ReadInteger('MapGen32', 'PathBuildMaxAttempts', 100);
finally
ini.Free;
end;
 
iniLoaded := true;
result := ERR_OK;
end;
 
function RandBetween(a, b: integer): integer;
begin
result := Random(b-a+1)+a;
end;
 
function IsInCircle(p, q: TPoint; r: integer): boolean;
begin
result := sqrt((p.x-q.x)*(p.x-q.x) + (p.y-q.y)*(p.y-q.y)) <= r;
end;
 
function _AcceptedPath(maxX, maxY: integer): boolean;
 
function __CheckCircle(x, y: integer): boolean;
var
i: integer;
p, q: TPoint;
begin
p := Point(x, y);
result := false;
for i := Low(FreeSpots) to High(FreeSpots) do
begin
q := Point(FreeSpots[i].X, FreeSpots[i].Y);
if IsInCircle(p, q, cPathAcceptCheckCornerCircleRadius) then
begin
result := true;
Break;
end;
end;
end;
 
function __CheckSquare(left, top, width, height: integer): boolean;
var
i: integer;
begin
result := false;
for i := Low(FreeSpots) to High(FreeSpots) do
begin
if (FreeSpots[i].X >= left) and
(FreeSpots[i].Y >= top) and
(FreeSpots[i].X <= left+width) and
(FreeSpots[i].Y <= top+height) then
begin
result := true;
break;
end;
end;
end;
 
function __AcceptCircleCheck: boolean;
begin
result :=
__CheckCircle( cPathAcceptCheckCornerCircleRadius, cPathAcceptCheckCornerCircleRadius) and // oben links
__CheckCircle(maxX-cPathAcceptCheckCornerCircleRadius, cPathAcceptCheckCornerCircleRadius) and // oben rechts
__CheckCircle( cPathAcceptCheckCornerCircleRadius, maxY-cPathAcceptCheckCornerCircleRadius) and // unten links
__CheckCircle(maxX-cPathAcceptCheckCornerCircleRadius, maxY-cPathAcceptCheckCornerCircleRadius); // unten rechts
end;
 
function __AcceptSquaresCheck: boolean;
var
ix, iy: integer;
left, top: integer;
squareWidth, squareHeight: integer;
begin
squareWidth := maxX div cPathAcceptCheckSquaresHorizontal;
squareHeight := maxY div cPathAcceptCheckSquaresVertical;
for ix := 0 to cPathAcceptCheckSquaresHorizontal-1 do
begin
left := ix * squareWidth;
for iy := 0 to cPathAcceptCheckSquaresVertical-1 do
begin
top := iy * squareHeight;
if not __CheckSquare(left, top, squareWidth, squareHeight) then
begin
result := false;
exit;
end;
end;
end;
result := true;
end;
 
begin
result := true;
 
if result and cPathAcceptCheckCornerCircle then
begin
result := result and __AcceptCircleCheck;
end;
 
if result and cPathAcceptCheckSquares then
begin
result := result and __AcceptSquaresCheck;
end;
end;
 
procedure _BuildPaths(nFreespots, maxX, maxY, nTrees, r, startX, startY, angle: integer);
var
i: integer;
x: integer;
maxdrawn: integer;
iBeginBranch: integer;
// midDistance: extended;
locFlexibility: integer;
// midDeltaX, midDeltaY: integer;
begin
SetLength(FreeSpots, nFreespots);
 
FreeSpots[0].A := angle;
FreeSpots[0].X := startX;
FreeSpots[0].Y := startY;
 
iBeginBranch := 1;
 
while true do
begin
maxdrawn := 0;
for i := iBeginBranch to iBeginBranch+cMaxBranchLength do
begin
if i > High(FreeSpots) then Exit;
 
// midDeltaX := FreeSpots[i-1].X - startX;
// midDeltaY := FreeSpots[i-1].Y - startY;
// midDistance := sqrt(midDeltaX*midDeltaX + midDeltaY*midDeltaY);
 
(*
if midDistance > 4000 then
locFlexibility := Round(cPathFlexibility + midDistance/5000)
else
locFlexibility := cPathFlexibility;
*)
locFlexibility := cPathFlexibility;
 
FreeSpots[i].A := RandBetween(FreeSpots[i-1].A-locFlexibility, FreeSpots[i-1].A+locFlexibility);
FreeSpots[i].X := FreeSpots[i-1].X + round(r*cos(FreeSpots[i].A/360*2*pi));
FreeSpots[i].Y := FreeSpots[i-1].Y + round(r*sin(FreeSpots[i].A/360*2*pi));
 
if FreeSpots[i].X > maxX-cMapBorderSize*r then break;
if FreeSpots[i].Y > maxY-cMapBorderSize*r then break;
if FreeSpots[i].X < cMapBorderSize*r then break;
if FreeSpots[i].Y < cMapBorderSize*r then break;
 
maxdrawn := i;
end;
 
x := RandBetween(maxdrawn div 2, maxdrawn); // RandBetween(0, maxdrawn);
FreeSpots[maxdrawn+1] := FreeSpots[x]; // virtual free spot
 
if RandBetween(0,1) = 0 then
FreeSpots[maxdrawn+1].A := FreeSpots[x].A-90
else
FreeSpots[maxdrawn+1].A := FreeSpots[x].A+90;
 
iBeginBranch := maxdrawn+2;
end;
end;
 
type
TDWordArray = array of DWord;
PDWordArray = ^TDWordArray;
 
function GetWaypointArrayElements(nTrees: integer): DWORD; cdecl;
begin
result := Round(cPathLength*nTrees);
end;
 
function GenerateMap(nTrees, treeRadius, mapX, mapY: integer;
memblockTrees, memblockWayPoints: PDWordArray): DWORD; cdecl;
var
pathSize: integer;
aryTrees, aryWaypoints: TDWordArray;
i, j, k: integer;
p, q: TPoint;
ok: boolean;
nFreespots: integer;
begin
if not iniLoaded then
begin
result := ERR_NO_INI_LOADED;
Exit;
end;
 
if memblockTrees <> nil then
aryTrees := TDWordArray(memblockTrees)
else
SetLength(aryTrees, 0); // prevent compiler warning
 
if memblockWayPoints <> nil then
aryWaypoints := TDWordArray(memblockWayPoints)
else
SetLength(aryWaypoints, 0); // prevent compiler warning
 
pathSize := Round(cPathWidthFactor * treeRadius);
nFreespots := GetWaypointArrayElements(nTrees);
 
k := 0;
repeat
Inc(k);
_BuildPaths(nFreespots, mapx, mapy, nTrees, treeradius, mapX div 2, mapY div 2, RandBetween(0,359));
until (k >= cPathBuildMaxAttempts) or _AcceptedPath(mapx, mapy);
 
if memblockTrees <> nil then
begin
for i := 0 to nTrees-1 do
begin
k := 0;
repeat
inc(k);
ok := true;
p := Point(Random(mapX+1), Random(mapY+1));
 
// Bäume nicht in den Weg bauen
for j := Low(FreeSpots) to High(FreeSpots) do
begin
q := Point(FreeSpots[j].X, FreeSpots[j].Y);
if IsInCircle(p, q, treeRadius + pathSize div 2) then
begin
ok := false;
break;
end;
end;
 
// Bäume sollen sich nicht überschneiden
for j := Low(FreeSpots) to High(FreeSpots) do
begin
q := Point(FreeSpots[j].X, FreeSpots[j].Y);
if IsInCircle(p, q, treeRadius + pathSize div 2) then
begin
ok := false;
break;
end;
end;
until ok or (k > cTreePlacementMaxAttempts);
 
aryTrees[i*2] := p.x;
aryTrees[i*2+1] := p.y;
end;
end;
 
if memblockWayPoints <> nil then
begin
for i := 0 to nFreespots-1 do
begin
aryWaypoints[i*2] := FreeSpots[i].X;
aryWaypoints[i*2+1] := FreeSpots[i].Y;
end;
end;
 
result := ERR_OK;
end;
 
function RandomSeed: integer; cdecl;
begin
Randomize;
result := RandSeed;
end;
 
procedure UseSeed(seed: integer); cdecl;
begin
RandSeed := seed;
end;
 
exports
GenerateMap name 'GenerateMap',
LoadParametersFromINI name 'LoadParametersFromINI',
RandomSeed name 'RandomSeed',
UseSeed name 'UseSeed',
GetWaypointArrayElements name 'GetWaypointArrayElements';
 
end.
/trunk/mapgen/MapGen32.identcache
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/mapgen/MapGen32.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/mapgen/MapGenTest.cfg
0,0 → 1,35
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-LE"c:\software_old\borland\delphi6\Projects\Bpl"
-LN"c:\software_old\borland\delphi6\Projects\Bpl"
/trunk/mapgen/MapGenTest.dof
0,0 → 1,83
[FileVersion]
Version=6.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1031
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
/trunk/mapgen/MapGenTest.dpr
0,0 → 1,13
program MapGenTest;
 
uses
Forms,
MapGenTestMain in 'MapGenTestMain.pas' {MainForm};
 
{$R *.res}
 
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.
/trunk/mapgen/MapGenTest.dproj
0,0 → 1,123
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{83DDB428-5F0B-4A64-A35D-734A32E65E3A}</ProjectGuid>
<MainSource>MapGenTest.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>18.2</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_E>false</DCC_E>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<DCC_N>true</DCC_N>
<DCC_S>false</DCC_S>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_DebugInformation>1</DCC_DebugInformation>
<DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo>
<SanitizedProjectName>MapGenTest</SanitizedProjectName>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_Locale>1031</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<Icon_MainIcon>MapGenTest_Icon.ico</Icon_MainIcon>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppEnableHighDPI>true</AppEnableHighDPI>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppEnableHighDPI>true</AppEnableHighDPI>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="MapGenTestMain.pas">
<Form>MainForm</Form>
</DCCReference>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">MapGenTest.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>
/trunk/mapgen/MapGenTest.dproj.local
0,0 → 1,2
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject/>
/trunk/mapgen/MapGenTest.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/mapgen/MapGenTest.identcache
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/mapgen/MapGenTest.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/mapgen/MapGenTest.stat
0,0 → 1,10
[Stats]
EditorSecs=24
DesignerSecs=4
InspectorSecs=1
CompileSecs=2464
OtherSecs=4
StartTime=28.05.2018 11:36:14
RealKeys=0
EffectiveKeys=0
DebugSecs=26
/trunk/mapgen/MapGenTestMain.dfm
0,0 → 1,126
object MainForm: TMainForm
Left = 190
Top = 121
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
ClientHeight = 565
ClientWidth = 589
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object MapImage: TImage
Left = 0
Top = 0
Width = 589
Height = 520
Align = alClient
end
object ControlPanel: TPanel
Left = 0
Top = 520
Width = 589
Height = 45
Align = alBottom
TabOrder = 0
DesignSize = (
589
45)
object SeedLabel: TLabel
Left = 216
Top = 12
Width = 36
Height = 16
Anchors = [akTop, akRight]
Caption = 'Seed:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object ShowPathCheckbox: TCheckBox
Left = 8
Top = 20
Width = 97
Height = 17
Anchors = [akLeft, akBottom]
Caption = 'Show path'
Checked = True
State = cbChecked
TabOrder = 2
OnClick = ShowPathCheckboxClick
end
object LoadINIButton: TButton
Left = 432
Top = 8
Width = 65
Height = 29
Anchors = [akTop, akRight, akBottom]
Caption = 'Load INI'
TabOrder = 4
OnClick = LoadINIButtonClick
end
object GenMapButton: TButton
Left = 504
Top = 8
Width = 77
Height = 29
Anchors = [akTop, akRight, akBottom]
Caption = 'New map'
Default = True
TabOrder = 0
OnClick = GenMapButtonClick
end
object SeedSpinEdit: TSpinEdit
Left = 256
Top = 8
Width = 97
Height = 26
Anchors = [akTop, akRight, akBottom]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
MaxValue = 0
MinValue = 0
ParentFont = False
TabOrder = 1
Value = 0
OnChange = SeedSpinEditChange
end
object PlayButton: TButton
Left = 360
Top = 8
Width = 65
Height = 29
Anchors = [akTop, akRight, akBottom]
Caption = 'Play'
TabOrder = 3
OnClick = PlayButtonClick
end
end
object InitTimer: TTimer
Interval = 200
OnTimer = InitTimerTimer
Left = 512
Top = 16
end
object INIOpenDialog: TOpenDialog
DefaultExt = '.ini'
Filter = 'INI Files (*.ini)|*.ini|All files (*.*)|*.*'
Options = [ofHideReadOnly, ofFileMustExist, ofEnableSizing]
Title = 'Select Forest.ini'
Left = 544
Top = 16
end
end
/trunk/mapgen/MapGenTestMain.pas
0,0 → 1,282
unit MapGenTestMain;
 
interface
 
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, IniFiles, Spin, ShellAPI;
 
type
TDWordPoint = array[0..1] of DWord;
 
TMainForm = class(TForm)
InitTimer: TTimer;
INIOpenDialog: TOpenDialog;
MapImage: TImage;
ControlPanel: TPanel;
ShowPathCheckbox: TCheckBox;
LoadINIButton: TButton;
GenMapButton: TButton;
SeedSpinEdit: TSpinEdit;
SeedLabel: TLabel;
PlayButton: TButton;
procedure GenMapButtonClick(Sender: TObject);
procedure InitTimerTimer(Sender: TObject);
procedure ShowPathCheckboxClick(Sender: TObject);
procedure LoadINIButtonClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure SeedSpinEditChange(Sender: TObject);
procedure PlayButtonClick(Sender: TObject);
private
mbTrees, mbWayPoints: array of TDWordPoint;
treeradius, ntrees, nwaypoints, mapX, mapY: DWord;
miniatureFactor: DWord;
drawn: boolean;
loadedINI: string;
procedure DrawCircle(x, y, r: integer; color: TColor);
procedure RedrawMap;
procedure ResizeMapForm;
function LoadINI(filename: AnsiString): boolean;
function FindINIFile: string;
procedure GenMapSeed(seed: integer);
end;
 
var
MainForm: TMainForm;
 
implementation
 
{$R *.dfm}
 
const
DEFAULT_INI_PATH = '..\Forest.ini';
 
resourcestring
LNG_TITLE = '%s - Map Generation Test';
LNG_MAPGEN_LOAD_FAILED = 'Map generator initialization failed with code %d';
LNG_MAPGEN_GEN_FAILED = 'Map generator failed with code %d';
LNG_GAMEFILE_NOT_FOUND = 'Game file "%s" not found';
 
type
TDWordArray = array of DWord;
PDWordArray = ^TDWordArray;
 
function GenerateMap(nTrees, treeRadius, mapX, mapY: integer;
memblockTrees, memblockWayPoints: PDWordArray): DWORD; cdecl;
external 'MapGen32.dll';
 
function LoadParametersFromINI(filename: PAnsiChar): DWORD; cdecl;
external 'MapGen32.dll';
 
function RandomSeed: integer; cdecl;
external 'MapGen32.dll';
 
procedure UseSeed(seed: integer); cdecl;
external 'MapGen32.dll';
 
function GetWaypointArrayElements(nTrees: integer): DWORD; cdecl;
external 'MapGen32.dll';
 
{ TMainForm }
 
procedure TMainForm.DrawCircle(x, y, r: integer; color: TColor);
begin
MapImage.Canvas.Brush.Color := color;
MapImage.Canvas.Pen.Color := color;
MapImage.Canvas.Ellipse(X-r, Y-r, X+r, Y+r);
end;
 
function TMainForm.LoadINI(filename: AnsiString): boolean;
var
ini: TMemIniFile;
ec: DWORD;
begin
result := false;
 
ec := LoadParametersFromINI(PAnsiChar(filename));
if ec <> 0 then
begin
ShowMessageFmt(LNG_MAPGEN_LOAD_FAILED, [ec]);
end;
 
ini := TMemIniFile.Create(filename);
try
treeradius := ini.ReadInteger('Forest', 'cTreeRadius', 100);
ntrees := ini.ReadInteger('Forest', 'cMaxTrees', 3000);
mapX := ini.ReadInteger('Forest', 'cMapSizeX', 10000);
mapY := ini.ReadInteger('Forest', 'cMapSizeZ', 10000);
 
if not drawn then
begin
ShowPathCheckbox.Checked := ini.ReadBool('MapViewer', 'DefaultDrawWaypoints', true);
end;
 
miniatureFactor := ini.ReadInteger('MapViewer', 'miniatureFactor', 20);
 
Caption := Format(LNG_TITLE, [ini.ReadString('Game', 'Title', '')]);
finally
ini.Free;
end;
 
loadedINI := filename;
 
ResizeMapForm;
 
if drawn then GenMapButton.Click;
 
result := true;
end;
 
procedure TMainForm.ResizeMapForm;
begin
ClientWidth := mapX div miniatureFactor;
ClientHeight := mapY div miniatureFactor + Cardinal(ControlPanel.Height);
end;
 
procedure TMainForm.GenMapSeed(seed: integer);
var
ec: DWORD;
begin
UseSeed(seed);
 
nwaypoints := GetWaypointArrayElements(ntrees);
 
SetLength(mbTrees, ntrees);
SetLength(mbWayPoints, nwaypoints);
 
ec := GenerateMap(ntrees, treeradius, mapx, mapy, @mbTrees[0][0], @mbWayPoints[0][0]);
if ec <> 0 then
begin
ShowMessageFmt(LNG_MAPGEN_GEN_FAILED, [ec]);
MapImage.Picture := nil;
Exit;
end;
 
RedrawMap;
drawn := true;
end;
 
procedure TMainForm.GenMapButtonClick(Sender: TObject);
begin
SeedSpinEdit.Value := RandomSeed;
end;
 
procedure TMainForm.InitTimerTimer(Sender: TObject);
begin
InitTimer.Enabled := False;
GenMapButton.Click;
end;
 
procedure TMainForm.ShowPathCheckboxClick(Sender: TObject);
begin
if drawn then
begin
RedrawMap;
end;
end;
 
procedure TMainForm.RedrawMap;
var
i: integer;
begin
MapImage.Picture := nil;
 
MapImage.Canvas.Brush.Color := clOlive;
MapImage.Canvas.Pen.Color := clBlack;
MapImage.Canvas.Rectangle(0, 0, mapx div miniatureFactor, mapy div miniatureFactor);
 
if ShowPathCheckbox.Checked then
begin
for i := 0 to nwaypoints-1 do
begin
// Paths
// TODO: neue variable pathradius anstelle treeradius?
DrawCircle(mbWayPoints[i][0] div miniatureFactor, mbWayPoints[i][1] div miniatureFactor, treeradius div miniatureFactor, clGreen);
end;
end;
 
for i := 0 to ntrees-1 do
begin
// Tree
DrawCircle(mbTrees[i][0] div miniatureFactor, mbTrees[i][1] div miniatureFactor, treeradius div miniatureFactor, clMaroon);
end;
 
// Playef
DrawCircle(mapX div 2 div miniatureFactor, mapY div 2 div miniatureFactor, treeradius div miniatureFactor, clBlue);
end;
 
procedure TMainForm.LoadINIButtonClick(Sender: TObject);
begin
if INIOpenDialog.Execute then
begin
LoadINI(INIOpenDialog.FileName);
end;
end;
 
function TMainForm.FindINIFile: string;
begin
if FileExists('Forest.ini') then
result := 'Forest.ini'
else if FileExists('..\Forest.ini') then
result := '..\Forest.ini'
else if INIOpenDialog.Execute then
result := INIOpenDialog.FileName
else
result := '';
end;
 
procedure TMainForm.FormShow(Sender: TObject);
var
ok: boolean;
filename: string;
begin
filename := FindINIFile;
 
if filename <> '' then
ok := LoadINI(filename)
else
ok := false;
 
if not ok then
begin
Close;
end;
end;
 
procedure TMainForm.SeedSpinEditChange(Sender: TObject);
begin
if SeedSpinEdit.Text <> '' then
begin
GenMapSeed(SeedSpinEdit.Value);
end;
end;
 
procedure TMainForm.PlayButtonClick(Sender: TObject);
var
ini: TMemIniFile;
seedfile, gamefile: string;
begin
gamefile := IncludeTrailingPathDelimiter(ExtractFileDir(loadedINI))+'Forest.exe';
if not FileExists(gamefile) then
begin
ShowMessageFmt(LNG_GAMEFILE_NOT_FOUND, [gamefile]);
Exit;
end;
 
seedfile := IncludeTrailingPathDelimiter(ExtractFileDir(loadedINI))+'Seed.ini';
ini := TMemIniFile.Create(seedfile);
try
ini.WriteInteger('Seed', 'onetime', 1);
ini.WriteInteger('Seed', 'active', 1);
ini.WriteInteger('Seed', 'seed', SeedSpinEdit.Value);
ini.UpdateFile;
finally
ini.Free;
end;
 
ShellExecute(0, 'open', PChar(gamefile), '', '', SW_NORMAL);
Close;
end;
 
end.
/trunk/mapgen/MapGenTest_Icon.ico
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property