module Dodge.Menu ( pauseMenu, gameOverMenu, splashMenu, ) where import Control.Monad import qualified Data.Aeson.Encode.Pretty as AEP import Data.ByteString.Lazy.Char8 (unpack) import Data.Maybe import Dodge.Base.Coordinate import Dodge.Concurrent import Dodge.Config import Dodge.Data.Universe import Dodge.Menu.Option import Dodge.Menu.OptionType import Dodge.Menu.PushPop import Dodge.Save import Dodge.SoundLogic import Dodge.StartNewGame import Geometry import LensHelp import MaybeHelp import Padding import Preload.Update import qualified SDL import System.Hclip import System.Directory import Text.Read splashMenu :: Universe -> ScreenLayer splashMenu = (scOptionFlag .~ SplashOptions) . initializeOptionMenu NoExtraMenuOption "GAME TITLE" splashMenuOptions splashMenuOptions :: [MenuOption] splashMenuOptions = [ Toggle (loadSaveSlot (SaveSlotNum 0)) displaycontinue , Toggle (startNewGameInSlot 0) (otext "NEW WITH RANDOM SEED") , Toggle reloadLevelStart (displaywhenseed "NEW WITH LAST SEED") , Toggle (pushScreen $ seedStartMenu "START FROM SEED") (otext "NEW WITH SPECIFIC SEED") , Toggle (pushScreen optionMenu) (otext "OPTIONS") , Toggle (pushScreen displayControls) (otext "VIEW CONTROLS") , Toggle (pushScreen displayConfig) (otext "VIEW CONFIG") , Toggle id (displaywhenseed "VIEW LAST SEED") , Toggle hardQuit (otext "QUIT") ] where otext = 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 (TopMenuOption $ Toggle unpause (const (MODString "CONTINUE"))) "PAUSED" pauseMenuOptions pauseMenuOptions :: [MenuOption] pauseMenuOptions = [ Toggle (startNewGameInSlot 0) (otext "NEW GAME") , Toggle reloadLevelStart (otext "RESTART") , Toggle (pushScreen $ seedStartMenu "START FROM SEED") (otext "NEW FROM SEED") , Toggle (pushScreen optionMenu) (otext "OPTIONS") , Toggle (pushScreen displayControls) (otext "VIEW CONTROLS") , Toggle id (otext "VIEW CURRENT SEED") , Toggle saveQuit (otext "SAVE AND QUIT") ] where otext = 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 str <- getClipboard return $ case readMaybe str of Nothing -> pushScreen (seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER") (u & uvScreenLayers %~ tail) Just i -> startSeedGame 0 i u titleOptionsMenu :: String -> [MenuOption] -> Universe -> ScreenLayer titleOptionsMenu = initializeOptionMenuBO "BACK" (popScreen . writeConfig) titleOptionsNoWrite :: String -> [MenuOption] -> Universe -> ScreenLayer titleOptionsNoWrite = initializeOptionMenuBO "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" , makeSubmenuOption logMenu $ MODString "LOG" ] debugMenu :: Universe -> ScreenLayer debugMenu = titleOptionsMenu "OPTIONS:DEBUG" debugMenuOptions logMenu :: Universe -> ScreenLayer logMenu = titleOptionsMenu "OPTIONS:LOG" logOptions debugMenuOptions :: [MenuOption] debugMenuOptions = map f [minBound ..] ++ [enumOption 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") logOptions :: [MenuOption] logOptions = [ Toggle (uvIOEffects %~ \f u -> generateGraphs >> f u) (const $ MODString "Create item combination graph") ] generateGraphs :: IO () generateGraphs = do createDirectoryIfMissing True "generated/graph" print "Placeholder for graph generation activated" gameplayMenu :: Universe -> ScreenLayer gameplayMenu = titleOptionsMenu "OPTIONS:GAMEPLAY" gameplayMenuOptions gameplayMenuOptions :: [MenuOption] gameplayMenuOptions = [boolOption 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 = [ enumOption gr_world_res "World resolution" (uvIOEffects .~ updatePreload) , enumOption gr_downsize_res "Downsize resolution" (uvIOEffects .~ updatePreload) , boolOption gr_upscale_filter "UPSCALE FILTER" , enumOption gr_shadow_rendering "SHADOW RENDERING" id , enumOption gr_shadows_on_clouds "SHADOW DETAIL ON CLOUDS" id , enumOption gr_shadow_size "SHADOW DETAIL" id , enumOption gr_distortions "ENABLE DISTORTIONS" id -- , enumOption gr_bloom "ENABLE BLOOM" id , boolOption gr_cloud_shadows "CLOUD SHADOWS TOGGLE" , enumOption gr_num_shadow_casters "NUM SHADOW CASTERS" id ] gameOverMenu :: Universe -> ScreenLayer gameOverMenu = set scOptionFlag GameOverOptions . initializeOptionMenu NoExtraMenuOption "GAME OVER" pauseMenuOptions unpause :: Universe -> Universe unpause u' = resumeSound . set uvScreenLayers [] . set (uvWorld . input . mousePos) (u' ^. uvWorld . cWorld . lWorld . lAimPos) $ over uvIOEffects (\f u -> SDL.warpMouse SDL.WarpCurrentFocus (SDL.P (SDL.V2 x' y')) >> f u) u' where cfig = u' ^. uvConfig x' = round $ x + 0.5 * windowXFloat cfig y' = round $ 0.5 * windowYFloat cfig - y V2 x y = worldPosToScreen (u' ^. uvWorld . wCam) (u' ^. uvWorld . cWorld . lWorld . lAimPos) -- 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 = lines . unpack . AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) . _uvConfig displayControls :: Universe -> ScreenLayer displayControls = titleOptionsNoWrite "CONTROLS" $ map (Toggle id . const . uncurry MODStringOption) listControls listControls :: [(String, String)] listControls = [ ("w|a|s|d", "MOVE") , ("", "AIM") , ("&", "USE SELECTED") , ("&", "ROTATE") , ("", "SELECT ITEM") , ("", "PICKUP ITEM") , ("f", "DROP ITEM") , ("+", "SWAP ITEMS") , ("&q|e|0-9", "SET HOTKEY") , ("q|e|0-9", "USE HOTKEY") , ("&q|e|0-9", "JUMP TO HOTKEY") , ("c", "COMBINE ITEMS") , ("p|", "PAUSE") , ("", "SELECT/MOVE ITEMS") , ("", "NORMAL CAMERA") , ("", "DEBUG CAMERA") , ("", "QUICKSAVE") , ("", "QUICKLOAD") ]