module Dodge.Menu ( pauseMenu, gameOverMenu, splashMenu, ) where import qualified Data.Aeson.Encode.Pretty as AEP import Control.Monad import Data.ByteString.Lazy.Char8 (unpack) --import SDL import Data.Maybe import Dodge.Concurrent import Dodge.Config.Update import Dodge.Data.Universe import Dodge.Menu.Option import Dodge.Menu.OptionType import Dodge.Menu.PushPop import Preload.Update import Dodge.Save import Dodge.SoundLogic import Dodge.StartNewGame import LensHelp import MaybeHelp import Padding import System.Clipboard import Text.Read splashMenu :: Universe -> ScreenLayer splashMenu u = initializeOptionMenu "AMNESIS" splashMenuOptions NoPositionedMenuOption u & scOptionFlag .~ SplashOptions splashMenuOptions :: [MenuOption] splashMenuOptions = [ 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 (pushScreen displayConfig) (opText "VIEW CONFIG") , Toggle id (displaywhenseed "VIEW LAST SEED") , Toggle hardQuit (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 :: Universe -> ScreenLayer 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") ] 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 = titleOptionsNoWrite str seedStartOptions seedStartOptions :: [MenuOption] seedStartOptions = [ Toggle (uvIOEffects .~ trySeedFromClipboard) (const $ MODString "PASTE NUMBER FROM CLIPBOARD") -- , 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 titleOptionsMenu :: String -> [MenuOption] -> Universe -> ScreenLayer titleOptionsMenu title ops = initializeOptionMenuBO title ops "BACK" (popScreen . writeConfig) titleOptionsNoWrite :: String -> [MenuOption] -> Universe -> ScreenLayer titleOptionsNoWrite title ops = initializeOptionMenuBO title ops "BACK" popScreen optionMenu :: Universe -> ScreenLayer optionMenu = titleOptionsNoWrite "OPTIONS" optionsOptions optionsOptions :: [MenuOption] optionsOptions = [ makeSubmenuOption soundMenu $ MODString "VOLUME" , makeSubmenuOption graphicsMenu $ MODString "GRAPHICS" , makeSubmenuOption gameplayMenu $ MODString "GAMEPLAY" , makeSubmenuOption debugMenu $ MODString "DEBUG OPTIONS" ] debugMenu :: Universe -> ScreenLayer debugMenu = titleOptionsMenu "OPTIONS:GAMEPLAY" debugMenuOptions debugMenuOptions :: [MenuOption] debugMenuOptions = map f [minBound ..] ++ [makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" id] where f :: DebugBool -> 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 :: Universe -> ScreenLayer gameplayMenu = titleOptionsMenu "OPTIONS:GAMEPLAY" gameplayMenuOptions gameplayMenuOptions :: [MenuOption] gameplayMenuOptions = [ makeBoolOption gameplay_rotate_to_wall "ROTATE TO WALL" ] soundMenu :: Universe -> ScreenLayer 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 ] where theoption stype str voltype = Toggle2 (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 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 :: Universe -> ScreenLayer graphicsMenu = titleOptionsMenu "OPTIONS:GRAPHICS" graphicsMenuOptions graphicsMenuOptions :: [MenuOption] graphicsMenuOptions = [ makeEnumOption graphics_world_resolution "World resolution" (uvIOEffects .~ updatePreload) , makeEnumOption graphics_downsize_resolution "Downsize resolution" (uvIOEffects .~ updatePreload) , makeEnumOption graphics_overlay_resolution "Overlay resolution" (uvIOEffects .~ updatePreload) , makeEnumOption graphics_shadow_rendering "SHADOW RENDERING" id , makeEnumOption graphics_shadow_size "SHADOW DETAIL" id , makeEnumOption graphics_distortions "ENABLE DISTORTIONS" id , makeEnumOption graphics_bloom "ENABLE BLOOM" id , makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS" , makeEnumOption graphics_num_shadow_casters "NUM SHADOW CASTERS" id ] gameOverMenu :: Universe -> ScreenLayer gameOverMenu u = initializeOptionMenu "GAME OVER" pauseMenuOptions NoPositionedMenuOption u & scOptionFlag .~ GameOverOptions --charToScode :: Char -> Scancode --charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum unpause :: Universe -> Universe unpause w = over uvWorld resumeSound $ w & uvScreenLayers .~ [] -- note that this won't update after it is first loaded displayConfig :: Universe -> ScreenLayer displayConfig u = titleOptionsNoWrite "CONFIG" (map (Toggle id . const . MODString) $ listConfig u) u listConfig :: Universe -> [String] listConfig u = lines $ unpack $ AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) $ u ^. uvConfig displayControls :: Universe -> ScreenLayer --displayControls = const $ ColumnsScreen "CONTROLS" listControls displayControls = titleOptionsNoWrite "CONTROLS" $ map (Toggle id . const . uncurry MODStringOption) listControls listControls :: [(String, String)] listControls = [ ("w|a|s|d", "MOVEMENT") , ("", "AIM") , ("&", "SHOOT/USE/EQUIP SELECTED") , ("", "USE EQUIPPED") , ("", "SELECT ITEM") , ("", "PICKUP ITEM") , ("m", "DISPLAY MAP") , ("f", "DROP ITEM") , ("c", "COMBINE ITEMS") , ("x", "EXAMINE ITEMS") , ("c|", "PAUSE AND DISPLAY MENU") , ("q|e", "ROTATE CAMERA") , ("", "PAUSE AND FLOAT CAMERA") , ("", "PAUSE AND PAN CAMERA") , ("", "QUICKSAVE") , ("", "QUICKLOAD") ]