diff --git a/app/Main.hs b/app/Main.hs index c9a6ca059..74cdf0f16 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -30,13 +30,14 @@ import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate) import qualified SDL import qualified SDL.Mixer as Mix -doPreload' :: IO (PreloadData a) -doPreload' = do +doPreload' :: Dodge.LoadConfig.Configuration -> IO (PreloadData a) +doPreload' config = do lChunks <- loadSounds lMusic <- loadMusic let sData = SoundData {_loadedChunks = lChunks, _playingSounds = M.empty} mData = MusicData {_loadedMusic = lMusic} Mix.playMusic Mix.Forever (lMusic IM.! 0) + setVolume config rData <- preloadRender return $ PreloadData { _renderData = rData @@ -49,11 +50,12 @@ main :: IO () main = do (sizex,sizey) <- loadConfig keyConfig <- loadKeyConfig + dodgeConfig <- loadDodgeConfig setupLoop (sizex,sizey) - (SDL.cursorVisible $= False >> doPreload' >>= resizeSpareFBO sizex sizey) + (SDL.cursorVisible $= False >> doPreload' dodgeConfig >>= resizeSpareFBO sizex sizey) (\x -> (SDL.cursorVisible $= True) >> cleanUpPreload x) - (fmap (setWindowSize sizex sizey keyConfig) firstWorld) + (fmap (setWindowSize sizex sizey keyConfig . (config .~ dodgeConfig)) firstWorld) ( \preData w -> do startTicks <- SDL.ticks updateDodgeConfig w diff --git a/src/Dodge/Config/Data.hs b/src/Dodge/Config/Data.hs new file mode 100644 index 000000000..be509d4b2 --- /dev/null +++ b/src/Dodge/Config/Data.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StrictData #-} +module Dodge.Config.Data ( + Configuration (..) + , defaultConfig + , volume_master + , volume_sound + , volume_music + ) where + +import Data.Aeson +import Foreign.C.Types +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 + } + deriving (Generic, Show) + +makeLenses ''Configuration + +instance ToJSON Configuration where + toEncoding = genericToEncoding defaultOptions + +instance FromJSON Configuration + +defaultConfig = Configuration + { _volume_master = 1 + , _volume_sound = 1 + , _volume_music = 1 + } + diff --git a/src/Dodge/Config/Update.hs b/src/Dodge/Config/Update.hs index ca70e8517..1a61d6818 100644 --- a/src/Dodge/Config/Update.hs +++ b/src/Dodge/Config/Update.hs @@ -1,10 +1,10 @@ {-| -IO actions that apply config side effects and save it to disk. +IO actions that apply config side effects and save configuration settings to disk. -} module Dodge.Config.Update where import Dodge.Data -import Dodge.LoadConfig +import Dodge.Config.Data import Sound import Data.Aeson (encodeFile) @@ -12,11 +12,14 @@ import Control.Monad (when) updateDodgeConfig :: World -> IO () updateDodgeConfig w = case _menuLayers w of - (ConfigSaveScreen _: _) -> do - putStrLn "Saving config" + (ConfigSaveScreen : _) -> do + putStrLn "Saving config to data/dodge.config.json" encodeFile "data/dodge.config.json" cfig - _ -> when (_configNeedsUpdate w) $ do - setSoundVolume ( _volume_master cfig * _volume_sound cfig) - setMusicVolume ( _volume_master cfig * _volume_music cfig) + _ -> when (_configNeedsUpdate w) (setVolume cfig) where cfig = _config w + +setVolume :: Configuration -> IO () +setVolume cfig = do + setSoundVolume ( _volume_master cfig * _volume_sound cfig) + setMusicVolume ( _volume_master cfig * _volume_music cfig) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 85b8f0e59..bb619fe40 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -26,7 +26,8 @@ import SDL (Scancode, MouseButton) import Graphics.Rendering.OpenGL (PrimitiveMode (..),GLfloat,Program,VertexArrayObject,BufferObject) import Codec.Picture (Image,PixelRGBA8) import qualified Data.DList as DL -import Dodge.LoadConfig +import Dodge.Config.Data +import Dodge.LoadConfig.KeyConfig import Data.Int (Int16) diff --git a/src/Dodge/Data/Menu.hs b/src/Dodge/Data/Menu.hs index b72710854..fdaf85252 100644 --- a/src/Dodge/Data/Menu.hs +++ b/src/Dodge/Data/Menu.hs @@ -6,6 +6,6 @@ data MenuLayer | PauseMenu | GameOverMenu | OptionMenu - | ConfigSaveScreen Int + | ConfigSaveScreen deriving (Eq,Ord) diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index 64a7a6de2..2b348b655 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -42,7 +42,7 @@ handlePressedKeyInMenu mState scode w = case mState of 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 + _ -> Just $ w & menuLayers %~ ([ConfigSaveScreen , ConfigSaveScreen] ++) . tail & configNeedsUpdate .~ False _ -> Just w where diff --git a/src/Dodge/LoadConfig.hs b/src/Dodge/LoadConfig.hs index 1dcb4584d..efb8bc2ec 100644 --- a/src/Dodge/LoadConfig.hs +++ b/src/Dodge/LoadConfig.hs @@ -4,50 +4,28 @@ {-# LANGUAGE StrictData #-} module Dodge.LoadConfig ( - Configuration (..) - , loadDodgeConfig - , defaultConfig - , volume_master - , volume_sound - , volume_music + loadDodgeConfig , module Dodge.LoadConfig.KeyConfig + , module Dodge.Config.Data ) where import Dodge.LoadConfig.KeyConfig +import Dodge.Config.Data +import Dodge.Config.Update import Data.Aeson -import Foreign.C.Types -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 - } - deriving (Generic, Show) - -makeLenses ''Configuration - -instance ToJSON Configuration where - toEncoding = genericToEncoding defaultOptions - -instance FromJSON Configuration loadDodgeConfig :: IO Configuration loadDodgeConfig = do - mayConfig <- decodeFileStrict "data/dodge.config.json" - case mayConfig of - Just config -> return config - Nothing -> do - putStrLn "invalid data/dodge.config.json, loading default config" - return defaultConfig - -defaultConfig = Configuration - { _volume_master = 1 - , _volume_sound = 1 - , _volume_music = 1 - } - + fExists <- doesFileExist "data/dodge.config.json" + if fExists + then do + mayConfig <- decodeFileStrict "data/dodge.config.json" + case mayConfig of + Just config -> setVolume config >> return config + Nothing -> do + putStrLn "invalid data/dodge.config.json, loading default config" + return defaultConfig + else do + putStrLn "No data/data/dodge.config.json found, loading defaults" + return defaultConfig diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 493d65233..42f46186d 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -28,8 +28,7 @@ In such menus, the only way to change the world is using event handling. -} update :: World -> World update w = case _menuLayers w of - (ConfigSaveScreen x: ls) -> w & menuLayers .~ (ConfigSaveScreen (x-1) : ls) - (ConfigSaveScreen 0: ls) -> w & menuLayers .~ ls + (ConfigSaveScreen : ls) -> w & menuLayers .~ ls (_ : _) -> w [] -> let w1 = updateParticles' . updateProjectiles . updateLightSources