Cleanup
This commit is contained in:
+64
-77
@@ -4,11 +4,13 @@ module Dodge.Menu (
|
||||
splashMenu,
|
||||
) where
|
||||
|
||||
import Dodge.Data.SelectionList
|
||||
import ShortShow
|
||||
import Control.Monad
|
||||
--import SDL
|
||||
|
||||
import Data.Maybe
|
||||
import Dodge.Concurrent
|
||||
import Dodge.Config.Update
|
||||
import Dodge.Data.SelectionList
|
||||
import Dodge.Data.Universe
|
||||
import Dodge.Menu.Option
|
||||
import Dodge.Menu.OptionType
|
||||
@@ -20,65 +22,65 @@ import Dodge.StartNewGame
|
||||
import LensHelp
|
||||
import MaybeHelp
|
||||
import Padding
|
||||
--import SDL
|
||||
import ShortShow
|
||||
import System.Clipboard
|
||||
import Text.Read
|
||||
import Data.Maybe
|
||||
|
||||
splashMenu :: Universe -> ScreenLayer
|
||||
splashMenu u =
|
||||
initializeOptionMenu "AMNESIS" splashMenuOptions Nothing id u
|
||||
initializeOptionMenu "AMNESIS" splashMenuOptions NoPositionedMenuOption u
|
||||
& scOptionFlag .~ SplashOptions
|
||||
|
||||
splashMenuOptions :: [MenuOption]
|
||||
splashMenuOptions =
|
||||
[ Toggle ( loadSaveSlot (SaveSlotNum 0)) displaycontinue
|
||||
, Toggle id (\u -> MODString $ show $ u ^? uvScreenLayers . _head . scSelectionList . slSelPos . _Just)
|
||||
, Toggle id (\u -> MODString $ shortShow $ u ^. uvWorld . input . mousePos)
|
||||
, Toggle ( startNewGameInSlot 0) (opText "NEW WITH RANDOM SEED")
|
||||
, Toggle reloadLevelStart (displaywhenseed "NEW WITH LAST SEED")
|
||||
, Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW WITH SPECIFIC SEED")
|
||||
, Toggle (pushScreen optionMenu) (opText "OPTIONS")
|
||||
, Toggle (pushScreen displayControls) (opText "VIEW CONTROLS")
|
||||
, Toggle id (displaywhenseed "VIEW LAST SEED")
|
||||
, Toggle hardQuit (opText "QUIT")
|
||||
]
|
||||
[ Toggle (loadSaveSlot (SaveSlotNum 0)) displaycontinue
|
||||
, Toggle id (\u -> MODString $ show $ u ^? uvScreenLayers . _head . scSelectionList . slSelPos . _Just)
|
||||
, Toggle id (\u -> MODString $ shortShow $ u ^. uvWorld . input . mousePos)
|
||||
, Toggle (startNewGameInSlot 0) (opText "NEW WITH RANDOM SEED")
|
||||
, Toggle reloadLevelStart (displaywhenseed "NEW WITH LAST SEED")
|
||||
, Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW WITH SPECIFIC SEED")
|
||||
, Toggle (pushScreen optionMenu) (opText "OPTIONS")
|
||||
, Toggle (pushScreen displayControls) (opText "VIEW CONTROLS")
|
||||
, Toggle id (displaywhenseed "VIEW LAST SEED")
|
||||
, Toggle hardQuit (opText "QUIT")
|
||||
]
|
||||
where
|
||||
opText = const . MODString
|
||||
displaycontinue u | _uvCanContinue u = MODString "CONTINUE"
|
||||
displaycontinue u
|
||||
| _uvCanContinue u = MODString "CONTINUE"
|
||||
| otherwise = MODBlockedString "CONTINUE"
|
||||
displaywhenseed str u | isNothing (_uvMSeed u) = MODBlockedString str
|
||||
displaywhenseed str u
|
||||
| isNothing (_uvMSeed u) = MODBlockedString str
|
||||
| otherwise = MODString str
|
||||
|
||||
pauseMenu :: Universe -> ScreenLayer
|
||||
pauseMenu = initializeOptionMenu' "PAUSED" pauseMenuOptions pmo
|
||||
pauseMenu = initializeOptionMenu "PAUSED" pauseMenuOptions pmo
|
||||
where
|
||||
pmo = TopMenuOption $ Toggle unpause (const (MODString "CONTINUE"))
|
||||
|
||||
pauseMenuOptions :: [MenuOption]
|
||||
pauseMenuOptions =
|
||||
[ Toggle (startNewGameInSlot 0) (opText "NEW GAME")
|
||||
, Toggle reloadLevelStart (opText "RESTART")
|
||||
, Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW FROM SEED")
|
||||
, Toggle (pushScreen optionMenu) (opText "OPTIONS")
|
||||
, Toggle (pushScreen displayControls) (opText "VIEW CONTROLS")
|
||||
, Toggle id (opText "VIEW CURRENT SEED")
|
||||
, Toggle saveQuit (opText "SAVE AND QUIT")
|
||||
]
|
||||
[ Toggle (startNewGameInSlot 0) (opText "NEW GAME")
|
||||
, Toggle reloadLevelStart (opText "RESTART")
|
||||
, Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW FROM SEED")
|
||||
, Toggle (pushScreen optionMenu) (opText "OPTIONS")
|
||||
, Toggle (pushScreen displayControls) (opText "VIEW CONTROLS")
|
||||
, Toggle id (opText "VIEW CURRENT SEED")
|
||||
, Toggle saveQuit (opText "SAVE AND QUIT")
|
||||
]
|
||||
where
|
||||
opText = const . MODString
|
||||
|
||||
saveQuit :: Universe -> Universe
|
||||
saveQuit u = u & addSideEffect (saveQuitConc u) "SAVING"
|
||||
|
||||
|
||||
saveQuitConc :: Universe -> IO (Universe -> Maybe Universe)
|
||||
saveQuitConc u = do
|
||||
void $ writeSaveSlot (SaveSlotNum 0) u
|
||||
return $ const Nothing
|
||||
|
||||
seedStartMenu :: String -> Universe -> ScreenLayer
|
||||
seedStartMenu str = initializeOptionMenu str seedStartOptions (Just "BACK") popScreen
|
||||
seedStartMenu str = titleOptionsNoWrite str seedStartOptions
|
||||
|
||||
seedStartOptions :: [MenuOption]
|
||||
seedStartOptions =
|
||||
@@ -91,37 +93,35 @@ trySeedFromClipboard u = do
|
||||
mcstr <- getClipboardString
|
||||
case mcstr >>= readMaybe of
|
||||
Nothing ->
|
||||
return $ pushScreen
|
||||
(seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")
|
||||
(u & uvScreenLayers %~ tail)
|
||||
return $
|
||||
pushScreen
|
||||
(seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")
|
||||
(u & uvScreenLayers %~ tail)
|
||||
Just i -> return $ startSeedGame 0 i u
|
||||
|
||||
slTitleOptions :: String -> [MenuOption] -> Universe -> ScreenLayer
|
||||
slTitleOptions title ops = initializeOptionMenu title ops (Just "BACK") (popScreen . writeConfig)
|
||||
titleOptionsMenu :: String -> [MenuOption] -> Universe -> ScreenLayer
|
||||
titleOptionsMenu title ops = initializeOptionMenuBO title ops "BACK" (popScreen . writeConfig)
|
||||
|
||||
optionsNoWrite :: String -> [MenuOption] -> Universe -> ScreenLayer
|
||||
optionsNoWrite title ops = initializeOptionMenu title ops (Just "BACK") popScreen
|
||||
titleOptionsNoWrite :: String -> [MenuOption] -> Universe -> ScreenLayer
|
||||
titleOptionsNoWrite title ops = initializeOptionMenuBO title ops "BACK" popScreen
|
||||
|
||||
optionMenu :: Universe -> ScreenLayer
|
||||
optionMenu = initializeOptionMenu "OPTIONS" optionsOptions (Just "BACK") popScreen
|
||||
optionMenu = titleOptionsNoWrite "OPTIONS" optionsOptions
|
||||
|
||||
optionsOptions :: [MenuOption]
|
||||
optionsOptions =
|
||||
[ makeSubmenuOption soundMenu $ MODString "VOLUME"
|
||||
, makeSubmenuOption graphicsMenu $ MODString "GRAPHICS"
|
||||
, makeSubmenuOption gameplayMenu $ MODString "GAMEPLAY"
|
||||
, makeSubmenuOption debugMenu $ MODString "DEBUG OPTIONS"
|
||||
]
|
||||
[ makeSubmenuOption soundMenu $ MODString "VOLUME"
|
||||
, makeSubmenuOption graphicsMenu $ MODString "GRAPHICS"
|
||||
, makeSubmenuOption gameplayMenu $ MODString "GAMEPLAY"
|
||||
, makeSubmenuOption debugMenu $ MODString "DEBUG OPTIONS"
|
||||
]
|
||||
|
||||
debugMenu :: Universe -> ScreenLayer
|
||||
debugMenu =
|
||||
slTitleOptions
|
||||
"OPTIONS:GAMEPLAY"
|
||||
debugMenuOptions
|
||||
debugMenu = titleOptionsMenu "OPTIONS:GAMEPLAY" debugMenuOptions
|
||||
|
||||
debugMenuOptions :: [MenuOption]
|
||||
debugMenuOptions =
|
||||
map f [minBound ..] ++ [makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" id]
|
||||
map f [minBound ..] ++ [makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" id]
|
||||
where
|
||||
f :: DebugBool -> MenuOption
|
||||
f bd =
|
||||
@@ -146,27 +146,21 @@ debugMenuOptions =
|
||||
-- ]
|
||||
-- $ map Scancode [4 ..]
|
||||
gameplayMenu :: Universe -> ScreenLayer
|
||||
gameplayMenu =
|
||||
slTitleOptions
|
||||
"OPTIONS:GAMEPLAY"
|
||||
gameplayMenuOptions
|
||||
gameplayMenu = titleOptionsMenu "OPTIONS:GAMEPLAY" gameplayMenuOptions
|
||||
|
||||
gameplayMenuOptions :: [MenuOption]
|
||||
gameplayMenuOptions =
|
||||
[ makeBoolOption gameplay_rotate_to_wall "ROTATE TO WALL"
|
||||
]
|
||||
[ makeBoolOption gameplay_rotate_to_wall "ROTATE TO WALL"
|
||||
]
|
||||
|
||||
soundMenu :: Universe -> ScreenLayer
|
||||
soundMenu =
|
||||
slTitleOptions
|
||||
"OPTIONS:VOLUME"
|
||||
soundMenuOptions
|
||||
soundMenu = titleOptionsMenu "OPTIONS:VOLUME" soundMenuOptions
|
||||
|
||||
soundMenuOptions :: [MenuOption]
|
||||
soundMenuOptions =
|
||||
[ theoption volume_master "MASTER VOLUME" _volume_master
|
||||
, theoption volume_sound "EFFECTS VOLUME" _volume_sound
|
||||
, theoption volume_music "MUSIC VOLUME" _volume_music
|
||||
, theoption volume_sound "EFFECTS VOLUME" _volume_sound
|
||||
, theoption volume_music "MUSIC VOLUME" _volume_music
|
||||
]
|
||||
where
|
||||
theoption stype str voltype =
|
||||
@@ -174,8 +168,9 @@ soundMenuOptions =
|
||||
(change dec stype)
|
||||
(change inc stype)
|
||||
(\w -> MODStringOption str (leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w) :: Int)))
|
||||
change g vt uv = uv & uvConfig . vt %~ g
|
||||
& uvIOEffects .~ \u -> sw uv >> return u
|
||||
change g vt uv =
|
||||
uv & uvConfig . vt %~ g
|
||||
& uvIOEffects .~ \u -> sw uv >> return u
|
||||
dec x = max 0 (x - 0.1)
|
||||
inc x = min 1 (x + 0.1)
|
||||
sw w = setVol (_uvConfig w)
|
||||
@@ -184,29 +179,21 @@ writeConfig :: Universe -> Universe
|
||||
writeConfig w = w & uvIOEffects %~ saveConfig (_uvConfig w)
|
||||
|
||||
graphicsMenu :: Universe -> ScreenLayer
|
||||
graphicsMenu = slTitleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions
|
||||
graphicsMenu = titleOptionsMenu "OPTIONS:GRAPHICS" graphicsMenuOptions
|
||||
|
||||
graphicsMenuOptions :: [MenuOption]
|
||||
graphicsMenuOptions =
|
||||
[ makeEnumOption graphics_resolution_factor "RESOLUTION" (uvIOEffects .~ updateFramebufferSize)
|
||||
, makeBoolOption graphics_wall_textured "WALL TEXTURES"
|
||||
, makeBoolOption graphics_object_shadows "OBJECT SHADOWS"
|
||||
, makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS"
|
||||
]
|
||||
[ makeEnumOption graphics_resolution_factor "RESOLUTION" (uvIOEffects .~ updateFramebufferSize)
|
||||
, makeBoolOption graphics_wall_textured "WALL TEXTURES"
|
||||
, makeBoolOption graphics_object_shadows "OBJECT SHADOWS"
|
||||
, makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS"
|
||||
]
|
||||
|
||||
gameOverMenu :: Universe -> ScreenLayer
|
||||
gameOverMenu u =
|
||||
initializeOptionMenu "GAME OVER" pauseMenuOptions Nothing id u
|
||||
initializeOptionMenu "GAME OVER" pauseMenuOptions NoPositionedMenuOption u
|
||||
& scOptionFlag .~ GameOverOptions
|
||||
|
||||
-- OptionScreen
|
||||
-- { _scTitle = const "GAME OVER"
|
||||
-- , _scOptions = pauseMenuOptions
|
||||
-- , _scDefaultEff = return . Just
|
||||
-- , _scOptionFlag = GameOverOptions
|
||||
-- , _scOptionsOffset = 0
|
||||
-- }
|
||||
|
||||
--charToScode :: Char -> Scancode
|
||||
--charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
|
||||
|
||||
@@ -215,7 +202,7 @@ unpause w = resumeSound $ w & uvScreenLayers .~ []
|
||||
|
||||
displayControls :: Universe -> ScreenLayer
|
||||
--displayControls = const $ ColumnsScreen "CONTROLS" listControls
|
||||
displayControls = optionsNoWrite "CONTROLS" $ map (Toggle id . const . uncurry MODStringOption) listControls
|
||||
displayControls = titleOptionsNoWrite "CONTROLS" $ map (Toggle id . const . uncurry MODStringOption) listControls
|
||||
|
||||
listControls :: [(String, String)]
|
||||
listControls =
|
||||
|
||||
Reference in New Issue
Block a user