diff --git a/appDodge/Main.hs b/appDodge/Main.hs index d0f92725b..cb8c7d0ca 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -82,6 +82,7 @@ firstWorldLoad theConfig = do ,_menuLayers = [] ,_savedWorlds = M.empty ,_keyConfig = theKeyConfig + , _uvIOEffects = return , _uvTestString = testStringInit } @@ -103,10 +104,9 @@ playSoundUnlessRewinding u doSideEffects :: Universe -> IO Universe doSideEffects u = do - let w = _uvWorld u let preData = _preloadData u newPlayingSounds <- playSoundUnlessRewinding u - u' <- _sideEffects w u + u' <- _uvIOEffects u u endTicks <- SDL.ticks let lastFrameTicks = _frameTimer preData when (debugOn Show_ms_frame $ _uvConfig u) $ void $ renderFoldable @@ -119,7 +119,7 @@ doSideEffects u = do & preloadData . frameTimer .~ endTicks & uvWorld . playingSounds .~ newPlayingSounds & uvWorld . toPlaySounds .~ M.empty - & uvWorld . sideEffects .~ return + & uvIOEffects .~ return fpsText :: (Show a, Ord a, Num a) => a -> Picture fpsText x = color col $ text $ "ms/frame " ++ show x diff --git a/src/Dodge/Config/Update.hs b/src/Dodge/Config/Update.hs index a44430160..f663c5f9d 100644 --- a/src/Dodge/Config/Update.hs +++ b/src/Dodge/Config/Update.hs @@ -5,6 +5,7 @@ module Dodge.Config.Update ( saveConfig , setVolThen , applyWorldConfig + , setVol ) where --import Dodge.Data.SoundOrigin import Dodge.Config.Data diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 5b52c2e9a..39f862441 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -169,6 +169,7 @@ data Universe = Universe , _menuLayers :: [ScreenLayer] , _savedWorlds :: M.Map SaveSlot World , _keyConfig :: KeyConfigSDL + , _uvIOEffects :: Universe -> IO Universe , _uvConfig :: Configuration , _uvTestString :: Universe -> [String] } @@ -244,7 +245,6 @@ data World = World , _rbOptions :: RightButtonOptions , _seenLocations :: IM.IntMap (WdP2,String) , _selLocation :: Int - , _sideEffects :: Universe -> IO Universe , _distortions :: [Distortion] , _worldBounds :: Bounds , _gameRooms :: [GameRoom] -- consider using an IntMap diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 0a82d8f37..f9a9e4a99 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -93,9 +93,6 @@ defaultWorld = World ,(1, (WdP2Const (V2 0 0) , "START POSITION")) ] , _selLocation = 0 - --, _keyConfig = defaultKeyConfigSDL --- , _config = defaultConfig - , _sideEffects = return , _foregroundShapes = mempty , _distortions = [] , _gameRooms = [] diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 73fd93c54..cd815d81a 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -74,7 +74,7 @@ handleResizeEvent :: WindowSizeChangedEventData -> Universe -> IO (Maybe Univers handleResizeEvent sev u = return . Just $ u & uvConfig . windowX .~ fromIntegral x & uvConfig . windowY .~ fromIntegral y - & uvWorld . sideEffects %~ sideEffectUpdatePreload divRes x y + & uvIOEffects %~ sideEffectUpdatePreload divRes x y where x = fromIntegral x' y = fromIntegral y' diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 370c3a2ed..c409af121 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -79,22 +79,24 @@ handlePressedKey _ scode u = case scode of _ | null (_menuLayers u) -> case u ^? uvWorld . hud . hudElement . subInventory of Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> return $ uvWorld (Just . handlePressedKeyTerminal tmid scode) u - _ -> return $ uvWorld (Just . handlePressedKeyInGame scode) u + _ -> return $ (Just . handlePressedKeyInGame scode) u _ -> handlePressedKeyInMenu (head $ _menuLayers u) scode u -handlePressedKeyInGame :: Scancode -> World -> World -handlePressedKeyInGame scode w = case scode of - ScancodeEscape -> pauseGame $ escapeMap w - ScancodeSpace -> spaceAction w - ScancodeP -> pauseGame $ escapeMap w - ScancodeF -> youDropItem w - ScancodeM -> toggleMap w - ScancodeR -> crToggleReloading (you w) w - ScancodeT -> testEvent w - ScancodeX -> w & hud . hudElement %~ toggleTweakInv - ScancodeC -> toggleCombineInv w - ScancodeI -> w & hud . hudElement %~ toggleInspectInv - _ -> w +handlePressedKeyInGame :: Scancode -> Universe -> Universe +handlePressedKeyInGame scode uv = case scode of + ScancodeEscape -> pauseGame $ over uvWorld escapeMap uv + ScancodeSpace -> over uvWorld spaceAction uv + ScancodeP -> pauseGame $ over uvWorld escapeMap uv + ScancodeF -> over uvWorld youDropItem uv + ScancodeM -> over uvWorld toggleMap uv + ScancodeR -> over uvWorld (crToggleReloading (you w)) uv + ScancodeT -> over uvWorld testEvent uv + ScancodeX -> uv & uvWorld . hud . hudElement %~ toggleTweakInv + ScancodeC -> over uvWorld toggleCombineInv uv + ScancodeI -> uv & uvWorld . hud . hudElement %~ toggleInspectInv + _ -> uv + where + w = _uvWorld uv handlePressedKeyTerminal :: Int -> Scancode -> World -> World @@ -138,8 +140,8 @@ spaceAction w = case _hudElement $ _hud w of theLoc = doWorldPos (fst (_seenLocations w IM.! _selLocation w)) w -- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail -pauseGame :: World -> World -pauseGame w = w & sideEffects %~ (. (menuLayers .~ [pauseMenu])) +pauseGame :: Universe -> Universe +pauseGame = menuLayers .~ [pauseMenu] toggleMap :: World -> World toggleMap w = case _hudElement $ _hud w of diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index ca3c53210..4a701fb9c 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -27,7 +27,6 @@ initialWorld = defaultWorld , _randGen = mkStdGen 2 , _mousePos = V2 0 0 , _yourID = 0 - , _sideEffects = return , _worldEvents = SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing : [MakeStartCloudAt (V3 x y 5) | x <- [-5,-4..5] , y <- [-5,-4..5]] , _pressPlates = IM.empty diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 7323f3004..cb8027f4b 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -3,15 +3,11 @@ module Dodge.LevelGen where import Dodge.Data import Dodge.Floor -import Dodge.Save import Dodge.Layout import Dodge.Initialisation ---import Dodge.RandomHelp ---import Dodge.LevelGen.Data import Dodge.Tree import Geometry.ConvexPoly import Dodge.Combine.Graph ---import Dodge.LevelGen.LevelStructure import Data.Foldable import System.Directory @@ -30,7 +26,7 @@ generateWorldFromSeed i = do writeFile "log/aGeneratedRoomLayout" "" generateGraphs (roomList,bounds) <- layoutLevelFromSeed 0 i - return $ saveLevelStartSlot + return -- $ saveLevelStartSlot $ postGenerationProcessing $ generateLevelFromRoomList roomList initialWorld{_randGen=mkStdGen i} & roomClipping .~ bounds diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index e973ba644..61b49362d 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -134,13 +134,13 @@ soundMenuOptions = scod2 (change inc stype) (\w -> Right (str , leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w)::Int))) - change g vt = return . Just . (uvConfig . vt %~ g) . sw + change g vt uv = sw uv >> return (Just $ uv & uvConfig . vt %~ g) dec x = max 0 (x - 0.1) inc x = min 1 (x + 0.1) - sw w = w & uvWorld . sideEffects %~ setVolThen (_uvConfig w) + sw w = setVol (_uvConfig w) writeConfig :: Universe -> Universe -writeConfig w = w & uvWorld . sideEffects %~ saveConfig (_uvConfig w) +writeConfig w = w & uvIOEffects %~ saveConfig (_uvConfig w) graphicsMenu :: ScreenLayer graphicsMenu = slTitleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions diff --git a/src/Dodge/Save.hs b/src/Dodge/Save.hs index a2ccd16a4..08ffceddf 100644 --- a/src/Dodge/Save.hs +++ b/src/Dodge/Save.hs @@ -30,7 +30,7 @@ doQuicksave = saveWorldInSlot QuicksaveSlot clearKeys :: World -> World clearKeys = (keys .~ mempty) . (mouseButtons .~ mempty) -saveLevelStartSlot :: World -> World +saveLevelStartSlot :: Universe -> Universe --saveLevelStartSlot = id -saveLevelStartSlot = sideEffects %~ (fmap (saveWorldInSlot LevelStartSlot) . ) +saveLevelStartSlot = saveWorldInSlot LevelStartSlot --saveLevelStartSlot = sideEffects %~ (fmap (undefined) . ) diff --git a/src/Dodge/StartNewGame.hs b/src/Dodge/StartNewGame.hs index c8cd141ad..3d82ec9d1 100644 --- a/src/Dodge/StartNewGame.hs +++ b/src/Dodge/StartNewGame.hs @@ -12,7 +12,7 @@ startNewGame u = startSeedGame i u startSeedGame :: Int -> Universe -> Universe startSeedGame i u = u & menuLayers .~ [WaitScreen (const "GENERATING...") 1] - & uvWorld . sideEffects .~ \_ -> do + & uvIOEffects .~ \_ -> do w <- generateWorldFromSeed i return $ u & menuLayers .~ [] & uvWorld .~ w & savedWorlds . at LevelStartSlot ?~ w diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 7d4b09566..b3c6a6b8c 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -62,7 +62,7 @@ updateUniverse u = case _menuLayers u of {- | The update step. -} functionalUpdate :: Universe -> Universe -functionalUpdate w = over uvWorld checkEndGame +functionalUpdate w = checkEndGame -- . updateRandGen . over uvWorld (mouseButtons . each .~ True) -- to determine if the mouse button is held . over uvWorld (worldClock +~ 1) @@ -364,13 +364,15 @@ markWallSeen !w !i = w { _walls = IM.adjust markSeen i $ _walls w } markSeen :: Wall -> Wall markSeen wl = wl {_wlSeen = True} -checkEndGame :: World -> World -checkEndGame w = case _deathDelay w of - Just x | x < 0 -> w & sideEffects %~ ( . (menuLayers .~ [gameOverMenu])) - & deathDelay .~ Nothing - Just _ -> w & deathDelay . _Just -~ 1 - _ | _crHP (you w) < 1 -> w & deathDelay ?~ 50 - _ -> w +checkEndGame :: Universe -> Universe +checkEndGame uv = case _deathDelay w of + Just x | x < 0 -> uv & menuLayers .~ [gameOverMenu] + & uvWorld . deathDelay .~ Nothing + Just _ -> uv & uvWorld . deathDelay . _Just -~ 1 + _ | _crHP (you w) < 1 -> uv & uvWorld . deathDelay ?~ 50 + _ -> uv + where + w = _uvWorld uv updateGusts :: World -> World updateGusts w = w