Apply all world side effects using list

app/Main.hs

@@ -9,6 +9,7 @@ import Dodge.Update
 import Dodge.Event
 import Dodge.Render
 import Dodge.LoadConfig
+import Dodge.Config.Load
 import Dodge.Config.Update
 import Dodge.LoadSound
 import Picture
@@ -47,7 +48,6 @@ main = do
 doSideEffects :: PreloadData SoundOrigin -> World -> IO (PreloadData SoundOrigin)
 doSideEffects 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)

src/Dodge/Config/Load.hs

@@ -0,0 +1,23 @@
+module Dodge.Config.Load
+    (
+      loadDodgeConfig
+    ) where
+import Dodge.Config.Data
+
+import Data.Aeson
+import System.Directory
+
+loadDodgeConfig :: IO Configuration
+loadDodgeConfig = do
+    fExists <- doesFileExist "data/dodge.config.json"
+    if fExists
+    then do
+        mayConfig <- decodeFileStrict "data/dodge.config.json"
+        case mayConfig of
+          Just config -> return config
+          Nothing -> do
+            putStrLn "invalid data/dodge.config.json, loading defaults"
+            return defaultConfig
+    else do
+        putStrLn "No data/data/dodge.config.json found, loading defaults"
+        return defaultConfig

src/Dodge/Config/Update.hs

@@ -6,20 +6,23 @@ module Dodge.Config.Update
 import Dodge.Data
 import Dodge.Config.Data
 import Sound
+import Preload.Data
 
 import Data.Aeson (encodeFile)
 import Control.Monad (when)
 
-updateDodgeConfig :: World -> IO ()
+saveConfig :: Configuration -> PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)
-updateDodgeConfig w = case _menuLayers w of
+saveConfig cfig d = do
-    (ConfigSaveScreen : _) -> do
     putStrLn "Saving config to data/dodge.config.json"
     encodeFile "data/dodge.config.json" cfig
-    _ -> when (_configNeedsUpdate w) (setVolume cfig)
+    return d
-  where
-    cfig = _config w
 
 setVolume :: Configuration -> IO ()
 setVolume cfig = do
     setSoundVolume ( _volume_master cfig * _volume_sound cfig)
     setMusicVolume ( _volume_master cfig * _volume_music cfig)
+
+setVol :: Configuration -> PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)
+setVol cfig d = do
+    setVolume cfig
+    return d

src/Dodge/Data.hs

@@ -10,27 +10,26 @@ module Dodge.Data
     )
   where
 import Dodge.Data.Menu
+import Dodge.Config.Data
+import Dodge.LoadConfig.KeyConfig
 import Preload.Data
-
 import Picture.Data
 import Geometry.Data
 import Sound.Data
+
 import Control.Lens
 import Control.Monad.State
 import System.Random
 import Data.Graph.Inductive
+import Data.Int (Int16)
 import qualified Data.Set as S
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Map as M
-import qualified SDL.Mixer as Mix
+import qualified Data.DList as DL
 import SDL (Scancode, MouseButton)
+import qualified SDL.Mixer as Mix
 import Graphics.Rendering.OpenGL (PrimitiveMode (..),GLfloat,Program,VertexArrayObject,BufferObject)
 import Codec.Picture (Image,PixelRGBA8)
-import qualified Data.DList as DL
-import Dodge.Config.Data
-import Dodge.LoadConfig.KeyConfig
-
-import Data.Int (Int16)
 
 data World = World 
     { _keys                 :: !(S.Set Scancode)
@@ -85,7 +84,6 @@ data World = World
     , _varMovementStrafeSpeedModifier :: Float
     , _debugMode            :: Bool
     , _config               :: Configuration
-    , _configNeedsUpdate    :: Bool
     , _sideEffects          :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)]
     , _doneSideEffects      :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)]
     } 
@@ -526,8 +524,6 @@ data DamageType
 
 data Either3 a b c = E3x1 a | E3x2 b | E3x3 c
 
