Add (persistent) volume control

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

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
+    }
+ 

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)

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)
 

src/Dodge/Data/Menu.hs

@@ -6,6 +6,6 @@ data MenuLayer
     | PauseMenu
     | GameOverMenu
     | OptionMenu
-    | ConfigSaveScreen Int
+    | ConfigSaveScreen
   deriving (Eq,Ord)
 

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 

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

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