diff options
| -rw-r--r-- | DefaultPlayer.hs | 26 | ||||
| -rw-r--r-- | GLDriver.hs | 10 | ||||
| -rw-r--r-- | GLX.hs | 93 | ||||
| -rw-r--r-- | HTanks.hs | 3 | ||||
| -rw-r--r-- | Render.hs | 1 |
5 files changed, 75 insertions, 58 deletions
diff --git a/DefaultPlayer.hs b/DefaultPlayer.hs index d1c1e24..6f80096 100644 --- a/DefaultPlayer.hs +++ b/DefaultPlayer.hs @@ -14,22 +14,22 @@ import Player import Tank -data DefaultPlayer = DefaultPlayer (S.Set Key) Micro Micro +data DefaultPlayer = DefaultPlayer (S.Set Key) Float Float deriving (Typeable, Show) instance Player DefaultPlayer where - playerUpdate (DefaultPlayer keys aimx aimy) tank = playerUpdate' keys aimx aimy tank + playerUpdate (DefaultPlayer keys aimx aimy) tank = + let x = (if (S.member KeyLeft keys) then (-1) else 0) + (if (S.member KeyRight keys) then 1 else 0) + y = (if (S.member KeyDown keys) then (-1) else 0) + (if (S.member KeyUp keys) then 1 else 0) + ax = aimx - (fromRational . toRational $ posx tank) + ay = aimy - (fromRational . toRational $ posy tank) + move = (x /= 0 || y /= 0) + angle = if move then Just $ fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000 else Nothing + aangle = if (ax /= 0 || ay /= 0) then Just $ fromRational $ round ((atan2 ay ax)*1000000*180/pi)%1000000 else Nothing + in (DefaultPlayer keys aimx aimy, angle, move, aangle) handleEvent (DefaultPlayer keys aimx aimy) ev - | Just (KeyPressEvent key) <- fromEvent ev = DefaultPlayer (S.insert key keys) aimx aimy - | Just (KeyReleaseEvent key) <- fromEvent ev = DefaultPlayer (S.delete key keys) aimx aimy + | Just (KeyPressEvent key) <- fromEvent ev = DefaultPlayer (S.insert key keys) aimx aimy + | Just (KeyReleaseEvent key) <- fromEvent ev = DefaultPlayer (S.delete key keys) aimx aimy + | Just (MouseMotionEvent x y) <- fromEvent ev = DefaultPlayer keys x y | otherwise = DefaultPlayer keys aimx aimy - - -playerUpdate' :: S.Set Key -> Micro -> Micro -> Tank -> (DefaultPlayer, Maybe Micro, Bool, Maybe Micro) -playerUpdate' keys aimx aimy tank = (DefaultPlayer keys aimx aimy, angle, move, Nothing) - where - x = (if (S.member KeyLeft keys) then (-1) else 0) + (if (S.member KeyRight keys) then 1 else 0) - y = (if (S.member KeyDown keys) then (-1) else 0) + (if (S.member KeyUp keys) then 1 else 0) - move = (x /= 0 || y /= 0) - angle = if move then Just $ fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000 else Nothing diff --git a/GLDriver.hs b/GLDriver.hs index f4dca5e..ce84563 100644 --- a/GLDriver.hs +++ b/GLDriver.hs @@ -6,10 +6,10 @@ module GLDriver ( Driver(..) , SomeEvent(..) , fromEvent , QuitEvent(..) - --, ResizeEvent(..) , Key(..) , KeyPressEvent(..) , KeyReleaseEvent(..) + , MouseMotionEvent(..) ) where import Data.Typeable @@ -23,7 +23,7 @@ class Driver a where swapBuffers :: a -> IO () - nextEvent :: a -> IO (Maybe SomeEvent) + nextEvent :: a -> IO (a, Maybe SomeEvent) data SomeDriver = forall d. Driver d => SomeDriver d @@ -32,7 +32,7 @@ instance Driver SomeDriver where initGL (SomeDriver d) = initGL d >>= return . SomeDriver deinitGL (SomeDriver d) = deinitGL d swapBuffers (SomeDriver d) = swapBuffers d - nextEvent (SomeDriver d) = nextEvent d + nextEvent (SomeDriver d) = nextEvent d >>= \(gl, ev) -> return (SomeDriver gl, ev) class (Typeable a, Show a) => Event a @@ -57,3 +57,7 @@ instance Event KeyPressEvent data KeyReleaseEvent = KeyReleaseEvent Key deriving (Typeable, Show) instance Event KeyReleaseEvent + + +data MouseMotionEvent = MouseMotionEvent Float Float deriving (Typeable, Show) +instance Event MouseMotionEvent
\ No newline at end of file @@ -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' @@ -164,7 +164,8 @@ simulationStep = do handleEvents :: Main () handleEvents = do - event <- gets driver >>= liftIO . nextEvent + (newgl, event) <- gets driver >>= liftIO . nextEvent + modify $ \state -> state {driver = newgl} when (isJust event) $ do Main.handleEvent $ fromJust event modify $ \state -> state {players = map (\p -> Player.handleEvent p $ fromJust event) $ players state} @@ -1,5 +1,4 @@ module Render ( setup - --, resize , render ) where |