Cache textures in game state

This commit is contained in:
Matthias Schiffer 2010-02-25 03:16:44 +01:00
parent b4c3367c63
commit c23e63e667
4 changed files with 44 additions and 8 deletions

View file

@ -7,17 +7,19 @@ module Game ( GameState(..)
import Level import Level
import Tank import Tank
import Texture
import Control.Monad import Control.Monad
import Control.Monad.State import Control.Monad.State
import qualified Data.Map as M
data GameState = GameState data GameState = GameState
{ level :: !Level { level :: !Level
, tanks :: ![Tank] , tanks :: ![Tank]
, textures :: !(M.Map Texture TextureObject)
} deriving (Show) } deriving (Show)
newtype Game a = Game (StateT GameState IO a) newtype Game a = Game (StateT GameState IO a)
deriving (Monad, MonadIO, MonadState GameState) deriving (Monad, MonadIO, MonadState GameState)

View file

@ -11,6 +11,7 @@ import GLX
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import Control.Monad.State import Control.Monad.State
import Data.Maybe import Data.Maybe
import qualified Data.Map as M
import Data.Ratio import Data.Ratio
import qualified Data.Set as S import qualified Data.Set as S
import Data.Time.Clock import Data.Time.Clock
@ -39,7 +40,7 @@ main = do
when (initialized gl) $ do when (initialized gl) $ do
currentTime <- getCurrentTime currentTime <- getCurrentTime
let mainState = MainState {run = True, driver = SomeDriver gl, time = currentTime, keyset = S.empty} 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 runGame gameState $ do
setup 800 600 setup 800 600

View file

@ -7,28 +7,52 @@ module Render ( setup
import Game import Game
import Level import Level
import Tank import Tank
import Texture
import Bindings.GLPng
import Control.Monad.State import Control.Monad.State
import Data.Fixed import Data.Fixed
import Data.Maybe
import Data.Ratio import Data.Ratio
import qualified Data.Map as M
import Bindings.GLPng
import Graphics.Rendering.OpenGL.GL (($=), GLfloat, GLdouble) import Graphics.Rendering.OpenGL.GL (($=), GLfloat, GLdouble)
import Graphics.Rendering.OpenGL.GL.BeginEnd (renderPrimitive, PrimitiveMode(..)) 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.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho)
import Graphics.Rendering.OpenGL.GL.Framebuffer (clear, ClearBuffer(..)) 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.Texturing.Parameters (Repetition(..), Clamping(..), TextureFilter(..), MinificationFilter, MagnificationFilter)
import Graphics.Rendering.OpenGL.GL.VertexSpec 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 :: Int -> Int -> Game ()
setup w h = do setup w h = do
resize w h 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 :: Int -> Int -> Game ()
resize w h = do resize w h = do

9
Texture.hs Normal file
View file

@ -0,0 +1,9 @@
module Texture ( Texture(..)
, TextureObject
) where
import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject)
data Texture = TextureWood
deriving (Eq, Ord, Show)