Details | Last modification | View Log | RSS feed
| Rev | Author | Line No. | Line |
|---|---|---|---|
| 2 | daniel-mar | 1 | library MapGen32; |
| 2 | |||
| 3 | uses |
||
| 4 | SysUtils, |
||
| 5 | Classes, |
||
| 6 | Windows, |
||
| 7 | IniFiles; |
||
| 8 | |||
| 9 | {$R *.res} |
||
| 10 | |||
| 11 | type |
||
| 12 | TFreeSpot = record |
||
| 13 | X: integer; |
||
| 14 | Y: integer; |
||
| 15 | A: integer; |
||
| 16 | end; |
||
| 17 | |||
| 18 | var |
||
| 19 | FreeSpots: array of TFreeSpot; |
||
| 20 | |||
| 21 | var |
||
| 22 | cMaxBranchLength: integer = 200; |
||
| 23 | cPathFlexibility: integer = 15; |
||
| 24 | cMapBorderSize: single = 5; |
||
| 25 | cPathWidthFactor: single = 1; |
||
| 26 | cPathLength: single = 0.20; |
||
| 27 | cTreePlacementMaxAttempts: integer = 1000; |
||
| 28 | iniLoaded: boolean = false; |
||
| 29 | cPathAcceptCheckCornerCircle: boolean = false; |
||
| 30 | cPathAcceptCheckCornerCircleRadius: integer = 500; |
||
| 31 | cPathAcceptCheckSquares: boolean = true; |
||
| 32 | cPathAcceptCheckSquaresHorizontal: integer = 5; |
||
| 33 | cPathAcceptCheckSquaresVertical: integer = 5; |
||
| 34 | cPathBuildMaxAttempts: integer = 100; |
||
| 35 | |||
| 36 | const |
||
| 37 | ERR_OK = 0; |
||
| 38 | ERR_NO_INI_LOADED = 2; |
||
| 39 | |||
| 40 | function LoadParametersFromINI(filename: PAnsiChar): DWORD; cdecl; |
||
| 41 | var |
||
| 42 | ini: TMemIniFile; |
||
| 43 | begin |
||
| 44 | ini := TMemIniFile.Create(filename); |
||
| 45 | try |
||
| 46 | DecimalSeparator := '.'; |
||
| 47 | |||
| 48 | cMaxBranchLength := ini.ReadInteger('MapGen32', 'MaxBranchLength', 200 ); |
||
| 49 | cPathFlexibility := ini.ReadInteger('MapGen32', 'PathFlexibility', 15 ); |
||
| 50 | cMapBorderSize := ini.ReadFloat ('MapGen32', 'MapBorderSize', 5 ); |
||
| 51 | cPathWidthFactor := ini.ReadFloat ('MapGen32', 'PathWidthFactor', 1 ); |
||
| 52 | cPathLength := ini.ReadFloat ('MapGen32', 'PathLength', 0.20); |
||
| 53 | cTreePlacementMaxAttempts := ini.ReadInteger('MapGen32', 'TreePlacementMaxAttempts', 1000 ); |
||
| 54 | |||
| 55 | cPathAcceptCheckCornerCircle := ini.ReadBool ('MapGen32', 'PathAcceptCheckCornerCircle', false); |
||
| 56 | cPathAcceptCheckCornerCircleRadius := ini.ReadInteger('MapGen32', 'PathAcceptCheckCornerCircleRadius', 500); |
||
| 57 | |||
| 58 | cPathAcceptCheckSquares := ini.readBool ('MapGen32', 'PathAcceptCheckSquares', true); |
||
| 59 | cPathAcceptCheckSquaresHorizontal := ini.ReadInteger('MapGen32', 'PathAcceptCheckSquaresHorizontal', 5); |
||
| 60 | cPathAcceptCheckSquaresVertical := ini.ReadInteger('MapGen32', 'PathAcceptCheckSquaresVertical', 5); |
||
| 61 | |||
| 62 | cPathBuildMaxAttempts := ini.ReadInteger('MapGen32', 'PathBuildMaxAttempts', 100); |
||
| 63 | finally |
||
| 64 | ini.Free; |
||
| 65 | end; |
||
| 66 | |||
| 67 | iniLoaded := true; |
||
| 68 | result := ERR_OK; |
||
| 69 | end; |
||
| 70 | |||
| 71 | function RandBetween(a, b: integer): integer; |
||
| 72 | begin |
||
| 73 | result := Random(b-a+1)+a; |
||
| 74 | end; |
||
| 75 | |||
| 76 | function IsInCircle(p, q: TPoint; r: integer): boolean; |
||
| 77 | begin |
||
| 78 | result := sqrt((p.x-q.x)*(p.x-q.x) + (p.y-q.y)*(p.y-q.y)) <= r; |
||
| 79 | end; |
||
| 80 | |||
| 81 | function _AcceptedPath(maxX, maxY: integer): boolean; |
||
| 82 | |||
| 83 | function __CheckCircle(x, y: integer): boolean; |
||
| 84 | var |
||
| 85 | i: integer; |
||
| 86 | p, q: TPoint; |
||
| 87 | begin |
||
| 88 | p := Point(x, y); |
||
| 89 | result := false; |
||
| 90 | for i := Low(FreeSpots) to High(FreeSpots) do |
||
| 91 | begin |
||
| 92 | q := Point(FreeSpots[i].X, FreeSpots[i].Y); |
||
| 93 | if IsInCircle(p, q, cPathAcceptCheckCornerCircleRadius) then |
||
| 94 | begin |
||
| 95 | result := true; |
||
| 96 | Break; |
||
| 97 | end; |
||
| 98 | end; |
||
| 99 | end; |
||
| 100 | |||
| 101 | function __CheckSquare(left, top, width, height: integer): boolean; |
||
| 102 | var |
||
| 103 | i: integer; |
||
| 104 | begin |
||
| 105 | result := false; |
||
| 106 | for i := Low(FreeSpots) to High(FreeSpots) do |
||
| 107 | begin |
||
| 108 | if (FreeSpots[i].X >= left) and |
||
| 109 | (FreeSpots[i].Y >= top) and |
||
| 110 | (FreeSpots[i].X <= left+width) and |
||
| 111 | (FreeSpots[i].Y <= top+height) then |
||
| 112 | begin |
||
| 113 | result := true; |
||
| 114 | break; |
||
| 115 | end; |
||
| 116 | end; |
||
| 117 | end; |
||
| 118 | |||
| 119 | function __AcceptCircleCheck: boolean; |
||
| 120 | begin |
||
| 121 | result := |
||
| 122 | __CheckCircle( cPathAcceptCheckCornerCircleRadius, cPathAcceptCheckCornerCircleRadius) and // oben links |
||
| 123 | __CheckCircle(maxX-cPathAcceptCheckCornerCircleRadius, cPathAcceptCheckCornerCircleRadius) and // oben rechts |
||
| 124 | __CheckCircle( cPathAcceptCheckCornerCircleRadius, maxY-cPathAcceptCheckCornerCircleRadius) and // unten links |
||
| 125 | __CheckCircle(maxX-cPathAcceptCheckCornerCircleRadius, maxY-cPathAcceptCheckCornerCircleRadius); // unten rechts |
||
| 126 | end; |
||
| 127 | |||
| 128 | function __AcceptSquaresCheck: boolean; |
||
| 129 | var |
||
| 130 | ix, iy: integer; |
||
| 131 | left, top: integer; |
||
| 132 | squareWidth, squareHeight: integer; |
||
| 133 | begin |
||
| 134 | squareWidth := maxX div cPathAcceptCheckSquaresHorizontal; |
||
| 135 | squareHeight := maxY div cPathAcceptCheckSquaresVertical; |
||
| 136 | for ix := 0 to cPathAcceptCheckSquaresHorizontal-1 do |
||
| 137 | begin |
||
| 138 | left := ix * squareWidth; |
||
| 139 | for iy := 0 to cPathAcceptCheckSquaresVertical-1 do |
||
| 140 | begin |
||
| 141 | top := iy * squareHeight; |
||
| 142 | if not __CheckSquare(left, top, squareWidth, squareHeight) then |
||
| 143 | begin |
||
| 144 | result := false; |
||
| 145 | exit; |
||
| 146 | end; |
||
| 147 | end; |
||
| 148 | end; |
||
| 149 | result := true; |
||
| 150 | end; |
||
| 151 | |||
| 152 | begin |
||
| 153 | result := true; |
||
| 154 | |||
| 155 | if result and cPathAcceptCheckCornerCircle then |
||
| 156 | begin |
||
| 157 | result := result and __AcceptCircleCheck; |
||
| 158 | end; |
||
| 159 | |||
| 160 | if result and cPathAcceptCheckSquares then |
||
| 161 | begin |
||
| 162 | result := result and __AcceptSquaresCheck; |
||
| 163 | end; |
||
| 164 | end; |
||
| 165 | |||
| 166 | procedure _BuildPaths(nFreespots, maxX, maxY, nTrees, r, startX, startY, angle: integer); |
||
| 167 | var |
||
| 168 | i: integer; |
||
| 169 | x: integer; |
||
| 170 | maxdrawn: integer; |
||
| 171 | iBeginBranch: integer; |
||
| 172 | // midDistance: extended; |
||
| 173 | locFlexibility: integer; |
||
| 174 | // midDeltaX, midDeltaY: integer; |
||
| 175 | begin |
||
| 176 | SetLength(FreeSpots, nFreespots); |
||
| 177 | |||
| 178 | FreeSpots[0].A := angle; |
||
| 179 | FreeSpots[0].X := startX; |
||
| 180 | FreeSpots[0].Y := startY; |
||
| 181 | |||
| 182 | iBeginBranch := 1; |
||
| 183 | |||
| 184 | while true do |
||
| 185 | begin |
||
| 186 | maxdrawn := 0; |
||
| 187 | for i := iBeginBranch to iBeginBranch+cMaxBranchLength do |
||
| 188 | begin |
||
| 189 | if i > High(FreeSpots) then Exit; |
||
| 190 | |||
| 191 | // midDeltaX := FreeSpots[i-1].X - startX; |
||
| 192 | // midDeltaY := FreeSpots[i-1].Y - startY; |
||
| 193 | // midDistance := sqrt(midDeltaX*midDeltaX + midDeltaY*midDeltaY); |
||
| 194 | |||
| 195 | (* |
||
| 196 | if midDistance > 4000 then |
||
| 197 | locFlexibility := Round(cPathFlexibility + midDistance/5000) |
||
| 198 | else |
||
| 199 | locFlexibility := cPathFlexibility; |
||
| 200 | *) |
||
| 201 | locFlexibility := cPathFlexibility; |
||
| 202 | |||
| 203 | FreeSpots[i].A := RandBetween(FreeSpots[i-1].A-locFlexibility, FreeSpots[i-1].A+locFlexibility); |
||
| 204 | FreeSpots[i].X := FreeSpots[i-1].X + round(r*cos(FreeSpots[i].A/360*2*pi)); |
||
| 205 | FreeSpots[i].Y := FreeSpots[i-1].Y + round(r*sin(FreeSpots[i].A/360*2*pi)); |
||
| 206 | |||
| 207 | if FreeSpots[i].X > maxX-cMapBorderSize*r then break; |
||
| 208 | if FreeSpots[i].Y > maxY-cMapBorderSize*r then break; |
||
| 209 | if FreeSpots[i].X < cMapBorderSize*r then break; |
||
| 210 | if FreeSpots[i].Y < cMapBorderSize*r then break; |
||
| 211 | |||
| 212 | maxdrawn := i; |
||
| 213 | end; |
||
| 214 | |||
| 215 | x := RandBetween(maxdrawn div 2, maxdrawn); // RandBetween(0, maxdrawn); |
||
| 216 | FreeSpots[maxdrawn+1] := FreeSpots[x]; // virtual free spot |
||
| 217 | |||
| 218 | if RandBetween(0,1) = 0 then |
||
| 219 | FreeSpots[maxdrawn+1].A := FreeSpots[x].A-90 |
||
| 220 | else |
||
| 221 | FreeSpots[maxdrawn+1].A := FreeSpots[x].A+90; |
||
| 222 | |||
| 223 | iBeginBranch := maxdrawn+2; |
||
| 224 | end; |
||
| 225 | end; |
||
| 226 | |||
| 227 | type |
||
| 228 | TDWordArray = array of DWord; |
||
| 229 | PDWordArray = ^TDWordArray; |
||
| 230 | |||
| 231 | function GetWaypointArrayElements(nTrees: integer): DWORD; cdecl; |
||
| 232 | begin |
||
| 233 | result := Round(cPathLength*nTrees); |
||
| 234 | end; |
||
| 235 | |||
| 236 | function GenerateMap(nTrees, treeRadius, mapX, mapY: integer; |
||
| 237 | memblockTrees, memblockWayPoints: PDWordArray): DWORD; cdecl; |
||
| 238 | var |
||
| 239 | pathSize: integer; |
||
| 240 | aryTrees, aryWaypoints: TDWordArray; |
||
| 241 | i, j, k: integer; |
||
| 242 | p, q: TPoint; |
||
| 243 | ok: boolean; |
||
| 244 | nFreespots: integer; |
||
| 245 | begin |
||
| 246 | if not iniLoaded then |
||
| 247 | begin |
||
| 248 | result := ERR_NO_INI_LOADED; |
||
| 249 | Exit; |
||
| 250 | end; |
||
| 251 | |||
| 252 | if memblockTrees <> nil then |
||
| 253 | aryTrees := TDWordArray(memblockTrees) |
||
| 254 | else |
||
| 255 | SetLength(aryTrees, 0); // prevent compiler warning |
||
| 256 | |||
| 257 | if memblockWayPoints <> nil then |
||
| 258 | aryWaypoints := TDWordArray(memblockWayPoints) |
||
| 259 | else |
||
| 260 | SetLength(aryWaypoints, 0); // prevent compiler warning |
||
| 261 | |||
| 262 | pathSize := Round(cPathWidthFactor * treeRadius); |
||
| 263 | nFreespots := GetWaypointArrayElements(nTrees); |
||
| 264 | |||
| 265 | k := 0; |
||
| 266 | repeat |
||
| 267 | Inc(k); |
||
| 268 | _BuildPaths(nFreespots, mapx, mapy, nTrees, treeradius, mapX div 2, mapY div 2, RandBetween(0,359)); |
||
| 269 | until (k >= cPathBuildMaxAttempts) or _AcceptedPath(mapx, mapy); |
||
| 270 | |||
| 271 | if memblockTrees <> nil then |
||
| 272 | begin |
||
| 273 | for i := 0 to nTrees-1 do |
||
| 274 | begin |
||
| 275 | k := 0; |
||
| 276 | repeat |
||
| 277 | inc(k); |
||
| 278 | ok := true; |
||
| 279 | p := Point(Random(mapX+1), Random(mapY+1)); |
||
| 280 | |||
| 281 | // Bäume nicht in den Weg bauen |
||
| 282 | for j := Low(FreeSpots) to High(FreeSpots) do |
||
| 283 | begin |
||
| 284 | q := Point(FreeSpots[j].X, FreeSpots[j].Y); |
||
| 285 | if IsInCircle(p, q, treeRadius + pathSize div 2) then |
||
| 286 | begin |
||
| 287 | ok := false; |
||
| 288 | break; |
||
| 289 | end; |
||
| 290 | end; |
||
| 291 | |||
| 292 | // Bäume sollen sich nicht überschneiden |
||
| 293 | for j := Low(FreeSpots) to High(FreeSpots) do |
||
| 294 | begin |
||
| 295 | q := Point(FreeSpots[j].X, FreeSpots[j].Y); |
||
| 296 | if IsInCircle(p, q, treeRadius + pathSize div 2) then |
||
| 297 | begin |
||
| 298 | ok := false; |
||
| 299 | break; |
||
| 300 | end; |
||
| 301 | end; |
||
| 302 | until ok or (k > cTreePlacementMaxAttempts); |
||
| 303 | |||
| 304 | aryTrees[i*2] := p.x; |
||
| 305 | aryTrees[i*2+1] := p.y; |
||
| 306 | end; |
||
| 307 | end; |
||
| 308 | |||
| 309 | if memblockWayPoints <> nil then |
||
| 310 | begin |
||
| 311 | for i := 0 to nFreespots-1 do |
||
| 312 | begin |
||
| 313 | aryWaypoints[i*2] := FreeSpots[i].X; |
||
| 314 | aryWaypoints[i*2+1] := FreeSpots[i].Y; |
||
| 315 | end; |
||
| 316 | end; |
||
| 317 | |||
| 318 | result := ERR_OK; |
||
| 319 | end; |
||
| 320 | |||
| 321 | function RandomSeed: integer; cdecl; |
||
| 322 | begin |
||
| 323 | Randomize; |
||
| 324 | result := RandSeed; |
||
| 325 | end; |
||
| 326 | |||
| 327 | procedure UseSeed(seed: integer); cdecl; |
||
| 328 | begin |
||
| 329 | RandSeed := seed; |
||
| 330 | end; |
||
| 331 | |||
| 332 | exports |
||
| 333 | GenerateMap name 'GenerateMap', |
||
| 334 | LoadParametersFromINI name 'LoadParametersFromINI', |
||
| 335 | RandomSeed name 'RandomSeed', |
||
| 336 | UseSeed name 'UseSeed', |
||
| 337 | GetWaypointArrayElements name 'GetWaypointArrayElements'; |
||
| 338 | |||
| 339 | end. |