Split land texture into small ones:
authorunc0rr
Wed, 18 Feb 2009 16:46:27 +0000
changeset 1807 795f97007833
parent 1806 3c4f0886c123
child 1808 2fc248766d57
Split land texture into small ones: - Better update texture performance - Support for old videocards
hedgewars/hwengine.dpr
hedgewars/uLand.pas
hedgewars/uLandGraphics.pas
hedgewars/uLandTexture.pas
hedgewars/uWorld.pas
--- a/hedgewars/hwengine.dpr	Wed Feb 18 16:35:03 2009 +0000
+++ b/hedgewars/hwengine.dpr	Wed Feb 18 16:46:27 2009 +0000
@@ -51,7 +51,8 @@
 	uSHA in 'uSHA.pas',
 	uFloat in 'uFloat.pas',
 	uStats in 'uStats.pas',
-	uChat in 'uChat.pas';
+	uChat in 'uChat.pas',
+	uLandTexture;
 
 {$INCLUDE options.inc}
 
@@ -126,6 +127,7 @@
 {$IFDEF DEBUGFILE}AddFileLog('Freeing resources...');{$ENDIF}
 if isSoundEnabled then ReleaseSound;
 StoreRelease;
+FreeLand;
 SendKB;
 CloseIPC;
 TTF_Quit;
--- a/hedgewars/uLand.pas	Wed Feb 18 16:35:03 2009 +0000
+++ b/hedgewars/uLand.pas	Wed Feb 18 16:46:27 2009 +0000
@@ -758,7 +758,7 @@
 
 if ((GameFlags and gfForts) = 0) and (Pathz[ptMapCurrent] = '') then AddObjects;
 
-UpdateLandTexture(0, LAND_HEIGHT);
+UpdateLandTexture(0, LAND_WIDTH, 0, LAND_HEIGHT);
 end;
 
 function GenPreview: TPreview;
--- a/hedgewars/uLandGraphics.pas	Wed Feb 18 16:35:03 2009 +0000
+++ b/hedgewars/uLandGraphics.pas	Wed Feb 18 16:46:27 2009 +0000
@@ -189,7 +189,7 @@
 end;
 
 procedure DrawExplosion(X, Y, Radius: LongInt);
-var dx, dy, d: LongInt;
+var dx, dy, ty, tx, d: LongInt;
 begin
 FillRoundInLand(X, Y, Radius, 0);
 
@@ -225,9 +225,11 @@
      end;
   if (dx = dy) then FillLandCircleLinesEBC(x, y, dx, dy);
 
-d:= max(Y - Radius - 1, 0);
-dy:= min(Y + Radius + 1, LAND_HEIGHT) - d;
-UpdateLandTexture(d, dy)
+tx:= max(X - Radius - 1, 0);
+dx:= min(X + Radius + 1, LAND_WIDTH) - tx;
+ty:= max(Y - Radius - 1, 0);
+dy:= min(Y + Radius + 1, LAND_HEIGHT) - ty;
+UpdateLandTexture(tx, dx, ty, dy)
 end;
 
 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
@@ -258,7 +260,7 @@
     end;
 
 
-UpdateLandTexture(0, LAND_HEIGHT)
+UpdateLandTexture(0, LAND_WIDTH, 0, LAND_HEIGHT)
 end;
 
 //
@@ -266,7 +268,7 @@
 //
 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
 var nx, ny, dX8, dY8: hwFloat;
-    i, t, tx, ty, stY: Longint;
+    i, t, tx, ty, stY, ddy: Longint;
 begin  // (-dY, dX) is (dX, dY) rotated by PI/2
 stY:= hwRound(Y);
 
@@ -322,9 +324,9 @@
     ny:= ny + dX;
     end;
 
-t:= max(stY - HalfWidth * 2 - 4 - abs(hwRound(dY * ticks)), 0);
-ty:= min(stY + HalfWidth * 2 + 4 + abs(hwRound(dY * ticks)), LAND_HEIGHT) - t;
-UpdateLandTexture(t, ty)
+ty:= max(stY - HalfWidth * 2 - 4 - abs(hwRound(dY * ticks)), 0);
+ddy:= min(stY + HalfWidth * 2 + 4 + abs(hwRound(dY * ticks)), LAND_HEIGHT) - t;
+UpdateLandTexture(0, LAND_WIDTH, ty, ddy)
 end;
 
 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean): boolean;
@@ -388,9 +390,11 @@
 if SDL_MustLock(Image) then
    SDL_UnlockSurface(Image);
 
+x:= max(cpX, leftX);
+w:= min(cpX + Image^.w, LAND_WIDTH) - x;
 y:= max(cpY, topY);
 h:= min(cpY + Image^.h, LAND_HEIGHT) - y;
-UpdateLandTexture(y, h)
+UpdateLandTexture(x, w, y, h)
 end;
 
 // was experimenting with applying as damage occurred.
@@ -450,7 +454,7 @@
 	
 	if updatedRow then
 		begin
-		UpdateLandTexture(y * 32, 32);
+		UpdateLandTexture(x * 32, 32, y * 32, 32);
 		Result:= true
 		end
 	end;
