hedgewars/uLandObjects.pas
changeset 10015 4feced261c68
parent 9998 736015b847e3
parent 9950 2759212a27de
child 10108 c68cf030eded
equal deleted inserted replaced
10014:56d2f2d5aad8 10015:4feced261c68
    92 
    92 
    93 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface); inline;
    93 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface); inline;
    94 begin
    94 begin
    95     BlitImageAndGenerateCollisionInfo(cpX, cpY, Width, Image, 0);
    95     BlitImageAndGenerateCollisionInfo(cpX, cpY, Width, Image, 0);
    96 end;
    96 end;
    97     
    97 
    98 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word);
    98 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word);
    99 var p: PLongwordArray;
    99 var p: PLongwordArray;
   100     x, y: Longword;
   100     x, y: Longword;
   101     bpp: LongInt;
   101     bpp: LongInt;
   102 begin
   102 begin
   122                 if (LandPixels[cpY + y, cpX + x] = 0)
   122                 if (LandPixels[cpY + y, cpX + x] = 0)
   123                 or (((p^[x] and AMask) <> 0) and (((LandPixels[cpY + y, cpX + x] and AMask) shr AShift) < 255)) then
   123                 or (((p^[x] and AMask) <> 0) and (((LandPixels[cpY + y, cpX + x] and AMask) shr AShift) < 255)) then
   124                     LandPixels[cpY + y, cpX + x]:= p^[x];
   124                     LandPixels[cpY + y, cpX + x]:= p^[x];
   125                 end
   125                 end
   126             else
   126             else
   127                 if LandPixels[(cpY + y) div 2, (cpX + x) div 2] = 0 then 
   127                 if LandPixels[(cpY + y) div 2, (cpX + x) div 2] = 0 then
   128                     LandPixels[(cpY + y) div 2, (cpX + x) div 2]:= p^[x];
   128                     LandPixels[(cpY + y) div 2, (cpX + x) div 2]:= p^[x];
   129 
   129 
   130             if (Land[cpY + y, cpX + x] <= lfAllObjMask) and ((p^[x] and AMask) <> 0) then
   130             if (Land[cpY + y, cpX + x] <= lfAllObjMask) and ((p^[x] and AMask) <> 0) then
   131                 Land[cpY + y, cpX + x]:= lfObject or LandFlags
   131                 Land[cpY + y, cpX + x]:= lfObject or LandFlags
   132             end;
   132             end;
   162             if (LandPixels[cpY + y, cpX + x] = 0)
   162             if (LandPixels[cpY + y, cpX + x] = 0)
   163             or (((p^[x] and AMask) <> 0) and (((LandPixels[cpY + y, cpX + x] and AMask) shr AShift) < 255)) then
   163             or (((p^[x] and AMask) <> 0) and (((LandPixels[cpY + y, cpX + x] and AMask) shr AShift) < 255)) then
   164                 LandPixels[cpY + y, cpX + x]:= p^[x];
   164                 LandPixels[cpY + y, cpX + x]:= p^[x];
   165             end
   165             end
   166         else
   166         else
   167             if LandPixels[(cpY + y) div 2, (cpX + x) div 2] = 0 then 
   167             if LandPixels[(cpY + y) div 2, (cpX + x) div 2] = 0 then
   168                 LandPixels[(cpY + y) div 2, (cpX + x) div 2]:= p^[x];
   168                 LandPixels[(cpY + y) div 2, (cpX + x) div 2]:= p^[x];
   169 
   169 
   170         if (Land[cpY + y, cpX + x] <= lfAllObjMask) or (Land[cpY + y, cpX + x] and lfObject <> 0)  then
   170         if (Land[cpY + y, cpX + x] <= lfAllObjMask) or (Land[cpY + y, cpX + x] and lfObject <> 0)  then
   171             SetLand(Land[cpY + y, cpX + x], mp^[x]);
   171             SetLand(Land[cpY + y, cpX + x], mp^[x]);
   172         end;
   172         end;
   259         i:= x2 + 12;
   259         i:= x2 + 12;
   260         repeat
   260         repeat
   261         inc(x2, 2);
   261         inc(x2, 2);
   262         k:= CountNonZeroz(x2, y)
   262         k:= CountNonZeroz(x2, y)
   263         until (x2 >= (rightX-150)) or (k = 0) or (k = 16) or (x2 > i) or (x2 - x1 >= 768);
   263         until (x2 >= (rightX-150)) or (k = 0) or (k = 16) or (x2 > i) or (x2 - x1 >= 768);
   264         
   264 
   265         if (x2 < (rightX - 150)) and (k = 16) and (x2 - x1 > 250) and (x2 - x1 < 768)
   265         if (x2 < (rightX - 150)) and (k = 16) and (x2 - x1 > 250) and (x2 - x1 < 768)
   266         and (not CheckIntersect(x1 - 32, y - 64, x2 - x1 + 64, 144)) then
   266         and (not CheckIntersect(x1 - 32, y - 64, x2 - x1 + 64, 144)) then
   267                 break;
   267                 break;
   268         end;
   268         end;
   269 x1:= 0;
   269 x1:= 0;
   275     tmpsurf:= LoadDataImageAltPath(ptCurrTheme, ptGraphics, 'Girder', ifCritical or ifTransparent or ifIgnoreCaps);
   275     tmpsurf:= LoadDataImageAltPath(ptCurrTheme, ptGraphics, 'Girder', ifCritical or ifTransparent or ifIgnoreCaps);
   276 
   276 
   277     rr.x:= x1;
   277     rr.x:= x1;
   278     while rr.x < x2 do
   278     while rr.x < x2 do
   279         begin
   279         begin
   280         if cIce then 
   280         if cIce then
   281             BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, tmpsurf^.w), tmpsurf, lfIce)
   281             BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, tmpsurf^.w), tmpsurf, lfIce)
   282         else
   282         else
   283             BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, tmpsurf^.w), tmpsurf);
   283             BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, tmpsurf^.w), tmpsurf);
   284         inc(rr.x, tmpsurf^.w);
   284         inc(rr.x, tmpsurf^.w);
   285         end;
   285         end;
   452 end;
   452 end;
   453 
   453 
   454 
   454 
   455 procedure CheckRect(Width, Height, x, y, w, h: LongWord);
   455 procedure CheckRect(Width, Height, x, y, w, h: LongWord);
   456 begin
   456 begin
   457     if (x + w > Width) then 
   457     if (x + w > Width) then
   458         OutError('Object''s rectangle exceeds image: x + w (' + inttostr(x) + ' + ' + inttostr(w) + ') > Width (' + inttostr(Width) + ')', true);
   458         OutError('Object''s rectangle exceeds image: x + w (' + inttostr(x) + ' + ' + inttostr(w) + ') > Width (' + inttostr(Width) + ')', true);
   459     if (y + h > Height) then 
   459     if (y + h > Height) then
   460         OutError('Object''s rectangle exceeds image: y + h (' + inttostr(y) + ' + ' + inttostr(h) + ') > Height (' + inttostr(Height) + ')', true);
   460         OutError('Object''s rectangle exceeds image: y + h (' + inttostr(y) + ' + ' + inttostr(h) + ') > Height (' + inttostr(Height) + ')', true);
   461 end;
   461 end;
   462 
   462 
   463 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);
   463 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);
   464 var s, key: shortstring;
   464 var s, key: shortstring;
   552                 t:= 255;
   552                 t:= 255;
   553             c2.r:= t;
   553             c2.r:= t;
   554             c2.g:= t;
   554             c2.g:= t;
   555             c2.b:= t
   555             c2.b:= t
   556             end;
   556             end;
   557         ExplosionBorderColor:= (c2.r shl RShift) or (c2.g shl GShift) or (c2.b shl BShift) or AMask; 
   557         ExplosionBorderColor:= (c2.r shl RShift) or (c2.g shl GShift) or (c2.b shl BShift) or AMask;
   558         end
   558         end
   559     else if key = 'water-top' then
   559     else if key = 'water-top' then
   560         begin
   560         begin
   561         i:= Pos(',', s);
   561         i:= Pos(',', s);
   562         WaterColorArray[0].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
   562         WaterColorArray[0].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));