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

Some improvements on coordinate calculation & player rendering

Browse source
This commit is contained in:
Matthias Schiffer 2010-04-12 14:40:31 +02:00
parent d56001cb33
commit dafe16f191
4 changed files with 23 additions and 21 deletions
Show stats 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 Data.Ratio
import Graphics.Rendering.OpenGL.GL (($=), GLdouble, GLfloat, Vector3(..), Capability(..)) import Graphics.Rendering.OpenGL.GL (($=), GLdouble, GLfloat, Vector3(..), Capability(..))
import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho, translate) import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho, translate, scale, rotate)
import Graphics.X11.Types import Graphics.X11.Types
import Graphics.X11.Xlib.Atom (internAtom) import Graphics.X11.Xlib.Atom (internAtom)
@ -179,8 +179,9 @@ windowToGameCoords :: Integral a => GLX -> a -> a -> IO (Float, Float)
windowToGameCoords glx x y = getWindowAttributes (glxDisplay glx) (glxWindow glx) >>= \wa -> windowToGameCoords glx x y = getWindowAttributes (glxDisplay glx) (glxWindow glx) >>= \wa ->
let w = fromIntegral . wa_width $ wa let w = fromIntegral . wa_width $ wa
h = fromIntegral . wa_height $ wa h = fromIntegral . wa_height $ wa
in return (((-w/2 + wx)/s + lw/2), ((h/2 - wy)/s + lh/2)) in return (((-w/2 + wx)/sx + lw/2), ((h/2 - wy)/sy + lh/2))
where s = fromRational . glxScale $ glx where sx = fromRational . glxScale $ glx
sy = sx*(cos $ pi/6)
lw = fromIntegral . glxLevelWidth $ glx lw = fromIntegral . glxLevelWidth $ glx
lh = fromIntegral . glxLevelHeight $ glx lh = fromIntegral . glxLevelHeight $ glx
wx = fromIntegral x wx = fromIntegral x
@ -197,6 +198,8 @@ resize lw lh w h = do
matrixMode $= Projection matrixMode $= Projection
loadIdentity loadIdentity
ortho (-sf*aspectf) (sf*aspectf) (-sf) sf (-1) 1 ortho (-sf*aspectf) (sf*aspectf) (-sf) sf (-1) 1
scale 1 1 (0.1 :: GLfloat)
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) (0 :: GLfloat)
matrixMode $= Modelview 0 matrixMode $= Modelview 0

6
src/HTanks.hs
View file

@ -27,7 +27,7 @@ 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,8 +36,8 @@ 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, models = M.empty, gameState = gamestate} ], textures = M.empty, models = M.empty, gameState = gamestate}

7
src/HWiidPlayer.hs
View file

@ -5,7 +5,7 @@ module HWiidPlayer ( HWiidPlayer
) where ) where
import Control.Monad import Control.Monad
import Data.Bits import Data.Bits hiding (rotate)
import Data.Function (on) import Data.Function (on)
import Data.List (sortBy) import Data.List (sortBy)
import Data.Maybe import Data.Maybe
@ -14,7 +14,7 @@ import Data.Typeable
import HWiid import HWiid
import Graphics.Rendering.OpenGL.GL (GLfloat, Vector3(..)) import Graphics.Rendering.OpenGL.GL (GLfloat, Vector3(..))
import Graphics.Rendering.OpenGL.GL.BeginEnd (unsafeRenderPrimitive, PrimitiveMode(..)) import Graphics.Rendering.OpenGL.GL.BeginEnd (unsafeRenderPrimitive, PrimitiveMode(..))
import Graphics.Rendering.OpenGL.GL.CoordTrans (unsafePreservingMatrix, translate) import Graphics.Rendering.OpenGL.GL.CoordTrans (unsafePreservingMatrix, translate, rotate)
import Graphics.Rendering.OpenGL.GL.VertexSpec import Graphics.Rendering.OpenGL.GL.VertexSpec
@ -65,7 +65,8 @@ instance Player HWiidPlayer where
renderPlayer (HWiidPlayer _ _ aims) = unsafePreservingMatrix $ do renderPlayer (HWiidPlayer _ _ aims) = unsafePreservingMatrix $ do
let (x, y) = mulV (1/(fromIntegral $ length aims)) $ foldr addV (0, 0) aims let (x, y) = mulV (1/(fromIntegral $ length aims)) $ foldr addV (0, 0) aims
translate $ Vector3 x y (0 :: GLfloat) translate $ Vector3 x y (0.2 :: GLfloat)
rotate 30 $ Vector3 1 0 (0 :: GLfloat)
unsafeRenderPrimitive Quads $ do unsafeRenderPrimitive Quads $ do
texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat) texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat)

22
src/Render.hs
View file

@ -92,13 +92,6 @@ setup = do
(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
matrixMode $= Projection
scale 1 1 (0.1 :: GLfloat)
translate $ Vector3 (lw/2) (lh/2) 0
rotate (-30) $ Vector3 1 0 (0 :: GLfloat)
translate $ Vector3 (-lw/2) (-lh/2) 0
matrixMode $= Modelview 0
blend $= Enabled blend $= Enabled
blendFunc $= (SrcAlpha, OneMinusSrcAlpha) blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
depthFunc $= Just Lequal depthFunc $= Just Lequal
@ -144,6 +137,8 @@ render = do
liftIO $ do liftIO $ do
clear [ColorBuffer, DepthBuffer] clear [ColorBuffer, DepthBuffer]
depthFunc $= Just Lequal
texture Texture2D $= Enabled texture Texture2D $= Enabled
textureBinding Texture2D $= Just textureWood textureBinding Texture2D $= Just textureWood
@ -224,23 +219,26 @@ render = do
y = realToFrac . bulletY $ bullet y = realToFrac . bulletY $ bullet
rotDir = realToFrac . bulletDir $ bullet rotDir = realToFrac . bulletDir $ bullet
translate $ Vector3 x y (0 :: GLfloat) translate $ Vector3 x y (0.1 :: GLfloat)
rotate 30 $ Vector3 1 0 (0 :: GLfloat)
rotate rotDir $ Vector3 0 0 (1 :: GLfloat) rotate rotDir $ Vector3 0 0 (1 :: GLfloat)
textureBinding Texture2D $= Just textureBullet textureBinding Texture2D $= Just textureBullet
unsafeRenderPrimitive Quads $ do unsafeRenderPrimitive Quads $ do
texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat) texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat)
vertex $ Vertex3 (-0.1 :: GLfloat) (-0.1 :: GLfloat) 0.01 vertex $ Vertex3 (-0.1 :: GLfloat) (-0.1 :: GLfloat) 0
texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat) texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat)
vertex $ Vertex3 (-0.1 :: GLfloat) (0.1 :: GLfloat) 0.01 vertex $ Vertex3 (-0.1 :: GLfloat) (0.1 :: GLfloat) 0
texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat) texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat)
vertex $ Vertex3 (0.1 :: GLfloat) (0.1 :: GLfloat) 0.01 vertex $ Vertex3 (0.1 :: GLfloat) (0.1 :: GLfloat) 0
texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat) texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat)
vertex $ Vertex3 (0.1 :: GLfloat) (-0.1 :: GLfloat) 0.01 vertex $ Vertex3 (0.1 :: GLfloat) (-0.1 :: GLfloat) 0
depthFunc $= Just Always
textureBinding Texture2D $= Just textureCrosshair textureBinding Texture2D $= Just textureCrosshair
forM_ playerlist renderPlayer forM_ playerlist renderPlayer