diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 58a163863..4b0c1f291 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -8,8 +8,7 @@ We cannot handle multiple keys held down at once here, (eg left mouse button + right mouse button) because these are separate events. Instead we store the events in a set, and deal with the combinations in -"Dodge.Update". --} +"Dodge.Update". -} module Dodge.Event ( handleEvent ) where @@ -35,13 +34,13 @@ import qualified Data.Set as S import SDL -handleEvent :: Event -> Universe -> Maybe Universe -handleEvent e uv = case handleEvent' e (_uvWorld uv) of - Nothing -> Nothing - Just w -> Just $ uv & uvWorld .~ w +--handleEvent :: Event -> Universe -> Maybe Universe +--handleEvent e uv = case handleEvent' e (_uvWorld uv) of +-- Nothing -> Nothing +-- Just w -> Just $ uv & uvWorld .~ w -handleEvent' :: Event -> World -> Maybe World -handleEvent' e = case eventPayload e of +handleEvent :: Event -> Universe -> Maybe Universe +handleEvent e = case eventPayload e of KeyboardEvent kev -> handleKeyboardEvent kev MouseMotionEvent mmev -> handleMouseMotionEvent mmev MouseButtonEvent mbev -> handleMouseButtonEvent mbev @@ -50,40 +49,39 @@ handleEvent' e = case eventPayload e of WindowMovedEvent mev -> handleWindowMoveEvent mev _ -> Just -handleMouseMotionEvent :: MouseMotionEventData -> World -> Maybe World -handleMouseMotionEvent mmev w = Just $ w & mousePos .~ V2 +handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe +handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2 (fromIntegral x - 0.5*getWindowX w) (0.5*getWindowY w - fromIntegral y) where + w = _uvWorld u P (V2 x y) = mouseMotionEventPos mmev -handleMouseButtonEvent :: MouseButtonEventData -> World -> Maybe World -handleMouseButtonEvent mbev w = case mouseButtonEventMotion mbev of - Released -> Just $ over mouseButtons (S.delete but) w - Pressed -> handlePressedMouseButton but $ over mouseButtons (S.insert but) w +handleMouseButtonEvent :: MouseButtonEventData -> Universe -> Maybe Universe +handleMouseButtonEvent mbev u = case mouseButtonEventMotion mbev of + Released -> Just $ u & uvWorld . mouseButtons %~ S.delete but + Pressed -> uvWorld + (handlePressedMouseButton but) + (u & uvWorld . mouseButtons %~ S.insert but) where but = mouseButtonEventButton mbev {- | Sets window position in config. -} -handleWindowMoveEvent :: WindowMovedEventData -> World -> Maybe World -handleWindowMoveEvent mev w = Just $ w - & config . windowPosX .~ fromIntegral x - & config . windowPosY .~ fromIntegral y +handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Maybe Universe +handleWindowMoveEvent mev u = Just $ u + & uvWorld . config . windowPosX .~ fromIntegral x + & uvWorld . config . windowPosY .~ fromIntegral y where P (V2 x y) = windowMovedEventPosition mev {- | Resets the world window size, and resizes the fbo that gets the light map drawn into it. -} -handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World -handleResizeEvent sev w = Just - . set (config . windowX) (fromIntegral x) - . set (config . windowY) (fromIntegral y) - $ over sideEffects (sideEffectUpdatePreload divRes x y) - w +handleResizeEvent :: WindowSizeChangedEventData -> Universe -> Maybe Universe +handleResizeEvent sev u = Just $ u + & uvWorld . config . windowX .~ fromIntegral x + & uvWorld . config . windowY .~ fromIntegral y + & uvWorld . sideEffects %~ sideEffectUpdatePreload divRes x y where --- up :: (World -> IO World) -> World -> IO World --- up f w' = do --- pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData w') --- f $ w' & preloadData .~ pdata + w = _uvWorld u x = fromIntegral x' y = fromIntegral y' V2 x' y' = windowSizeChangedEventSize sev @@ -95,10 +93,10 @@ handlePressedMouseButton but w = Just $ w & clickMousePos .~ _mousePos w | otherwise = Just w -handleMouseWheelEvent :: MouseWheelEventData -> World -> Maybe World -handleMouseWheelEvent mwev w = case _menuLayers w of +handleMouseWheelEvent :: MouseWheelEventData -> Universe -> Maybe Universe +handleMouseWheelEvent mwev w = case _menuLayers (_uvWorld w) of [] -> case mouseWheelEventPos mwev of - V2 _ y -> Just $ wheelEvent (fromIntegral y) w + V2 _ y -> Just $ w & uvWorld %~ wheelEvent (fromIntegral y) _ -> Just w wheelEvent :: Float -> World -> World @@ -138,5 +136,3 @@ moveYourAmmoParam i w = case yourItem w ^? wpAmmo . aoType. amPjParams . ix para _ -> w where paramid = _amParamSel $ _aoType $ _wpAmmo $ yourItem w - - diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 0ac69c965..01d46da30 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -23,10 +23,12 @@ On release, remove scancode from the 'Set' of pressed keys. On press, adds the scancode, and perhaps applies a direct effect: see 'handlePressedKeyInGame'. -} -handleKeyboardEvent :: KeyboardEventData -> World -> Maybe World -handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of - Released -> Just $ w & keys %~ S.delete kcode - Pressed -> handlePressedKey (keyboardEventRepeat kev) kcode (w & keys %~ S.insert kcode) +handleKeyboardEvent :: KeyboardEventData -> Universe -> Maybe Universe +handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of + Released -> Just $ u & uvWorld . keys %~ S.delete kcode + Pressed -> uvWorld + (handlePressedKey (keyboardEventRepeat kev) kcode) + (u & uvWorld . keys %~ S.insert kcode) where kcode = (keysymScancode . keyboardEventKeysym) kev