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

Move menu layers outside of world

Browse Source
This commit is contained in:
justin
2021-11-28 14:26:15 +00:00
parent 574f195b21
commit 462100703c
13 changed files with 132 additions and 124 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Menu.hs
+28 -28
View File
@@ -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