109 lines
4.1 KiB
Haskell
109 lines
4.1 KiB
Haskell
module Dodge.Event.Menu
|
|
( handlePressedKeyInMenu
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Data.Menu
|
|
import Dodge.Base.Window
|
|
import Dodge.Floor
|
|
import Dodge.Initialisation
|
|
import Dodge.SoundLogic
|
|
import Dodge.Config.Data
|
|
import Dodge.Config.Update
|
|
import Dodge.Layout
|
|
import Framebuffer.Update
|
|
import Dodge.Debug.Terminal
|
|
|
|
import Data.Maybe
|
|
--import qualified Data.Set as S
|
|
import Control.Lens
|
|
import SDL
|
|
import SDL.Internal.Numbered
|
|
|
|
handlePressedKeyInMenu :: MenuLayer -> Scancode -> World -> Maybe World
|
|
handlePressedKeyInMenu mState scode w = case mState of
|
|
TerminalMessage 0 _ -> popMenu w
|
|
TerminalMessage _ m -> Just $ w & menuLayers %~ ((TerminalMessage 0 m : ) . tail)
|
|
Terminal s -> case scode of
|
|
ScancodeEscape -> popMenu w
|
|
ScancodeReturn -> popMenu $ applyTerminalString s w
|
|
ScancodeBackspace -> popMenu w >>= pushMenu (Terminal $ dropLast s)
|
|
_ -> popMenu w >>= pushMenu (Terminal $ s ++ [scodeToChar scode])
|
|
LevelMenu _ -> case scode of
|
|
ScancodeEscape -> Nothing
|
|
ScancodeO -> pushMenu OptionMenu w
|
|
ScancodeC -> pushMenu ControlList w
|
|
_ -> startLevel w
|
|
PauseMenu -> case scode of
|
|
ScancodeEscape -> Nothing
|
|
ScancodeR -> return $ fromMaybe w $ _storedLevel w
|
|
ScancodeN -> startNewGame
|
|
ScancodeO -> pushMenu OptionMenu w
|
|
ScancodeC -> pushMenu ControlList w
|
|
_ -> unpause w
|
|
GameOverMenu -> case scode of
|
|
ScancodeEscape -> Nothing
|
|
ScancodeR -> Just $ fromMaybe w $ _storedLevel w
|
|
ScancodeN -> startNewGame
|
|
ScancodeO -> pushMenu OptionMenu w
|
|
ScancodeC -> pushMenu ControlList w
|
|
_ -> Just w
|
|
OptionMenu -> case scode of
|
|
ScancodeV -> pushMenu SoundOptionMenu w
|
|
ScancodeG -> pushMenu GraphicsOptionMenu w
|
|
_ -> popMenu w
|
|
SoundOptionMenu -> 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
|
|
_ -> popMenu $ w & sideEffects %~ (saveConfig (_config w) :)
|
|
GraphicsOptionMenu -> case scode of
|
|
ScancodeW -> Just $ w & config . wall_textured %~ not
|
|
ScancodeS -> Just $ updateFramebufferSize $ w & config . shadow_resolution %~ cycleResolution
|
|
_ -> popMenu $ w & sideEffects %~ (saveConfig (_config w) :)
|
|
ControlList -> Just $ w & menuLayers %~ tail
|
|
_ -> Just w
|
|
where
|
|
unpause w' = Just . resumeSound $
|
|
w' {_menuLayers = []}
|
|
startLevel = unpause . storeLevel
|
|
dec x = max 0 (x - 0.1)
|
|
inc x = min 1 (x + 0.1)
|
|
pushMenu ml w' = Just $ w' & menuLayers %~ (ml :)
|
|
popMenu w' = Just $ w' & menuLayers %~ tail
|
|
sw = w & sideEffects %~ (setVol (_config w) : )
|
|
startNewGame = Just $ w
|
|
& menuLayers .~ [WaitMessage "GENERATING..." 1]
|
|
& worldEvents .~ const aNewGame
|
|
aNewGame :: World
|
|
aNewGame = updateFramebufferSize $ generateLevelFromRoomList levx $ initialWorld
|
|
& randGen .~ _randGen w
|
|
& config .~ _config w
|
|
dropLast (x:xs) = init (x:xs)
|
|
dropLast _ = []
|
|
|
|
-- | hacky
|
|
scodeToChar :: Scancode -> Char
|
|
scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber
|
|
|
|
updateFramebufferSize :: World -> World
|
|
updateFramebufferSize w = w & sideEffects
|
|
%~ (sizeFBOs (x `div` divRes) (y `div` divRes) x y : )
|
|
where
|
|
(x,y) = (round $ getWindowX w, round $ getWindowY w)
|
|
divRes = w ^. config . shadow_resolution
|
|
|
|
|
|
cycleResolution :: (Eq a, Num a, Num p) => a -> p
|
|
cycleResolution 1 = 2
|
|
cycleResolution 2 = 4
|
|
cycleResolution 4 = 1
|
|
cycleResolution _ = 1
|
|
|
|
storeLevel :: World -> World
|
|
storeLevel w = case _storedLevel w of
|
|
Nothing -> w & storedLevel ?~ w
|
|
_ -> w
|