-data WLID = WLID { _wlIDx :: Int, _wlIDy :: Int, _wlIDid :: Int}
-
 data Wall 
     = Wall 
         { _wlLine :: [Point2] , _wlID :: Int 
@@ -596,36 +592,6 @@ data SoundOrigin = InventorySound
     | GlassBreakSound Int
   deriving (Eq,Ord,Show)
 
-type Poly = [Point2]
-data PSType = PutCrit Creature
-    | PutLS LightSource Picture
-    | PutButton Button
-    | PutFlIt FloorItem
-    | PutPressPlate PressPlate
-    | PutAutoDoor Point2 Point2
-    | PutBlock [Int] Color [Point2]
-    | PutLineBlock Wall Float Float Point2 Point2
-    | PutTriggerDoor Color (World -> Bool) Point2 Point2
-    | PutBtDoor Color Point2 Float Point2 Point2
-    | PutSwitchDoor Color Point2 Float Point2 Point2
-    | RandPS (State StdGen PSType)
-    | PutNothing
-    | CollectivePS 
-        { _collectiveID  :: Int 
-        , _collectiveNum :: Int 
-        , _collectiveFunction :: [Int] -> State StdGen [PSType]
-        }
-    | LabelPS { _psLabel :: Int, _ps :: PSType}
-    | PutWindow { _pwPoly :: [Point2] , _pwColor :: Color
-                }
-data PlacementSpot = PS
-    { _psPos :: Point2
-    , _psRot :: Float
-    , _psType :: PSType
-    }
-
-data SubNode a = SN a | InLink | OutLink
-
 
 makeLenses ''World
 makeLenses ''Cloud
@@ -651,8 +617,6 @@ makeLenses ''ForceField
 makeLenses ''FFState
 makeLenses ''PressPlate
 makeLenses ''Button
-makeLenses ''PSType
-makeLenses ''PlacementSpot
 
 numColor :: Int -> Color
 numColor 0  = (1,0,0,1) 

src/Dodge/Default.hs

@@ -236,7 +236,6 @@ defaultWorld = World
     , _varMovementStrafeSpeedModifier = 3
     , _debugMode = True
     , _config       = defaultConfig
-    , _configNeedsUpdate = False
     , _sideEffects          = []
     , _doneSideEffects      = []
     }

src/Dodge/Event.hs

@@ -128,4 +128,3 @@ before y (x:z:ys) | y == z    = x
                   | otherwise = before y (z:ys)
 after y (x:z:ys)  | y == x    = z
                   | otherwise = after y (z:ys)
-

src/Dodge/Event/Menu.hs

@@ -8,6 +8,7 @@ import Dodge.Floor
 import Dodge.Initialisation
 import Dodge.SoundLogic
 import Dodge.LoadConfig
+import Dodge.Config.Update
 
 import Data.Maybe
 import qualified Data.Set as S
@@ -39,14 +40,14 @@ handlePressedKeyInMenu mState scode w = case mState of
             ScancodeC       -> goToControls w
             _               -> Just w
     OptionMenu -> case scode of
-            ScancodeY       -> Just $ w & config . volume_master %~ dec
+            ScancodeY       -> Just $ sw & config . volume_master %~ dec
-            ScancodeU       -> Just $ w & config . volume_master %~ inc
+            ScancodeU       -> Just $ sw & config . volume_master %~ inc
-            ScancodeH       -> Just $ w & config . volume_sound  %~ dec
+            ScancodeH       -> Just $ sw & config . volume_sound  %~ dec
-            ScancodeJ       -> Just $ w & config . volume_sound  %~ inc
+            ScancodeJ       -> Just $ sw & config . volume_sound  %~ inc
-            ScancodeN       -> Just $ w & config . volume_music  %~ dec
+            ScancodeN       -> Just $ sw & config . volume_music  %~ dec
-            ScancodeM       -> Just $ w & config . volume_music  %~ inc
+            ScancodeM       -> Just $ sw & config . volume_music  %~ inc
-            _               -> Just $ w & menuLayers %~ ([ConfigSaveScreen , ConfigSaveScreen] ++) . tail
+            _               -> Just $ w & menuLayers %~ tail
-                                        & configNeedsUpdate .~ False
+                                        & sideEffects %~ (saveConfig (_config w) :)
     ControlList -> Just $ w & menuLayers %~ tail
     _ -> Just w
   where 
@@ -57,8 +58,8 @@ handlePressedKeyInMenu mState scode w = case mState of
     dec x = max 0 (x - 0.1)
     inc x = min 1 (x + 0.1)
     goToOptionMenu w = Just $ w & menuLayers %~ (OptionMenu :)
-                                & configNeedsUpdate .~ True
     goToControls w = Just $ w & menuLayers %~ (ControlList :)
+    sw = w & sideEffects %~ (setVol (_config w) : )
 
 storeLevel :: World -> World
 storeLevel w = case _storedLevel w of

src/Dodge/Floor.hs

@@ -5,7 +5,6 @@ module Dodge.Floor
     where
 import Geometry
 import Picture
-
 import Dodge.Data
 import Dodge.Rooms
 import Dodge.Room.Data
@@ -15,6 +14,7 @@ import Dodge.Creature
 import Dodge.SoundLogic
 import Dodge.RandomHelp
 import Dodge.LightSources
+import Dodge.LevelGen.Data
 
 import Data.Tree
 

src/Dodge/Layout.hs

