module Dodge.Menu ( pauseMenu, gameOverMenu, splashMenu, ) where import Control.Monad import Dodge.Concurrent import Dodge.Config.Update import Dodge.Data.Universe import Dodge.Menu.Option import Dodge.Menu.OptionType import Dodge.Menu.PushPop import Dodge.PreloadData import Dodge.Save import Dodge.SoundLogic import Dodge.StartNewGame import LensHelp import MaybeHelp import Padding import SDL import System.Clipboard import Text.Read import Data.Maybe splashMenu :: ScreenLayer splashMenu = slTitleOptionsEff "AMNESIS" splashMenuOptions (return . Just) & scOptionFlag .~ SplashOptions splashMenuOptions :: [MenuOption] splashMenuOptions = basicKeyOptions [ Toggle (return . Just . loadSaveSlot (SaveSlotNum 0)) displaycontinue , Toggle (return . Just . startNewGameInSlot 0) (opText "NEW WITH RANDOM SEED") , Toggle (return . Just . 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 (return . Just) (displaywhenseed "VIEW LAST SEED") , Toggle (return . const Nothing) (opText "QUIT") ] where opText = const . MODString displaycontinue u | _uvCanContinue u = MODString "CONTINUE" | otherwise = MODBlockedString "CONTINUE" displaywhenseed str u | isNothing (_uvMSeed u) = MODBlockedString str | otherwise = MODString str pauseMenu :: ScreenLayer pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause) pauseMenuOptions :: [MenuOption] pauseMenuOptions = basicKeyOptions [ Toggle popScreen (opText "CONTINUE") , Toggle (return . Just . startNewGameInSlot 0) (opText "NEW GAME") , Toggle (return . Just . 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 (return . Just) (opText "VIEW CURRENT SEED") , Toggle saveQuit (opText "SAVE AND QUIT") ] ++ [ InvisibleToggle ScancodeEscape (return . const Nothing) ] where opText = const . MODString saveQuit :: Universe -> IO (Maybe Universe) saveQuit u = return $ Just $ u & tryConcEffect True "SAVING" (saveQuitConc u) saveQuitConc :: Universe -> IO (Universe -> Maybe Universe) saveQuitConc u = do void $ writeSaveSlot (SaveSlotNum 0) u return $ const Nothing seedStartMenu :: String -> ScreenLayer seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen seedStartOptions :: [MenuOption] seedStartOptions = [ Toggle trySeedFromClipboard (const $ MODString "PASTE NUMBER FROM CLIPBOARD") ScancodeA -- , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER") ] trySeedFromClipboard :: Universe -> IO (Maybe Universe) trySeedFromClipboard u = do mcstr <- getClipboardString case mcstr >>= readMaybe of Nothing -> pushScreen (seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER") (u & uvScreenLayers %~ tail) Just i -> return . Just $ startSeedGame 0 i u slTitleOptions :: String -> [MenuOption] -> ScreenLayer slTitleOptions title ops = slTitleOptionsEff title ops (popScreen . writeConfig) optionMenu :: ScreenLayer optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen optionsOptions :: [MenuOption] optionsOptions = basicKeyOptions [ makeSubmenuOption soundMenu $ MODString "VOLUME" , makeSubmenuOption graphicsMenu $ MODString "GRAPHICS" , makeSubmenuOption gameplayMenu $ MODString "GAMEPLAY" , makeSubmenuOption debugMenu $ MODString "DEBUG OPTIONS" ] debugMenu :: ScreenLayer debugMenu = slTitleOptions "OPTIONS:GAMEPLAY" debugMenuOptions debugMenuOptions :: [MenuOption] debugMenuOptions = zipWith ($) (map f [minBound ..] ++ [makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" return]) $ map Scancode [4 ..] where f :: DebugBool -> Scancode -> MenuOption f bd = Toggle (return . Just . (uvConfig . debug_booleans . at bd %~ toggleJust)) (uncurry MODStringOption . g bd . (^? uvConfig . debug_booleans . ix bd)) g bd Nothing = (show bd, "False") g bd _ = (show bd, "True") -- zipWith ($) -- [ makeBoolOption debug_seconds_frame "SHOW SECONDS/FRAME" -- , makeBoolOption debug_noclip "NOCLIP" -- , makeBoolOption debug_cr_status "SHOW CREATURE STATUS" -- , makeBoolOption debug_cr_awareness "SHOW CREATURE AWARENESS" -- , makeBoolOption debug_view_boundaries "SHOW VIEW BOUNDARIES" -- , makeBoolOption debug_pathing "SHOW PATHING" -- , makeBoolOption debug_show_sound "SHOW VISUAL SOUNDS" -- , makeBoolOption debug_mouse_position "SHOW MOUSE POSITION" -- , makeBoolOption debug_walls "SHOW WALL INFO" -- , makeBoolOption debug_remove_LOS "REMOVE LOS" -- , makeBoolOption debug_cull_more_lights "CULL MORE LIGHTS" -- ] -- $ map Scancode [4 ..] gameplayMenu :: ScreenLayer gameplayMenu = slTitleOptions "OPTIONS:GAMEPLAY" gameplayMenuOptions gameplayMenuOptions :: [MenuOption] gameplayMenuOptions = basicKeyOptions [ makeBoolOption gameplay_rotate_to_wall "ROTATE TO WALL" ] basicKeyOptions :: [Scancode -> c] -> [c] basicKeyOptions xs = zipWith ($) xs $ map Scancode [4 ..] soundMenu :: ScreenLayer soundMenu = slTitleOptions "OPTIONS:VOLUME" soundMenuOptions soundMenuOptions :: [MenuOption] soundMenuOptions = [ theoption ScancodeY volume_master ScancodeU "MASTER VOLUME" _volume_master , theoption ScancodeH volume_sound ScancodeJ "EFFECTS VOLUME" _volume_sound , theoption ScancodeN volume_music ScancodeM "MUSIC VOLUME" _volume_music ] where theoption scod1 stype scod2 str voltype = Toggle2 scod1 (change dec stype) scod2 (change inc stype) (\w -> MODStringOption str (leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w) :: Int))) 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 = setVol (_uvConfig w) writeConfig :: Universe -> Universe writeConfig w = w & uvIOEffects %~ saveConfig (_uvConfig w) graphicsMenu :: ScreenLayer graphicsMenu = slTitleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions graphicsMenuOptions :: [MenuOption] graphicsMenuOptions = basicKeyOptions [ makeEnumOption graphics_resolution_factor "RESOLUTION" updateFramebufferSize , makeBoolOption graphics_wall_textured "WALL TEXTURES" , makeBoolOption graphics_object_shadows "OBJECT SHADOWS" , makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS" ] gameOverMenu :: ScreenLayer gameOverMenu = slTitleOptionsEff "GAME OVER" pauseMenuOptions (return . Just) & 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 unpause :: Universe -> Maybe Universe unpause w = Just . resumeSound $ w & uvScreenLayers .~ [] displayControls :: ScreenLayer displayControls = ColumnsScreen (const "CONTROLS") listControls listControls :: [(String, String)] listControls = [ ("wasd", "MOVEMENT") , ("[rmb]", "AIM") , ("[rmb+lmb]", "SHOOT/USE/EQUIP SELECTED") , ("[lmb]", "USE EQUIPPED") , ("[wheelscroll]", "SELECT ITEM") , ("[space]", "PICKUP ITEM") , ("m", "DISPLAY MAP") , ("f", "DROP ITEM") , ("c", "COMBINE ITEMS") , ("x", "TWEAK ITEMS") , ("c[esc]", "PAUSE") , ("qe", "ROTATE CAMERA") , ("F5", "QUICKSAVE") , ("F9", "QUICKLOAD") ]