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
author: Matthias Schiffer
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
data-files: tex/*.png
data-files: tex/*.png model/*.obj
executable: HTanks
hs-source-dirs: src
main-is: HTanks.hs
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
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 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

2
src/MainLoop.hs
View file

@ -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
}

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)

72
src/Render.hs
View file

@ -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