Try to move sound into world, slightly broken now

appDodge/Main.hs

@@ -21,7 +21,6 @@ import Sound.Data
 import Music
 import Data.Preload
 import Data.Preload.Render
-import Shader.Poke
 
 import Control.Lens
 --import Foreign (Word32)
@@ -33,59 +32,37 @@ import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate)
 import qualified SDL
 import qualified SDL.Mixer                 as Mix
 
-main' :: IO ()
-main' = do
-    (sizex,sizey) <- loadConfig
-    theKeyConfig <- loadKeyConfig
-    dodgeConfig <- loadDodgeConfig
-    setupLoop
-        (sizex,sizey)
-        (SDL.cursorVisible $= False >> doPreload >>= applyWorldConfig dodgeConfig)
-        (\x -> (SDL.cursorVisible $= True) >> cleanUpPreload x)
-        (fmap (setWindowSize sizex sizey . (keyConfig .~ theKeyConfig) . (config .~ dodgeConfig)) firstWorld)
-        doSideEffects
-        handleEvent
-        (Just . update)
-
 main :: IO ()
 main = do
     (sizex,sizey) <- loadConfig
-    theKeyConfig <- loadKeyConfig
-    dodgeConfig <- loadDodgeConfig
     setupLoop'
         (sizex,sizey)
         theCleanup
-        (firstWorldLoad (sizex,sizey) theKeyConfig dodgeConfig)
+        (firstWorldLoad (sizex,sizey))
         theUpdateStep
         handleEvent
---        (SDL.cursorVisible $= False >> doPreload >>= applyWorldConfig dodgeConfig)
---        (fmap (setWindowSize sizex sizey . (keyConfig .~ theKeyConfig) . (config .~ dodgeConfig)) firstWorld)
---        doSideEffects
 
 theCleanup :: World -> IO ()
 theCleanup w = SDL.cursorVisible $= True >> cleanUpPreload (_preloadData w)
 
---firstWorldLoad :: Configuration -> IO World
+firstWorldLoad :: (Int,Int) -> IO World
-firstWorldLoad (sizex,sizey) theKeyConfig theConfig = do
+firstWorldLoad (sizex,sizey) = do
     SDL.cursorVisible $= False
+    theKeyConfig <- loadKeyConfig
+    theConfig <- loadDodgeConfig
     pdata <- doPreload >>= applyWorldConfig theConfig
     w <- fmap (setWindowSize sizex sizey . (keyConfig .~ theKeyConfig) . (config .~ theConfig)) firstWorld
     return $ w & preloadData .~ pdata
 
 theUpdateStep :: World -> IO World
-theUpdateStep = applySideEffects . update
+theUpdateStep = doSideEffects . update
 
-applySideEffects :: World -> IO (World)
+doSideEffects :: World -> IO World
-applySideEffects w = do
+doSideEffects w = do
-    newpdata <- doSideEffects (_preloadData w) w
+    let preData = _preloadData w
-    return $ w & preloadData .~ newpdata
-
-doSideEffects :: PreloadData SoundOrigin -> World -> IO (PreloadData SoundOrigin)
-doSideEffects preData w = do
-    --startTicks <- SDL.ticks
     void $ doDrawing (_renderData preData) w
     playPositionalSoundQueue (_loadedChunks $ _soundData preData) (_soundQueue w)
-    newPlayingSounds <- playSoundAndUpdate (_soundData preData) (_sounds w)
+    newPlayingSounds <- playSoundAndUpdate (_soundData preData) (_playingSounds w) (_sounds w)
     
     endTicks <- SDL.ticks
     let lastFrameTicks = _frameTimer preData
@@ -96,14 +73,14 @@ doSideEffects preData w = do
                     . translate (-0.5) (-0.8) . scale 0.0005 0.0005
                     . text $ "ms/frame " ++ show (endTicks - lastFrameTicks)
                 )
-    foldr (=<<) (return (preData & soundData . playingSounds .~ newPlayingSounds
+    newpdata <- foldr (=<<) (return (preData & frameTimer .~ endTicks)) (_doneSideEffects w)
-                    & frameTimer .~ endTicks)) (_doneSideEffects w)
+    return $ w & preloadData .~ newpdata
 
-doPreload :: IO (PreloadData a)
+doPreload :: IO PreloadData
 doPreload = do
     lChunks <- loadSounds
     lMusic  <- loadMusic
-    let sData = SoundData {_loadedChunks = lChunks, _playingSounds = M.empty}
+    let sData = SoundData {_loadedChunks = lChunks}
         mData = MusicData {_loadedMusic = lMusic}
     Mix.playMusic Mix.Forever (lMusic IM.! 0)
     rData <- preloadRender

src/Data/Preload.hs

@@ -8,9 +8,9 @@ import Music
 import Control.Lens
 import GHC.Word (Word32)
 
-data PreloadData a = PreloadData
+data PreloadData = PreloadData
     { _renderData   :: RenderData
-    , _soundData    :: SoundData a
+    , _soundData    :: SoundData
     , _musicData    :: MusicData
     , _frameTimer   :: Word32
     }

src/Dodge/Config/Update.hs

@@ -14,7 +14,7 @@ import Data.Aeson (encodeFile)
 {- |
 Write the current world configuration to disk as a json file.
  -}
