From d6fb6adc66c03774e1de00a54de71740a0e3f94e Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 28 Nov 2021 11:43:17 +0000 Subject: [PATCH] Apply side effects to universe not world --- appDodge/Main.hs | 36 ++++++++++++++++++++++-------------- src/Dodge/Data.hs | 6 +++++- src/Dodge/Event.hs | 23 +++++++++++++++-------- src/Dodge/Menu.hs | 15 ++++++++++----- 4 files changed, 52 insertions(+), 28 deletions(-) diff --git a/appDodge/Main.hs b/appDodge/Main.hs index e16ce445d..eabbe7a97 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -47,21 +47,26 @@ main = do theUpdateStep (flip handleEvent) -theCleanup :: World -> IO () -theCleanup w = SDL.cursorVisible $= True >> cleanUpPreload (_preloadData w) +theCleanup :: Universe -> IO () +theCleanup uv = let w = _uvWorld uv + in SDL.cursorVisible $= True >> cleanUpPreload (_preloadData w) -firstWorldLoad :: Configuration -> IO World +firstWorldLoad :: Configuration -> IO Universe firstWorldLoad theConfig = do SDL.cursorVisible $= False theKeyConfig <- loadKeyConfig pdata <- doPreload >>= applyWorldConfig theConfig w <- generateWorldFromSeed 0 - return $ w & preloadData .~ pdata + return $ Universe ( w & preloadData .~ pdata & keyConfig .~ theKeyConfig & config .~ theConfig + ) -theUpdateStep :: World -> IO World -theUpdateStep = doSideEffects <=< updateRenderSplit +theUpdateStep :: Universe -> IO Universe +theUpdateStep = doSideEffects <=< traverseOf uvWorld theUpdateStep' + +theUpdateStep' :: World -> IO World +theUpdateStep' = updateRenderSplit updateRenderSplit :: World -> IO World updateRenderSplit w = do @@ -74,12 +79,13 @@ playSoundUnlessRewinding w | _rewinding w = return M.empty | otherwise = playSoundAndUpdate (_soundData $ _preloadData w) (_playingSounds w) (_toPlaySounds w) -doSideEffects :: World -> IO World -doSideEffects w = do +doSideEffects :: Universe -> IO Universe +doSideEffects u = do + let w = _uvWorld u let preData = _preloadData w --newPlayingSounds <- playSoundAndUpdate (_soundData preData) (_playingSounds w) (_toPlaySounds w) newPlayingSounds <- playSoundUnlessRewinding w - w' <- _sideEffects w w + u' <- _sideEffects w u endTicks <- SDL.ticks let lastFrameTicks = _frameTimer preData when (_debug_seconds_frame $ _config w) $ void $ renderFoldable @@ -88,11 +94,13 @@ doSideEffects w = do . translate (-0.5) (-0.8) . scale 0.0005 0.0005 . text $ "ms/frame " ++ show (endTicks - lastFrameTicks) ) - return $ w' & preloadData . frameTimer .~ endTicks - & playingSounds .~ newPlayingSounds - & toPlaySounds .~ M.empty - & sideEffects .~ return - & rewinding .~ False -- this is probably not the best place for this + return $ u' + & uvWorld . preloadData . frameTimer .~ endTicks + & uvWorld . playingSounds .~ newPlayingSounds + & uvWorld . toPlaySounds .~ M.empty + & uvWorld . sideEffects .~ return + & uvWorld . rewinding .~ False -- this is probably not the best place for this + doPreload :: IO PreloadData doPreload = do diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index b06f1f05b..3c7f467dc 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -52,6 +52,9 @@ import qualified Data.Map.Strict as M import SDL (Scancode, MouseButton) import Data.Monoid type CRUpdate = Creature -> World -> (Endo World, Maybe Creature) +data Universe = Universe + { _uvWorld :: World + } data World = World { _keys :: !(S.Set Scancode) , _mouseButtons :: !(S.Set MouseButton) @@ -105,7 +108,7 @@ data World = World , _closeActiveObjects :: [Either FloorItem Button] , _seenLocations :: IM.IntMap (World -> Point2,String) , _selLocation :: Int - , _sideEffects :: World -> IO World + , _sideEffects :: Universe -> IO Universe , _inventoryMode :: InventoryMode , _distortions :: [Distortion] , _worldBounds :: Bounds @@ -900,3 +903,4 @@ makeLenses ''ItemDimension makeLenses ''Vocalization makeLenses ''UseDelay makeLenses ''AimParams +makeLenses ''Universe diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 25eec1a22..58a163863 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -18,11 +18,12 @@ import Dodge.Event.Keyboard import Dodge.Data import Dodge.Base import Dodge.Base.Window +import Dodge.PreloadData --import Dodge.Creature.Action import Dodge.SoundLogic import Dodge.Inventory --import Geometry -import Preload.Update +--import Preload.Update import qualified IntMapHelp as IM import Control.Lens @@ -33,8 +34,14 @@ import Control.Lens import qualified Data.Set as S import SDL -handleEvent :: Event -> World -> Maybe World -handleEvent e = case eventPayload e of + +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 KeyboardEvent kev -> handleKeyboardEvent kev MouseMotionEvent mmev -> handleMouseMotionEvent mmev MouseButtonEvent mbev -> handleMouseButtonEvent mbev @@ -70,13 +77,13 @@ handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World handleResizeEvent sev w = Just . set (config . windowX) (fromIntegral x) . set (config . windowY) (fromIntegral y) - $ over sideEffects up + $ over sideEffects (sideEffectUpdatePreload divRes x y) w 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 +-- 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 x = fromIntegral x' y = fromIntegral y' V2 x' y' = windowSizeChangedEventSize sev diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 4335b0618..d5ca7a3a1 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -159,11 +159,16 @@ pauseMenuOptions = startNewGame :: World -> Maybe World startNewGame w = Just $ w & menuLayers .~ [WaitScreen (const "GENERATING...") 1] - & sideEffects .~ const (generateWorldFromSeed i <&> keyConfig .~ _keyConfig w <&> config .~ _config w - <&> preloadData .~ _preloadData w) -- this kills save games etc... + & sideEffects .~ uvWorld (uvWorldSideEffects i w) where i = fst $ random (_randGen w) +uvWorldSideEffects :: Int -> World -> b -> IO World +uvWorldSideEffects i w = const (generateWorldFromSeed i <&> keyConfig .~ _keyConfig w <&> config .~ _config w + <&> preloadData .~ _preloadData w) +-- this kills save games etc... + + -- | hacky scodeToChar :: Scancode -> Char scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber @@ -176,10 +181,10 @@ updateFramebufferSize w = w & sideEffects %~ up where (x,y) = (round $ getWindowX w, round $ getWindowY w) divRes = w ^. config . resolution_factor - up :: (World -> IO World) -> World -> IO World + up :: (Universe -> IO Universe) -> Universe -> IO Universe up f w' = do - pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData w') - f $ w' & preloadData .~ pdata + pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData (_uvWorld w')) + f $ w' & uvWorld . preloadData .~ pdata --levelMenu :: Int -> ScreenLayer --levelMenu x = OptionScreen