diff --git a/appDodge/Main.hs b/appDodge/Main.hs index 089144c93..7e16225da 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -56,10 +56,13 @@ firstWorldLoad theConfig = do theKeyConfig <- loadKeyConfig pdata <- doPreload >>= applyWorldConfig theConfig w <- generateWorldFromSeed 0 - return $ Universe ( w - & keyConfig .~ theKeyConfig - & config .~ theConfig - ) pdata + return $ Universe + {_uvWorld = w + & keyConfig .~ theKeyConfig + & config .~ theConfig + ,_preloadData = pdata + ,_menuLayers = [] + } theUpdateStep :: Universe -> IO Universe theUpdateStep = doSideEffects <=< updateRenderSplit @@ -67,8 +70,8 @@ theUpdateStep = doSideEffects <=< updateRenderSplit updateRenderSplit :: Universe -> IO Universe updateRenderSplit u = do let preData = _preloadData u - update (_uvWorld u) `par` void (doDrawing (_renderData preData) (_uvWorld u)) - return $ u {_uvWorld = update (_uvWorld u)} + updateUniverse u `par` void (doDrawing (_renderData preData) u) + return $ updateUniverse u playSoundUnlessRewinding :: Universe -> IO (M.Map SoundOrigin Sound) playSoundUnlessRewinding u diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 43aa6bfb7..7dc4bf42e 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -55,6 +55,7 @@ type CRUpdate = Creature -> World -> (Endo World, Maybe Creature) data Universe = Universe { _uvWorld :: World , _preloadData :: PreloadData + , _menuLayers :: [ScreenLayer] } data World = World { _keys :: !(S.Set Scancode) @@ -98,7 +99,6 @@ data World = World , _pathGraph :: ~(Gr Point2 Float) , _pathGraphP :: ~[(Point2,Point2)] , _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)])) - , _menuLayers :: [ScreenLayer] , _worldFlags :: S.Set WorldFlag , _carteDisplay :: !Bool , _carteCenter :: !Point2 @@ -129,37 +129,37 @@ data SaveSlot = QuicksaveSlot | LevelStartSlot data OptionScreenFlag = NormalOptions | GameOverOptions data ScreenLayer = OptionScreen - { _scTitle :: World -> String + { _scTitle :: Universe -> String , _scOptions :: [MenuOption] - , _scDefaultEff :: World -> Maybe World + , _scDefaultEff :: Universe -> Maybe Universe , _scOptionFlag :: OptionScreenFlag } | ColumnsScreen String [(String,String)] | InputScreen String | TerminalScreen Int [(Int,String)] | WaitScreen - { _scWaitMessage :: World -> String + { _scWaitMessage :: Universe -> String , _scWaitTime :: Int } | DisplayScreen - { _scDisplay :: World -> Picture + { _scDisplay :: Universe -> Picture } data MenuOption = Toggle { _moKey :: Scancode - , _moEff :: World -> Maybe World - , _moString :: World -> String + , _moEff :: Universe -> Maybe Universe + , _moString :: Universe -> String } | Toggle2 { _moKey1 :: Scancode - , _moEff1 :: World -> Maybe World + , _moEff1 :: Universe -> Maybe Universe , _moKey2 :: Scancode - , _moEff2 :: World -> Maybe World - , _moString :: World -> String + , _moEff2 :: Universe -> Maybe Universe + , _moString :: Universe -> String } | InvisibleToggle { _moKey :: Scancode - , _moEff :: World -> Maybe World + , _moEff :: Universe -> Maybe Universe } data InventoryMode = TopInventory diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index b6a7ce630..40381694b 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -55,7 +55,7 @@ defaultWorld = World , _corpses = Zone IM.empty , _decorations = IM.empty , _savedWorlds = M.empty - , _menuLayers = [] +-- , _menuLayers = [] , _worldFlags = S.empty , _clickMousePos = V2 0 0 , _pathGraph = Data.Graph.Inductive.Graph.empty diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 2c57d0888..81c1f76f8 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -93,7 +93,7 @@ handlePressedMouseButton but w | otherwise = Just w handleMouseWheelEvent :: MouseWheelEventData -> Universe -> Maybe Universe -handleMouseWheelEvent mwev w = case _menuLayers (_uvWorld w) of +handleMouseWheelEvent mwev w = case _menuLayers w of [] -> case mouseWheelEventPos mwev of V2 _ y -> Just $ w & uvWorld %~ wheelEvent (fromIntegral y) _ -> Just w diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 5cdacce55..becb80a98 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -35,15 +35,15 @@ handlePressedKey :: Bool -> Scancode -> Universe -> Maybe Universe handlePressedKey True _ w = Just w handlePressedKey _ ScancodeF5 w = Just $ over uvWorld doQuicksave w handlePressedKey _ ScancodeF9 w = Just $ over uvWorld (loadSaveSlot QuicksaveSlot) w -handlePressedKey _ ScancodeSemicolon w = Just $ over uvWorld gotoTerminal w +handlePressedKey _ ScancodeSemicolon w = Just $ gotoTerminal w handlePressedKey _ scode w - | null (_menuLayers (_uvWorld w)) = uvWorld (handlePressedKeyInGame scode) w - | otherwise = handlePressedKeyInMenu (head $ _menuLayers (_uvWorld w)) scode w + | null (_menuLayers w) = uvWorld (handlePressedKeyInGame scode) w + | otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w handlePressedKeyInGame :: Scancode -> World -> Maybe World handlePressedKeyInGame scode w | scode == escapeKey (_keyConfig w) = Nothing - | scode == pauseKey (_keyConfig w) = Just $ pauseGame $ escapeMap w +-- | scode == pauseKey (_keyConfig w) = Just $ pauseGame $ escapeMap w | scode == dropItemKey (_keyConfig w) = Just $ youDropItem w | scode == toggleMapKey (_keyConfig w) = Just $ toggleMap w | scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ startReloadingWeapon (you w) w @@ -61,7 +61,7 @@ toggleInv x y | x == y = TopInventory | otherwise = x -gotoTerminal :: World -> World +gotoTerminal :: Universe -> Universe gotoTerminal w = case _menuLayers w of (InputScreen _ : _ ) -> w _ -> w & menuLayers %~ (InputScreen [] :) @@ -77,7 +77,7 @@ spaceAction w = if _carteDisplay w theLoc = fst (_seenLocations w IM.! _selLocation w) w updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail -pauseGame :: World -> World +pauseGame :: Universe -> Universe pauseGame w = w {_menuLayers = [pauseMenu]} toggleMap :: World -> World diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index 4d8d69cd9..7ab709d9d 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -13,29 +13,30 @@ import SDL handlePressedKeyInMenu :: ScreenLayer -> Scancode -> Universe -> Maybe Universe handlePressedKeyInMenu mState scode = case mState of OptionScreen { _scOptions = mos, _scDefaultEff = defeff} - -> uvWorld $ optionListToEffects mos defeff scode - DisplayScreen {} -> uvWorld $ popScreen - ColumnsScreen {} -> uvWorld $ popScreen + -> optionListToEffects mos defeff scode + DisplayScreen {} -> popScreen + ColumnsScreen {} -> popScreen WaitScreen {} -> Just - TerminalScreen 0 _ -> uvWorld $ popScreen - TerminalScreen _ m -> Just . (uvWorld . menuLayers %~ ( (TerminalScreen 0 m : ) . tail) ) + TerminalScreen 0 _ -> popScreen + TerminalScreen _ m -> Just . (menuLayers %~ ( (TerminalScreen 0 m : ) . tail) ) InputScreen s -> case scode of - ScancodeEscape -> uvWorld $ popScreen - ScancodeReturn -> uvWorld $ popScreen . applyTerminalString s + ScancodeEscape -> popScreen + ScancodeReturn -> popScreen . (over uvWorld $ applyTerminalString s) ScancodeBackspace - -> uvWorld $ popScreen >=> pushScreen (InputScreen $ dropLast s) - _ -> uvWorld $ popScreen >=> pushScreen (InputScreen $ s ++ [scodeToChar scode]) + -> popScreen >=> pushScreen (InputScreen $ dropLast s) + _ -> popScreen >=> pushScreen (InputScreen $ s ++ [scodeToChar scode]) where dropLast (x:xs) = init (x:xs) dropLast _ = [] -optionListToEffects :: [MenuOption] -> (World -> Maybe World) -> Scancode -> World -> Maybe World +optionListToEffects :: [MenuOption] -> (Universe -> Maybe Universe) -> Scancode + -> Universe -> Maybe Universe optionListToEffects mos defaulteff sc w = case lookup sc listEffects of Nothing -> defaulteff w Just eff -> eff w where listEffects = concatMap menuOptionToEffects mos -menuOptionToEffects :: MenuOption -> [(Scancode,World -> Maybe World)] +menuOptionToEffects :: MenuOption -> [(Scancode,Universe -> Maybe Universe)] menuOptionToEffects Toggle {_moKey = k, _moEff = eff} = [(k,eff)] menuOptionToEffects InvisibleToggle {_moKey = k, _moEff = eff} = [(k,eff)] menuOptionToEffects Toggle2 diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index dfbda14cb..496b02daa 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -34,7 +34,7 @@ initialWorld = defaultWorld , _buttons = IM.empty , _toPlaySounds = M.empty , _decorations = IM.empty - , _menuLayers = [TerminalScreen 300 rezText'] +-- , _menuLayers = [TerminalScreen 300 rezText'] } testStringInit :: World -> [String] diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index a19829d5d..eee15bf43 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -40,7 +40,7 @@ debugMenu :: ScreenLayer debugMenu = OptionScreen { _scTitle = const "OPTIONS:GAMEPLAY" , _scOptions = debugMenuOptions - , _scDefaultEff = popScreen . writeConfig + , _scDefaultEff = popScreen . over uvWorld writeConfig , _scOptionFlag = NormalOptions } debugMenuOptions :: [MenuOption] @@ -53,12 +53,12 @@ debugMenuOptions = ] where doption scode l t rec - = Toggle scode (Just . (config . l %~ not)) (\w -> t ++ ":" ++ show (rec $ _config w)) + = Toggle scode (Just . (uvWorld . config . l %~ not)) (\w -> t ++ ":" ++ show (rec $ _config (_uvWorld w))) gameplayMenu :: ScreenLayer gameplayMenu = OptionScreen { _scTitle = const "OPTIONS:GAMEPLAY" , _scOptions = gameplayMenuOptions - , _scDefaultEff = popScreen . writeConfig + , _scDefaultEff = popScreen . over uvWorld writeConfig , _scOptionFlag = NormalOptions } gameplayMenuOptions :: [MenuOption] @@ -67,43 +67,43 @@ gameplayMenuOptions = , option ScancodeS show_sound "SHOW VISUAL SOUNDS" _show_sound ] where - option scode l t rec = Toggle scode (Just . (config . l %~ not)) - (\w -> t ++ ":" ++ show (rec $ _config w)) + option scode l t rec = Toggle scode (Just . (uvWorld . config . l %~ not)) + (\w -> t ++ ":" ++ show (rec $ _config (_uvWorld w))) soundMenu :: ScreenLayer soundMenu = OptionScreen { _scTitle = const "OPTIONS:VOLUME" , _scOptions = soundMenuOptions - , _scDefaultEff = popScreen . writeConfig + , _scDefaultEff = popScreen . over uvWorld writeConfig , _scOptionFlag = NormalOptions } soundMenuOptions :: [MenuOption] soundMenuOptions = [ Toggle2 ScancodeY (master dec . sw) - ScancodeU (master inc . sw) (\w -> "MASTER VOLUME:" ++ mavol w) + ScancodeU (master inc . sw) (\w -> "MASTER VOLUME:" ++ mavol (_uvWorld w)) , Toggle2 ScancodeH (soundEffs dec . sw) - ScancodeJ (soundEffs inc . sw) (\w -> "EFFECTS VOLUME:" ++ snvol w) + ScancodeJ (soundEffs inc . sw) (\w -> "EFFECTS VOLUME:" ++ snvol (_uvWorld w)) , Toggle2 ScancodeN (music dec . sw) - ScancodeM (music inc . sw) (\w -> "MUSIC VOLUME:" ++ muvol w) + ScancodeM (music inc . sw) (\w -> "MUSIC VOLUME:" ++ muvol (_uvWorld w)) ] where dec x = max 0 (x - 0.1) inc x = min 1 (x + 0.1) --sw w = w & sideEffects %~ (setVol (_config w) : ) - sw w = w & sideEffects %~ setVolThen (_config w) - master g = Just . (config . volume_master %~ g) - soundEffs g = Just . (config . volume_sound %~ g) - music g = Just . (config . volume_music %~ g) + sw w = w & uvWorld . sideEffects %~ setVolThen (_config (_uvWorld w)) + master g = Just . (uvWorld . config . volume_master %~ g) + soundEffs g = Just . (uvWorld . config . volume_sound %~ g) + music g = Just . (uvWorld . config . volume_music %~ g) cfig w = _config w mavol w = f $ _volume_master $ cfig w snvol w = f $ _volume_sound $ cfig w muvol w = f $ _volume_music $ cfig w f x = show (round $ 10 * x :: Int) -pushScreen :: ScreenLayer -> World -> Maybe World +pushScreen :: ScreenLayer -> Universe -> Maybe Universe pushScreen ml w = Just $ w & menuLayers %~ (ml :) -popScreen :: World -> Maybe World +popScreen :: Universe -> Maybe Universe popScreen = Just . (menuLayers %~ tail) writeConfig :: World -> World @@ -113,20 +113,20 @@ graphicsMenu :: ScreenLayer graphicsMenu = OptionScreen { _scTitle = const "OPTIONS:GRAPHICS" , _scOptions = graphicsMenuOptions - , _scDefaultEff = popScreen . writeConfig + , _scDefaultEff = popScreen . over uvWorld writeConfig , _scOptionFlag = NormalOptions } graphicsMenuOptions :: [MenuOption] graphicsMenuOptions = - [ Toggle ScancodeW (Just . (config . wall_textured %~ not)) wtextstring + [ Toggle ScancodeW (Just . (uvWorld . config . wall_textured %~ not)) wtextstring , Toggle ScancodeS upf resostring - , Toggle ScancodeD (Just . (config . cloud_shadows %~ not)) cshadstring + , Toggle ScancodeD (Just . (uvWorld . config . cloud_shadows %~ not)) cshadstring ] where - wtextstring w = "WALL TEXTURES:" ++ show (_wall_textured $ _config w) - resostring w = "RESOLUTION: 1/" ++ show (_resolution_factor $ _config w) - upf w = Just $ updateFramebufferSize $ w & config . resolution_factor %~ cycleResolution - cshadstring w = "CLOUD SHADOWS:" ++ show (_cloud_shadows $ _config w) + wtextstring w = "WALL TEXTURES:" ++ show (_wall_textured $ _config (_uvWorld w)) + resostring w = "RESOLUTION: 1/" ++ show (_resolution_factor $ _config (_uvWorld w)) + upf w = Just $ over uvWorld updateFramebufferSize $ w & uvWorld . config . resolution_factor %~ cycleResolution + cshadstring w = "CLOUD SHADOWS:" ++ show (_cloud_shadows $ _config (_uvWorld w)) cycleResolution :: (Eq a, Num a, Num p) => a -> p cycleResolution 1 = 2 @@ -152,17 +152,17 @@ pauseMenu = OptionScreen pauseMenuOptions :: [MenuOption] pauseMenuOptions = [ Toggle ScancodeN startNewGame (const "NEW LEVEL") - , Toggle ScancodeR (Just . loadSaveSlot LevelStartSlot) (const "RESTART") + , Toggle ScancodeR (uvWorld (Just . loadSaveSlot LevelStartSlot)) (const "RESTART") , Toggle ScancodeO (pushScreen optionMenu ) (const "OPTIONS") , Toggle ScancodeC (pushScreen displayControls) (const "CONTROLS") , InvisibleToggle ScancodeEscape (const Nothing) ] -startNewGame :: World -> Maybe World +startNewGame :: Universe -> Maybe Universe startNewGame w = Just $ w & menuLayers .~ [WaitScreen (const "GENERATING...") 1] - & sideEffects .~ uvWorld (uvWorldSideEffects i w) + & uvWorld . sideEffects .~ uvWorld (uvWorldSideEffects i (_uvWorld w)) where - i = fst $ random (_randGen w) + i = fst $ random (_randGen (_uvWorld w)) uvWorldSideEffects :: Int -> World -> b -> IO World uvWorldSideEffects i w = const (generateWorldFromSeed i <&> keyConfig .~ _keyConfig w <&> config .~ _config w @@ -195,8 +195,8 @@ updateFramebufferSize w = w & sideEffects %~ sideEffectUpdatePreload divRes x y -- , _scDefaultEff = unpause . storeLevel -- , _scOptionFlag = NormalOptions -- } -unpause :: World -> Maybe World -unpause w = Just . resumeSound $ w {_menuLayers = []} +unpause :: Universe -> Maybe Universe +unpause w = Just . resumeSound $ w & menuLayers .~ [] displayControls :: ScreenLayer displayControls = ColumnsScreen "CONTROLS" listControls diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 8f87f3f08..9a5c3b044 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -30,8 +30,9 @@ import qualified SDL import qualified Data.Vector.Unboxed.Mutable as UMV import Graphics.GL.Core43 -doDrawing :: RenderData -> World -> IO Word32 -doDrawing pdata w = do +doDrawing :: RenderData -> Universe -> IO Word32 +doDrawing pdata u = do + let w = _uvWorld u sTicks <- SDL.ticks let rot = _cameraRot w camzoom = _cameraZoom w @@ -245,7 +246,7 @@ doDrawing pdata w = do blendFunc $= (SrcAlpha,OneMinusSrcAlpha) renderLayer 4 shadV layerCounts bufferUBO $ isoMatrix 0 1 (V2 0 0) (V2 2 2) - renderFoldable shadV $ fixedCoordPictures w + renderFoldable shadV $ fixedCoordPictures u depthMask $= Enabled eTicks <- SDL.ticks return (eTicks - sTicks) diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index 63a2c2df7..924cc40af 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -9,18 +9,15 @@ import Picture import Dodge.Menu import Padding -menuScreen - :: World - -> ScreenLayer - -> Picture +menuScreen :: Universe -> ScreenLayer -> Picture menuScreen w screen = case screen of OptionScreen {_scTitle = titf, _scOptions = mos} -> drawOptions w (titf w) mos (WaitScreen sf _) -> drawOptions w (sf w) [] (InputScreen s) -> drawOptions w ('>':s) [] - (TerminalScreen t xs ) -> displayStringList w $ map snd $ filter (( > t) . fst) xs + (TerminalScreen t xs ) -> displayStringList (_uvWorld w) $ map snd $ filter (( > t) . fst) xs (DisplayScreen sd ) -> sd w - (ColumnsScreen title pairs) -> drawTwoColumnsScreen w title pairs + (ColumnsScreen title pairs) -> drawTwoColumnsScreen (_uvWorld w) title pairs displayStringList :: World -> [String] -> Picture displayStringList w ss = pictures @@ -52,14 +49,13 @@ drawTwoColumns w lps = pictures $ zipWith f [hh-100,hh-130..] lps hw = halfWidth w ln = maximum (map (length . fst) lps) + 3 -drawOptions - :: World +drawOptions :: Universe -> String -- ^ Title -> [MenuOption] -- ^ Options -> Picture drawOptions w title ops = pictures $ - [darkenBackground w - ,drawTitle w title] + [darkenBackground (_uvWorld w) + ,drawTitle (_uvWorld w) title] ++ zipWith (\ s vpos -> placeString (-hw + 50) vpos 0.2 s) (map (menuOptionToString w) ops') [hh-100,hh-150 ..] where @@ -67,8 +63,8 @@ drawOptions w title ops = pictures $ notInvisible InvisibleToggle {} = False notInvisible _ = True placeString x y sc t = translate x y $ scale sc sc $ color white $ text t - hh = halfHeight w - hw = halfWidth w + hh = halfHeight (_uvWorld w) + hw = halfWidth (_uvWorld w) darkenBackground :: World -> Picture darkenBackground = color (withAlpha 0.5 black) . polygon . screenBox @@ -80,7 +76,7 @@ drawTitle w = placeString (-hw + 30) (hh - 50) 0.4 hh = halfHeight w hw = halfWidth w -menuOptionToString :: World -> MenuOption -> String +menuOptionToString :: Universe -> MenuOption -> String menuOptionToString w mo = theKeys ++ _moString mo w where theKeys :: String diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index cbecea4ea..1b54e13f6 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -10,15 +10,15 @@ import Dodge.Render.MenuScreen import Geometry import Picture -fixedCoordPictures :: World -> Picture +fixedCoordPictures :: Universe -> Picture fixedCoordPictures w = case _menuLayers w of [] -> pictures - [ hudDrawings w - , customMouseCursor w + [ hudDrawings (_uvWorld w) + , customMouseCursor (_uvWorld w) ] (lay:_) -> scaler . onLayer MenuDepth $ menuScreen w lay where - scaler = setDepth (-1) . scale (2 / getWindowX w) (2 / getWindowY w) + scaler = setDepth (-1) . scale (2 / getWindowX (_uvWorld w)) (2 / getWindowY (_uvWorld w)) customMouseCursor :: World -> Picture customMouseCursor w = diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index e61c9cfcc..4a47466da 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -40,7 +40,7 @@ pauseSound :: World -> World pauseSound w = w {-| Placeholder...-} -resumeSound :: World -> World +resumeSound :: Universe -> Universe resumeSound w = w soundWithStatus diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 8399ce5e5..a651e41a9 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -2,7 +2,10 @@ Module : Dodge.Update Description : Simulation update -} -module Dodge.Update (update) where +module Dodge.Update + (update + ,updateUniverse + ) where import Dodge.Data import Dodge.Hammer import Dodge.Block @@ -27,47 +30,51 @@ import Control.Lens import Data.Monoid import System.Random +updateUniverse :: Universe -> Universe +updateUniverse w = case _menuLayers w of + (TerminalScreen t xs:mls) -> w & menuLayers .~ (TerminalScreen (max (t-1) 0) xs:mls) + (WaitScreen s i : _) + | i < 1 -> w & over uvWorld (dbArg _worldEvents) + | otherwise -> w & menuLayers %~ ( (WaitScreen s (i-1) :) . tail ) + (OptionScreen {_scOptionFlag = GameOverOptions} : _) -> + -- updateParticles + -- . updateProjectiles + -- . updateLightSources + -- $ updateClouds + w + (_ : _) -> w + [] -> over uvWorld update w + update :: World -> World update = (frameClock +~ 1) . functionalUpdate {- | The update step. For most menus the only way to change the world is using event handling. -} functionalUpdate :: World -> World -functionalUpdate w = case _menuLayers w of - (TerminalScreen t xs:mls) -> w & menuLayers .~ (TerminalScreen (max (t-1) 0) xs:mls) - (WaitScreen s i : _) - | i < 1 -> w & dbArg _worldEvents - | otherwise -> w & menuLayers %~ ( (WaitScreen s (i-1) :) . tail ) - (OptionScreen {_scOptionFlag = GameOverOptions} : _) -> updateParticles - . updateProjectiles - . updateLightSources - $ updateClouds - w - (_ : _) -> w - [] -> checkEndGame - . updateDistortions - . updateCreatureSoundPositions - . ppEvents - . updateCamera - . colCrsWalls --- . ifConfigWallRotate - . simpleCrSprings - . zoneCreatures - . updateDoors - . resetWorldEvents - . dbArg _worldEvents - . updateModifications - . updateParticles - . updateProjectiles - . updateLightSources - . updateClouds - . zoneClouds - . updateMachines - . updateCreatures - . updateCreatureGroups - . updateBlocks - . updateSeenWalls - . (lSelHammerPosition %~ moveHammerUp) - $ updateCloseObjects w +functionalUpdate w = checkEndGame + . updateDistortions + . updateCreatureSoundPositions + . ppEvents + . updateCamera + . colCrsWalls +-- . ifConfigWallRotate + . simpleCrSprings + . zoneCreatures + . updateDoors + . resetWorldEvents + . dbArg _worldEvents + . updateModifications + . updateParticles + . updateProjectiles + . updateLightSources + . updateClouds + . zoneClouds + . updateMachines + . updateCreatures + . updateCreatureGroups + . updateBlocks + . updateSeenWalls + . (lSelHammerPosition %~ moveHammerUp) + $ updateCloseObjects w where --updatedLightSources = mapMaybe (\b -> _tlsUpdate b w b) $ _tempLightSources w zoneCreatures = set (creaturesZone . znObjects) @@ -171,7 +178,7 @@ markWallSeen w wl = w { _walls = IM.adjust mw (_wlID wl) $ _walls w } checkEndGame :: World -> World checkEndGame w - | _crHP (you w) < 1 = haltSound $ w {_menuLayers = [gameOverMenu]} + | _crHP (you w) < 1 = undefined -- haltSound $ w {_menuLayers = [gameOverMenu]} | otherwise = w updateClouds :: World -> World