180 lines
6.4 KiB
Haskell
180 lines
6.4 KiB
Haskell
module Dodge.Menu
|
|
( scodeToChar
|
|
, pauseMenu
|
|
, gameOverMenu
|
|
) where
|
|
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 =
|
|
[ Toggle ScancodeN (return . Just . startNewGame) (opText "NEW LEVEL")
|
|
, Toggle ScancodeR (return . Just . loadSaveSlot LevelStartSlot) (opText "RESTART")
|
|
, Toggle ScancodeS (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED")
|
|
, Toggle ScancodeO (pushScreen optionMenu ) (opText "OPTIONS")
|
|
, Toggle ScancodeC (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 ScancodeP trySeedFromClipboard (const $ Left "PASTE NUMBER FROM CLIPBOARD")
|
|
-- , 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 =
|
|
[ makeSubmenuOption ScancodeV soundMenu $ Left "VOLUME"
|
|
, makeSubmenuOption ScancodeG graphicsMenu $ Left "GRAPHICS"
|
|
, makeSubmenuOption ScancodeP gameplayMenu $ Left "GAMEPLAY"
|
|
, makeSubmenuOption ScancodeD debugMenu $ Left "DEBUG OPTIONS"
|
|
]
|
|
debugMenu :: ScreenLayer
|
|
debugMenu = slTitleOptions
|
|
"OPTIONS:GAMEPLAY"
|
|
debugMenuOptions
|
|
debugMenuOptions :: [MenuOption]
|
|
debugMenuOptions =
|
|
[ doption ScancodeF debug_seconds_frame "SHOW SECONDS/FRAME" _debug_seconds_frame
|
|
, doption ScancodeC debug_noclip "NOCLIP" _debug_noclip
|
|
, doption ScancodeT debug_cr_status "SHOW CREATURE STATUS" _debug_cr_status
|
|
, doption ScancodeA debug_cr_awareness "SHOW CREATURE AWARENESS" _debug_cr_awareness
|
|
, doption ScancodeV debug_view_boundaries "SHOW VIEW BOUNDARIES" _debug_view_boundaries
|
|
, makeEnumOption ScancodeB debug_view_clip_bounds "SHOW ROOM CLIP" return
|
|
, doption ScancodeP debug_pathing "SHOW PATHING" _debug_pathing
|
|
, doption ScancodeS debug_show_sound "SHOW VISUAL SOUNDS" _debug_show_sound
|
|
, doption ScancodeM debug_mouse_position "SHOW MOUSE POSITION" _debug_mouse_position
|
|
]
|
|
where
|
|
doption scode l t rec
|
|
= Toggle scode (return . Just . (config . l %~ not)) (\w -> Right (t ,show (rec $ _config w)))
|
|
gameplayMenu :: ScreenLayer
|
|
gameplayMenu = slTitleOptions
|
|
"OPTIONS:GAMEPLAY"
|
|
gameplayMenuOptions
|
|
|
|
gameplayMenuOptions :: [MenuOption]
|
|
gameplayMenuOptions =
|
|
[ makeBoolOption ScancodeR gameplay_rotate_to_wall "ROTATE TO WALL"
|
|
]
|
|
|
|
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 =
|
|
[ makeEnumOption ScancodeS graphics_resolution_factor "RESOLUTION" updateFramebufferSize
|
|
, makeBoolOption ScancodeW graphics_wall_textured "WALL TEXTURES"
|
|
, makeBoolOption ScancodeO graphics_object_shadows "OBJECT SHADOWS"
|
|
, makeBoolOption ScancodeC 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")
|
|
]
|