Cache textures in game state

4 files changed, 44 insertions, 8 deletions

diff --git a/Game.hs b/Game.hs
index ef760d7..9097bca 100644
--- a/Game.hs
+++ b/Game.hs
@@ -7,17 +7,19 @@ module Game ( GameState(..)
 
 import Level
 import Tank
+import Texture
 
 import Control.Monad
 import Control.Monad.State
+import qualified Data.Map as M
 
 
 data GameState = GameState
-    { level   :: !Level
-    , tanks   :: ![Tank]
+    { level    :: !Level
+    , tanks    :: ![Tank]
+    , textures :: !(M.Map Texture TextureObject)
     } deriving (Show)
 
-
 newtype Game a = Game (StateT GameState IO a)
     deriving (Monad, MonadIO, MonadState GameState)
 
diff --git a/HTanks.hs b/HTanks.hs
index 27b5755..d0dab4a 100644
--- a/HTanks.hs
+++ b/HTanks.hs
@@ -11,6 +11,7 @@ import GLX
 import Control.Concurrent (threadDelay)
 import Control.Monad.State
 import Data.Maybe
+import qualified Data.Map as M
 import Data.Ratio
 import qualified Data.Set as S
 import Data.Time.Clock
@@ -39,7 +40,7 @@ main = do
   when (initialized gl) $ do
          currentTime <- getCurrentTime
          let mainState = MainState {run = True, driver = SomeDriver gl, time = currentTime, keyset = S.empty}
-             gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0 0 2]}
+             gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0 0 2], textures = M.empty}
          
          runGame gameState $ do
                             setup 800 600
diff --git a/Render.hs b/Render.hs
index a38e462..cee9e6c 100644
--- a/Render.hs
+++ b/Render.hs
@@ -7,28 +7,52 @@ module Render ( setup
 import Game
 import Level
 import Tank
-
-import Bindings.GLPng
+import Texture
 
 import Control.Monad.State
 
 import Data.Fixed
+import Data.Maybe
 import Data.Ratio
+import qualified Data.Map as M
+
+import Bindings.GLPng
 
 import Graphics.Rendering.OpenGL.GL (($=), GLfloat, GLdouble)
 import Graphics.Rendering.OpenGL.GL.BeginEnd (renderPrimitive, PrimitiveMode(..))
 import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho)
 import Graphics.Rendering.OpenGL.GL.Framebuffer (clear, ClearBuffer(..))
+import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject(..))
 import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (Repetition(..), Clamping(..), TextureFilter(..), MinificationFilter, MagnificationFilter)
 import Graphics.Rendering.OpenGL.GL.VertexSpec
 
 
+texturePath :: Texture -> String
+texturePath t
+    | t == TextureWood = "tex/Wood.png"
+
+getTexture :: Texture -> Game TextureObject
+getTexture t = do
+  ts <- gets textures
+  let tobj = M.lookup t ts
+  
+  if (isJust tobj)
+      then
+          return $ fromJust tobj
+      else do
+          tex <- liftIO $ pngBind (texturePath t) NoMipmap Solid (Repeated, Repeat) (Linear', Nothing) Linear' >>= return . TextureObject . fromIntegral . fst
+          modify $ \state -> state {textures = M.insert t tex ts}
+          return tex
+                                               
+
 setup :: Int -> Int -> Game ()
 setup w h = do
   resize w h
-  (tex, info) <- liftIO $ pngBind "tex/Wood.png" NoMipmap Solid (Repeated, Repeat) (Linear', Nothing) Linear'
-  liftIO $ print info
   
+  -- cache textures
+  getTexture TextureWood
+  
+  return ()
 
 resize :: Int -> Int -> Game ()
 resize w h = do
diff --git a/Texture.hs b/Texture.hs
new file mode 100644
index 0000000..083d9ac
--- /dev/null
+++ b/Texture.hs
@@ -0,0 +1,9 @@
+module Texture ( Texture(..)
+               , TextureObject
+               ) where
+
+import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject)
+
+data Texture = TextureWood
+             deriving (Eq, Ord, Show)
+  
\ No newline at end of file