(* * Hedgewars, a free turn based strategy game * Copyright (c) 2004-2015 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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 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, uUtils;const TEXSIZE = 128; // in avoid tile borders stretch the blurry texture by 1 pixel more BLURRYLANDOVERLAP: real = 1 / TEXSIZE / 2.0; // 1 pixel divided by texsize and blurry land scale factortype 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; tSize : LongInt;begin if cOnlyStats then exit; if (Width <= 0) or (Height <= 0) then exit; checkFails((X >= 0) and (X < LAND_WIDTH), 'UpdateLandTexture: wrong X parameter', true); checkFails(X + Width <= LAND_WIDTH, 'UpdateLandTexture: wrong Width parameter', true); checkFails((Y >= 0) and (Y < LAND_HEIGHT), 'UpdateLandTexture: wrong Y parameter', true); checkFails(Y + Height <= LAND_HEIGHT, 'UpdateLandTexture: wrong Height parameter', true); if not allOK then exit; tSize:= TEXSIZE; // land textures have half the size/resolution in blurry mode if (cReducedQuality and rqBlurryLand) <> 0 then tSize:= tSize * 2; for ty:= Y div tSize to (Y + Height - 1) div tSize do for tx:= X div tSize to (X + Width - 1) div tSize do begin if not LandTextures[tx, ty].shouldUpdate then begin LandTextures[tx, ty].shouldUpdate:= true; inc(dirtyLandTexCount); end; LandTextures[tx, ty].landAdded:= landAdded end;end;procedure RealLandTexUpdate(x1, x2, y1, y2: LongInt);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:= x1 to x2 do for y:= y1 to y2 do with LandTextures[x, y] do if shouldUpdate then begin shouldUpdate:= false; dec(dirtyLandTexCount); 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, Pred(lx + TEXSIZE)] 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[Pred(ly + TEXSIZE), 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 FreeAndNilTexture(tex); // nothing else to do if dirtyLandTexCount < 1 then exit; endend;procedure DrawLand(dX, dY: LongInt);var x, y, tX, ty, tSize, fx, lx, fy, ly: LongInt; tScale: GLfloat; overlap: boolean;begin// init values based on quality settingsif (cReducedQuality and rqBlurryLand) <> 0 then begin tSize:= TEXSIZE * 2; tScale:= 2.0; overlap:= (cReducedQuality and rqClampLess) <> 0; endelse begin tSize:= TEXSIZE; tScale:= 1.0; overlap:= false; end;// figure out visible area// first columntx:= ViewLeftX - dx;fx:= tx div tSize;if tx < 0 then dec(fx);fx:= max(0, fx);// last columntx:= ViewRightX - dx;lx:= tx div tSize;if tx < 0 then dec(lx);lx:= min(LANDTEXARW -1, lx);// all offscreenif (fx > lx) then exit;// first rowty:= ViewTopY - dy;fy:= ty div tSize;if ty < 0 then dec(fy);fy:= max(0, fy);// last rowty:= ViewBottomY - dy;ly:= ty div tSize;if ty < 0 then dec(ly);ly:= min(LANDTEXARH -1, ly);// all offscreenif (fy > ly) then exit;// update visible areas of landtex before drawingif dirtyLandTexCount > 0 then RealLandTexUpdate(fx, lx, fy, ly);tX:= dX + tsize * fx;// loop through columnsfor x:= fx to lx do begin // loop through textures in this column for y:= fy to ly do with LandTextures[x, y] do if tex <> nil then begin ty:= dY + y * tSize; if overlap then DrawTexture2(tX, ty, tex, tScale, BLURRYLANDOVERLAP) else DrawTexture(tX, ty, tex, tScale); end; // increment tX inc(tX, tSize); end;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 FreeAndNilTexture(tex);end;procedure freeModule;begin ResetLand; if LandBackSurface <> nil then SDL_FreeSurface(LandBackSurface); LandBackSurface:= nil; SetLength(LandTextures, 0, 0);end;end.