hedgewars/uLandObjects.pas
branchwebgl
changeset 8330 aaefa587e277
parent 8096 453917e94e55
parent 8145 6408c0ba4ba1
child 8833 c13ebed437cb
equal deleted inserted replaced
8116:d24257910f8d 8330:aaefa587e277
    35      , uPhysFSLayer;
    35      , uPhysFSLayer;
    36 
    36 
    37 const MaxRects = 512;
    37 const MaxRects = 512;
    38       MAXOBJECTRECTS = 16;
    38       MAXOBJECTRECTS = 16;
    39       MAXTHEMEOBJECTS = 32;
    39       MAXTHEMEOBJECTS = 32;
       
    40       cThemeCFGFilename = 'theme.cfg';
    40 
    41 
    41 type TRectsArray = array[0..MaxRects] of TSDL_Rect;
    42 type TRectsArray = array[0..MaxRects] of TSDL_Rect;
    42      PRectArray = ^TRectsArray;
    43      PRectArray = ^TRectsArray;
    43      TThemeObject = record
    44      TThemeObject = record
    44                      Surf: PSDL_Surface;
    45                      Surf: PSDL_Surface;
    71 
    72 
    72 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface); inline;
    73 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface); inline;
    73 begin
    74 begin
    74     BlitImageAndGenerateCollisionInfo(cpX, cpY, Width, Image, 0);
    75     BlitImageAndGenerateCollisionInfo(cpX, cpY, Width, Image, 0);
    75 end;
    76 end;
    76     
    77 
    77 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; extraFlags: Word);
    78 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; extraFlags: Word);
    78 var p: PLongwordArray;
    79 var p: PLongwordArray;
    79     x, y: Longword;
    80     x, y: Longword;
    80     bpp: LongInt;
    81     bpp: LongInt;
    81 begin
    82 begin
   101                 if (LandPixels[cpY + y, cpX + x] = 0)
   102                 if (LandPixels[cpY + y, cpX + x] = 0)
   102                 or (((p^[x] and AMask) <> 0) and (((LandPixels[cpY + y, cpX + x] and AMask) shr AShift) < 255)) then
   103                 or (((p^[x] and AMask) <> 0) and (((LandPixels[cpY + y, cpX + x] and AMask) shr AShift) < 255)) then
   103                     LandPixels[cpY + y, cpX + x]:= p^[x];
   104                     LandPixels[cpY + y, cpX + x]:= p^[x];
   104                 end
   105                 end
   105             else
   106             else
   106                 if LandPixels[(cpY + y) div 2, (cpX + x) div 2] = 0 then 
   107                 if LandPixels[(cpY + y) div 2, (cpX + x) div 2] = 0 then
   107                     LandPixels[(cpY + y) div 2, (cpX + x) div 2]:= p^[x];
   108                     LandPixels[(cpY + y) div 2, (cpX + x) div 2]:= p^[x];
   108 
   109 
   109             if ((Land[cpY + y, cpX + x] and $FF00) = 0) and ((p^[x] and AMask) <> 0) then
   110             if ((Land[cpY + y, cpX + x] and $FF00) = 0) and ((p^[x] and AMask) <> 0) then
   110                 begin
   111                 begin
   111                 Land[cpY + y, cpX + x]:= lfObject;
   112                 Land[cpY + y, cpX + x]:= lfObject;
   200         i:= x2 + 12;
   201         i:= x2 + 12;
   201         repeat
   202         repeat
   202         inc(x2, 2);
   203         inc(x2, 2);
   203         k:= CountNonZeroz(x2, y)
   204         k:= CountNonZeroz(x2, y)
   204         until (x2 >= (rightX-150)) or (k = 0) or (k = 16) or (x2 > i) or (x2 - x1 >= 768);
   205         until (x2 >= (rightX-150)) or (k = 0) or (k = 16) or (x2 > i) or (x2 - x1 >= 768);
   205         
   206 
   206         if (x2 < (rightX - 150)) and (k = 16) and (x2 - x1 > 250) and (x2 - x1 < 768)
   207         if (x2 < (rightX - 150)) and (k = 16) and (x2 - x1 > 250) and (x2 - x1 < 768)
   207         and (not CheckIntersect(x1 - 32, y - 64, x2 - x1 + 64, 144)) then
   208         and (not CheckIntersect(x1 - 32, y - 64, x2 - x1 + 64, 144)) then
   208                 break;
   209                 break;
   209         end;
   210         end;
   210 x1:= 0;
   211 x1:= 0;
   217 
   218 
   218     rr.x:= x1;
   219     rr.x:= x1;
   219     while rr.x < x2 do
   220     while rr.x < x2 do
   220         begin
   221         begin
   221         // For testing only. Intent is to flag this on objects with masks, or use it for an ice ray gun
   222         // For testing only. Intent is to flag this on objects with masks, or use it for an ice ray gun
   222         if (Theme = 'Snow') or (Theme = 'Christmas') then 
   223         if (Theme = 'Snow') or (Theme = 'Christmas') then
   223             BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, tmpsurf^.w), tmpsurf, lfIce)
   224             BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, tmpsurf^.w), tmpsurf, lfIce)
   224         else
   225         else
   225             BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, tmpsurf^.w), tmpsurf);
   226             BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, tmpsurf^.w), tmpsurf);
   226         inc(rr.x, tmpsurf^.w);
   227         inc(rr.x, tmpsurf^.w);
   227         end;
   228         end;
   392 end;
   393 end;
   393 
   394 
   394 
   395 
   395 procedure CheckRect(Width, Height, x, y, w, h: LongWord);
   396 procedure CheckRect(Width, Height, x, y, w, h: LongWord);
   396 begin
   397 begin
   397     if (x + w > Width) then 
   398     if (x + w > Width) then
   398         OutError('Object''s rectangle exceeds image: x + w (' + inttostr(x) + ' + ' + inttostr(w) + ') > Width (' + inttostr(Width) + ')', true);
   399         OutError('Object''s rectangle exceeds image: x + w (' + inttostr(x) + ' + ' + inttostr(w) + ') > Width (' + inttostr(Width) + ')', true);
   399     if (y + h > Height) then 
   400     if (y + h > Height) then
   400         OutError('Object''s rectangle exceeds image: y + h (' + inttostr(y) + ' + ' + inttostr(h) + ') > Height (' + inttostr(Height) + ')', true);
   401         OutError('Object''s rectangle exceeds image: y + h (' + inttostr(y) + ' + ' + inttostr(h) + ') > Height (' + inttostr(Height) + ')', true);
   401 end;
   402 end;
   402 
   403 
   403 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);
   404 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);
   404 var s, key: shortstring;
   405 var s, key: shortstring;
   492                 t:= 255;
   493                 t:= 255;
   493             c2.r:= t;
   494             c2.r:= t;
   494             c2.g:= t;
   495             c2.g:= t;
   495             c2.b:= t
   496             c2.b:= t
   496             end;
   497             end;
   497         ExplosionBorderColor:= (c2.r shl RShift) or (c2.g shl GShift) or (c2.b shl BShift) or AMask; 
   498         ExplosionBorderColor:= (c2.r shl RShift) or (c2.g shl GShift) or (c2.b shl BShift) or AMask;
   498         end
   499         end
   499     else if key = 'water-top' then
   500     else if key = 'water-top' then
   500         begin
   501         begin
   501         i:= Pos(',', s);
   502         i:= Pos(',', s);
   502         WaterColorArray[0].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
   503         WaterColorArray[0].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));