hedgewars/uLandObjects.pas
changeset 6492 71db3c0daa0a
parent 6453 11c578d30bd3
child 6534 e6cb8a41b5f4
equal deleted inserted replaced
6491:736479f3d348 6492:71db3c0daa0a
   149    inc(i)
   149    inc(i)
   150    until (i = RectCount) or (res);
   150    until (i = RectCount) or (res);
   151 CheckIntersect:= res;
   151 CheckIntersect:= res;
   152 end;
   152 end;
   153 
   153 
       
   154 
       
   155 function CountNonZeroz(x, y: LongInt): Longword;
       
   156 var i: LongInt;
       
   157     lRes: Longword;
       
   158 begin
       
   159     lRes:= 0;
       
   160     for i:= y to y + 15 do
       
   161         if Land[i, x] <> 0 then inc(lRes);
       
   162     CountNonZeroz:= lRes;
       
   163 end;
       
   164 
   154 function AddGirder(gX: LongInt): boolean;
   165 function AddGirder(gX: LongInt): boolean;
   155 var tmpsurf: PSDL_Surface;
   166 var tmpsurf: PSDL_Surface;
   156     x1, x2, y, k, i: LongInt;
   167     x1, x2, y, k, i: LongInt;
   157     rr: TSDL_Rect;
   168     rr: TSDL_Rect;
   158     bRes: boolean;
   169     bRes: boolean;
   159 
       
   160     function CountNonZeroz(x, y: LongInt): Longword;
       
   161     var i: LongInt;
       
   162         lRes: Longword;
       
   163     begin
       
   164     lRes:= 0;
       
   165     for i:= y to y + 15 do
       
   166         if Land[i, x] <> 0 then inc(lRes);
       
   167     CountNonZeroz:= lRes;
       
   168     end;
       
   169 
       
   170 begin
   170 begin
   171 y:= topY+150;
   171 y:= topY+150;
   172 repeat
   172 repeat
   173     inc(y, 24);
   173     inc(y, 24);
   174     x1:= gX;
   174     x1:= gX;
   374         end else Maxcnt:= 0
   374         end else Maxcnt:= 0
   375     end;
   375     end;
   376 TryPut:= bRes;
   376 TryPut:= bRes;
   377 end;
   377 end;
   378 
   378 
       
   379 
       
   380 procedure CheckRect(Width, Height, x, y, w, h: LongWord);
       
   381 begin
       
   382     if (x + w > Width) then 
       
   383         OutError('Object''s rectangle exceeds image: x + w (' + inttostr(x) + ' + ' + inttostr(w) + ') > Width (' + inttostr(Width) + ')', true);
       
   384     if (y + h > Height) then 
       
   385         OutError('Object''s rectangle exceeds image: y + h (' + inttostr(y) + ' + ' + inttostr(h) + ') > Height (' + inttostr(Height) + ')', true);
       
   386 end;
       
   387 
   379 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);
   388 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);
   380 var s, key: shortstring;
   389 var s, key: shortstring;
   381     f: textfile;
   390     f: textfile;
   382     i: LongInt;
   391     i: LongInt;
   383     ii, t: Longword;
   392     ii, t: Longword;
   384     c2: TSDL_Color;
   393     c2: TSDL_Color;
   385 
       
   386     procedure CheckRect(Width, Height, x, y, w, h: LongWord);
       
   387     begin
       
   388     if (x + w > Width) then OutError('Object''s rectangle exceeds image: x + w (' + inttostr(x) + ' + ' + inttostr(w) + ') > Width (' + inttostr(Width) + ')', true);
       
   389     if (y + h > Height) then OutError('Object''s rectangle exceeds image: y + h (' + inttostr(y) + ' + ' + inttostr(h) + ') > Height (' + inttostr(Height) + ')', true);
       
   390     end;
       
   391 
       
   392 begin
   394 begin
   393 
   395 
   394 AddProgress;
   396 AddProgress;
   395 // Set default water greyscale values
   397 // Set default water greyscale values
   396 if cGrayScale then
   398 if cGrayScale then