diff options
-rw-r--r-- | Game.hs | 8 | ||||
-rw-r--r-- | HTanks.hs | 3 | ||||
-rw-r--r-- | Render.hs | 32 | ||||
-rw-r--r-- | Texture.hs | 9 |
4 files changed, 44 insertions, 8 deletions
@@ -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) @@ -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 @@ -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 |