loop/src/Dodge/Menu.hs

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")
    ]