Skip to content
This repository has been archived by the owner. It is now read-only.
Permalink
Browse files

support for multiple inland rectangles

  • Loading branch information...
KoBeWi committed Oct 5, 2016
1 parent c92b869 commit 12c47c691029c19620e680c5fe9e6667399fa9db
Showing with 81 additions and 67 deletions.
  1. +81 −67 hedgewars/uLandObjects.pas
@@ -34,7 +34,7 @@ procedure SetLand(var LandWord: Word; Pixel: LongWord); inline;

implementation
uses uStore, uConsts, uConsole, uRandom, uSound
, uTypes, uVariables, uDebug, uUtils
, uTypes, uVariables, uUtils, uDebug, SysUtils
, uPhysFSLayer;

const MaxRects = 512;
@@ -46,9 +46,10 @@ implementation
PRectArray = ^TRectsArray;
TThemeObject = record
Surf, Mask: PSDL_Surface;
inland: TSDL_Rect;
inland: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;
outland: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;
rectcnt: Longword;
rectcnt2: Longword;
Width, Height: Longword;
Maxcnt: Longword;
end;
@@ -109,14 +110,10 @@ procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PS
WriteToConsole('Generating collision info... ');

if SDL_MustLock(Image) then
if SDLCheck(SDL_LockSurface(Image) >= 0, 'SDL_LockSurface', true) then exit;
SDLTry(SDL_LockSurface(Image) >= 0, true);

bpp:= Image^.format^.BytesPerPixel;
if checkFails(bpp = 4, 'Land object should be 32bit', true) then
begin
if SDL_MustLock(Image) then
SDL_UnlockSurface(Image);
end;
TryDo(bpp = 4, 'Land object should be 32bit', true);

if Width = 0 then
Width:= Image^.w;
@@ -164,14 +161,10 @@ procedure BlitImageUsingMask(cpX, cpY: Longword; Image, Mask: PSDL_Surface);
WriteToConsole('Generating collision info... ');

if SDL_MustLock(Image) then
if SDLCheck(SDL_LockSurface(Image) >= 0, 'SDL_LockSurface', true) then exit;
SDLTry(SDL_LockSurface(Image) >= 0, true);

bpp:= Image^.format^.BytesPerPixel;
if checkFails(bpp = 4, 'Land object should be 32bit', true) then
begin
if SDL_MustLock(Image) then
SDL_UnlockSurface(Image);
end;
TryDo(bpp = 4, 'Land object should be 32bit', true);

p:= Image^.pixels;
mp:= Mask^.pixels;
@@ -211,13 +204,13 @@ procedure AddRect(x1, y1, w1, h1: LongInt);
h:= h1
end;
inc(RectCount);
checkFails(RectCount < MaxRects, 'AddRect: overflow', true)
TryDo(RectCount < MaxRects, 'AddRect: overflow', true)
end;

procedure InitRects;
begin
RectCount:= 0;
New(Rects)
RectCount:= 0;
New(Rects)
end;

procedure FreeRects;
@@ -355,25 +348,30 @@ function CheckCanPlace(x, y: Longword; var Obj: TThemeObject): boolean;
var i: Longword;
bRes: boolean;
begin
with Obj do
if CheckLand(inland, x, y, lfBasic) then
begin
bRes:= true;
i:= 1;
while bRes and (i <= rectcnt) do
begin
bRes:= CheckLand(outland[i], x, y, 0);
inc(i)
end;
if bRes then
bRes:= not CheckIntersect(x, y, Width, Height)
with Obj do begin
bRes:= true;
i:= 1;
while bRes and (i <= rectcnt2) do
begin
bRes:= CheckLand(inland[i], x, y, lfBasic);
inc(i)
end;

i:= 1;
while bRes and (i <= rectcnt) do
begin
bRes:= CheckLand(outland[i], x, y, 0);
inc(i)
end;

if bRes then
bRes:= not CheckIntersect(x, y, Width, Height);

CheckCanPlace:= bRes;
end
else
bRes:= false;
CheckCanPlace:= bRes;
end;

function TryPut(var Obj: TThemeObject): boolean;
function TryPut(var Obj: TThemeObject): boolean; overload;
const MaxPointsIndex = 2047;
var x, y: Longword;
ar: array[0..MaxPointsIndex] of TPoint;
@@ -394,12 +392,12 @@ function TryPut(var Obj: TThemeObject): boolean;
begin
ar[cnt].x:= x;
ar[cnt].y:= y;
if cnt >= MaxPointsIndex then // buffer is full, do not check the rest land
inc(cnt);
if cnt > MaxPointsIndex then // buffer is full, do not check the rest land
begin
y:= LAND_HEIGHT;
x:= LAND_WIDTH;
end
else inc(cnt);
end;
inc(y, 3);
until y >= LAND_HEIGHT - Height;
@@ -420,15 +418,15 @@ function TryPut(var Obj: TThemeObject): boolean;
TryPut:= bRes;
end;

