neocturne/htanks
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Added 3D models

Browse source
This commit is contained in:
Matthias Schiffer 2010-04-12 02:47:09 +02:00
parent 4ecea2f9dc
commit a4f2d991da
7 changed files with 2062 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
htanks.cabal
View file

@ -7,14 +7,14 @@ license: GPL-3
license-file: LICENSE license-file: LICENSE
author: Matthias Schiffer author: Matthias Schiffer
maintainer: matthias@gamezock.de maintainer: matthias@gamezock.de
build-depends: base >= 4, syb, containers, mtl, time, X11, OpenGL, hwiid build-depends: base >= 4, syb, containers, mtl, time, X11, OpenGL, hwiid, obj-model, obj-model-gl
build-type: Simple build-type: Simple
data-files: tex/*.png data-files: tex/*.png model/*.obj
executable: HTanks executable: HTanks
hs-source-dirs: src hs-source-dirs: src
main-is: HTanks.hs main-is: HTanks.hs
other-modules: Collision, CPUPlayer, DefaultPlayer, HWiidPlayer, Game, GLDriver, GLX, Level, MainLoop, Paths_htanks, Player, Render, Simulation, Texture, Debris, other-modules: Collision, CPUPlayer, DefaultPlayer, HWiidPlayer, Game, GLDriver, GLX, Level, MainLoop, Paths_htanks, Player, Render, Simulation, Texture, Debris,
Tank, Bindings.GLX, Bindings.GLPng Tank, Model, Bindings.GLX, Bindings.GLPng
--ghc-options: -threaded --ghc-options: -threaded
extra-libraries: glpng extra-libraries: glpng

BIN
model/tank.blend Normal file
View file

Binary file not shown.

1980
model/tank.obj Normal file
View file

File diff suppressed because it is too large Load diff

12
src/HTanks.hs
View file

@ -14,20 +14,20 @@ import Tank
import GLDriver import GLDriver
import GLX import GLX
import Control.Concurrent (threadDelay)
import Control.Monad.State import Control.Monad.State
import Data.Maybe import Data.Maybe
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
import Data.Time import Data.Time
import Foreign.C.Types import Data.Obj3D
import Data.Obj3D.GL
main :: IO () main :: IO ()
main = do main = do
let theLevel = testLevel let theLevel = testLevel
hwiidPlayer <- newHWiidPlayer --hwiidPlayer <- newHWiidPlayer
gl <- initGL $ glxDriver (levelWidth theLevel) (levelHeight theLevel) gl <- initGL $ glxDriver (levelWidth theLevel) (levelHeight theLevel)
when (initialized gl) $ do 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 , Tank 5.0 3.5 0 0 1.5 270 False 3 1 5 1
], bullets = []} ], bullets = []}
mainstate = MainState {run = True, driver = SomeDriver gl, time = currentTime, players = mainstate = MainState {run = True, driver = SomeDriver gl, time = currentTime, players =
[ --SomePlayer $ DefaultPlayer S.empty 0 0 False [ SomePlayer $ DefaultPlayer S.empty 0 0 False
SomePlayer $ hwiidPlayer --SomePlayer $ hwiidPlayer
, SomePlayer $ CPUPlayer 0 , SomePlayer $ CPUPlayer 0
], textures = M.empty, gameState = gamestate} ], textures = M.empty, models = M.empty, gameState = gamestate}
runMain mainstate $ do runMain mainstate $ do
setup setup

2
src/MainLoop.hs
View file

@ -9,6 +9,7 @@ import Game
import GLDriver import GLDriver
import Player import Player
import Texture import Texture
import Model
import Control.Monad.State import Control.Monad.State
import Control.Monad.Trans import Control.Monad.Trans
@ -22,6 +23,7 @@ data MainState = MainState
, time :: !UTCTime , time :: !UTCTime
, players :: ![SomePlayer] , players :: ![SomePlayer]
, textures :: !(M.Map Texture TextureObject) , textures :: !(M.Map Texture TextureObject)
, models :: !(M.Map Model InterleavedObj)
, gameState :: !GameState , gameState :: !GameState
} }

8
src/Model.hs Normal file
View file

@ -0,0 +1,8 @@
module Model ( Model(..)
, InterleavedObj
) where
import Data.Obj3D.GL (InterleavedObj)
data Model = ModelTank
deriving (Eq, Ord, Show)

70
src/Render.hs
View file

@ -10,11 +10,14 @@ import Level
import Player import Player
import Tank import Tank
import Texture import Texture
import Model
import Control.Monad.State import Control.Monad.State
import Data.Fixed import Data.Fixed
import Data.Maybe import Data.Maybe
import Data.Obj3D
import Data.Obj3D.GL
import Data.Ratio import Data.Ratio
import qualified Data.Map as M 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 (($=), GLfloat, GLdouble, Capability(..), Vector3(..))
import Graphics.Rendering.OpenGL.GL.BeginEnd (unsafeRenderPrimitive, PrimitiveMode(..)) 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.Framebuffer (clear, ClearBuffer(..))
import Graphics.Rendering.OpenGL.GL.PerFragment (blend, blendFunc, BlendingFactor(..)) import Graphics.Rendering.OpenGL.GL.PerFragment (blend, blendFunc, BlendingFactor(..))
import Graphics.Rendering.OpenGL.GL.Texturing.Application (texture) import Graphics.Rendering.OpenGL.GL.Texturing.Application (texture)
import Graphics.Rendering.OpenGL.GL.Texturing.Objects (textureBinding, TextureObject(..)) 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.Parameters (Repetition(..), Clamping(..), TextureFilter(..), MinificationFilter, MagnificationFilter)
import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureTarget(..)) import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureTarget(..))
import Graphics.Rendering.OpenGL.GL.VertexArrays (clientState, ClientArrayType(..))
import Graphics.Rendering.OpenGL.GL.VertexSpec import Graphics.Rendering.OpenGL.GL.VertexSpec
import Foreign.ForeignPtr
import Foreign.Marshal.Array
texturePath :: Texture -> IO FilePath texturePath :: Texture -> IO FilePath
texturePath t = getDataFileName $ path t texturePath t = getDataFileName $ path t
@ -55,6 +62,29 @@ getTexture t = do
modify $ \state -> state {textures = M.insert t tex ts} modify $ \state -> state {textures = M.insert t tex ts}
return tex 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 () setup :: Main ()
setup = do setup = do
@ -62,13 +92,15 @@ setup = do
blend $= Enabled blend $= Enabled
blendFunc $= (SrcAlpha, OneMinusSrcAlpha) blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
-- cache textures -- cache textures & models
getTexture TextureWood getTexture TextureWood
getTexture TextureTank getTexture TextureTank
getTexture TextureCannon getTexture TextureCannon
getTexture TextureBullet getTexture TextureBullet
getTexture TextureCrosshair getTexture TextureCrosshair
getModel ModelTank
return () return ()
@ -84,6 +116,8 @@ render = do
textureBullet <- getTexture TextureBullet textureBullet <- getTexture TextureBullet
textureCrosshair <- getTexture TextureCrosshair textureCrosshair <- getTexture TextureCrosshair
modelTank <- getModel ModelTank
(lw, lh) <- gets (level . gameState) >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat) (lw, lh) <- gets (level . gameState) >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat)
liftIO $ do liftIO $ do
@ -105,6 +139,13 @@ render = do
texCoord $ TexCoord2 0 (lh/2) texCoord $ TexCoord2 0 (lh/2)
vertex $ Vertex2 (0 :: GLfloat) (0 :: GLfloat) 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 forM_ tanklist $ \tank -> unsafePreservingMatrix $ do
let x = realToFrac . tankX $ tank let x = realToFrac . tankX $ tank
y = realToFrac . tankY $ tank y = realToFrac . tankY $ tank
@ -112,11 +153,16 @@ render = do
rotAim = realToFrac . tankAim $ tank rotAim = realToFrac . tankAim $ tank
translate $ Vector3 x y (0 :: GLfloat) translate $ Vector3 x y (0 :: GLfloat)
scale 0.1 0.1 (0.1 :: GLfloat)
rotate rotDir $ Vector3 0 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) texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat)
vertex $ Vertex2 (-0.5 :: GLfloat) (-0.5 :: GLfloat) vertex $ Vertex2 (-0.5 :: GLfloat) (-0.5 :: GLfloat)
@ -127,13 +173,19 @@ render = do
vertex $ Vertex2 (0.5 :: GLfloat) (0.5 :: GLfloat) vertex $ Vertex2 (0.5 :: GLfloat) (0.5 :: GLfloat)
texCoord $ TexCoord2 (1 :: GLfloat) (0 :: 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) 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) texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat)
vertex $ Vertex2 (-0.5 :: GLfloat) (-0.5 :: GLfloat) vertex $ Vertex2 (-0.5 :: GLfloat) (-0.5 :: GLfloat)
@ -144,7 +196,9 @@ render = do
vertex $ Vertex2 (0.5 :: GLfloat) (0.5 :: GLfloat) vertex $ Vertex2 (0.5 :: GLfloat) (0.5 :: GLfloat)
texCoord $ TexCoord2 (1 :: GLfloat) (0 :: 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 forM_ bulletlist $ \bullet -> unsafePreservingMatrix $ do
let x = realToFrac . bulletX $ bullet let x = realToFrac . bulletX $ bullet