diff -r 3c4f0886c123 -r 795f97007833 hedgewars/uLandTexture.pas --- 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.