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

Added more models and render with perspective transform now

Browse source
This commit is contained in:
Matthias Schiffer 2010-04-16 03:08:48 +02:00
parent 5951108c0a
commit a19dc0d6aa
10 changed files with 1156 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

9
src/GLX.hs
View file

@ -11,7 +11,7 @@ import Data.Maybe (isJust)
import Data.Ratio
import Graphics.Rendering.OpenGL.GL (($=), GLdouble, GLfloat, Vector3(..), Capability(..))
import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho, translate, scale, rotate)
import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho, translate, scale, rotate, frustum)
import Graphics.X11.Types
import Graphics.X11.Xlib.Atom (internAtom)
@ -205,10 +205,11 @@ resize lw lh w h = do
matrixMode $= Projection
loadIdentity
ortho (-sf*aspectf) (sf*aspectf) (-sf) sf (-1) 1
scale 1 1 (0.1 :: GLfloat)
--ortho (-sf*aspectf) (sf*aspectf) (-sf) sf (-1) 1
--scale 1 1 (0.1 :: GLfloat)
frustum (-sf*aspectf) (sf*aspectf) (-sf) sf 10 100
rotate (-30) $ Vector3 1 0 (0 :: GLfloat)
translate $ Vector3 (-(fromIntegral lw)/2) (-(fromIntegral lh)/2) (0 :: GLfloat)
translate $ Vector3 (-(fromIntegral lw)/2) ((fromIntegral lh)/2) (-11 :: GLfloat)
matrixMode $= Modelview 0

8
src/HTanks.hs
View file

