Corrected some coordinate calculations
This commit is contained in:
Matthias Schiffer
parent
000f7b30b7
commit
d8cf601ac2
3 changed files with 32 additions and 29 deletions
41
GLX.hs
41
GLX.hs
|
|
@ -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)
|
||||
|
|
@ -29,20 +29,24 @@ import Foreign.Storable
|
|||
|
||||
|
||||
data GLX = GLX
|
||||
{ glxDisplay :: !Display
|
||||
, glxWindow :: !Window
|
||||
, glxContext :: !Context
|
||||
{ glxDisplay :: !Display
|
||||
, glxWindow :: !Window
|
||||
, glxContext :: !Context
|
||||
, glxDeleteWindow :: !Atom
|
||||
, glxScale :: !Rational
|
||||
, 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'
|
||||
|
|
|
|||
|
|
@ -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
14
Render.hs
|
|
@ -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
|
||||
|
|
|
|||
Reference in a new issue