From c23e63e66786410f53b9460a6456b7c893d2a234 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Thu, 25 Feb 2010 03:16:44 +0100 Subject: Cache textures in game state --- Game.hs | 8 +++++--- HTanks.hs | 3 ++- Render.hs | 32 ++++++++++++++++++++++++++++---- Texture.hs | 9 +++++++++ 4 files changed, 44 insertions(+), 8 deletions(-) create mode 100644 Texture.hs 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 -- cgit v1.2.3