Push universe into events

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
-
-

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