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 Tank
import Texture
import Control.Monad
import Control.Monad.State
import qualified Data.Map as M
data GameState = GameState
{ level :: !Level
, tanks :: ![Tank]
, textures :: !(M.Map Texture TextureObject)
} deriving (Show)
newtype Game a = Game (StateT GameState IO a)
deriving (Monad, MonadIO, MonadState GameState)

View file

@ -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

View file

@ -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

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)