211 lines
7.2 KiB
Haskell
211 lines
7.2 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.Base.Window
|
|
import Dodge.SoundLogic
|
|
import Dodge.LevelGen
|
|
|
|
import Control.Lens
|
|
import System.Random
|
|
|
|
optionMenu :: ScreenLayer
|
|
optionMenu = OptionScreen
|
|
{ _scTitle = const "OPTIONS"
|
|
, _scOptions = optionsOptions
|
|
, _scDefaultEff = popScreen
|
|
, _scOptionFlag = NormalOptions
|
|
}
|
|
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 = OptionScreen
|
|
{ _scTitle = const "OPTIONS:GAMEPLAY"
|
|
, _scOptions = debugMenuOptions
|
|
, _scDefaultEff = popScreen . over uvWorld writeConfig
|
|
, _scOptionFlag = NormalOptions
|
|
}
|
|
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 . (uvWorld . config . l %~ not)) (\w -> t ++ ":" ++ show (rec $ _config (_uvWorld w)))
|
|
gameplayMenu :: ScreenLayer
|
|
gameplayMenu = OptionScreen
|
|
{ _scTitle = const "OPTIONS:GAMEPLAY"
|
|
, _scOptions = gameplayMenuOptions
|
|
, _scDefaultEff = popScreen . over uvWorld writeConfig
|
|
, _scOptionFlag = NormalOptions
|
|
}
|
|
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 . (uvWorld . config . l %~ not))
|
|
(\w -> t ++ ":" ++ show (rec $ _config (_uvWorld w)))
|
|
|
|
soundMenu :: ScreenLayer
|
|
soundMenu = OptionScreen
|
|
{ _scTitle = const "OPTIONS:VOLUME"
|
|
, _scOptions = soundMenuOptions
|
|
, _scDefaultEff = popScreen . over uvWorld writeConfig
|
|
, _scOptionFlag = NormalOptions
|
|
}
|
|
soundMenuOptions :: [MenuOption]
|
|
soundMenuOptions =
|
|
[ Toggle2 ScancodeY (master dec . sw)
|
|
ScancodeU (master inc . sw) (\w -> "MASTER VOLUME:" ++ mavol (_uvWorld w))
|
|
, Toggle2 ScancodeH (soundEffs dec . sw)
|
|
ScancodeJ (soundEffs inc . sw) (\w -> "EFFECTS VOLUME:" ++ snvol (_uvWorld w))
|
|
, Toggle2 ScancodeN (music dec . sw)
|
|
ScancodeM (music inc . sw) (\w -> "MUSIC VOLUME:" ++ muvol (_uvWorld w))
|
|
]
|
|
where
|
|
dec x = max 0 (x - 0.1)
|
|
inc x = min 1 (x + 0.1)
|
|
--sw w = w & sideEffects %~ (setVol (_config w) : )
|
|
sw w = w & uvWorld . sideEffects %~ setVolThen (_config (_uvWorld w))
|
|
master g = Just . (uvWorld . config . volume_master %~ g)
|
|
soundEffs g = Just . (uvWorld . config . volume_sound %~ g)
|
|
music g = Just . (uvWorld . 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 :: World -> World
|
|
writeConfig w = w & sideEffects %~ saveConfig (_config w)
|
|
|
|
graphicsMenu :: ScreenLayer
|
|
graphicsMenu = OptionScreen
|
|
{ _scTitle = const "OPTIONS:GRAPHICS"
|
|
, _scOptions = graphicsMenuOptions
|
|
, _scDefaultEff = popScreen . over uvWorld writeConfig
|
|
, _scOptionFlag = NormalOptions
|
|
}
|
|
graphicsMenuOptions :: [MenuOption]
|
|
graphicsMenuOptions =
|
|
[ Toggle ScancodeW (Just . (uvWorld . config . wall_textured %~ not)) wtextstring
|
|
, Toggle ScancodeS upf resostring
|
|
, Toggle ScancodeD (Just . (uvWorld . config . cloud_shadows %~ not)) cshadstring
|
|
]
|
|
where
|
|
wtextstring w = "WALL TEXTURES:" ++ show (_wall_textured $ _config (_uvWorld w))
|
|
resostring w = "RESOLUTION: 1/" ++ show (_resolution_factor $ _config (_uvWorld w))
|
|
upf w = Just $ over uvWorld updateFramebufferSize $ w & uvWorld . config . resolution_factor %~ cycleResolution
|
|
cshadstring w = "CLOUD SHADOWS:" ++ show (_cloud_shadows $ _config (_uvWorld 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 = Just
|
|
, _scOptionFlag = GameOverOptions
|
|
}
|
|
|
|
pauseMenu :: ScreenLayer
|
|
pauseMenu = OptionScreen
|
|
{ _scTitle = const "PAUSED"
|
|
, _scOptions = pauseMenuOptions
|
|
, _scDefaultEff = unpause
|
|
, _scOptionFlag = NormalOptions
|
|
}
|
|
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 .~ uvWorld (uvWorldSideEffects i (_uvWorld w))
|
|
where
|
|
i = fst $ random (_randGen (_uvWorld w))
|
|
|
|
uvWorldSideEffects :: Int -> World -> b -> IO World
|
|
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 :: World -> World
|
|
updateFramebufferSize w = w & sideEffects %~ sideEffectUpdatePreload divRes x y
|
|
where
|
|
(x,y) = (round $ getWindowX w, round $ getWindowY w)
|
|
divRes = w ^. 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")
|
|
]
|