Skip to content

Commit

Permalink
Minor fixes to 2 previous commits
Browse files Browse the repository at this point in the history
  • Loading branch information
@KoBeWi
KoBeWi committed Oct 6, 2016
1 parent 043eb1f commit 7041168
Show file tree
Hide file tree
Showing 2 changed files with 81 additions and 73 deletions.
139 changes: 73 additions & 66 deletions hedgewars/uLandObjects.pas
View file
Expand Up @@ -34,7 +34,7 @@ procedure SetLand(var LandWord: Word; Pixel: LongWord); inline;

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

const MaxRects = 512;
Expand Down Expand Up @@ -110,10 +110,14 @@ procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PS
WriteToConsole('Generating collision info... ');

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

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

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

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

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

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

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

procedure FreeRects;
Expand Down Expand Up @@ -348,30 +356,30 @@ function CheckCanPlace(x, y: Longword; var Obj: TThemeObject): boolean;
var i: Longword;
bRes: boolean;
begin
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
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
end;

function TryPut(var Obj: TThemeObject): boolean; overload;
function TryPut(var Obj: TThemeObject): boolean;
const MaxPointsIndex = 2047;
var x, y: Longword;
ar: array[0..MaxPointsIndex] of TPoint;
Expand All @@ -392,12 +400,12 @@ function TryPut(var Obj: TThemeObject): boolean; overload;
begin
ar[cnt].x:= x;
ar[cnt].y:= y;
inc(cnt);
if cnt > MaxPointsIndex then // buffer is full, do not check the rest land
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;
Expand All @@ -418,15 +426,15 @@ function TryPut(var Obj: TThemeObject): boolean; overload;
TryPut:= bRes;
end;

function TryPut(var Obj: TSprayObject; Surface: PSDL_Surface): boolean; overload;
function TryPut2(var Obj: TSprayObject; Surface: PSDL_Surface): boolean;
const MaxPointsIndex = 8095;
var x, y: Longword;
ar: array[0..MaxPointsIndex] of TPoint;
cnt, i: Longword;
r: TSDL_Rect;
bRes: boolean;
begin
TryPut:= false;
TryPut2:= false;
cnt:= 0;
with Obj do
begin
Expand All @@ -445,18 +453,19 @@ function TryPut(var Obj: TSprayObject; Surface: PSDL_Surface): boolean; overload
begin
ar[cnt].x:= x;
ar[cnt].y:= y;
inc(cnt);
if cnt > MaxPointsIndex then // buffer is full, do not check the rest land
if cnt >= MaxPointsIndex then // buffer is full, do not check the rest land
begin
y:= 5000;
x:= 5000;
y:= $FF000000;
x:= $FF000000;
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);
Expand All @@ -470,7 +479,7 @@ function TryPut(var Obj: TSprayObject; Surface: PSDL_Surface): boolean; overload
end
else Maxcnt:= 0
end;
TryPut:= bRes;
TryPut2:= bRes;
end;


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

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

while not pfsEOF(f) do
while (not pfsEOF(f)) and allOK do
begin
pfsReadLn(f, s);
if Length(s) = 0 then
Expand Down Expand Up @@ -659,8 +668,7 @@ 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);

rectcnt2 := 0;
rectcnt2 := 0;
for ii := 1 to Length(S) do
if S[ii] = ',' then
inc(rectcnt2);
Expand All @@ -674,27 +682,26 @@ procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSpra
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;
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
Expand Down Expand Up @@ -868,13 +875,13 @@ procedure AddThemeObjects(var ThemeObjects: TThemeObjects);
exit;
WriteLnToConsole('Adding theme objects...');

for i:=0 to ThemeObjects.Count do
for i:=0 to Pred(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 ThemeObjects.Count do
for i:= 0 to Pred(ThemeObjects.Count) do
begin
ii := (i+t) mod ThemeObjects.Count;

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

for i:=0 to SprayObjects.Count do
for i:= 0 to Pred(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 SprayObjects.Count do
for i:= 0 to Pred(SprayObjects.Count) do
begin
ii := (i+t) mod SprayObjects.Count;

if SprayObjects.objs[ii].Maxcnt <> 0 then
b := b or TryPut(SprayObjects.objs[ii], Surface)
b := b or TryPut2(SprayObjects.objs[ii], Surface)
end;
until not b;
end;
Expand Down
15 changes: 8 additions & 7 deletions hedgewars/uVisualGearsHandlers.pas
View file
Expand Up @@ -162,13 +162,14 @@ procedure doStepFlake(Gear: PVisualGear; Steps: Longword);
X:= X - cScreenSpace;
moved:= true
end;
if round(Y) < (LAND_HEIGHT - 1024 - 75) then
begin
X:= cLeftScreenBorder + random(cScreenSpace);
Y:= Y+(1024 + 200 + random(50));
moved:= true
end
if (Gear^.Layer = 2) and (round(Y) - 400 > LAND_HEIGHT) and (cGravityf >= 0) then

if round(Y) < (LAND_HEIGHT - 1024 - 75) then
begin
X:= cLeftScreenBorder + random(cScreenSpace);
Y:= Y+(1024 + 200 + random(50));
moved:= true
end
else if (Gear^.Layer = 2) and (round(Y) - 400 > LAND_HEIGHT) and (cGravityf >= 0) then
begin
X:= cLeftScreenBorder + random(cScreenSpace);
Y:= Y-(1024 + 400 + random(50)); // TODO - configure in theme (jellies for example could use limited range)
Expand Down

0 comments on commit 7041168

Please sign in to comment.