From a4f2d991dacfb539a26e71002b6f244c44753b72 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Mon, 12 Apr 2010 02:47:09 +0200 Subject: Added 3D models --- src/HTanks.hs | 12 +++++----- src/MainLoop.hs | 2 ++ src/Model.hs | 8 +++++++ src/Render.hs | 72 +++++++++++++++++++++++++++++++++++++++++++++++++-------- 4 files changed, 79 insertions(+), 15 deletions(-) create mode 100644 src/Model.hs (limited to 'src') diff --git a/src/HTanks.hs b/src/HTanks.hs index 5a8bdec..c9525b9 100644 --- a/src/HTanks.hs +++ b/src/HTanks.hs @@ -14,20 +14,20 @@ import Tank import GLDriver import GLX -import Control.Concurrent (threadDelay) import Control.Monad.State import Data.Maybe import qualified Data.Map as M import qualified Data.Set as S import Data.Time -import Foreign.C.Types +import Data.Obj3D +import Data.Obj3D.GL main :: IO () main = do let theLevel = testLevel - hwiidPlayer <- newHWiidPlayer + --hwiidPlayer <- newHWiidPlayer gl <- initGL $ glxDriver (levelWidth theLevel) (levelHeight theLevel) when (initialized gl) $ do @@ -36,10 +36,10 @@ main = do , Tank 5.0 3.5 0 0 1.5 270 False 3 1 5 1 ], bullets = []} mainstate = MainState {run = True, driver = SomeDriver gl, time = currentTime, players = - [ --SomePlayer $ DefaultPlayer S.empty 0 0 False - SomePlayer $ hwiidPlayer + [ SomePlayer $ DefaultPlayer S.empty 0 0 False + --SomePlayer $ hwiidPlayer , SomePlayer $ CPUPlayer 0 - ], textures = M.empty, gameState = gamestate} + ], textures = M.empty, models = M.empty, gameState = gamestate} runMain mainstate $ do setup diff --git a/src/MainLoop.hs b/src/MainLoop.hs index a484435..de28499 100644 --- a/src/MainLoop.hs +++ b/src/MainLoop.hs @@ -9,6 +9,7 @@ import Game import GLDriver import Player import Texture +import Model import Control.Monad.State import Control.Monad.Trans @@ -22,6 +23,7 @@ data MainState = MainState , time :: !UTCTime , players :: ![SomePlayer] , textures :: !(M.Map Texture TextureObject) + , models :: !(M.Map Model InterleavedObj) , gameState :: !GameState } diff --git a/src/Model.hs b/src/Model.hs new file mode 100644 index 0000000..daec0c2 --- /dev/null +++ b/src/Model.hs @@ -0,0 +1,8 @@ +module Model ( Model(..) + , InterleavedObj + ) where + +import Data.Obj3D.GL (InterleavedObj) + +data Model = ModelTank + deriving (Eq, Ord, Show) diff --git a/src/Render.hs b/src/Render.hs index c00a476..bf3bb39 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -10,11 +10,14 @@ import Level import Player import Tank import Texture +import Model import Control.Monad.State import Data.Fixed import Data.Maybe +import Data.Obj3D +import Data.Obj3D.GL import Data.Ratio import qualified Data.Map as M @@ -22,15 +25,19 @@ import Bindings.GLPng import Graphics.Rendering.OpenGL.GL (($=), GLfloat, GLdouble, Capability(..), Vector3(..)) import Graphics.Rendering.OpenGL.GL.BeginEnd (unsafeRenderPrimitive, PrimitiveMode(..)) -import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, unsafePreservingMatrix, ortho, translate, rotate) +import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, unsafePreservingMatrix, ortho, translate, rotate, scale) import Graphics.Rendering.OpenGL.GL.Framebuffer (clear, ClearBuffer(..)) import Graphics.Rendering.OpenGL.GL.PerFragment (blend, blendFunc, BlendingFactor(..)) import Graphics.Rendering.OpenGL.GL.Texturing.Application (texture) import Graphics.Rendering.OpenGL.GL.Texturing.Objects (textureBinding, TextureObject(..)) import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (Repetition(..), Clamping(..), TextureFilter(..), MinificationFilter, MagnificationFilter) import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureTarget(..)) +import Graphics.Rendering.OpenGL.GL.VertexArrays (clientState, ClientArrayType(..)) import Graphics.Rendering.OpenGL.GL.VertexSpec +import Foreign.ForeignPtr +import Foreign.Marshal.Array + texturePath :: Texture -> IO FilePath texturePath t = getDataFileName $ path t @@ -54,6 +61,29 @@ getTexture t = do tex <- liftIO $ pngBind path BuildMipmap Alpha (Repeated, Repeat) (Linear', Just Linear') Linear' >>= return . TextureObject . fromIntegral . fst modify $ \state -> state {textures = M.insert t tex ts} return tex + +modelPath :: Model -> IO FilePath +modelPath t = getDataFileName $ path t + where + path ModelTank = "model/tank.obj" + +getModel :: Model -> Main InterleavedObj +getModel m = do + ms <- gets models + let mobj = M.lookup m ms + + if (isJust mobj) + then + return $ fromJust mobj + else do + path <- liftIO $ modelPath m + objmod <- liftIO $ loadObjFile path + + model <- case objmod of + Left error -> fail $ show error + Right obj -> liftIO $ makeInterleavedArrays obj + modify $ \state -> state {models = M.insert m model ms} + return model setup :: Main () @@ -62,13 +92,15 @@ setup = do blend $= Enabled blendFunc $= (SrcAlpha, OneMinusSrcAlpha) - -- cache textures + -- cache textures & models getTexture TextureWood getTexture TextureTank getTexture TextureCannon getTexture TextureBullet getTexture TextureCrosshair + getModel ModelTank + return () @@ -84,6 +116,8 @@ render = do textureBullet <- getTexture TextureBullet textureCrosshair <- getTexture TextureCrosshair + modelTank <- getModel ModelTank + (lw, lh) <- gets (level . gameState) >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat) liftIO $ do @@ -104,7 +138,14 @@ render = do texCoord $ TexCoord2 0 (lh/2) vertex $ Vertex2 (0 :: GLfloat) (0 :: GLfloat) - + + texture Texture2D $= Disabled + + clientState VertexArray $= Enabled + clientState NormalArray $= Enabled + clientState TextureCoordArray $= Enabled + bindInterleavedArrays modelTank + forM_ tanklist $ \tank -> unsafePreservingMatrix $ do let x = realToFrac . tankX $ tank y = realToFrac . tankY $ tank @@ -112,11 +153,16 @@ render = do rotAim = realToFrac . tankAim $ tank translate $ Vector3 x y (0 :: GLfloat) + scale 0.1 0.1 (0.1 :: GLfloat) rotate rotDir $ Vector3 0 0 (1 :: GLfloat) - textureBinding Texture2D $= Just textureTank + --textureBinding Texture2D $= Just textureTank - unsafeRenderPrimitive Quads $ do + unsafePreservingMatrix $ do + rotate 90 $ Vector3 1 0 (0 :: GLfloat) + drawObject modelTank 1 + + {-unsafeRenderPrimitive Quads $ do texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat) vertex $ Vertex2 (-0.5 :: GLfloat) (-0.5 :: GLfloat) @@ -127,13 +173,19 @@ render = do vertex $ Vertex2 (0.5 :: GLfloat) (0.5 :: GLfloat) texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat) - vertex $ Vertex2 (0.5 :: GLfloat) (-0.5 :: GLfloat) + vertex $ Vertex2 (0.5 :: GLfloat) (-0.5 :: GLfloat)-} rotate (rotAim-rotDir) $ Vector3 0 0 (1 :: GLfloat) - textureBinding Texture2D $= Just textureCannon + --textureBinding Texture2D $= Just textureCannon - unsafeRenderPrimitive Quads $ do + unsafePreservingMatrix $ do + rotate 90 $ Vector3 1 0 (0 :: GLfloat) + drawObject modelTank 0 + + + + {-unsafeRenderPrimitive Quads $ do texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat) vertex $ Vertex2 (-0.5 :: GLfloat) (-0.5 :: GLfloat) @@ -144,7 +196,9 @@ render = do vertex $ Vertex2 (0.5 :: GLfloat) (0.5 :: GLfloat) texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat) - vertex $ Vertex2 (0.5 :: GLfloat) (-0.5 :: GLfloat) + vertex $ Vertex2 (0.5 :: GLfloat) (-0.5 :: GLfloat)-} + + texture Texture2D $= Enabled forM_ bulletlist $ \bullet -> unsafePreservingMatrix $ do let x = realToFrac . bulletX $ bullet -- cgit v1.2.3