194 lines
6.7 KiB
Haskell
194 lines
6.7 KiB
Haskell
module Dodge.Menu
|
|
( scodeToChar
|
|
, pauseMenu
|
|
, gameOverMenu
|
|
) where
|
|
import Dodge.Config.Data
|
|
import LensHelp
|
|
import Dodge.Menu.OptionType
|
|
import Dodge.StartNewGame
|
|
import Dodge.Menu.PushPop
|
|
import Dodge.Data
|
|
import Dodge.PreloadData
|
|
import Dodge.Save
|
|
import Dodge.Config.Update
|
|
import Padding
|
|
--import SDL.Internal.Numbered
|
|
--import Preload.Update
|
|
import Dodge.SoundLogic
|
|
--import Dodge.LevelGen
|
|
|
|
import Text.Read
|
|
import SDL
|
|
import System.Clipboard
|
|
--import Control.Lens
|
|
--import System.Random
|
|
|
|
slTitleOptionsEff :: String -> [MenuOption] -> (Universe -> IO (Maybe Universe)) -> ScreenLayer
|
|
slTitleOptionsEff title ops eff = OptionScreen
|
|
{ _scTitle = const title
|
|
, _scOptions = ops
|
|
, _scDefaultEff = eff
|
|
, _scOptionFlag = NormalOptions
|
|
}
|
|
pauseMenu :: ScreenLayer
|
|
pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
|
|
pauseMenuOptions :: [MenuOption]
|
|
pauseMenuOptions = basicKeyOptions
|
|
[ Toggle (return . Just . startNewGame) (opText "NEW LEVEL")
|
|
, Toggle (return . Just . loadSaveSlot LevelStartSlot) (opText "RESTART")
|
|
, Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED")
|
|
, Toggle (pushScreen optionMenu ) (opText "OPTIONS")
|
|
, Toggle (pushScreen displayControls) (opText "CONTROLS")
|
|
]
|
|
++
|
|
[ InvisibleToggle ScancodeEscape (return . const Nothing)
|
|
]
|
|
where
|
|
opText = const . Left
|
|
seedStartMenu :: String -> ScreenLayer
|
|
seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen
|
|
seedStartOptions :: [MenuOption]
|
|
seedStartOptions =
|
|
[ Toggle trySeedFromClipboard (const $ Left "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 & menuLayers %~ tail)
|
|
Just i -> return . Just $ startSeedGame 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 $ Left "VOLUME"
|
|
, makeSubmenuOption graphicsMenu $ Left "GRAPHICS"
|
|
, makeSubmenuOption gameplayMenu $ Left "GAMEPLAY"
|
|
, makeSubmenuOption debugMenu $ Left "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 . (config . debug_booleans . at bd %~ toggleJust))
|
|
(Right . g bd . (^? config . 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 -> Right (str , leftPad 2 '.' $ show (round $ 10 * voltype (_config w)::Int)))
|
|
change g vt = return . Just . (config . vt %~ g) . sw
|
|
dec x = max 0 (x - 0.1)
|
|
inc x = min 1 (x + 0.1)
|
|
sw w = w & uvWorld . sideEffects %~ setVolThen (_config w)
|
|
|
|
writeConfig :: Universe -> Universe
|
|
writeConfig w = w & uvWorld . sideEffects %~ saveConfig (_config 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 = OptionScreen
|
|
{ _scTitle = const "GAME OVER"
|
|
, _scOptions = pauseMenuOptions
|
|
, _scDefaultEff = return . Just
|
|
, _scOptionFlag = GameOverOptions
|
|
}
|
|
|
|
-- | hacky - no longer used
|
|
scodeToChar :: Scancode -> Char
|
|
scodeToChar = toEnum . (+ 61) . fromIntegral . unwrapScancode
|
|
|
|
|
|
--charToScode :: Char -> Scancode
|
|
--charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
|
|
|
|
unpause :: Universe -> Maybe Universe
|
|
unpause w = Just . resumeSound $ w & menuLayers .~ []
|
|
|
|
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")
|
|
]
|