justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Move universe IO effects outside of world

Browse Source
This commit is contained in:
justin
2022-07-23 12:53:20 +01:00
parent 2892bb25f0
commit 12fad676f2
12 changed files with 41 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Config/Update.hs
+1
View File
@@ -5,6 +5,7 @@ module Dodge.Config.Update
( saveConfig
, setVolThen
, applyWorldConfig
, setVol
) where
--import Dodge.Data.SoundOrigin
import Dodge.Config.Data
src/Dodge/Data.hs
+1 -1
View File
@@ -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
src/Dodge/Default/World.hs
-3
View File
@@ -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 = []
src/Dodge/Event.hs
+1 -1
View File
@@ -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'
src/Dodge/Event/Keyboard.hs
+18 -16
View File
@@ -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
src/Dodge/Initialisation.hs
-1
View File
@@ -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
src/Dodge/LevelGen.hs
+1 -5
View File
@@ -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
src/Dodge/Menu.hs
+3 -3
View File
@@ -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
src/Dodge/Save.hs
+2 -2
View File
@@ -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) . )
src/Dodge/StartNewGame.hs
+1 -1
View File
@@ -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
src/Dodge/Update.hs
+10 -8
View File
@@ -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