diff --git a/app/Main.hs b/app/Main.hs index e7237e107..c9a6ca059 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -9,6 +9,7 @@ import Dodge.Update import Dodge.Event import Dodge.Render import Dodge.LoadConfig +import Dodge.Config.Update import Dodge.LoadSound import Picture import Picture.Render @@ -55,6 +56,7 @@ main = do (fmap (setWindowSize sizex sizey keyConfig) firstWorld) ( \preData w -> do startTicks <- SDL.ticks + updateDodgeConfig w void $ doDrawing (_renderData preData) w playPositionalSoundQueue (_loadedChunks $ _soundData preData) (_soundQueue w) newPlayingSounds <- playAndUpdate (_soundData preData) (_sounds w) diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 0c0380c44..d72a1a4b2 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -770,7 +770,7 @@ levLayer HPtLayer = 73 levLayer ShadowLayer = 75 levLayer LabelLayer = 80 levLayer InvLayer = 85 -levLayer MenuLayer = 90 +levLayer MenuDepth = 90 {- | Transform coordinates from world position to normalised screen coordinates. -} diff --git a/src/Dodge/Config/Update.hs b/src/Dodge/Config/Update.hs new file mode 100644 index 000000000..ca70e8517 --- /dev/null +++ b/src/Dodge/Config/Update.hs @@ -0,0 +1,22 @@ +{-| +IO actions that apply config side effects and save it to disk. +-} +module Dodge.Config.Update + where +import Dodge.Data +import Dodge.LoadConfig +import Sound + +import Data.Aeson (encodeFile) +import Control.Monad (when) + +updateDodgeConfig :: World -> IO () +updateDodgeConfig w = case _menuLayers w of + (ConfigSaveScreen _: _) -> do + putStrLn "Saving config" + encodeFile "data/dodge.config.json" cfig + _ -> when (_configNeedsUpdate w) $ do + setSoundVolume ( _volume_master cfig * _volume_sound cfig) + setMusicVolume ( _volume_master cfig * _volume_music cfig) + where + cfig = _config w diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index ddc3277c0..85b8f0e59 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -65,7 +65,7 @@ data World = World , _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)])) , _pathInc :: ~(M.Map Point2 [Point2]) , _storedLevel :: Maybe World - , _menuState :: MenuState + , _menuLayers :: [MenuLayer] , _worldState :: M.Map WorldState Bool , _windowX :: !Float , _windowY :: !Float @@ -83,6 +83,7 @@ data World = World , _varMovementStrafeSpeedModifier :: Float , _debugMode :: Bool , _config :: Configuration + , _configNeedsUpdate :: Bool } data Corpse = Corpse @@ -100,7 +101,7 @@ data Layer | FlItLayer | LabelLayer | InvLayer - | MenuLayer + | MenuDepth | PressPlateLayer | CorpseLayer | UPtLayer diff --git a/src/Dodge/Data/Menu.hs b/src/Dodge/Data/Menu.hs index 61abc4719..b72710854 100644 --- a/src/Dodge/Data/Menu.hs +++ b/src/Dodge/Data/Menu.hs @@ -1,11 +1,11 @@ {-# LANGUAGE StrictData #-} module Dodge.Data.Menu where -data MenuState +data MenuLayer = LevelMenu Int | PauseMenu | GameOverMenu | OptionMenu - | InGame + | ConfigSaveScreen Int deriving (Eq,Ord) diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 2f5131423..0abd1fc67 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -210,7 +210,7 @@ defaultWorld = World , _corpses = IM.empty , _decorations = IM.empty , _storedLevel = Nothing - , _menuState = LevelMenu 1 + , _menuLayers = [LevelMenu 1] , _worldState = M.empty , _clickMousePos = (0,0) , _pathGraph = Data.Graph.Inductive.Graph.empty @@ -236,6 +236,7 @@ defaultWorld = World , _varMovementStrafeSpeedModifier = 3 , _debugMode = True , _config = defaultConfig + , _configNeedsUpdate = False } youLight = TLS { _tlsPos = (0,0) diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 811f9835e..b780d9757 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -57,8 +57,8 @@ handleMouseButtonEvent mbev w = case mouseButtonEventMotion mbev of where but = mouseButtonEventButton mbev handleMouseWheelEvent :: MouseWheelEventData -> World -> Maybe World -handleMouseWheelEvent mwev w = case _menuState w of - InGame -> case mouseWheelEventPos mwev of +handleMouseWheelEvent mwev w = case _menuLayers w of + [] -> case mouseWheelEventPos mwev of V2 x y | y > 0 -> Just (wheelUpEvent w) | y < 0 -> Just (wheelDownEvent w) | otherwise -> Just w diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 61900fc61..03c83163c 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -57,9 +57,9 @@ handlePressedKeyInGame _ w = Just w handlePressedKey :: Bool -> Scancode -> World -> Maybe World handlePressedKey True _ w = Just w handlePressedKey _ scode w - | _menuState w == InGame + | _menuLayers w == [] = handlePressedKeyInGame scode w - | otherwise = handlePressedKeyInMenu (_menuState w) scode w + | otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w handlePressedKey _ _ w = Just w debugKey :: Scancode -> World -> Maybe World @@ -70,7 +70,6 @@ debugKey scancode w | scancode == ScancodeF6 = Just $ dropLight' w debugKey _ w = Just w - spaceAction :: World -> World spaceAction w = case listToMaybe $ _closeActiveObjects w of Just (Left flit) -> pickUpItem' flit w @@ -78,7 +77,7 @@ spaceAction w = case listToMaybe $ _closeActiveObjects w of Nothing -> w pauseGame :: World -> World -pauseGame w = w {_menuState = PauseMenu} +pauseGame w = w {_menuLayers = [PauseMenu]} toggleMap w = w & carteDisplay %~ not escapeMap w = w & carteDisplay .~ False diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index 7b8dc3acc..64a7a6de2 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -7,24 +7,25 @@ import Dodge.Rooms import Dodge.Floor import Dodge.Initialisation import Dodge.SoundLogic +import Dodge.LoadConfig import Data.Maybe import qualified Data.Set as S - import Control.Lens - import SDL -handlePressedKeyInMenu :: MenuState -> Scancode -> World -> Maybe World +handlePressedKeyInMenu :: MenuLayer -> Scancode -> World -> Maybe World handlePressedKeyInMenu mState scode w = case mState of LevelMenu _ -> case scode of ScancodeEscape -> Nothing + ScancodeO -> goToOptionMenu 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 _ -> unpause w GameOverMenu -> case scode of ScancodeEscape -> Nothing @@ -32,13 +33,27 @@ handlePressedKeyInMenu mState scode w = case mState of ScancodeN -> Just $ putSound $ generateLevel 1 $ initialWorld {_randGen = _randGen w} + ScancodeO -> goToOptionMenu w _ -> Just w + OptionMenu -> case scode of + ScancodeY -> Just $ w & config . volume_master %~ dec + ScancodeU -> Just $ w & config . volume_master %~ inc + ScancodeH -> Just $ w & config . volume_sound %~ dec + ScancodeJ -> Just $ w & config . volume_sound %~ inc + ScancodeN -> Just $ w & config . volume_music %~ dec + ScancodeM -> Just $ w & config . volume_music %~ inc + _ -> Just $ w & menuLayers %~ (ConfigSaveScreen 1:) . tail + & configNeedsUpdate .~ False _ -> Just w where unpause w' = Just . resumeSound $ - w' {_menuState = InGame} + 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 :) + & configNeedsUpdate .~ True storeLevel :: World -> World storeLevel w = case _storedLevel w of diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 6fd6f79bc..e90ef110b 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -47,7 +47,7 @@ initialWorld = defaultWorld , _sounds = M.empty , _decorations = IM.empty , _storedLevel = Nothing - , _menuState = LevelMenu 1 + , _menuLayers = [LevelMenu 1] , _worldState = M.empty , _windowX = 800 , _windowY = 600 diff --git a/src/Dodge/LoadConfig.hs b/src/Dodge/LoadConfig.hs index 6b6126859..1dcb4584d 100644 --- a/src/Dodge/LoadConfig.hs +++ b/src/Dodge/LoadConfig.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-} @@ -6,6 +7,9 @@ module Dodge.LoadConfig Configuration (..) , loadDodgeConfig , defaultConfig + , volume_master + , volume_sound + , volume_music , module Dodge.LoadConfig.KeyConfig ) where import Dodge.LoadConfig.KeyConfig @@ -16,14 +20,17 @@ import GHC.Generics import qualified GHC.Int import qualified SDL import System.Directory +import Control.Lens data Configuration = Configuration - { volume_master :: Float - , volume_sound :: Float - , volume_music :: Float + { _volume_master :: Float + , _volume_sound :: Float + , _volume_music :: Float } deriving (Generic, Show) +makeLenses ''Configuration + instance ToJSON Configuration where toEncoding = genericToEncoding defaultOptions @@ -39,8 +46,8 @@ loadDodgeConfig = do return defaultConfig defaultConfig = Configuration - { volume_master = 1 - , volume_sound = 1 - , volume_music = 1 + { _volume_master = 1 + , _volume_sound = 1 + , _volume_music = 1 } diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index 95435a1c2..3eaff5990 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -3,34 +3,50 @@ module Dodge.Render.MenuScreen ) where import Dodge.Data +import Dodge.LoadConfig import Dodge.Base (halfWidth,halfHeight) import Picture menuScreen :: World -> Picture -menuScreen w = case _menuState w of - InGame -> blank - LevelMenu x -> - pictures [--color (withAlpha 0.5 black) $ polygon $ screenBox w - tst (-100) 100 0.4 ("LEVEL "++show x) - ,controlsList - ] - PauseMenu -> pictures - [color (withAlpha 0.5 black) $ polygon $ screenBox w - ,tst (-100) 100 0.4 "PAUSED" - ,tst (-100) 50 0.2 "n - new level" - ,tst (-100) 0 0.2 "r - restart" - ,tst (-100) (-50) 0.2 "o - options" - , controlsList - ] - GameOverMenu -> pictures [color (withAlpha 0.5 black) $ polygon $ screenBox w - ,tst (-100) 100 0.4 "GAME OVER" - ,tst (-100) 50 0.2 "n - new level" - ,tst (-100) 0 0.2 "r - restart" - ,tst (-100) (-50) 0.2 "o - options" - ,controlsList - ] - where tst x y sc t = translate x y $ scale sc sc $ color white $ text t +menuScreen w = case _menuLayers w of + [] -> blank + (LevelMenu x:_) -> pictures + [color (withAlpha 0.5 black) $ polygon $ screenBox w + ,tst (-100) 100 0.4 ("LEVEL "++show x) + ,controlsList + ] + (PauseMenu:_) -> pictures + [color (withAlpha 0.5 black) $ polygon $ screenBox w + ,tst (-100) 100 0.4 "PAUSED" + ,tst (-100) 50 0.2 "n - new level" + ,tst (-100) 0 0.2 "r - restart" + ,tst (-100) (-50) 0.2 "o - options" + , controlsList + ] + (GameOverMenu:_) -> pictures + [color (withAlpha 0.5 black) $ polygon $ screenBox w + ,tst (-100) 100 0.4 "GAME OVER" + ,tst (-100) 50 0.2 "n - new level" + ,tst (-100) 0 0.2 "r - restart" + ,tst (-100) (-50) 0.2 "o - options" + ,controlsList + ] + (OptionMenu : _) -> pictures + [color (withAlpha 0.5 black) $ polygon $ screenBox w + ,tst (-100) 100 0.4 "OPTIONS" + ,tst (-180) 50 0.2 $ "y - master volume + u : " ++ mavol + ,tst (-180) 0 0.2 $ "h - sound volume + j : " ++ snvol + ,tst (-180) (-50) 0.2 $ "n - music volume + m : " ++ muvol + ,controlsList + ] + _ -> blank + where + tst x y sc t = translate x y $ scale sc sc $ color white $ text t + mavol = f $ _volume_master $ _config w + snvol = f $ _volume_sound $ _config w + muvol = f $ _volume_music $ _config w + f x = show $ round $ 10 * x controlsList = pictures [tst (-250) (-130) 0.15 "controls:" ,tst (-150) (-130) 0.15 "wasd" diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index a1f400d96..3f95003db 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -29,7 +29,7 @@ worldPictures w = pictures $ concat fixedCoordPictures :: World -> Picture fixedCoordPictures w = pictures [ hudDrawings w - , scaler . onLayer MenuLayer $ menuScreen w + , scaler . onLayer MenuDepth $ menuScreen w , customMouseCursor w ] where diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 2d4741a8a..493d65233 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -23,14 +23,15 @@ import qualified Data.IntMap.Strict as IM import qualified Data.Map as M import Control.Lens {- | The update step. -If the '_menuState' is not 'InGame', this is the identity. -This means that the only way to change the world is using event handling. +If '_menuLayers' is not empty, or the saving screen, this is the identity. +In such menus, the only way to change the world is using event handling. -} update :: World -> World -update w - | _menuState w /= InGame = w - | otherwise = - let w1 = updateParticles' . updateProjectiles +update w = case _menuLayers w of + (ConfigSaveScreen x: ls) -> w & menuLayers .~ (ConfigSaveScreen (x-1) : ls) + (ConfigSaveScreen 0: ls) -> w & menuLayers .~ ls + (_ : _) -> w + [] -> let w1 = updateParticles' . updateProjectiles . updateLightSources . zoneClouds . updateClouds @@ -101,7 +102,7 @@ setTestStringIO = fmap (\ w -> set testString (show $ s w) w) where s w = (-.-) <$> (w ^? creatures . ix 0 . crPos) <*> (w ^? creatures . ix 0 . crOldPos) checkEndGame :: World -> World -checkEndGame w | _crHP (you w) < 1 = haltSound $ w {_menuState = GameOverMenu} +checkEndGame w | _crHP (you w) < 1 = haltSound $ w {_menuLayers = [GameOverMenu]} | otherwise = w updateClouds :: World -> World