-saveConfig :: Configuration -> PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)
+saveConfig :: Configuration -> PreloadData -> IO PreloadData
 saveConfig cfig d = do
     putStrLn "Saving config to data/dodge.config.json"
     encodeFile "data/dodge.config.json" cfig
@@ -23,7 +23,7 @@ saveConfig cfig d = do
 {- |
 Apply the volume settings from the world configuration to the running game.
  -}
-setVol :: Configuration -> PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)
+setVol :: Configuration -> PreloadData -> IO PreloadData
 setVol cfig d = do
     setSoundVolume ( _volume_master cfig * _volume_sound cfig)
     setMusicVolume ( _volume_master cfig * _volume_music cfig)
@@ -34,8 +34,8 @@ Apply /all/ of the values in the world configuration to the running game.
  -}
 applyWorldConfig
     :: Configuration 
-    -> PreloadData SoundOrigin 
+    -> PreloadData
-    -> IO (PreloadData SoundOrigin)
+    -> IO PreloadData
 applyWorldConfig cfig pdata = do
     setVol cfig pdata >>= pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y
   where

src/Dodge/Data.hs

@@ -78,6 +78,7 @@ data World = World
     , _buttons              :: IM.IntMap Button
     , _soundQueue           :: [(Int,Int16)]
     , _sounds               :: M.Map SoundOrigin Sound
+    , _playingSounds        :: M.Map SoundOrigin Sound
     , _decorations          :: IM.IntMap Picture
     , _foregroundDecorations :: [Polyhedra]
     , _foregroundEdgeVerx   :: [Point3]
@@ -102,14 +103,14 @@ data World = World
     , _selLocation          :: Int
     , _keyConfig            :: KeyConfigSDL
     , _config               :: Configuration
-    , _sideEffects          :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)]
+    , _sideEffects          :: [PreloadData -> IO PreloadData]
-    , _doneSideEffects      :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)]
+    , _doneSideEffects      :: [PreloadData -> IO PreloadData]
     , _debugFlags           :: DebugFlags
     , _inventoryMode        :: InventoryMode
     , _lClickHammer         :: HammerPosition
     , _radDistortion        :: [(Point2,Point2,Point2,Float)]
     , _gameRooms            :: [GameRoom]
-    , _preloadData          :: PreloadData SoundOrigin
+    , _preloadData          :: PreloadData
     }
 data OptionScreenFlag = NormalOptions | GameOverOptions
 data ScreenLayer

src/Dodge/Default/World.hs

@@ -50,10 +50,10 @@ defaultWorld = World
     , _buttons = IM.empty
     , _soundQueue = []
     , _sounds = M.empty
+    , _playingSounds = M.empty
     , _corpses = IM.empty
     , _decorations = IM.empty
     , _storedLevel = Nothing
-    --, _menuLayers = [levelMenu 1]
     , _menuLayers = []
     , _worldState = M.empty
     , _worldTriggers = S.empty

src/Preload.hs

@@ -9,10 +9,10 @@ import Sound.Data
 import qualified SDL.Mixer as Mix
 
 
-cleanUpPreload :: PreloadData a -> IO ()
+cleanUpPreload :: PreloadData -> IO ()
 cleanUpPreload pd = do
     cleanUpRenderPreload $ _renderData pd
     cleanUpSoundPreload $ _soundData pd
 
-cleanUpSoundPreload :: SoundData a -> IO ()
+cleanUpSoundPreload :: SoundData -> IO ()
 cleanUpSoundPreload _ = Mix.closeAudio

src/Preload/Update.hs

@@ -15,8 +15,8 @@ pdataResizeUpdate
     -> Int  -- ^ Scaled height
     -> Int  -- ^ Full width
     -> Int  -- ^ Full height
-    -> PreloadData a
+    -> PreloadData
-    -> IO (PreloadData a)
+    -> IO PreloadData
 pdataResizeUpdate xsize ysize xfull yfull pdata = do
     rd <- renderDataResizeUpdate xsize ysize xfull yfull (_renderData pdata)
     return (pdata {_renderData = rd})

src/Sound.hs

@@ -49,9 +49,9 @@ In the update:
     3. apply 'Just' sound position effects, set value to 'Nothing'
     4. remove sounds that have stopped playing from the map.
  -}
-playSoundAndUpdate :: Ord a => SoundData a -> M.Map a Sound -> IO (M.Map a Sound)
+playSoundAndUpdate :: Ord a => SoundData -> M.Map a Sound -> M.Map a Sound -> IO (M.Map a Sound)
-playSoundAndUpdate sData newSounds 
+playSoundAndUpdate sData oldSounds newSounds
-    = updateSounds (_loadedChunks sData) (M.unionWith mergeSound (_playingSounds sData) newSounds)
+    = updateSounds (_loadedChunks sData) (M.unionWith mergeSound oldSounds newSounds)
 
 mergeSound :: Sound -> Sound -> Sound
 mergeSound oldS newS

src/Sound/Data.hs

@@ -16,9 +16,8 @@ data SoundStatus
     | ToStart
   deriving (Eq,Ord,Show)
 
-data SoundData a = SoundData
+data SoundData = SoundData
     {_loadedChunks :: IM.IntMap Mix.Chunk
-    ,_playingSounds :: M.Map a Sound
     }
 data Sound = Sound 
     { _soundTime        :: Maybe Int