68 lines
2.7 KiB
Haskell
68 lines
2.7 KiB
Haskell
module Dodge.Event.Menu
|
|
( handlePressedKeyInMenu
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Rooms
|
|
import Dodge.Floor
|
|
import Dodge.Initialisation
|
|
import Dodge.SoundLogic
|
|
import Dodge.LoadConfig
|
|
import Dodge.Config.Update
|
|
|
|
import Data.Maybe
|
|
import qualified Data.Set as S
|
|
import Control.Lens
|
|
import SDL
|
|
|
|
handlePressedKeyInMenu :: MenuLayer -> Scancode -> World -> Maybe World
|
|
handlePressedKeyInMenu mState scode w = case mState of
|
|
LevelMenu _ -> case scode of
|
|
ScancodeEscape -> Nothing
|
|
ScancodeO -> goToOptionMenu w
|
|
ScancodeC -> goToControls w
|
|
_ -> startLevel w
|
|
PauseMenu -> case scode of
|
|
ScancodeEscape -> Nothing
|
|
ScancodeR -> return $ fromMaybe w $ _storedLevel w
|
|
ScancodeN -> Just $ putSound $ generateLevel 1
|
|
$ initialWorld {_randGen = _randGen w}
|
|
ScancodeO -> goToOptionMenu w
|
|
ScancodeC -> goToControls w
|
|
_ -> unpause w
|
|
GameOverMenu -> case scode of
|
|
ScancodeEscape -> Nothing
|
|
ScancodeR -> Just $ fromMaybe w $ _storedLevel w
|
|
ScancodeN -> Just $ putSound $ generateLevel 1
|
|
$ initialWorld
|
|
{_randGen = _randGen w}
|
|
ScancodeO -> goToOptionMenu w
|
|
ScancodeC -> goToControls w
|
|
_ -> Just w
|
|
OptionMenu -> case scode of
|
|
ScancodeY -> Just $ sw & config . volume_master %~ dec
|
|
ScancodeU -> Just $ sw & config . volume_master %~ inc
|
|
ScancodeH -> Just $ sw & config . volume_sound %~ dec
|
|
ScancodeJ -> Just $ sw & config . volume_sound %~ inc
|
|
ScancodeN -> Just $ sw & config . volume_music %~ dec
|
|
ScancodeM -> Just $ sw & config . volume_music %~ inc
|
|
_ -> Just $ w & menuLayers %~ tail
|
|
& sideEffects %~ (saveConfig (_config w) :)
|
|
ControlList -> Just $ w & menuLayers %~ tail
|
|
_ -> Just w
|
|
where
|
|
unpause w' = Just . resumeSound $
|
|
w' {_menuLayers = []}
|
|
startLevel = unpause . storeLevel
|
|
putSound = id -- set loadedSounds (_loadedSounds w)
|
|
dec x = max 0 (x - 0.1)
|
|
inc x = min 1 (x + 0.1)
|
|
goToOptionMenu w = Just $ w & menuLayers %~ (OptionMenu :)
|
|
goToControls w = Just $ w & menuLayers %~ (ControlList :)
|
|
sw = w & sideEffects %~ (setVol (_config w) : )
|
|
|
|
storeLevel :: World -> World
|
|
storeLevel w = case _storedLevel w of
|
|
Nothing -> w & storedLevel ?~ w
|
|
_ -> w
|