--- a/hedgewars/uLandTexture.pas	Wed Feb 18 16:35:03 2009 +0000
+++ b/hedgewars/uLandTexture.pas	Wed Feb 18 16:46:27 2009 +0000
@@ -18,50 +18,87 @@
 
 unit uLandTexture;
 interface
-uses SDLh, uLandTemplates, uFloat, GL, uConsts;
+uses SDLh;
 
-procedure UpdateLandTexture(Y, Height: LongInt);
-procedure DrawLand (X, Y: LongInt);
+procedure UpdateLandTexture(X, Width, Y, Height: LongInt);
+procedure DrawLand(dX, dY: LongInt);
+procedure FreeLand;
 
 implementation
-uses uMisc, uLand, uStore;
+uses uMisc, uLand, uStore, GL, uConsts;
+
+const TEXSIZE = 256;
+	LANDTEXARW = LAND_WIDTH div TEXSIZE;
+	LANDTEXARH = LAND_HEIGHT div TEXSIZE;
 
-var LandTexture: PTexture = nil;
-    updTopY: LongInt = LAND_HEIGHT;
-    updBottomY: LongInt = 0;
+var
+	LandTextures: array[0..LANDTEXARW - 1, 0..LANDTEXARH - 1] of
+			record
+			shouldUpdate: boolean;
+			tex: PTexture;
+			end;
+
+	tmpPixels: array [0..TEXSIZE - 1, 0..TEXSIZE - 1] of LongWord;
 
-
-procedure UpdateLandTexture(Y, Height: LongInt);
+function Pixels(x, y: Longword): Pointer;
+var ty: Longword;
 begin
-if (Height <= 0) then exit;
+for ty:= 0 to TEXSIZE - 1 do
+	Move(LandPixels[y * TEXSIZE + ty, x * TEXSIZE], tmpPixels[ty, 0], sizeof(Longword) * TEXSIZE);
+	
+Pixels:= @tmpPixels
+end;
 
+procedure UpdateLandTexture(X, Width, Y, Height: LongInt);
+var tx, ty: Longword;
+begin
+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 Y < updTopY then updTopY:= Y;
-if Y + Height > updBottomY then updBottomY:= Y + Height
+for ty:= Y div TEXSIZE to (Y + Height - 1) div TEXSIZE do
+	for tx:= X div TEXSIZE to (X + Width - 1) div TEXSIZE do
+		LandTextures[tx, ty].shouldUpdate:= true
 end;
 
 procedure RealLandTexUpdate;
+var x, y: LongWord;
 begin
-if updBottomY = 0 then exit;
-
-if LandTexture = nil then
-	LandTexture:= NewTexture(LAND_WIDTH, LAND_HEIGHT, @LandPixels)
+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
+				tex:= NewTexture(TEXSIZE, TEXSIZE, Pixels(x, y))
 else
-	begin
-	glBindTexture(GL_TEXTURE_2D, LandTexture^.id);
-	glTexSubImage2D(GL_TEXTURE_2D, 0, 0, updTopY, LAND_WIDTH, updBottomY - updTopY, GL_RGBA, GL_UNSIGNED_BYTE, @LandPixels[updTopY, 0]);
-	end;
-
-updTopY:= LAND_HEIGHT + 1;
-updBottomY:= 0
+	for x:= 0 to LANDTEXARW -1 do
+		for y:= 0 to LANDTEXARH - 1 do
+			with LandTextures[x, y] do
+				if shouldUpdate then
+					begin
+					glBindTexture(GL_TEXTURE_2D, tex^.id);
+					glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, TEXSIZE, TEXSIZE, GL_RGBA, GL_UNSIGNED_BYTE, Pixels(x, y));
+					end
 end;
 
-procedure DrawLand(X, Y: LongInt);
+procedure DrawLand(dX, dY: LongInt);
+var x, y: LongInt;
 begin
 RealLandTexUpdate;
-DrawTexture(X, Y, LandTexture)
+
+for x:= 0 to LANDTEXARW -1 do
+	for y:= 0 to LANDTEXARH - 1 do
+		with LandTextures[x, y] do
+			DrawTexture(dX + x * TEXSIZE, dY + y * TEXSIZE, tex)
+end;
+
+procedure FreeLand;
+var x, y: LongInt;
+begin
+for x:= 0 to LANDTEXARW -1 do
+	for y:= 0 to LANDTEXARH - 1 do
+		with LandTextures[x, y] do
+			FreeTexture(tex)
 end;
 
 end.
--- a/hedgewars/uWorld.pas	Wed Feb 18 16:35:03 2009 +0000
+++ b/hedgewars/uWorld.pas	Wed Feb 18 16:46:27 2009 +0000
@@ -41,7 +41,7 @@
 implementation
 uses uStore, uMisc, uTeams, uIO, uConsole, uKeys, uLocale, uSound, GL,
      uAmmos, uVisualGears, uChat, uLandTexture;
-     
+
 const FPS: Longword = 0;
       CountTicks: Longword = 0;
       SoundTimerTicks: Longword = 0;