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

Corrected some coordinate calculations

Browse source
This commit is contained in:
Matthias Schiffer 2010-03-08 19:31:48 +01:00
parent 000f7b30b7
commit d8cf601ac2
3 changed files with 32 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
GLX.hs
View file

@ -10,8 +10,8 @@ import Data.Bits ((.|.))
import Data.Maybe (isJust)
import Data.Ratio
import Graphics.Rendering.OpenGL.GL (($=), GLdouble, Capability(..))
import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho)
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.X11.Types
import Graphics.X11.Xlib.Atom (internAtom)
@ -34,15 +34,19 @@ data GLX = GLX
, glxContext :: !Context
, glxDeleteWindow :: !Atom
, glxScale :: !Rational
, glxLevelWidth :: !Int
, glxLevelHeight :: !Int
}
glxDriver :: GLX
glxDriver = GLX
glxDriver :: Int -> Int -> GLX
glxDriver w h = GLX
{ glxDisplay = Display nullPtr
, glxWindow = 0
, glxContext = Context nullPtr
, glxDeleteWindow = 0
, glxScale = 1
, glxLevelWidth = w
, glxLevelHeight = h
}
@ -84,9 +88,9 @@ instance Driver GLX where
makeCurrent disp wnd ctx
wa <- getWindowAttributes disp wnd
s <- resize (fromIntegral . wa_width $ wa) (fromIntegral . wa_height $ wa)
s <- resize (glxLevelWidth glx) (glxLevelHeight glx) (fromIntegral . wa_width $ wa) (fromIntegral . wa_height $ wa)
return GLX
return glx
{ glxDisplay = disp
, glxWindow = wnd
, glxContext = ctx
@ -124,7 +128,7 @@ handleEvent glx xevent = do
let evtype = ev_event_type event
case () of
_ | evtype == configureNotify -> do
s <- resize (fromIntegral . ev_width $ event) (fromIntegral . ev_height $ event)
s <- resize (glxLevelWidth glx) (glxLevelHeight glx) (fromIntegral . ev_width $ event) (fromIntegral . ev_height $ event)
return (glx {glxScale = s}, Nothing)
| evtype == keyPress -> do
keysym <- keycodeToKeysym (glxDisplay glx) (ev_keycode event) 0
@ -153,30 +157,29 @@ handleEvent glx xevent = do
wa <- getWindowAttributes (glxDisplay glx) (glxWindow glx)
let x = fromIntegral . ev_x $ event
y = fromIntegral . ev_y $ event
w = fromIntegral . wa_width $ wa
h = fromIntegral . wa_height $ wa
s = fromRational . glxScale $ glx
return (glx, Just $ SomeEvent $ MouseMotionEvent ((x-w/2)/s) ((-y+h/2)/s))
return (glx, Just $ SomeEvent $ MouseMotionEvent (x/s) ((h-y)/s))
| otherwise -> return (glx, Nothing)
resize :: Int -> Int -> IO Rational
resize w h = do
let size = 5
aspect = (fromIntegral w)%(fromIntegral h)
s = max (size/aspect) size
resize :: Int -> Int -> Int -> Int -> IO Rational
resize lw lh w h = do
let aspect = (fromIntegral w)%(fromIntegral h)
s = (max ((fromIntegral lw)/aspect) (fromIntegral lh))/2
sf = fromRational s
aspectf = fromRational aspect
matrixMode $= Projection
loadIdentity
ortho (-sf*aspectf) (sf*aspectf) (-sf) sf (-1) 1
translate $ Vector3 (-(fromIntegral lw)/2) (-(fromIntegral lh)/2) (0 :: GLfloat)
matrixMode $= Modelview 0
viewport $= ((Position 0 0), (Size (fromIntegral w) (fromIntegral h)))
return $ (fromIntegral h)/(s*2)
return $ (fromIntegral h)/(2*s)
waitForMapNotify :: Display -> Window -> IO ()
waitForMapNotify disp wnd = allocaXEvent waitForMapNotify'

6
HTanks.hs
View file

@ -39,7 +39,7 @@ runMain st (MainT a) = runStateT a st
main :: IO ()
main = do
gl <- initGL glxDriver
gl <- initGL $ glxDriver 10 10
when (initialized gl) $ do
currentTime <- getCurrentTime
@ -47,8 +47,8 @@ main = do
[ SomePlayer $ DefaultPlayer S.empty 0 0
, SomePlayer $ CPUPlayer 0
]}
gameState = GameState {level = testLevel, tanks = [ Tank 0.0 0.0 0 0 2 360 False
, Tank 0.0 (-1.5) 0 0 2 360 False
gameState = GameState {level = testLevel, tanks = [ Tank 5.0 5.0 0 0 2 360 False
, Tank 5.0 3.5 0 0 2 360 False
], textures = M.empty}
runGame gameState $ do

14
Render.hs
View file

@ -80,16 +80,16 @@ render = do
renderPrimitive Quads $ do
texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat)
vertex $ Vertex2 (-0.5*lw) (-0.5*lh)
vertex $ Vertex2 0 lh
texCoord $ TexCoord2 0 lw
vertex $ Vertex2 (-0.5*lw) (0.5*lh)
texCoord $ TexCoord2 lw 0
vertex $ Vertex2 lw lh
texCoord $ TexCoord2 lh lw
vertex $ Vertex2 (0.5*lw) (0.5*lh)
texCoord $ TexCoord2 lw lh
vertex $ Vertex2 lw 0
texCoord $ TexCoord2 lh (0 :: GLfloat)
vertex $ Vertex2 (0.5*lw) (-0.5*lh)
texCoord $ TexCoord2 0 lh
vertex $ Vertex2 (0 :: GLfloat) (0 :: GLfloat)
forM_ tanklist $ \tank -> preservingMatrix $ do
let x = fromReal . posx $ tank