@@ -6,6 +6,7 @@ module Dodge.Layout
 -- imports {{{
 import Dodge.Data
 import Dodge.LevelGen
+import Dodge.LevelGen.Data
 import Dodge.Base
 import Dodge.RandomHelp
 import Dodge.Graph

src/Dodge/LevelGen.hs

@@ -1,9 +1,10 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE FlexibleInstances #-}
+-- | deals with placement of objects within the world
+-- after they have had their coordinates set by the layout
 module Dodge.LevelGen 
     ( module Dodge.LevelGen
     , cutWalls
---    , createInnerWalls
     , pairsToGraph
     , makeButton
     , makeSwitch
@@ -13,7 +14,6 @@ module Dodge.LevelGen
 import Dodge.Data
 import Dodge.Base
 import Dodge.Room.Data
-
 import Dodge.LevelGen.Block
 import Dodge.LevelGen.LineBlock
 import Dodge.LevelGen.Pathing
@@ -21,24 +21,21 @@ import Dodge.LevelGen.StaticWalls
 import Dodge.LevelGen.AutoDoor
 import Dodge.LevelGen.TriggerDoor
 import Dodge.LevelGen.Switch
-
+import Dodge.LevelGen.Data
 import Geometry
 import Picture
 
 import System.Random
-
 import Control.Monad.State
-import Data.List
-import Data.Function
 import Control.Applicative
 import Control.Lens
+import Data.List
+import Data.Function
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Set as S
 import qualified Data.Map as M
 
--- deals with placement of objects within the world
--- after they have had their coordinates set by the layout
 
 placeSpots :: [PlacementSpot] -> World -> World
 placeSpots pss w = foldr placeSpot w basicPlacements

src/Dodge/LevelGen/Data.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.LevelGen.Data
+    where
+import Dodge.Data
+import Picture
+
+import Control.Lens
+import Control.Monad.State
+import System.Random
+
+data PSType = PutCrit Creature
+    | PutLS LightSource Picture
+    | PutButton Button
+    | PutFlIt FloorItem
+    | PutPressPlate PressPlate
+    | PutAutoDoor Point2 Point2
+    | PutBlock [Int] Color [Point2]
+    | PutLineBlock Wall Float Float Point2 Point2
+    | PutTriggerDoor Color (World -> Bool) Point2 Point2
+    | PutBtDoor Color Point2 Float Point2 Point2
+    | PutSwitchDoor Color Point2 Float Point2 Point2
+    | RandPS (State StdGen PSType)
+    | PutNothing
+    | CollectivePS 
+        { _collectiveID  :: Int 
+        , _collectiveNum :: Int 
+        , _collectiveFunction :: [Int] -> State StdGen [PSType]
+        }
+    | LabelPS { _psLabel :: Int, _ps :: PSType}
+    | PutWindow { _pwPoly :: [Point2] , _pwColor :: Color
+                }
+data PlacementSpot = PS
+    { _psPos :: Point2
+    , _psRot :: Float
+    , _psType :: PSType
+    }
+
+makeLenses ''PSType
+makeLenses ''PlacementSpot

src/Dodge/LightSources.hs

@@ -1,15 +1,10 @@
 module Dodge.LightSources where
 import Dodge.Data
 import Dodge.Base
-
+import Dodge.LevelGen.Data
 import Geometry
 import Picture
 
---import Graphics.Gloss
---import Graphics.Gloss.Data.Vector
---import Graphics.Gloss.Geometry.Line
---import Graphics.Gloss.Geometry.Angle
-
 import qualified Data.IntMap.Strict as IM
 
 lightAt p i = 

src/Dodge/LoadConfig.hs

@@ -4,8 +4,7 @@
 {-# LANGUAGE StrictData #-}
 module Dodge.LoadConfig
     ( 
-      loadDodgeConfig
+      module Dodge.LoadConfig.KeyConfig
-    , module Dodge.LoadConfig.KeyConfig
     , module Dodge.Config.Data
     ) where
 import Dodge.LoadConfig.KeyConfig

src/Dodge/Room/Data.hs

@@ -2,16 +2,17 @@
 {-# LANGUAGE StrictData #-}
 module Dodge.Room.Data
   where
+import Dodge.LevelGen.Data
+import Geometry
 
-import Dodge.Data
 import Control.Lens
 
 data Room = Room
-    { _rmPolys  :: [Poly]
+    { _rmPolys  :: [ [Point2] ]
     , _rmLinks  :: [(Point2,Float)]
     , _rmPath :: [(Point2, Point2)]
     , _rmPS :: [PlacementSpot]
-    , _rmBound :: Poly
+    , _rmBound :: [Point2]
     }
 data RoomLink = RL {_rlPos :: Point2, _rlRot :: Float}
 

src/Dodge/Room/Placement.hs

@@ -1,6 +1,7 @@
 module Dodge.Room.Placement
   where
 import Dodge.Data
+import Dodge.LevelGen.Data
 import Picture
 import Dodge.Creature.Inanimate
 

src/Dodge/Rooms.hs

@@ -9,6 +9,7 @@ import Dodge.Item.Weapon
 import Dodge.Creature
 import Dodge.Creature.Inanimate
 import Dodge.LevelGen
+import Dodge.LevelGen.Data
 import Dodge.Base
 import Dodge.RandomHelp
 import Dodge.Default