equal
deleted
inserted
replaced
195 TryDo(RectCount < MaxRects, 'AddRect: overflow', true) |
195 TryDo(RectCount < MaxRects, 'AddRect: overflow', true) |
196 end; |
196 end; |
197 |
197 |
198 procedure InitRects; |
198 procedure InitRects; |
199 begin |
199 begin |
200 RectCount:= 0; |
200 RectCount:= 0; |
201 New(Rects) |
201 New(Rects) |
202 end; |
202 end; |
203 |
203 |
204 procedure FreeRects; |
204 procedure FreeRects; |
205 begin |
205 begin |
206 Dispose(rects) |
206 Dispose(rects) |
351 else |
351 else |
352 bRes:= false; |
352 bRes:= false; |
353 CheckCanPlace:= bRes; |
353 CheckCanPlace:= bRes; |
354 end; |
354 end; |
355 |
355 |
356 function TryPut(var Obj: TThemeObject): boolean; overload; |
356 function TryPut(var Obj: TThemeObject): boolean; |
357 const MaxPointsIndex = 2047; |
357 const MaxPointsIndex = 2047; |
358 var x, y: Longword; |
358 var x, y: Longword; |
359 ar: array[0..MaxPointsIndex] of TPoint; |
359 ar: array[0..MaxPointsIndex] of TPoint; |
360 cnt, i: Longword; |
360 cnt, i: Longword; |
361 bRes: boolean; |
361 bRes: boolean; |
372 repeat |
372 repeat |
373 if CheckCanPlace(x, y, Obj) then |
373 if CheckCanPlace(x, y, Obj) then |
374 begin |
374 begin |
375 ar[cnt].x:= x; |
375 ar[cnt].x:= x; |
376 ar[cnt].y:= y; |
376 ar[cnt].y:= y; |
377 inc(cnt); |
377 if cnt >= MaxPointsIndex then // buffer is full, do not check the rest land |
378 if cnt > MaxPointsIndex then // buffer is full, do not check the rest land |
|
379 begin |
378 begin |
380 y:= 5000; |
379 y:= $FF000000; |
381 x:= 5000; |
380 x:= $FF000000; |
382 end |
381 end |
|
382 else inc(cnt); |
383 end; |
383 end; |
384 inc(y, 3); |
384 inc(y, 3); |
385 until y >= LAND_HEIGHT - Height; |
385 until y >= LAND_HEIGHT - Height; |
386 inc(x, getrandom(6) + 3) |
386 inc(x, getrandom(6) + 3) |
387 until x >= LAND_WIDTH - Width; |
387 until x >= LAND_WIDTH - Width; |
398 else Maxcnt:= 0 |
398 else Maxcnt:= 0 |
399 end; |
399 end; |
400 TryPut:= bRes; |
400 TryPut:= bRes; |
401 end; |
401 end; |
402 |
402 |
403 function TryPut(var Obj: TSprayObject; Surface: PSDL_Surface): boolean; overload; |
403 function TryPut2(var Obj: TSprayObject; Surface: PSDL_Surface): boolean; |
404 const MaxPointsIndex = 8095; |
404 const MaxPointsIndex = 8095; |
405 var x, y: Longword; |
405 var x, y: Longword; |
406 ar: array[0..MaxPointsIndex] of TPoint; |
406 ar: array[0..MaxPointsIndex] of TPoint; |
407 cnt, i: Longword; |
407 cnt, i: Longword; |
408 r: TSDL_Rect; |
408 r: TSDL_Rect; |
409 bRes: boolean; |
409 bRes: boolean; |
410 begin |
410 begin |
411 TryPut:= false; |
411 TryPut2:= false; |
412 cnt:= 0; |
412 cnt:= 0; |
413 with Obj do |
413 with Obj do |
414 begin |
414 begin |
415 if Maxcnt = 0 then |
415 if Maxcnt = 0 then |
416 exit; |
416 exit; |
425 if CheckLand(r, x, y - 8, lfBasic) |
425 if CheckLand(r, x, y - 8, lfBasic) |
426 and (not CheckIntersect(x, y, Width, Height)) then |
426 and (not CheckIntersect(x, y, Width, Height)) then |
427 begin |
427 begin |
428 ar[cnt].x:= x; |
428 ar[cnt].x:= x; |
429 ar[cnt].y:= y; |
429 ar[cnt].y:= y; |
430 inc(cnt); |
430 if cnt >= MaxPointsIndex then // buffer is full, do not check the rest land |
431 if cnt > MaxPointsIndex then // buffer is full, do not check the rest land |
|
432 begin |
431 begin |
433 y:= 5000; |
432 y:= $FF000000; |
434 x:= 5000; |
433 x:= $FF000000; |
435 end |
434 end |
|
435 else inc(cnt); |
436 end; |
436 end; |
437 inc(y, 12); |
437 inc(y, 12); |
438 until y >= LAND_HEIGHT - Height - 8; |
438 until y >= LAND_HEIGHT - Height - 8; |
439 inc(x, getrandom(12) + 12) |
439 inc(x, getrandom(12) + 12) |
440 until x >= LAND_WIDTH - Width; |
440 until x >= LAND_WIDTH - Width; |
441 bRes:= cnt <> 0; |
441 bRes:= cnt <> 0; |
|
442 AddFileLog('CHECKPOINT 004'); |
442 if bRes then |
443 if bRes then |
443 begin |
444 begin |
444 i:= getrandom(cnt); |
445 i:= getrandom(cnt); |
445 r.x:= ar[i].X; |
446 r.x:= ar[i].X; |
446 r.y:= ar[i].Y; |
447 r.y:= ar[i].Y; |
450 AddRect(ar[i].x - 32, ar[i].y - 32, Width + 64, Height + 64); |
451 AddRect(ar[i].x - 32, ar[i].y - 32, Width + 64, Height + 64); |
451 dec(Maxcnt) |
452 dec(Maxcnt) |
452 end |
453 end |
453 else Maxcnt:= 0 |
454 else Maxcnt:= 0 |
454 end; |
455 end; |
455 TryPut:= bRes; |
456 TryPut2:= bRes; |
456 end; |
457 end; |
457 |
458 |
458 |
459 |
459 procedure CheckRect(Width, Height, x, y, w, h: LongWord); |
460 procedure CheckRect(Width, Height, x, y, w, h: LongWord); |
460 begin |
461 begin |
812 begin |
813 begin |
813 if ThemeObjects.Count = 0 then |
814 if ThemeObjects.Count = 0 then |
814 exit; |
815 exit; |
815 WriteLnToConsole('Adding theme objects...'); |
816 WriteLnToConsole('Adding theme objects...'); |
816 |
817 |
817 for i:=0 to ThemeObjects.Count do |
818 for i:=0 to Pred(ThemeObjects.Count) do |
818 ThemeObjects.objs[i].Maxcnt := max(1, (ThemeObjects.objs[i].Maxcnt * MaxHedgehogs) div 18); // Maxcnt is proportional to map size, but allow objects to span even if we're on a tiny map |
819 ThemeObjects.objs[i].Maxcnt := max(1, (ThemeObjects.objs[i].Maxcnt * MaxHedgehogs) div 18); // Maxcnt is proportional to map size, but allow objects to span even if we're on a tiny map |
819 |
820 |
820 repeat |
821 repeat |
821 t := getrandom(ThemeObjects.Count); |
822 t := getrandom(ThemeObjects.Count); |
822 b := false; |
823 b := false; |
823 for i:=0 to ThemeObjects.Count do |
824 for i:= 0 to Pred(ThemeObjects.Count) do |
824 begin |
825 begin |
825 ii := (i+t) mod ThemeObjects.Count; |
826 ii := (i+t) mod ThemeObjects.Count; |
826 |
827 |
827 if ThemeObjects.objs[ii].Maxcnt <> 0 then |
828 if ThemeObjects.objs[ii].Maxcnt <> 0 then |
828 b := b or TryPut(ThemeObjects.objs[ii]) |
829 b := b or TryPut(ThemeObjects.objs[ii]) |
836 begin |
837 begin |
837 if SprayObjects.Count = 0 then |
838 if SprayObjects.Count = 0 then |
838 exit; |
839 exit; |
839 WriteLnToConsole('Adding spray objects...'); |
840 WriteLnToConsole('Adding spray objects...'); |
840 |
841 |
841 for i:=0 to SprayObjects.Count do |
842 for i:= 0 to Pred(SprayObjects.Count) do |
842 SprayObjects.objs[i].Maxcnt := max(1, (SprayObjects.objs[i].Maxcnt * MaxHedgehogs) div 18); // Maxcnt is proportional to map size, but allow objects to span even if we're on a tiny map |
843 SprayObjects.objs[i].Maxcnt := max(1, (SprayObjects.objs[i].Maxcnt * MaxHedgehogs) div 18); // Maxcnt is proportional to map size, but allow objects to span even if we're on a tiny map |
843 |
844 |
844 repeat |
845 repeat |
845 t := getrandom(SprayObjects.Count); |
846 t := getrandom(SprayObjects.Count); |
846 b := false; |
847 b := false; |
847 for i:=0 to SprayObjects.Count do |
848 for i:= 0 to Pred(SprayObjects.Count) do |
848 begin |
849 begin |
849 ii := (i+t) mod SprayObjects.Count; |
850 ii := (i+t) mod SprayObjects.Count; |
850 |
851 |
851 if SprayObjects.objs[ii].Maxcnt <> 0 then |
852 if SprayObjects.objs[ii].Maxcnt <> 0 then |
852 b := b or TryPut(SprayObjects.objs[ii], Surface) |
853 b := b or TryPut2(SprayObjects.objs[ii], Surface) |
853 end; |
854 end; |
854 until not b; |
855 until not b; |
855 end; |
856 end; |
856 |
857 |
857 procedure AddObjects(); |
858 procedure AddObjects(); |
874 end; |
875 end; |
875 |
876 |
876 procedure AddOnLandObjects(Surface: PSDL_Surface); |
877 procedure AddOnLandObjects(Surface: PSDL_Surface); |
877 begin |
878 begin |
878 InitRects; |
879 InitRects; |
879 //AddSprayObjects(Surface, SprayObjects, 12); |
|
880 AddSprayObjects(Surface, SprayObjects); |
880 AddSprayObjects(Surface, SprayObjects); |
881 FreeRects |
881 FreeRects |
882 end; |
882 end; |
883 |
883 |
884 procedure LoadThemeConfig; |
884 procedure LoadThemeConfig; |