hedgewars/uLandGraphics.pas
changeset 3689 e2be39ee19f0
parent 3608 c509bbc779e7
child 3697 d5b30d6373fc
equal deleted inserted replaced
3687:f2d5bc20064a 3689:e2be39ee19f0
    28                                    end;
    28                                    end;
    29 
    29 
    30 function  SweepDirty: boolean;
    30 function  SweepDirty: boolean;
    31 function  Despeckle(X, Y: LongInt): boolean;
    31 function  Despeckle(X, Y: LongInt): boolean;
    32 function  CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean;
    32 function  CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean;
    33 procedure DrawExplosion(X, Y, Radius: LongInt);
    33 function DrawExplosion(X, Y, Radius: LongInt): Longword;
    34 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    34 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    35 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
    35 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
    36 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    36 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    37 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet: boolean);
    37 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet: boolean);
    38 
    38 
   179             else
   179             else
   180                 LandPixels[t div 2, i div 2]:= 0;
   180                 LandPixels[t div 2, i div 2]:= 0;
   181 
   181 
   182 end;
   182 end;
   183 
   183 
   184 procedure FillLandCircleLinesBG(x, y, dx, dy: LongInt);
   184 function FillLandCircleLinesBG(x, y, dx, dy: LongInt): Longword;
   185 var i, t: LongInt;
   185 var i, t: LongInt;
   186 begin
   186     cnt: Longword;
       
   187 begin
       
   188 cnt:= 0;
   187 t:= y + dy;
   189 t:= y + dy;
   188 if (t and LAND_HEIGHT_MASK) = 0 then
   190 if (t and LAND_HEIGHT_MASK) = 0 then
   189    for i:= max(x - dx, 0) to min(x + dx, LAND_WIDTH - 1) do
   191    for i:= max(x - dx, 0) to min(x + dx, LAND_WIDTH - 1) do
   190        if ((Land[t, i] and lfBasic) <> 0) then
   192        if ((Land[t, i] and lfBasic) <> 0) then
       
   193            begin
       
   194            inc(cnt);
   191            if (cReducedQuality and rqBlurryLand) = 0 then
   195            if (cReducedQuality and rqBlurryLand) = 0 then
   192                LandPixels[t, i]:= LandBackPixel(i, t)
   196                LandPixels[t, i]:= LandBackPixel(i, t)
   193            else
   197            else
   194                LandPixels[t div 2, i div 2]:= LandBackPixel(i, t)
   198                LandPixels[t div 2, i div 2]:= LandBackPixel(i, t)
       
   199            end
   195        else
   200        else
   196            if ((Land[t, i] and lfObject) <> 0) then
   201            if ((Land[t, i] and lfObject) <> 0) then
   197                if (cReducedQuality and rqBlurryLand) = 0 then
   202                if (cReducedQuality and rqBlurryLand) = 0 then
   198                    LandPixels[t, i]:= 0
   203                    LandPixels[t, i]:= 0
   199                else
   204                else
   201 
   206 
   202 t:= y - dy;
   207 t:= y - dy;
   203 if (t and LAND_HEIGHT_MASK) = 0 then
   208 if (t and LAND_HEIGHT_MASK) = 0 then
   204    for i:= max(x - dx, 0) to min(x + dx, LAND_WIDTH - 1) do
   209    for i:= max(x - dx, 0) to min(x + dx, LAND_WIDTH - 1) do
   205        if ((Land[t, i] and lfBasic) <> 0) then
   210        if ((Land[t, i] and lfBasic) <> 0) then
       
   211            begin
       
   212            inc(cnt);
   206            if (cReducedQuality and rqBlurryLand) = 0 then
   213            if (cReducedQuality and rqBlurryLand) = 0 then
   207                LandPixels[t, i]:= LandBackPixel(i, t)
   214                LandPixels[t, i]:= LandBackPixel(i, t)
   208            else
   215            else
   209                LandPixels[t div 2, i div 2]:= LandBackPixel(i, t)
   216                LandPixels[t div 2, i div 2]:= LandBackPixel(i, t)
       
   217            end
   210        else
   218        else
   211            if ((Land[t, i] and lfObject) <> 0) then
   219            if ((Land[t, i] and lfObject) <> 0) then
   212                if (cReducedQuality and rqBlurryLand) = 0 then
   220                if (cReducedQuality and rqBlurryLand) = 0 then
   213                    LandPixels[t, i]:= 0
   221                    LandPixels[t, i]:= 0
   214                else
   222                else
   216 
   224 
   217 t:= y + dx;
   225 t:= y + dx;
   218 if (t and LAND_HEIGHT_MASK) = 0 then
   226 if (t and LAND_HEIGHT_MASK) = 0 then
   219    for i:= max(x - dy, 0) to min(x + dy, LAND_WIDTH - 1) do
   227    for i:= max(x - dy, 0) to min(x + dy, LAND_WIDTH - 1) do
   220        if ((Land[t, i] and lfBasic) <> 0) then
   228        if ((Land[t, i] and lfBasic) <> 0) then
       
   229            begin
       
   230            inc(cnt);
   221            if (cReducedQuality and rqBlurryLand) = 0 then
   231            if (cReducedQuality and rqBlurryLand) = 0 then
   222            LandPixels[t, i]:= LandBackPixel(i, t)
   232            LandPixels[t, i]:= LandBackPixel(i, t)
   223             else 
   233             else 
   224            LandPixels[t div 2, i div 2]:= LandBackPixel(i, t)
   234            LandPixels[t div 2, i div 2]:= LandBackPixel(i, t)
       
   235            end
   225        else
   236        else
   226             if ((Land[t, i] and lfObject) <> 0) then
   237             if ((Land[t, i] and lfObject) <> 0) then
   227             if (cReducedQuality and rqBlurryLand) = 0 then
   238             if (cReducedQuality and rqBlurryLand) = 0 then
   228           LandPixels[t, i]:= 0
   239           LandPixels[t, i]:= 0
   229             else
   240             else
   231 
   242 
   232 t:= y - dx;
   243 t:= y - dx;
   233 if (t and LAND_HEIGHT_MASK) = 0 then
   244 if (t and LAND_HEIGHT_MASK) = 0 then
   234    for i:= max(x - dy, 0) to min(x + dy, LAND_WIDTH - 1) do
   245    for i:= max(x - dy, 0) to min(x + dy, LAND_WIDTH - 1) do
   235        if ((Land[t, i] and lfBasic) <> 0) then
   246        if ((Land[t, i] and lfBasic) <> 0) then
   236             if (cReducedQuality and rqBlurryLand) = 0 then
   247            begin
   237           LandPixels[t, i]:= LandBackPixel(i, t)
   248            inc(cnt);
   238         else 
   249            if (cReducedQuality and rqBlurryLand) = 0 then
   239          LandPixels[t div 2, i div 2]:= LandBackPixel(i, t)
   250                LandPixels[t, i]:= LandBackPixel(i, t)
   240 
   251            else 
       
   252                LandPixels[t div 2, i div 2]:= LandBackPixel(i, t)
       
   253            end
   241        else
   254        else
   242           if ((Land[t, i] and lfObject) <> 0) then
   255           if ((Land[t, i] and lfObject) <> 0) then
   243               if (cReducedQuality and rqBlurryLand) = 0 then
   256               if (cReducedQuality and rqBlurryLand) = 0 then
   244                 LandPixels[t, i]:= 0
   257                 LandPixels[t, i]:= 0
   245               else
   258               else
   246                 LandPixels[t div 2, i div 2]:= 0;
   259                 LandPixels[t div 2, i div 2]:= 0;
   247 
   260 FillLandCircleLinesBG:= cnt;
   248 end;
   261 end;
   249 
   262 
   250 procedure FillLandCircleLinesEBC(x, y, dx, dy: LongInt);
   263 procedure FillLandCircleLinesEBC(x, y, dx, dy: LongInt);
   251 var i, t: LongInt;
   264 var i, t: LongInt;
   252 begin
   265 begin
   308           //Despeckle(i, y - dy);
   321           //Despeckle(i, y - dy);
   309           LandDirty[t div 32, i div 32]:= 1;
   322           LandDirty[t div 32, i div 32]:= 1;
   310           end;
   323           end;
   311 end;
   324 end;
   312 
   325 
   313 procedure DrawExplosion(X, Y, Radius: LongInt);
   326 function DrawExplosion(X, Y, Radius: LongInt): Longword;
   314 var dx, dy, ty, tx, d: LongInt;
   327 var dx, dy, ty, tx, d: LongInt;
       
   328     cnt: Longword;
   315 begin
   329 begin
   316 
   330 
   317 // draw background land texture
   331 // draw background land texture
   318     begin
   332     begin
       
   333     cnt:= 0;
   319     dx:= 0;
   334     dx:= 0;
   320     dy:= Radius;
   335     dy:= Radius;
   321     d:= 3 - 2 * Radius;
   336     d:= 3 - 2 * Radius;
   322 
   337 
   323     while (dx < dy) do
   338     while (dx < dy) do
   324         begin
   339         begin
   325         FillLandCircleLinesBG(x, y, dx, dy);
   340         inc(cnt, FillLandCircleLinesBG(x, y, dx, dy));
   326         if (d < 0)
   341         if (d < 0)
   327         then d:= d + 4 * dx + 6
   342         then d:= d + 4 * dx + 6
   328         else begin
   343         else begin
   329             d:= d + 4 * (dx - dy) + 10;
   344             d:= d + 4 * (dx - dy) + 10;
   330             dec(dy)
   345             dec(dy)
   331             end;
   346             end;
   332         inc(dx)
   347         inc(dx)
   333         end;
   348         end;
   334     if (dx = dy) then FillLandCircleLinesBG(x, y, dx, dy);
   349     if (dx = dy) then inc(cnt, FillLandCircleLinesBG(x, y, dx, dy));
   335     end;
   350     end;
   336 
   351 
   337 // draw a hole in land
   352 // draw a hole in land
   338 if Radius > 20 then
   353 if Radius > 20 then
   339     begin
   354     begin
   380 
   395 
   381 tx:= max(X - Radius - 1, 0);
   396 tx:= max(X - Radius - 1, 0);
   382 dx:= min(X + Radius + 1, LAND_WIDTH) - tx;
   397 dx:= min(X + Radius + 1, LAND_WIDTH) - tx;
   383 ty:= max(Y - Radius - 1, 0);
   398 ty:= max(Y - Radius - 1, 0);
   384 dy:= min(Y + Radius + 1, LAND_HEIGHT) - ty;
   399 dy:= min(Y + Radius + 1, LAND_HEIGHT) - ty;
   385 UpdateLandTexture(tx, dx, ty, dy)
   400 UpdateLandTexture(tx, dx, ty, dy);
       
   401 DrawExplosion:= cnt
   386 end;
   402 end;
   387 
   403 
   388 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
   404 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
   389 var tx, ty, i: LongInt;
   405 var tx, ty, i: LongInt;
   390 begin
   406 begin