Added 3D models
This commit is contained in:
Matthias Schiffer
parent
4ecea2f9dc
commit
a4f2d991da
7 changed files with 2062 additions and 18 deletions
|
|
@ -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
|
||||
|
|
|
|||
Reference in a new issue