(* * Hedgewars, a free turn based strategy game * Copyright (c) 2004-2012 Andrey Korotaev <unC0Rr@gmail.com> * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; version 2 of the License * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA *){$INCLUDE "options.inc"}unit uLandTexture;interfaceuses SDLh;procedure initModule;procedure freeModule;procedure UpdateLandTexture(X, Width, Y, Height: LongInt; landAdded: boolean);procedure DrawLand(dX, dY: LongInt);procedure ResetLand;procedure SetLandTexture;implementationuses uConsts, GLunit, uTypes, uVariables, uTextures, uDebug, uRender;const TEXSIZE = 128;type TLandRecord = record shouldUpdate, landAdded: boolean; tex: PTexture; end;var LandTextures: array of array of TLandRecord; tmpPixels: array [0..TEXSIZE - 1, 0..TEXSIZE - 1] of LongWord; LANDTEXARW: LongWord; LANDTEXARH: LongWord;function Pixels(x, y: Longword): Pointer;var ty: Longword;beginfor ty:= 0 to TEXSIZE - 1 do Move(LandPixels[y * TEXSIZE + ty, x * TEXSIZE], tmpPixels[ty, 0], sizeof(Longword) * TEXSIZE);Pixels:= @tmpPixelsend;function Pixels2(x, y: Longword): Pointer;var tx, ty: Longword;beginfor ty:= 0 to TEXSIZE - 1 do for tx:= 0 to TEXSIZE - 1 do tmpPixels[ty, tx]:= Land[y * TEXSIZE + ty, x * TEXSIZE + tx] or AMask;Pixels2:= @tmpPixelsend;procedure UpdateLandTexture(X, Width, Y, Height: LongInt; landAdded: boolean);var tx, ty: Longword;begin if cOnlyStats then exit; if (Width <= 0) or (Height <= 0) then exit; TryDo((X >= 0) and (X < LAND_WIDTH), 'UpdateLandTexture: wrong X parameter', true); TryDo(X + Width <= LAND_WIDTH, 'UpdateLandTexture: wrong Width parameter', true); TryDo((Y >= 0) and (Y < LAND_HEIGHT), 'UpdateLandTexture: wrong Y parameter', true); TryDo(Y + Height <= LAND_HEIGHT, 'UpdateLandTexture: wrong Height parameter', true); if (cReducedQuality and rqBlurryLand) = 0 then for ty:= Y div TEXSIZE to (Y + Height - 1) div TEXSIZE do for tx:= X div TEXSIZE to (X + Width - 1) div TEXSIZE do begin LandTextures[tx, ty].shouldUpdate:= true; LandTextures[tx, ty].landAdded:= landAdded end else for ty:= (Y div TEXSIZE) div 2 to ((Y + Height - 1) div TEXSIZE) div 2 do for tx:= (X div TEXSIZE) div 2 to ((X + Width - 1) div TEXSIZE) div 2 do begin LandTextures[tx, ty].shouldUpdate:= true; LandTextures[tx, ty].landAdded:= landAdded endend;procedure RealLandTexUpdate;var x, y, ty, tx, lx, ly : LongWord; isEmpty: boolean;begin if cOnlyStats then exit;(*if LandTextures[0, 0].tex = nil then for x:= 0 to LANDTEXARW -1 do for y:= 0 to LANDTEXARH - 1 do with LandTextures[x, y] do begin tex:= NewTexture(TEXSIZE, TEXSIZE, Pixels(x, y)); glBindTexture(GL_TEXTURE_2D, tex^.id); glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_PRIORITY, tpHigh); endelse*) for x:= 0 to LANDTEXARW -1 do for y:= 0 to LANDTEXARH - 1 do with LandTextures[x, y] do if shouldUpdate then begin shouldUpdate:= false; isEmpty:= not landAdded; landAdded:= false; ty:= 0; tx:= 1; ly:= y * TEXSIZE; lx:= x * TEXSIZE; // first check edges while isEmpty and (ty < TEXSIZE) do begin isEmpty:= LandPixels[ly + ty, lx] and AMask = 0; if isEmpty then isEmpty:= LandPixels[ly + ty, lx + TEXSIZE-1] and AMask = 0; inc(ty) end; while isEmpty and (tx < TEXSIZE-1) do begin isEmpty:= LandPixels[ly, lx + tx] and AMask = 0; if isEmpty then isEmpty:= LandPixels[ly + TEXSIZE-1, lx + tx] and AMask = 0; inc(tx) end; // then search every other remaining. does this sort of stuff defeat compiler opts? ty:= 2; while isEmpty and (ty < TEXSIZE-1) do begin tx:= 2; while isEmpty and (tx < TEXSIZE-1) do begin isEmpty:= LandPixels[ly + ty, lx + tx] and AMask = 0; inc(tx,2) end; inc(ty,2); end; // and repeat ty:= 1; while isEmpty and (ty < TEXSIZE-1) do begin tx:= 1; while isEmpty and (tx < TEXSIZE-1) do begin isEmpty:= LandPixels[ly + ty, lx + tx] and AMask = 0; inc(tx,2) end; inc(ty,2); end; if not isEmpty then begin if tex = nil then tex:= NewTexture(TEXSIZE, TEXSIZE, Pixels(x, y)); glBindTexture(GL_TEXTURE_2D, tex^.id); glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, TEXSIZE, TEXSIZE, 0, GL_RGBA, GL_UNSIGNED_BYTE, Pixels(x,y)); end else if tex <> nil then begin FreeTexture(tex); tex:= nil end; endend;procedure DrawLand(dX, dY: LongInt);var x, y: LongInt;beginRealLandTexUpdate;for x:= 0 to LANDTEXARW -1 do for y:= 0 to LANDTEXARH - 1 do with LandTextures[x, y] do if tex <> nil then if (cReducedQuality and rqBlurryLand) = 0 then DrawTexture(dX + x * TEXSIZE, dY + y * TEXSIZE, tex) else DrawTexture(dX + x * TEXSIZE * 2, dY + y * TEXSIZE * 2, tex, 2.0)end;procedure SetLandTexture;begin if (cReducedQuality and rqBlurryLand) = 0 then begin LANDTEXARW:= LAND_WIDTH div TEXSIZE; LANDTEXARH:= LAND_HEIGHT div TEXSIZE; end else begin LANDTEXARW:= (LAND_WIDTH div TEXSIZE) div 2; LANDTEXARH:= (LAND_HEIGHT div TEXSIZE) div 2; end; SetLength(LandTextures, LANDTEXARW, LANDTEXARH);end;procedure initModule;beginend;procedure ResetLand;var x, y: LongInt;begin for x:= 0 to LANDTEXARW - 1 do for y:= 0 to LANDTEXARH - 1 do with LandTextures[x, y] do begin if tex <> nil then begin FreeTexture(tex); tex:= nil end end;end;procedure freeModule;begin ResetLand; if LandBackSurface <> nil then SDL_FreeSurface(LandBackSurface); LandBackSurface:= nil; SetLength(LandTextures, 0, 0);end;end.