hedgewars/uLandTexture.pas
changeset 1807 795f97007833
parent 1806 3c4f0886c123
child 1808 2fc248766d57
--- 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.