Added 3D models

4 files changed, 79 insertions, 15 deletions

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