hedgewars/uLandTexture.pas
changeset 10270 cd78906ed898
parent 10269 2193bef70edf
child 10494 0eb97cf4c78e
equal deleted inserted replaced
10269:2193bef70edf 10270:cd78906ed898
    65 Pixels2:= @tmpPixels
    65 Pixels2:= @tmpPixels
    66 end;
    66 end;
    67 
    67 
    68 procedure UpdateLandTexture(X, Width, Y, Height: LongInt; landAdded: boolean);
    68 procedure UpdateLandTexture(X, Width, Y, Height: LongInt; landAdded: boolean);
    69 var tx, ty: Longword;
    69 var tx, ty: Longword;
       
    70     tSize : LongInt;
    70 begin
    71 begin
    71     if cOnlyStats then exit;
    72     if cOnlyStats then exit;
    72     if (Width <= 0) or (Height <= 0) then
    73     if (Width <= 0) or (Height <= 0) then
    73         exit;
    74         exit;
    74     TryDo((X >= 0) and (X < LAND_WIDTH), 'UpdateLandTexture: wrong X parameter', true);
    75     TryDo((X >= 0) and (X < LAND_WIDTH), 'UpdateLandTexture: wrong X parameter', true);
    75     TryDo(X + Width <= LAND_WIDTH, 'UpdateLandTexture: wrong Width parameter', true);
    76     TryDo(X + Width <= LAND_WIDTH, 'UpdateLandTexture: wrong Width parameter', true);
    76     TryDo((Y >= 0) and (Y < LAND_HEIGHT), 'UpdateLandTexture: wrong Y parameter', true);
    77     TryDo((Y >= 0) and (Y < LAND_HEIGHT), 'UpdateLandTexture: wrong Y parameter', true);
    77     TryDo(Y + Height <= LAND_HEIGHT, 'UpdateLandTexture: wrong Height parameter', true);
    78     TryDo(Y + Height <= LAND_HEIGHT, 'UpdateLandTexture: wrong Height parameter', true);
    78 
    79 
    79     if (cReducedQuality and rqBlurryLand) = 0 then
    80     tSize:= TEXSIZE;
    80         for ty:= Y div TEXSIZE to (Y + Height - 1) div TEXSIZE do
    81 
    81             for tx:= X div TEXSIZE to (X + Width - 1) div TEXSIZE do
    82     // land textures have half the size/resolution in blurry mode
       
    83     if (cReducedQuality and rqBlurryLand) <> 0 then
       
    84         tSize:= tSize * 2;
       
    85 
       
    86     for ty:= Y div tSize to (Y + Height - 1) div tSize do
       
    87         for tx:= X div tSize to (X + Width - 1) div tSize do
       
    88             begin
       
    89             if not LandTextures[tx, ty].shouldUpdate then
    82                 begin
    90                 begin
    83                 LandTextures[tx, ty].shouldUpdate:= true;
    91                 LandTextures[tx, ty].shouldUpdate:= true;
    84                 LandTextures[tx, ty].landAdded:= landAdded
    92                 inc(dirtyLandTexCount);
    85                 end
    93                 end;
    86     else
    94             LandTextures[tx, ty].landAdded:= landAdded
    87         for ty:= (Y div TEXSIZE) div 2 to ((Y + Height - 1) div TEXSIZE) div 2 do
    95             end;
    88             for tx:= (X div TEXSIZE) div 2 to ((X + Width - 1) div TEXSIZE) div 2 do
       
    89                 begin
       
    90                 LandTextures[tx, ty].shouldUpdate:= true;
       
    91                 LandTextures[tx, ty].landAdded:= landAdded
       
    92                 end
       
    93 end;
    96 end;
    94 
    97 
    95 procedure RealLandTexUpdate(x1, x2, y1, y2: LongInt);
    98 procedure RealLandTexUpdate(x1, x2, y1, y2: LongInt);
    96 var x, y, ty, tx, lx, ly : LongWord;
    99 var x, y, ty, tx, lx, ly : LongWord;
    97     isEmpty: boolean;
   100     isEmpty: boolean;
   113         for y:= y1 to y2 do
   116         for y:= y1 to y2 do
   114             with LandTextures[x, y] do
   117             with LandTextures[x, y] do
   115                 if shouldUpdate then
   118                 if shouldUpdate then
   116                     begin
   119                     begin
   117                     shouldUpdate:= false;
   120                     shouldUpdate:= false;
       
   121                     dec(dirtyLandTexCount);
   118                     isEmpty:= not landAdded;
   122                     isEmpty:= not landAdded;
   119                     landAdded:= false;
   123                     landAdded:= false;
   120                     ty:= 0;
   124                     ty:= 0;
   121                     tx:= 1;
   125                     tx:= 1;
   122                     ly:= y * TEXSIZE;
   126                     ly:= y * TEXSIZE;
   167                     else if tex <> nil then
   171                     else if tex <> nil then
   168                         begin
   172                         begin
   169                         FreeTexture(tex);
   173                         FreeTexture(tex);
   170                         tex:= nil
   174                         tex:= nil
   171                         end;
   175                         end;
       
   176 
       
   177                     // nothing else to do
       
   178                     if dirtyLandTexCount < 1 then
       
   179                         exit;
   172                     end
   180                     end
   173 end;
   181 end;
   174 
   182 
   175 procedure DrawLand(dX, dY: LongInt);
   183 procedure DrawLand(dX, dY: LongInt);
   176 var x, y, tX, ty, tSize, fx, lx, fy, ly: LongInt;
   184 var x, y, tX, ty, tSize, fx, lx, fy, ly: LongInt;
   223 // all offscreen
   231 // all offscreen
   224 if (fy > ly) then
   232 if (fy > ly) then
   225     exit;
   233     exit;
   226 
   234 
   227 // update visible areas of landtex before drawing
   235 // update visible areas of landtex before drawing
   228 RealLandTexUpdate(fx, lx, fy, ly);
   236 if dirtyLandTexCount > 0 then
       
   237     RealLandTexUpdate(fx, lx, fy, ly);
   229 
   238 
   230 tX:= dX + tsize * fx;
   239 tX:= dX + tsize * fx;
   231 
   240 
   232 // loop through columns
   241 // loop through columns
   233 for x:= fx to lx do
   242 for x:= fx to lx do