--- a/hedgewars/CMakeLists.txt Wed Feb 18 16:28:21 2009 +0000
+++ b/hedgewars/CMakeLists.txt Wed Feb 18 16:35:03 2009 +0000
@@ -25,6 +25,7 @@
uLandGraphics.pas
uLandObjects.pas
uLandTemplates.pas
+ uLandTexture.pas
uLocale.pas
uMisc.pas
uRandom.pas
--- a/hedgewars/uLand.pas Wed Feb 18 16:28:21 2009 +0000
+++ b/hedgewars/uLand.pas Wed Feb 18 16:35:03 2009 +0000
@@ -26,7 +26,6 @@
var Land: TLandArray;
LandPixels: TLandArray;
- LandTexture: PTexture = nil;
LandDirty: TDirtyTag;
hasBorder: boolean; // I'm putting this here for now. I'd like it to be toggleable by user (so user can set a border on a non-cave map) - will turn off air attacks
hasGirders: boolean; // I think should be on template by template basis. some caverns might have open water and large spaces. Some islands don't need? It might be better to tweak the girder code based upon space above. dunno.
@@ -37,20 +36,15 @@
procedure GenMap;
function GenPreview: TPreview;
procedure CheckLandDigest(s: shortstring);
-procedure UpdateLandTexture(Y, Height: LongInt);
-procedure DrawLand (X, Y: LongInt);
implementation
-uses uConsole, uStore, uMisc, uRandom, uTeams, uLandObjects, uSHA, uIO, uAmmos;
+uses uConsole, uStore, uMisc, uRandom, uTeams, uLandObjects, uSHA, uIO, uAmmos, uLandTexture;
type TPixAr = record
Count: Longword;
ar: array[0..Pred(cMaxEdgePoints)] of TPoint;
end;
-var updTopY: LongInt = LAND_HEIGHT;
- updBottomY: LongInt = 0;
-
procedure LogLandDigest;
var ctx: TSHA1Context;
dig: TSHA1Digest;
@@ -790,39 +784,6 @@
GenPreview:= Preview
end;
-procedure UpdateLandTexture(Y, Height: LongInt);
-begin
-if (Height <= 0) then exit;
-
-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
-end;
-
-procedure RealLandTexUpdate;
-begin
-if updBottomY = 0 then exit;
-
-if LandTexture = nil then
- LandTexture:= NewTexture(LAND_WIDTH, LAND_HEIGHT, @LandPixels)
-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
-end;
-
-procedure DrawLand(X, Y: LongInt);
-begin
-RealLandTexUpdate;
-DrawTexture(X, Y, LandTexture)
-end;
-
initialization
end.
--- a/hedgewars/uLandGraphics.pas Wed Feb 18 16:28:21 2009 +0000
+++ b/hedgewars/uLandGraphics.pas Wed Feb 18 16:35:03 2009 +0000
@@ -37,7 +37,7 @@
function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean): boolean;
implementation
-uses SDLh, uMisc, uLand;
+uses SDLh, uMisc, uLand, uLandTexture;
procedure FillCircleLines(x, y, dx, dy: LongInt; Value: Longword);
var i: LongInt;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uLandTexture.pas Wed Feb 18 16:35:03 2009 +0000
@@ -0,0 +1,67 @@
+(*
+ * Hedgewars, a free turn based strategy game
+ * Copyright (c) 2009 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
+ *)
+
+unit uLandTexture;
+interface
+uses SDLh, uLandTemplates, uFloat, GL, uConsts;
+
+procedure UpdateLandTexture(Y, Height: LongInt);
+procedure DrawLand (X, Y: LongInt);
+
+implementation
+uses uMisc, uLand, uStore;
+
+var LandTexture: PTexture = nil;
+ updTopY: LongInt = LAND_HEIGHT;
+ updBottomY: LongInt = 0;
+
+
+procedure UpdateLandTexture(Y, Height: LongInt);
+begin
+if (Height <= 0) then exit;
+
+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
+end;
+
+procedure RealLandTexUpdate;
+begin
+if updBottomY = 0 then exit;
+
+if LandTexture = nil then
+ LandTexture:= NewTexture(LAND_WIDTH, LAND_HEIGHT, @LandPixels)
+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
+end;
+
+procedure DrawLand(X, Y: LongInt);
+begin
+RealLandTexUpdate;
+DrawTexture(X, Y, LandTexture)
+end;
+
+end.
--- a/hedgewars/uStore.pas Wed Feb 18 16:28:21 2009 +0000
+++ b/hedgewars/uStore.pas Wed Feb 18 16:35:03 2009 +0000
@@ -567,8 +567,7 @@
if SpritesData[ii].Surface <> nil then SDL_FreeSurface(SpritesData[ii].Surface)
end;
-FreeTexture(HHTexture);
-FreeTexture(LandTexture)
+FreeTexture(HHTexture)
end;
function RenderStringTex(s: string; Color: Longword; font: THWFont): PTexture;
--- a/hedgewars/uWorld.pas Wed Feb 18 16:28:21 2009 +0000
+++ b/hedgewars/uWorld.pas Wed Feb 18 16:35:03 2009 +0000
@@ -40,7 +40,7 @@
implementation
uses uStore, uMisc, uTeams, uIO, uConsole, uKeys, uLocale, uSound, GL,
- uAmmos, uVisualGears, uChat, uLand;
+ uAmmos, uVisualGears, uChat, uLandTexture;
const FPS: Longword = 0;
CountTicks: Longword = 0;