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. |