202 lines
6.6 KiB
Haskell
202 lines
6.6 KiB
Haskell
module Dodge.Menu
|
|
( scodeToChar
|
|
, popScreen
|
|
, pushScreen
|
|
, pauseMenu
|
|
, gameOverMenu
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.PreloadData
|
|
import Dodge.Save
|
|
import Dodge.Config.Update
|
|
import SDL
|
|
import SDL.Internal.Numbered
|
|
--import Preload.Update
|
|
import Dodge.SoundLogic
|
|
import Dodge.LevelGen
|
|
|
|
import Control.Lens
|
|
import System.Random
|
|
|
|
titleOptions title ops = titleOptionsEff title ops (return . popScreen . writeConfig)
|
|
|
|
titleOptionsEff title ops eff = OptionScreen
|
|
{ _scTitle = const title
|
|
, _scOptions = ops
|
|
, _scDefaultEff = eff
|
|
, _scOptionFlag = NormalOptions
|
|
}
|
|
|
|
optionMenu :: ScreenLayer
|
|
optionMenu = titleOptionsEff "OPTIONS" optionsOptions (return . popScreen)
|
|
|
|
optionsOptions :: [MenuOption]
|
|
optionsOptions =
|
|
[ anOption ScancodeV soundMenu "VOLUME"
|
|
, anOption ScancodeG graphicsMenu "GRAPHICS"
|
|
, anOption ScancodeP gameplayMenu "GAMEPLAY"
|
|
, anOption ScancodeD debugMenu "DEBUG OPTIONS"
|
|
]
|
|
where
|
|
anOption scode submenu t = Toggle scode (pushScreen submenu) (const t)
|
|
debugMenu :: ScreenLayer
|
|
debugMenu = titleOptions
|
|
"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 ScancodeS debug_cr_status "SHOW CREATURE STATUS" _debug_cr_status
|
|
, doption ScancodeV debug_view_boundaries "SHOW VIEW BOUNDARIES" _debug_view_boundaries
|
|
, doption ScancodeP debug_pathing "SHOW PATHING" _debug_pathing
|
|
]
|
|
where
|
|
doption scode l t rec
|
|
= Toggle scode (Just . (config . l %~ not)) (\w -> t ++ ":" ++ show (rec $ _config w))
|
|
gameplayMenu :: ScreenLayer
|
|
gameplayMenu = titleOptions
|
|
"OPTIONS:GAMEPLAY"
|
|
gameplayMenuOptions
|
|
|
|
gameplayMenuOptions :: [MenuOption]
|
|
gameplayMenuOptions =
|
|
[ option ScancodeR rotate_to_wall "ROTATE TO WALL" _rotate_to_wall
|
|
, option ScancodeS show_sound "SHOW VISUAL SOUNDS" _show_sound
|
|
]
|
|
where
|
|
option scode l t rec = Toggle scode (Just . (config . l %~ not))
|
|
(\w -> t ++ ":" ++ show (rec $ _config w))
|
|
|
|
soundMenu :: ScreenLayer
|
|
soundMenu = titleOptions
|
|
"OPTIONS:VOLUME"
|
|
soundMenuOptions
|
|
|
|
soundMenuOptions :: [MenuOption]
|
|
soundMenuOptions =
|
|
[ Toggle2 ScancodeY (master dec . sw)
|
|
ScancodeU (master inc . sw) (\w -> "MASTER VOLUME:" ++ mavol w)
|
|
, Toggle2 ScancodeH (soundEffs dec . sw)
|
|
ScancodeJ (soundEffs inc . sw) (\w -> "EFFECTS VOLUME:" ++ snvol w)
|
|
, Toggle2 ScancodeN (music dec . sw)
|
|
ScancodeM (music inc . sw) (\w -> "MUSIC VOLUME:" ++ muvol w)
|
|
]
|
|
where
|
|
dec x = max 0 (x - 0.1)
|
|
inc x = min 1 (x + 0.1)
|
|
sw w = w & uvWorld . sideEffects %~ setVolThen (_config w)
|
|
master g = Just . (config . volume_master %~ g)
|
|
soundEffs g = Just . (config . volume_sound %~ g)
|
|
music g = Just . (config . volume_music %~ g)
|
|
cfig w = _config w
|
|
mavol w = f $ _volume_master $ cfig w
|
|
snvol w = f $ _volume_sound $ cfig w
|
|
muvol w = f $ _volume_music $ cfig w
|
|
f x = show (round $ 10 * x :: Int)
|
|
|
|
pushScreen :: ScreenLayer -> Universe -> Maybe Universe
|
|
pushScreen ml w = Just $ w & menuLayers %~ (ml :)
|
|
|
|
popScreen :: Universe -> Maybe Universe
|
|
popScreen = Just . (menuLayers %~ tail)
|
|
|
|
writeConfig :: Universe -> Universe
|
|
writeConfig w = w & uvWorld . sideEffects %~ saveConfig (_config w)
|
|
|
|
graphicsMenu :: ScreenLayer
|
|
graphicsMenu = titleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions
|
|
|
|
graphicsMenuOptions :: [MenuOption]
|
|
graphicsMenuOptions =
|
|
[ Toggle ScancodeW (Just . (config . wall_textured %~ not)) wtextstring
|
|
, Toggle ScancodeS upf resostring
|
|
, Toggle ScancodeD (Just . (config . cloud_shadows %~ not)) cshadstring
|
|
]
|
|
where
|
|
wtextstring w = "WALL TEXTURES:" ++ show (_wall_textured $ _config w)
|
|
resostring w = "RESOLUTION: 1/" ++ show (_resolution_factor $ _config w)
|
|
upf w = Just $ updateFramebufferSize $ w & config . resolution_factor %~ cycleResolution
|
|
cshadstring w = "CLOUD SHADOWS:" ++ show (_cloud_shadows $ _config w)
|
|
|
|
cycleResolution :: (Eq a, Num a, Num p) => a -> p
|
|
cycleResolution 1 = 2
|
|
cycleResolution 2 = 4
|
|
cycleResolution 4 = 1
|
|
cycleResolution _ = 1
|
|
|
|
gameOverMenu :: ScreenLayer
|
|
gameOverMenu = OptionScreen
|
|
{ _scTitle = const "GAME OVER"
|
|
, _scOptions = pauseMenuOptions
|
|
, _scDefaultEff = return . Just
|
|
, _scOptionFlag = GameOverOptions
|
|
}
|
|
|
|
pauseMenu :: ScreenLayer
|
|
pauseMenu = titleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
|
|
|
|
pauseMenuOptions :: [MenuOption]
|
|
pauseMenuOptions =
|
|
[ Toggle ScancodeN startNewGame (const "NEW LEVEL")
|
|
, Toggle ScancodeR (Just . loadSaveSlot LevelStartSlot) (const "RESTART")
|
|
, Toggle ScancodeO (pushScreen optionMenu ) (const "OPTIONS")
|
|
, Toggle ScancodeC (pushScreen displayControls) (const "CONTROLS")
|
|
, InvisibleToggle ScancodeEscape (const Nothing)
|
|
]
|
|
startNewGame :: Universe -> Maybe Universe
|
|
startNewGame w = Just $ w
|
|
& menuLayers .~ [WaitScreen (const "GENERATING...") 1]
|
|
& uvWorld . sideEffects .~ \u -> do
|
|
w' <- generateWorldFromSeed i
|
|
return (u & uvWorld .~ w')
|
|
where
|
|
i = fst $ random (_randGen (_uvWorld w))
|
|
|
|
--uvWorldSideEffects :: Int -> Universe -> b -> IO Universe
|
|
--uvWorldSideEffects i w = const (generateWorldFromSeed i <&> config .~ _config w)
|
|
|
|
|
|
-- | hacky
|
|
scodeToChar :: Scancode -> Char
|
|
scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber
|
|
|
|
--charToScode :: Char -> Scancode
|
|
--charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
|
|
|
|
updateFramebufferSize :: Universe -> Universe
|
|
updateFramebufferSize u = u & uvWorld . sideEffects %~ sideEffectUpdatePreload divRes x y
|
|
where
|
|
(x,y) = (round $ _windowX cfig, round $ _windowY cfig)
|
|
cfig = _config u
|
|
divRes = u ^. config . resolution_factor
|
|
|
|
--levelMenu :: Int -> ScreenLayer
|
|
--levelMenu x = OptionScreen
|
|
-- { _scTitle = const $ "LEVEL "++ show x
|
|
-- , _scOptions = levelMenuOptions
|
|
-- , _scDefaultEff = unpause . storeLevel
|
|
-- , _scOptionFlag = NormalOptions
|
|
-- }
|
|
unpause :: Universe -> Maybe Universe
|
|
unpause w = Just . resumeSound $ w & menuLayers .~ []
|
|
|
|
displayControls :: ScreenLayer
|
|
displayControls = ColumnsScreen "CONTROLS" listControls
|
|
|
|
listControls :: [(String,String)]
|
|
listControls =
|
|
[("wasd", "MOVEMENT")
|
|
,("[rmb]", "AIM")
|
|
,("[rmb+lmb]", "SHOOT OR USE ITEM")
|
|
,("[wheelscroll]" , "SELECT ITEM" )
|
|
,("[space]" , "PICKUP ITEM" )
|
|
,("m" , "DISPLAY MAP" )
|
|
,("f" , "DROP ITEM" )
|
|
,("c[esc]" , "PAUSE" )
|
|
,("qe" , "ROTATE CAMERA")
|
|
,("F5" , "QUICKSAVE")
|
|
,("F9" , "QUICKLOAD")
|
|
]
|