@ -33,12 +33,14 @@ main = do
when (initialized gl) $ do
currentTime <- getCurrentTime
let gamestate = GameState {level = theLevel, tanks = [ Tank 5.0 5.0 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
let gamestate = GameState {level = theLevel, tanks = [ Tank 7.0 4.0 0 0 1.5 270 False 3 1 5 1
, Tank 4.0 4.0 0 0 1.5 270 False 3 1 5 1
, Tank 10.0 4.0 0 0 1.5 270 False 3 1 5 1
], bullets = []}
mainstate = MainState {run = True, driver = SomeDriver gl, time = currentTime, players =
[ SomePlayer humanPlayer
, SomePlayer $ CPUPlayer 0
, SomePlayer $ CPUPlayer (-90)
, SomePlayer $ CPUPlayer 90
], textures = M.empty, models = M.empty, gameState = gamestate}
runMain mainstate $ do

4
src/Model.hs
View file

@ -6,10 +6,12 @@ module Model ( Model(..)
import Paths_htanks
import Data.Obj3D.GL (InterleavedObj)
data Model = ModelTank
data Model = ModelTank | ModelBullet | ModelBlock
deriving (Eq, Ord, Show)
modelPath :: Model -> IO FilePath
modelPath t = getDataFileName $ "model/" ++ (name t) ++ ".obj"
where
name ModelTank = "tank"
name ModelBullet = "bullet"
name ModelBlock = "cube"

76
src/Render.hs
View file

@ -80,7 +80,7 @@ setup = do
shadeModel $= Smooth
lighting $= Enabled
light (Light 0) $= Enabled
position (Light 0) $= Vertex4 (-1) (-1) 1 (0 :: GLfloat)
position (Light 0) $= Vertex4 (-1) (-1) 1.5 (0 :: GLfloat)
colorMaterial $= Just (Front, AmbientAndDiffuse)
clientState VertexArray $= Enabled
@ -96,6 +96,8 @@ setup = do
getTexture TextureCrosshair
getModel ModelTank
getModel ModelBullet
getModel ModelBlock
return ()
@ -113,6 +115,8 @@ render = do
textureCrosshair <- getTexture TextureCrosshair
modelTank <- getModel ModelTank
modelBullet <- getModel ModelBullet
modelBlock <- getModel ModelBlock
(lw, lh) <- gets (level . gameState) >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat)
@ -127,17 +131,17 @@ render = do
normal $ Normal3 0 0 (1 :: GLfloat)
unsafeRenderPrimitive Quads $ do
texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat)
vertex $ Vertex2 0 lh
texCoord $ TexCoord2 (-0.5 :: GLfloat) (-0.5 :: GLfloat)
vertex $ Vertex2 (-1) (lh+1)
texCoord $ TexCoord2 (lw/2) 0
vertex $ Vertex2 lw lh
texCoord $ TexCoord2 (lw/2+0.5) (-0.5)
vertex $ Vertex2 (lw+1) (lh+1)
texCoord $ TexCoord2 (lw/2) (lh/2)
vertex $ Vertex2 lw 0
texCoord $ TexCoord2 (lw/2+0.5) (lh/2+0.5)
vertex $ Vertex2 (lw+1) (-1)
texCoord $ TexCoord2 0 (lh/2)
vertex $ Vertex2 (0 :: GLfloat) (0 :: GLfloat)
texCoord $ TexCoord2 (-0.5) (lh/2+0.5)
vertex $ Vertex2 (-1 :: GLfloat) (-1 :: GLfloat)
bindInterleavedArrays modelTank
@ -163,30 +167,44 @@ render = do
unsafePreservingMatrix $ do
rotate 90 $ Vector3 1 0 (0 :: GLfloat)
drawObject modelTank 0
texture Texture2D $= Disabled
bindInterleavedArrays modelBullet
forM_ bulletlist $ \bullet -> unsafePreservingMatrix $ do
let x = realToFrac . bulletX $ bullet
y = realToFrac . bulletY $ bullet
rotDir = realToFrac . bulletDir $ bullet
let x = realToFrac . bulletX $ bullet
y = realToFrac . bulletY $ bullet
rotDir = realToFrac . bulletDir $ bullet
translate $ Vector3 x y (0.2 :: GLfloat)
rotate 30 $ Vector3 1 0 (0 :: GLfloat)
rotate rotDir $ Vector3 0 0 (1 :: GLfloat)
translate $ Vector3 x y (0.25 :: GLfloat)
rotate (rotDir-90) $ Vector3 0 0 (1 :: GLfloat)
textureBinding Texture2D $= Just textureBullet
unsafeRenderPrimitive Quads $ do
texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat)
vertex $ Vertex3 (-0.1 :: GLfloat) (-0.1 :: GLfloat) 0
texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat)
vertex $ Vertex3 (-0.1 :: GLfloat) (0.1 :: GLfloat) 0
texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat)
vertex $ Vertex3 (0.1 :: GLfloat) (0.1 :: GLfloat) 0
texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat)
vertex $ Vertex3 (0.1 :: GLfloat) (-0.1 :: GLfloat) 0
unsafePreservingMatrix $ do
drawObject modelBullet 0
bindInterleavedArrays modelBlock
texture Texture2D $= Enabled
textureBinding Texture2D $= Just textureWood
forM_ [0.5..13.5] $ \x -> unsafePreservingMatrix $ do
translate $ Vector3 x 8.5 (0.5 :: GLfloat)
rotate 90 $ Vector3 1 0 (0 :: GLfloat)
drawObject modelBlock 0
forM_ [0.5..13.5] $ \x -> unsafePreservingMatrix $ do
translate $ Vector3 x (-0.5) (0.5 :: GLfloat)
rotate 90 $ Vector3 1 0 (0 :: GLfloat)
drawObject modelBlock 0
forM_ [-0.5..8.5] $ \y -> unsafePreservingMatrix $ do
translate $ Vector3 (-0.5) y (0.5 :: GLfloat)
rotate 90 $ Vector3 1 0 (0 :: GLfloat)
drawObject modelBlock 0
forM_ [-0.5..8.5] $ \y -> unsafePreservingMatrix $ do
translate $ Vector3 14.5 y (0.5 :: GLfloat)
rotate 90 $ Vector3 1 0 (0 :: GLfloat)
drawObject modelBlock 0
depthFunc $= Just Always