Cache textures in game state
This commit is contained in:
parent
b4c3367c63
commit
c23e63e667
4 changed files with 44 additions and 8 deletions
4
Game.hs
4
Game.hs
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
32
Render.hs
32
Render.hs
|
@ -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
9
Texture.hs
Normal 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)
|
||||||
|
|
Reference in a new issue