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 id & scOptionFlag .~ SplashOptions splashMenuOptions :: [MenuOption] splashMenuOptions = basicKeyOptions [ Toggle ( loadSaveSlot (SaveSlotNum 0)) displaycontinue , 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 (id) (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 (unpause) pauseMenuOptions :: [MenuOption] pauseMenuOptions = basicKeyOptions [ Toggle popScreen (opText "CONTINUE") , 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") ] ++ [ InvisibleToggle ScancodeEscape id ] 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 -> ScreenLayer seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen seedStartOptions :: [MenuOption] seedStartOptions = [ Toggle (uvIOEffects .~ trySeedFromClipboard) (const $ MODString "PASTE NUMBER FROM CLIPBOARD") ScancodeA -- , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER") ] trySeedFromClipboard :: Universe -> IO Universe trySeedFromClipboard u = do mcstr <- getClipboardString case mcstr >>= readMaybe of Nothing -> return $ pushScreen (seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER") (u & uvScreenLayers %~ tail) Just i -> return $ 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" id]) $ map Scancode [4 ..] where f :: DebugBool -> Scancode -> MenuOption f bd = Toggle ((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 = 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) 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" (uvIOEffects .~ 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 id & 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 -> Universe unpause w = 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") ]