Simplify the main loop, events only perform functional update

src/Dodge/Event.hs

@@ -15,46 +15,32 @@ module Dodge.Event (
     handleEvent,
 ) where
 
+import Dodge.Concurrent
 import LensHelp
 import Dodge.Data.Universe
-import Dodge.Event.Keyboard
+import Dodge.Event.Input
 import Dodge.PreloadData
 import SDL
 
-handleEvent :: Event -> Universe -> IO (Maybe Universe)
-handleEvent e = case eventPayload e of
-    TextInputEvent tev -> return . Just . handleTextInput (textInputEventText tev)
-    KeyboardEvent kev -> return . Just . handleKeyboardEvent kev
-    MouseMotionEvent mmev -> return . handleMouseMotionEvent mmev
-    MouseButtonEvent mbev -> return . Just . over uvWorld (handleMouseButtonEvent mbev)
-    MouseWheelEvent mwev -> return . handleMouseWheelEvent mwev
-    WindowSizeChangedEvent sev -> handleResizeEvent sev
-    WindowMovedEvent mev -> return . handleWindowMoveEvent mev
-    _ -> return . Just
-
-handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe
-handleMouseMotionEvent mmev u =
-    Just $
-        u & uvWorld . input . mousePos
-            .~ V2
-                (fromIntegral x - 0.5 * _windowX cfig)
-                (0.5 * _windowY cfig - fromIntegral y)
+handleEvent :: Event -> Universe -> Universe
+handleEvent e u = case eventPayload e of
+    TextInputEvent tev -> inputpoint (handleTextInput (textInputEventText tev)) u
+    KeyboardEvent kev -> inputpoint (handleKeyboardEvent kev) u
+    MouseMotionEvent mmev -> inputpoint (handleMouseMotionEvent mmev cfig) u
+    MouseButtonEvent mbev -> inputpoint (handleMouseButtonEvent mbev) u
+    MouseWheelEvent mwev -> inputpoint (handleMouseWheelEvent mwev) u
+    WindowSizeChangedEvent sev -> handleResizeEvent sev u
+    WindowMovedEvent mev -> handleWindowMoveEvent mev u
+    QuitEvent -> hardQuit u
+    WindowClosedEvent _ -> hardQuit u
+    _ -> u
   where
+    inputpoint = over (uvWorld . input)
     cfig = _uvConfig u
-    P (V2 x y) = mouseMotionEventPos mmev
-
-handleMouseButtonEvent :: MouseButtonEventData -> World -> World
-handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
-    Released -> input . mouseButtons . at thebutton .~ Nothing
-    Pressed -> input . mouseButtons . at thebutton ?~ False
-  where
-    thebutton = mouseButtonEventButton mbev
 
 -- | Sets window position in config.
-handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Maybe Universe
-handleWindowMoveEvent mev =
-    Just
-        . (uvConfig . windowPosX .~ fromIntegral x)
+handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Universe
+handleWindowMoveEvent mev = (uvConfig . windowPosX .~ fromIntegral x)
         . (uvConfig . windowPosY .~ fromIntegral y)
   where
     P (V2 x y) = windowMovedEventPosition mev
@@ -63,9 +49,8 @@ handleWindowMoveEvent mev =
 
 -- using a sideeffect here for the io change seems to work better, more testing
 -- later may be a good idea
-handleResizeEvent :: WindowSizeChangedEventData -> Universe -> IO (Maybe Universe)
+handleResizeEvent :: WindowSizeChangedEventData -> Universe -> Universe
 handleResizeEvent sev u =
-    return . Just $
         u
             & uvConfig . windowX .~ fromIntegral x
             & uvConfig . windowY .~ fromIntegral y
@@ -75,10 +60,3 @@ handleResizeEvent sev u =
     y = fromIntegral y'
     V2 x' y' = windowSizeChangedEventSize sev
     divRes = resFactorNum $ u ^. uvConfig . graphics_resolution_factor
-
-handleMouseWheelEvent :: MouseWheelEventData -> Universe -> Maybe Universe
-handleMouseWheelEvent mwev w = case _uvScreenLayers w of
-    [] -> case mouseWheelEventPos mwev of
-        V2 _ y -> Just $ w -- & uvWorld %~ wheelEvent (fromIntegral y)
-            & uvWorld . input . scrollAmount +~ fromIntegral y
-    _ -> Just w