Ross
105 lines
4.4 KiB
Haskell
105 lines
4.4 KiB
Haskell
module Dodge.Menu where
|
|
-- imports {{{
|
|
import Dodge.Data
|
|
import Dodge.Rooms
|
|
import Dodge.Floor
|
|
import Dodge.Initialisation
|
|
import Dodge.SoundLogic
|
|
|
|
import Data.Tree
|
|
import Data.Maybe
|
|
import qualified Data.Set as S
|
|
|
|
import Control.Lens
|
|
import Control.Monad
|
|
import Control.Monad.State
|
|
|
|
|
|
import System.Exit
|
|
import System.Random
|
|
|
|
--import Graphics.Gloss.Interface.IO.Game
|
|
import SDL
|
|
-- }}}
|
|
|
|
keyPressedDown :: Event -> Maybe Scancode
|
|
keyPressedDown e = case eventPayload e of
|
|
KeyboardEvent (KeyboardEventData _ Pressed False keysym) -> Just $ keysymScancode keysym
|
|
_ -> Nothing
|
|
|
|
menuEvents :: (Event -> World -> Maybe World) -> Event -> World -> Maybe World
|
|
menuEvents f e w = case _menuState w of
|
|
LevelMenu _ -> case keyPressedDown e of
|
|
Just ScancodeEscape -> Nothing
|
|
Just _ -> startLevel w >>= f e
|
|
_ -> Just w
|
|
PauseMenu -> case keyPressedDown e of
|
|
Just ScancodeEscape -> Nothing
|
|
Just ScancodeR -> return $ fromMaybe w $ _storedLevel w
|
|
Just ScancodeN -> Just $ putSound $ generateLevel 1
|
|
$ initialWorld {_randGen = _randGen w}
|
|
Just _ -> unpause w >>= f e
|
|
_ -> Just w
|
|
GameOverMenu -> case keyPressedDown e of
|
|
Just ScancodeEscape -> Nothing
|
|
Just ScancodeR -> Just $ fromMaybe w $ _storedLevel w
|
|
Just ScancodeN -> Just $ putSound $ generateLevel 1
|
|
$ initialWorld
|
|
{_randGen = _randGen w}
|
|
_ -> return w
|
|
_ -> f e w
|
|
where unpause w' = Just $ resumeSound $
|
|
w' {_menuState = InGame,_keys = S.empty}
|
|
startLevel = unpause . storeLevel
|
|
putSound = id -- set loadedSounds (_loadedSounds w)
|
|
|
|
|
|
--- menuCheckKeyEvents :: (Event -> World -> IO World) -> Event -> World -> IO World
|
|
--- menuCheckKeyEvents f e w = case _menuState w of
|
|
--- LevelMenu _ -> case e of
|
|
--- (EventKey (SpecialKey KeyEsc) Down _ _)
|
|
--- -> exitSuccess
|
|
--- (EventKey _ Down _ _) -> startLevel w >>= f e
|
|
--- _ -> return w
|
|
--- PauseMenu -> case e of
|
|
--- (EventKey (SpecialKey KeyEsc) Down _ _)
|
|
--- -> exitSuccess
|
|
--- (EventKey (Char 'r') Down _ _) -> return $ fromMaybe w $ _storedLevel w
|
|
--- (EventKey (Char 'n') Down _ _) -> fmap putSound $ generateLevel 1
|
|
--- $ initialWorld
|
|
--- {_randGen = _randGen w}
|
|
--- -- (EventKey (Char 'c') Down _ _) -> unpaused
|
|
--- -- (EventKey (Char 'p') Down _ _) -> unpaused
|
|
--- -- (EventKey (SpecialKey KeySpace) Down _ _) -> unpaused
|
|
--- (EventKey _ Down _ _) -> unpause w >>= f e
|
|
--- _ -> return w
|
|
--- GameOverMenu -> case e of
|
|
--- (EventKey (SpecialKey KeyEsc) Down _ _)
|
|
--- -> exitSuccess
|
|
--- (EventKey (Char 'r') Down _ _) -> return $ fromMaybe w $ _storedLevel w
|
|
--- (EventKey (Char 'n') Down _ _) -> fmap putSound $ generateLevel 1
|
|
--- $ initialWorld
|
|
--- {_randGen = _randGen w}
|
|
--- -- (EventKey (Char 'c') Down _ _) -> unpaused
|
|
--- _ -> return w
|
|
--- _ -> f e w
|
|
--- where unpause w' = do Mix.resume (-1)
|
|
--- return w' {_menuState = InGame,_keys = S.empty}
|
|
--- startLevel = unpause . storeLevel
|
|
--- putSound = set loadedSounds (_loadedSounds w)
|
|
--- -- there might be a better way to pass the loaded sounds around
|
|
|
|
updateRandGen :: World -> World
|
|
updateRandGen = over randGen (fst . split)
|
|
|
|
menuCheckUpdate :: (Float -> World -> IO World) -> Float -> World -> IO World
|
|
menuCheckUpdate f t w = case _menuState w of
|
|
InGame -> f t w
|
|
_ -> return w
|
|
|
|
storeLevel :: World -> World
|
|
storeLevel w = case _storedLevel w of
|
|
Nothing -> set storedLevel (Just w) w
|
|
_ -> w
|
|
|