diff --git a/app/Main.hs b/app/Main.hs index c75aff5ed..76b8a9c68 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -60,8 +60,8 @@ doSideEffects preData w = do . translate (-0.5) (-0.8) . scale 0.0005 0.0005 . text $ "ms/frame " ++ show (endTicks - lastFrameTicks) ) - return $ preData & soundData . playingSounds .~ newPlayingSounds - & frameTimer .~ endTicks + foldr (=<<) (return (preData & soundData . playingSounds .~ newPlayingSounds + & frameTimer .~ endTicks)) (_doneSideEffects w) doPreload' :: Dodge.LoadConfig.Configuration -> IO (PreloadData a) doPreload' config = do @@ -79,7 +79,6 @@ doPreload' config = do , _frameTimer = 0 } - checkForGlErrors :: IO () checkForGlErrors = do errs <- errors diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index bb619fe40..7723de9cc 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -10,6 +10,7 @@ module Dodge.Data ) where import Dodge.Data.Menu +import Preload.Data import Picture.Data import Geometry.Data @@ -85,6 +86,8 @@ data World = World , _debugMode :: Bool , _config :: Configuration , _configNeedsUpdate :: Bool + , _sideEffects :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)] + , _doneSideEffects :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)] } data Corpse = Corpse diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 0abd1fc67..3de64d618 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -237,6 +237,8 @@ defaultWorld = World , _debugMode = True , _config = defaultConfig , _configNeedsUpdate = False + , _sideEffects = [] + , _doneSideEffects = [] } youLight = TLS { _tlsPos = (0,0) diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index b780d9757..05004587e 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -21,6 +21,8 @@ import Dodge.CreatureAction import Dodge.SoundLogic import Dodge.Inventory import Geometry +import Preload.Update + import Control.Lens import Data.Maybe import Data.Char @@ -65,9 +67,12 @@ handleMouseWheelEvent mwev w = case _menuLayers w of _ -> Just w handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World -handleResizeEvent sev = Just . set windowX (fromIntegral x) - . set windowY (fromIntegral y) - where V2 x y = windowSizeChangedEventSize sev +handleResizeEvent sev = Just + . set windowX (fromIntegral x) + . set windowY (fromIntegral y) + . over sideEffects ( resizeSpareFBO (fromIntegral x) (fromIntegral y) : ) + where + V2 x y = windowSizeChangedEventSize sev handlePressedMouseButton :: MouseButton -> World -> Maybe World handlePressedMouseButton but w diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 42f46186d..667575b42 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -22,12 +22,20 @@ import qualified Data.Set as S import qualified Data.IntMap.Strict as IM import qualified Data.Map as M import Control.Lens + +update = update' . pushSideEffects + +pushSideEffects :: World -> World +pushSideEffects w = w + & sideEffects .~ [] + & doneSideEffects .~ _sideEffects w + {- | The update step. If '_menuLayers' is not empty, or the saving screen, this is the identity. In such menus, the only way to change the world is using event handling. -} -update :: World -> World -update w = case _menuLayers w of +update' :: World -> World +update' w = case _menuLayers w of (ConfigSaveScreen : ls) -> w & menuLayers .~ ls (_ : _) -> w [] -> let w1 = updateParticles' . updateProjectiles