function TryPut2(var Obj: TSprayObject; Surface: PSDL_Surface): boolean;
function TryPut(var Obj: TSprayObject; Surface: PSDL_Surface): boolean; overload;
const MaxPointsIndex = 8095;
var x, y: Longword;
ar: array[0..MaxPointsIndex] of TPoint;
cnt, i: Longword;
r: TSDL_Rect;
bRes: boolean;
begin
TryPut2:= false;
TryPut:= false;
cnt:= 0;
with Obj do
begin
@@ -447,19 +445,18 @@ function TryPut2(var Obj: TSprayObject; Surface: PSDL_Surface): boolean;
begin
ar[cnt].x:= x;
ar[cnt].y:= y;
if cnt >= MaxPointsIndex then // buffer is full, do not check the rest land
inc(cnt);
if cnt > MaxPointsIndex then // buffer is full, do not check the rest land
begin
y:= $FF000000;
x:= $FF000000;
y:= 5000;
x:= 5000;
end
else inc(cnt);
end;
inc(y, 12);
until y >= LAND_HEIGHT - Height - 8;
inc(x, getrandom(12) + 12)
until x >= LAND_WIDTH - Width;
bRes:= cnt <> 0;
AddFileLog('CHECKPOINT 004');
if bRes then
begin
i:= getrandom(cnt);
@@ -473,7 +470,7 @@ function TryPut2(var Obj: TSprayObject; Surface: PSDL_Surface): boolean;
end
else Maxcnt:= 0
end;
TryPut2:= bRes;
TryPut:= bRes;
end;


@@ -520,12 +517,12 @@ procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSpra
s:= cPathz[ptCurrTheme] + '/' + cThemeCFGFilename;
WriteLnToConsole('Reading objects info...');
f:= pfsOpenRead(s);
if checkFails(f <> nil, 'Bad data or cannot access file ' + s, true) then exit;
TryDo(f <> nil, 'Bad data or cannot access file ' + s, true);

ThemeObjects.Count:= 0;
SprayObjects.Count:= 0;

while (not pfsEOF(f)) and allOK do
while not pfsEOF(f) do
begin
pfsReadLn(f, s);
if Length(s) = 0 then
@@ -662,25 +659,42 @@ procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSpra
Delete(s, 1, i);
if (Maxcnt < 1) or (Maxcnt > MAXTHEMEOBJECTS) then
OutError('Object''s max count should be between 1 and '+ inttostr(MAXTHEMEOBJECTS) +' (it was '+ inttostr(Maxcnt) +').', true);
with inland do
begin
i:= Pos(',', s);
x:= StrToInt(Trim(Copy(s, 1, Pred(i))));
Delete(s, 1, i);
i:= Pos(',', s);
y:= StrToInt(Trim(Copy(s, 1, Pred(i))));
Delete(s, 1, i);
i:= Pos(',', s);
w:= StrToInt(Trim(Copy(s, 1, Pred(i))));
Delete(s, 1, i);
i:= Pos(',', s);
h:= StrToInt(Trim(Copy(s, 1, Pred(i))));
Delete(s, 1, i);
CheckRect(Width, Height, x, y, w, h)
end;

rectcnt2 := 0;
for ii := 1 to Length(S) do
if S[ii] = ',' then
inc(rectcnt2);

if rectcnt2 mod 2 = 0 then
rectcnt2 := 1
else begin
i:= Pos(',', s);
rectcnt2:= StrToInt(Trim(Copy(s, 1, Pred(i))));
Delete(s, 1, i);
end;

for ii:= 1 to rectcnt2 do
with inland[ii] do
begin
i:= Pos(',', s);
x:= StrToInt(Trim(Copy(s, 1, Pred(i))));
Delete(s, 1, i);
i:= Pos(',', s);
y:= StrToInt(Trim(Copy(s, 1, Pred(i))));
Delete(s, 1, i);
i:= Pos(',', s);
w:= StrToInt(Trim(Copy(s, 1, Pred(i))));
Delete(s, 1, i);
i:= Pos(',', s);
h:= StrToInt(Trim(Copy(s, 1, Pred(i))));
Delete(s, 1, i);
CheckRect(Width, Height, x, y, w, h)
end;

i:= Pos(',', s);
rectcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
Delete(s, 1, i);

for ii:= 1 to rectcnt do
with outland[ii] do
begin
@@ -854,13 +868,13 @@ procedure AddThemeObjects(var ThemeObjects: TThemeObjects);
exit;
WriteLnToConsole('Adding theme objects...');

for i:=0 to Pred(ThemeObjects.Count) do
for i:=0 to ThemeObjects.Count do
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

repeat
t := getrandom(ThemeObjects.Count);
b := false;
for i:= 0 to Pred(ThemeObjects.Count) do
for i:=0 to ThemeObjects.Count do
begin
ii := (i+t) mod ThemeObjects.Count;

@@ -878,18 +892,18 @@ procedure AddSprayObjects(Surface: PSDL_Surface; var SprayObjects: TSprayObjects
exit;
WriteLnToConsole('Adding spray objects...');

for i:= 0 to Pred(SprayObjects.Count) do
for i:=0 to SprayObjects.Count do
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

repeat
t := getrandom(SprayObjects.Count);
b := false;
for i:= 0 to Pred(SprayObjects.Count) do
for i:=0 to SprayObjects.Count do
begin
ii := (i+t) mod SprayObjects.Count;

if SprayObjects.objs[ii].Maxcnt <> 0 then
b := b or TryPut2(SprayObjects.objs[ii], Surface)
b := b or TryPut(SprayObjects.objs[ii], Surface)
end;
until not b;
end;
@@ -947,4 +961,4 @@ procedure FreeLandObjects();
end;
end;

end.
end.

0 comments on commit 12c47c6

Please sign in to comment.
You can’t perform that action at this time.