From 0fb75af68220527fb10ab0ce39e35f61cba67e4c Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Fri, 5 Mar 2010 04:38:31 +0100 Subject: Aim with mouse in DefaultPlayer --- GLX.hs | 93 ++++++++++++++++++++++++++++++++++++++---------------------------- 1 file changed, 53 insertions(+), 40 deletions(-) (limited to 'GLX.hs') diff --git a/GLX.hs b/GLX.hs index 4e9abc4..affc185 100644 --- a/GLX.hs +++ b/GLX.hs @@ -8,6 +8,7 @@ import Control.Monad (when, unless) 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) @@ -16,7 +17,7 @@ import Graphics.X11.Types import Graphics.X11.Xlib.Atom (internAtom) import Graphics.X11.Xlib.Display (defaultScreen, openDisplay, rootWindow) import Graphics.X11.Xlib.Event (XEventPtr, allocaXEvent, nextEvent, get_Window, get_EventType, pending) -import Graphics.X11.Xlib.Extras (ClassHint(..), getEvent, ev_event_type, ev_width, ev_height, ev_keycode, ev_data) +import Graphics.X11.Xlib.Extras (ClassHint(..), getEvent, ev_event_type, ev_width, ev_height, ev_keycode, ev_data, ev_x, ev_y, getWindowAttributes, wa_width, wa_height) import Graphics.X11.Xlib.Misc (keycodeToKeysym, setWMProtocols) import Graphics.X11.Xlib.Types import Graphics.X11.Xlib.Window (destroyWindow, mapWindow, storeName) @@ -32,7 +33,7 @@ data GLX = GLX , glxWindow :: !Window , glxContext :: !Context , glxDeleteWindow :: !Atom - , glxScale :: !GLdouble + , glxScale :: !Rational } glxDriver :: GLX @@ -82,14 +83,14 @@ instance Driver GLX where ctx <- with visualinfo $ \vi -> createContext disp vi (Context nullPtr) True makeCurrent disp wnd ctx - resize 800 600 + s <- resize 800 600 return GLX { glxDisplay = disp , glxWindow = wnd , glxContext = ctx , glxDeleteWindow = delwnd - , glxScale = 1 + , glxScale = s } deinitGL glx = do @@ -101,68 +102,80 @@ instance Driver GLX where nextEvent glx = allocaXEvent $ nextEvent' glx -nextEvent' :: GLX -> XEventPtr -> IO (Maybe SomeEvent) +nextEvent' :: GLX -> XEventPtr -> IO (GLX, Maybe SomeEvent) nextEvent' glx xevent = do p <- pending $ glxDisplay glx if (p > 0) then do Graphics.X11.Xlib.Event.nextEvent (glxDisplay glx) xevent - ev <- handleEvent glx xevent + (newglx, ev) <- handleEvent glx xevent if isJust ev then - return ev + return (newglx, ev) else - nextEvent' glx xevent + nextEvent' newglx xevent else - return Nothing + return (glx, Nothing) -handleEvent :: GLX -> XEventPtr -> IO (Maybe SomeEvent) +handleEvent :: GLX -> XEventPtr -> IO (GLX, Maybe SomeEvent) handleEvent glx xevent = do event <- getEvent xevent let evtype = ev_event_type event case () of _ | evtype == configureNotify -> do - resize (fromIntegral . ev_width $ event) (fromIntegral . ev_height $ event) - return Nothing + s <- resize (fromIntegral . ev_width $ event) (fromIntegral . ev_height $ event) + return (glx {glxScale = s}, Nothing) | evtype == keyPress -> do - keysym <- keycodeToKeysym (glxDisplay glx) (ev_keycode event) 0 - case () of - _ | keysym == xK_Escape -> return $ Just $ SomeEvent QuitEvent - | keysym == xK_Up -> return $ Just $ SomeEvent $ KeyPressEvent KeyUp - | keysym == xK_Down -> return $ Just $ SomeEvent $ KeyPressEvent KeyDown - | keysym == xK_Left -> return $ Just $ SomeEvent $ KeyPressEvent KeyLeft - | keysym == xK_Right -> return $ Just $ SomeEvent $ KeyPressEvent KeyRight - | otherwise -> return Nothing + keysym <- keycodeToKeysym (glxDisplay glx) (ev_keycode event) 0 + case () of + _ | keysym == xK_Escape -> return (glx, Just $ SomeEvent QuitEvent) + | keysym == xK_Up -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyUp) + | keysym == xK_Down -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyDown) + | keysym == xK_Left -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyLeft) + | keysym == xK_Right -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyRight) + | otherwise -> return (glx, Nothing) | evtype == keyRelease -> do - keysym <- keycodeToKeysym (glxDisplay glx) (ev_keycode event) 0 - case () of - _ | keysym == xK_Up -> return $ Just $ SomeEvent $ KeyReleaseEvent KeyUp - | keysym == xK_Down -> return $ Just $ SomeEvent $ KeyReleaseEvent KeyDown - | keysym == xK_Left -> return $ Just $ SomeEvent $ KeyReleaseEvent KeyLeft - | keysym == xK_Right -> return $ Just $ SomeEvent $ KeyReleaseEvent KeyRight - | otherwise -> return Nothing + keysym <- keycodeToKeysym (glxDisplay glx) (ev_keycode event) 0 + case () of + _ | keysym == xK_Up -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyUp) + | keysym == xK_Down -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyDown) + | keysym == xK_Left -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyLeft) + | keysym == xK_Right -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyRight) + | otherwise -> return (glx, Nothing) | evtype == clientMessage -> do - if ((glxDeleteWindow glx) == (fromIntegral . head . ev_data $ event)) - then - return $ Just $ SomeEvent QuitEvent - else - return Nothing - | otherwise -> return Nothing - - -resize :: Int -> Int -> IO () + if ((glxDeleteWindow glx) == (fromIntegral . head . ev_data $ event)) + then + return (glx, Just $ SomeEvent QuitEvent) + else + return (glx, Nothing) + | evtype == motionNotify -> 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)) + | otherwise -> return (glx, Nothing) + + +resize :: Int -> Int -> IO Rational resize w h = do - let aspect = (fromIntegral w)/(fromIntegral h) - s = max (5/aspect) 5 :: GLdouble + let size = 5 + aspect = (fromIntegral w)%(fromIntegral h) + s = max (size/aspect) size + sf = fromRational s + aspectf = fromRational aspect matrixMode $= Projection loadIdentity - ortho (-s*aspect) (s*aspect) (-s) s (-1) 1 + ortho (-sf*aspectf) (sf*aspectf) (-sf) sf (-1) 1 matrixMode $= Modelview 0 viewport $= ((Position 0 0), (Size (fromIntegral w) (fromIntegral h))) - + + return $ (fromIntegral h)/(s*2) waitForMapNotify :: Display -> Window -> IO () waitForMapNotify disp wnd = allocaXEvent waitForMapNotify' -- cgit v1.2.3