hedgewars/uLandTexture.pas
changeset 3615 b78d7959540a
parent 3612 b50215a8a43d
child 3666 f9c8fc74ac93
equal deleted inserted replaced
3614:5806f8f614b7 3615:b78d7959540a
    24 
    24 
    25 procedure initModule;
    25 procedure initModule;
    26 procedure freeModule;
    26 procedure freeModule;
    27 procedure UpdateLandTexture(X, Width, Y, Height: LongInt);
    27 procedure UpdateLandTexture(X, Width, Y, Height: LongInt);
    28 procedure DrawLand(dX, dY: LongInt);
    28 procedure DrawLand(dX, dY: LongInt);
    29 procedure FreeLand;
       
    30 
    29 
    31 implementation
    30 implementation
    32 uses uMisc, uLand, uStore, uConsts, GLunit;
    31 uses uMisc, uLand, uStore, uConsts, GLunit;
    33 
    32 
    34 
    33 
    36 
    35 
    37 type TLandRecord = record
    36 type TLandRecord = record
    38             shouldUpdate: boolean;
    37             shouldUpdate: boolean;
    39             tex: PTexture;
    38             tex: PTexture;
    40             end;
    39             end;
       
    40 
    41 var LandTextures: array of array of TLandRecord;
    41 var LandTextures: array of array of TLandRecord;
    42     tmpPixels: array [0..TEXSIZE - 1, 0..TEXSIZE - 1] of LongWord;
    42     tmpPixels: array [0..TEXSIZE - 1, 0..TEXSIZE - 1] of LongWord;
    43 LANDTEXARW: LongWord;
    43     LANDTEXARW: LongWord;
    44     LANDTEXARH: LongWord;
    44     LANDTEXARH: LongWord;
       
    45     
    45 function Pixels(x, y: Longword): Pointer;
    46 function Pixels(x, y: Longword): Pointer;
    46 var ty: Longword;
    47 var ty: Longword;
    47 begin
    48 begin
    48 for ty:= 0 to TEXSIZE - 1 do
    49 for ty:= 0 to TEXSIZE - 1 do
    49     Move(LandPixels[y * TEXSIZE + ty, x * TEXSIZE], tmpPixels[ty, 0], sizeof(Longword) * TEXSIZE);
    50     Move(LandPixels[y * TEXSIZE + ty, x * TEXSIZE], tmpPixels[ty, 0], sizeof(Longword) * TEXSIZE);
   117             else
   118             else
   118                 DrawTexture(dX + x * TEXSIZE * 2, dY + y * TEXSIZE * 2, tex, 2.0)
   119                 DrawTexture(dX + x * TEXSIZE * 2, dY + y * TEXSIZE * 2, tex, 2.0)
   119 
   120 
   120 end;
   121 end;
   121 
   122 
   122 procedure FreeLand;
       
   123 var x, y: LongInt;
       
   124 begin
       
   125     for x:= 0 to LANDTEXARW -1 do
       
   126         for y:= 0 to LANDTEXARH - 1 do
       
   127             with LandTextures[x, y] do
       
   128             begin
       
   129                 FreeTexture(tex);
       
   130                 tex:= nil;
       
   131             end;
       
   132     if LandBackSurface <> nil then
       
   133         SDL_FreeSurface(LandBackSurface);
       
   134     LandBackSurface:= nil;
       
   135 end;
       
   136 
       
   137 procedure initModule;
   123 procedure initModule;
   138 begin
   124 begin
   139     if (cReducedQuality and rqBlurryLand) = 0 then
   125     if (cReducedQuality and rqBlurryLand) = 0 then
   140     begin
   126     begin
   141         LANDTEXARW:= LAND_WIDTH div TEXSIZE;
   127         LANDTEXARW:= LAND_WIDTH div TEXSIZE;
   149     
   135     
   150     SetLength(LandTextures, LANDTEXARW, LANDTEXARH);
   136     SetLength(LandTextures, LANDTEXARW, LANDTEXARH);
   151 end;
   137 end;
   152     
   138     
   153 procedure freeModule;
   139 procedure freeModule;
       
   140 var x, y: LongInt;
   154 begin
   141 begin
       
   142     for x:= 0 to LANDTEXARW -1 do
       
   143         for y:= 0 to LANDTEXARH - 1 do
       
   144             with LandTextures[x, y] do
       
   145             begin
       
   146                 FreeTexture(tex);
       
   147                 tex:= nil;
       
   148             end;
       
   149     if LandBackSurface <> nil then
       
   150         SDL_FreeSurface(LandBackSurface);
       
   151     LandBackSurface:= nil;
   155     LandTextures:= nil;
   152     LandTextures:= nil;
   156 end;
   153 end;
   157 end.
   154 end.