Add source files, commit before reverting pictures to lists

src/Dodge/Menu.hs

@@ -0,0 +1,103 @@
+module Dodge.Menu where
+-- imports {{{
+import Dodge.Data
+import Dodge.Rooms
+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 Keycode
+keyPressedDown e = case eventPayload e of
+    KeyboardEvent (KeyboardEventData _ Pressed False keysym) -> Just $ keysymKeycode 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 KeycodeEscape -> Nothing
+            Just _             -> startLevel w >>= f e
+            _                  -> Just w
+    PauseMenu -> case keyPressedDown e of
+            Just KeycodeEscape -> Nothing
+            Just KeycodeR      -> return $ fromMaybe w $ _storedLevel w
+            Just KeycodeN      -> Just $ putSound $ generateLevel 1 
+                                           $ initialWorld {_randGen = _randGen w}
+            Just _             -> unpause w >>= f e
+            _                  -> Just w
+    GameOverMenu -> case keyPressedDown e of
+            Just KeycodeEscape -> Nothing
+            Just KeycodeR      -> Just $ fromMaybe w $ _storedLevel w
+            Just KeycodeN      -> 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
+