diff options
Diffstat (limited to 'GLX.hs')
| -rw-r--r-- | GLX.hs | 41 |
1 files changed, 22 insertions, 19 deletions
@@ -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' |