summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Game.hs8
-rw-r--r--HTanks.hs3
-rw-r--r--Render.hs32
-rw-r--r--Texture.hs9
4 files changed, 44 insertions, 8 deletions
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