Move menu layers outside of world

appDodge/Main.hs

@@ -56,10 +56,13 @@ firstWorldLoad theConfig = do
     theKeyConfig <- loadKeyConfig
     pdata <- doPreload >>= applyWorldConfig theConfig
     w <- generateWorldFromSeed 0
-    return $ Universe ( w
+    return $ Universe 
+        {_uvWorld = w
             & keyConfig .~ theKeyConfig
             & config .~ theConfig
-        ) pdata
+        ,_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))
+    updateUniverse u `par` void (doDrawing (_renderData preData) u)
-    return $ u {_uvWorld = update (_uvWorld u)}
+    return $ updateUniverse u
 
 playSoundUnlessRewinding :: Universe -> IO (M.Map SoundOrigin Sound)
 playSoundUnlessRewinding u

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
+        , _moEff    :: Universe -> Maybe Universe
-        , _moString :: World -> String
+        , _moString :: Universe -> String
         }
     | Toggle2
         { _moKey1   :: Scancode
-        , _moEff1   :: World -> Maybe World
+        , _moEff1   :: Universe -> Maybe Universe
         , _moKey2   :: Scancode
-        , _moEff2   :: World -> Maybe World
+        , _moEff2   :: Universe -> Maybe Universe
-        , _moString :: World -> String
+        , _moString :: Universe -> String
         }
     | InvisibleToggle
         { _moKey    :: Scancode
-        , _moEff    :: World -> Maybe World
+        , _moEff    :: Universe -> Maybe Universe
         }
 data InventoryMode
     = TopInventory

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

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

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
+    | null (_menuLayers w)      = uvWorld (handlePressedKeyInGame scode) w
-    | otherwise                 = handlePressedKeyInMenu (head $ _menuLayers (_uvWorld w)) 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

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
+                        -> optionListToEffects mos defeff scode
-    DisplayScreen {}    -> uvWorld $ popScreen
+    DisplayScreen {}    -> popScreen
-    ColumnsScreen {}    -> uvWorld $ popScreen
+    ColumnsScreen {}    -> popScreen
     WaitScreen {}       -> Just
-    TerminalScreen 0 _  -> uvWorld $ popScreen
+    TerminalScreen 0 _  -> popScreen
-    TerminalScreen _ m  -> Just . (uvWorld . menuLayers %~ ( (TerminalScreen 0 m : ) . tail) )
+    TerminalScreen _ m  -> Just . (menuLayers %~ ( (TerminalScreen 0 m : ) . tail) )
     InputScreen s       -> case scode of
-        ScancodeEscape  -> uvWorld $ popScreen
+        ScancodeEscape  -> popScreen
-        ScancodeReturn  -> uvWorld $ popScreen . applyTerminalString s
+        ScancodeReturn  -> popScreen . (over uvWorld $ applyTerminalString s)
         ScancodeBackspace 
-            -> uvWorld $ popScreen >=> pushScreen (InputScreen $ dropLast s)
+            -> popScreen >=> pushScreen (InputScreen $ dropLast s)
-        _   -> uvWorld $ popScreen >=> pushScreen (InputScreen $ s ++ [scodeToChar scode])
+        _   -> 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 

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]

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)) 
+    option scode l t rec = Toggle scode (Just . (uvWorld . config . l %~ not)) 
-        (\w -> t ++ ":" ++ show (rec $ _config w))
+        (\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)
+    sw w = w & uvWorld . sideEffects %~ setVolThen (_config (_uvWorld w))
-    master g    = Just . (config . volume_master %~ g)
+    master g    = Just . (uvWorld . config . volume_master %~ g)
-    soundEffs g = Just . (config . volume_sound %~ g)
+    soundEffs g = Just . (uvWorld . config . volume_sound %~ g)
-    music g     = Just . (config . volume_music %~ 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)
+    wtextstring w = "WALL TEXTURES:" ++ show (_wall_textured $ _config (_uvWorld w))
-    resostring w  = "RESOLUTION: 1/" ++ show (_resolution_factor $ _config w)
+    resostring w  = "RESOLUTION: 1/" ++ show (_resolution_factor $ _config (_uvWorld w))
-    upf w = Just $ updateFramebufferSize $ w & config . resolution_factor %~ cycleResolution
+    upf w = Just $ over uvWorld updateFramebufferSize $ w & uvWorld . config . resolution_factor %~ cycleResolution
-    cshadstring w = "CLOUD SHADOWS:" ++ show (_cloud_shadows $ _config w)
+    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 :: Universe -> Maybe Universe
-unpause w = Just . resumeSound $ w {_menuLayers = []}
+unpause w = Just . resumeSound $ w & menuLayers .~ []
 
 displayControls :: ScreenLayer
 displayControls = ColumnsScreen "CONTROLS" listControls

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 :: RenderData -> Universe -> IO Word32
-doDrawing pdata w = do
+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)

src/Dodge/Render/MenuScreen.hs

@@ -9,18 +9,15 @@ import Picture
 import Dodge.Menu
 import Padding
 
-menuScreen 
+menuScreen :: Universe -> ScreenLayer -> Picture
-    :: World
-    -> 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
+drawOptions :: Universe
-    :: World
     -> String       -- ^ Title
     -> [MenuOption] -- ^ Options
     -> Picture
 drawOptions w title ops = pictures $
-    [darkenBackground w
+    [darkenBackground (_uvWorld w)
-    ,drawTitle w title]
+    ,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
+    hh = halfHeight (_uvWorld w)
-    hw = halfWidth 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

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
+        [ hudDrawings (_uvWorld w)
-        , customMouseCursor 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 = 

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

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,23 +30,27 @@ 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
+functionalUpdate w = checkEndGame 
-    (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 
@@ -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