Add sound source files

app/Main.hs

@@ -65,6 +65,7 @@ main = do
 --                                    ]
 --                          )
         )
+        (\_ _ -> return)       
         (flip $ menuEvents $ flip handleEvent)
         (\w -> Just $ update w)
     Mix.closeAudio

src/Dodge/Data.hs

@@ -64,7 +64,6 @@ data World = World
                 , _pressPlates :: IM.IntMap PressPlate
                 , _buttons :: IM.IntMap Button
                 , _soundQueue :: [Int]
---                , _loadedSounds :: IM.IntMap Mix.Chunk
                 , _sounds :: M.Map SoundOrigin Sound
                 , _decorations :: IM.IntMap Drawing
                 , _corpses :: IM.IntMap (IM.IntMap [Corpse])

src/Dodge/LoadSound.hs

@@ -111,27 +111,14 @@ loadSounds = do
 --   --       fmap (set soundQueue creatureSounds) $ return w
 --     where creatureSounds = []
 
+--playSounds :: a -> World -> IO ()
+--playSounds _ w = do
+--     forM_ (_soundQueue w) (\n -> Mix.playOn (-1) 0 (_loadedSounds w IM.! n))
+-- --      = return $ set soundQueue creatureSounds w
+--   --  = do forM_ (_soundQueue w) (\n -> Mix.playOn (-1) (_loadedSounds w IM.! n) 0)
+--   --       fmap (set soundQueue creatureSounds) $ return w
+--     where creatureSounds = []
+
 soundOnce :: Int -> World -> World
 soundOnce i = over soundQueue ((:) i)
 
---stepSoundTimers :: World -> IO World
---stepSoundTimers w = M.foldrWithKey stepSoundTimer (return w) (_sounds w)
-
--- ok, this is hard to reason about-- bugs can occur because I am unsure when
--- everything is evaluated
---stepSoundTimer :: SoundOrigin -> Sound -> IO World -> IO World
---stepSoundTimer so s w = 
---    case _soundChannel s of
---        Nothing -> do w1 <- w
---                      let soundChunk = _loadedSounds w1 IM.! _soundType s
-----                      n <- Mix.playingCount
---                      channel <- Mix.playOn (-1) (-1) soundChunk
---                      -- w2 <- w -- Note that using w2 instead of w1 in the
---                                 -- final return breaks the sound sometimes, must be
---                                 -- something to do with order of evaluation
---                      return $ set (sounds . ix so . soundChannel) (Just $ fromIntegral channel) w1
---        Just channel -> case _soundTime s of
---                                x | x > 0     -> fmap (set (sounds . ix so . soundTime) (x-1)) w
---                                  | x <= 0 -> do Mix.fadeOut channel (fromIntegral $ _soundFadeTime s+ 1)
---                                                 fmap (over sounds (M.delete so)) w
--- the sound fade doesn't seem to like being 0

src/Dodge/Update.hs

@@ -61,6 +61,30 @@ update w
             where (x,y) = zoneOfPoint $ _clPos cr
                   cid = _clID cr
 
+--updateSound :: World -> World
+--updateSound = set soundQueue [] . stepSoundTimers
+--stepSoundTimers :: World -> IO World
+--stepSoundTimers w = M.foldrWithKey stepSoundTimer (return w) (_sounds w)
+
+---- ok, this is hard to reason about-- bugs can occur because I am unsure when
+---- everything is evaluated
+--stepSoundTimer :: SoundOrigin -> Sound -> IO World -> IO World
+--stepSoundTimer so s w = 
+--    case _soundChannel s of
+--        Nothing -> do w1 <- w
+--                      let soundChunk = _loadedSounds w1 IM.! _soundType s
+----                      n <- Mix.playingCount
+--                      channel <- Mix.playOn (-1) (-1) soundChunk
+--                      -- w2 <- w -- Note that using w2 instead of w1 in the
+--                                 -- final return breaks the sound sometimes, must be
+--                                 -- something to do with order of evaluation
+--                      return $ set (sounds . ix so . soundChannel) (Just $ fromIntegral channel) w1
+--        Just channel -> case _soundTime s of
+--                                x | x > 0     -> fmap (set (sounds . ix so . soundTime) (x-1)) w
+--                                  | x <= 0 -> do Mix.fadeOut channel (fromIntegral $ _soundFadeTime s+ 1)
+--                                                 fmap (over sounds (M.delete so)) w
+---- the sound fade doesn't seem to like being 0
+
 updateLightSources w = set tempLightSources (catMaybes tlss) w'
     where (w',tlss) = mapAccumR (\a b -> _tlsUpdate b a b) w $ _tempLightSources w
 

src/Loop.hs

@@ -29,11 +29,12 @@ setupLoop :: String
         -> (setupParams -> IO ())
         -> world
         -> (setupParams -> world -> IO ())
+        -> (setupParams -> world -> storableSideEffects -> IO storableSideEffects)
         -> (world -> Event -> Maybe world)
         -> (world -> Maybe world)
         -> IO ()
 setupLoop wName xSize ySize 
-            customInit initCleanup startWorld sideEffects eventFn worldFn = do 
+            customInit initCleanup startWorld sideEffects storableFn eventFn worldFn = do 
     initializeAll
     bracket (createWindow (T.pack wName) (winConfig xSize ySize)) destroyWindow
         (\window -> 
@@ -47,7 +48,7 @@ setupLoop wName xSize ySize
                             GL.clearColor $= GL.Color4 0 0.5 0 1
                             GL.clearDepth $= (200)
                             doLoop setup window startWorld
-                                   sideEffects eventFn worldFn
+                                   sideEffects storableFn eventFn worldFn
                  )
         )
 
@@ -59,9 +60,14 @@ setupLoop wName xSize ySize
 --            -> IO ()
 doLoop setup window startWorld
         worldSideEffects 
+        storableFn
         eventFn 
         worldUpdate 
   = do
+    GL.clear [GL.ColorBuffer,GL.DepthBuffer]
+    worldSideEffects setup startWorld
+    glSwapWindow window
+    --worldSideEffects setup updatedWorld
     startLoopTicks <- ticks
     events <- pollEvents
     --let-- maybeUpdatedWorld :: Maybe (WorldView world0)
@@ -69,15 +75,15 @@ doLoop setup window startWorld
     maybeUpdatedWorld <- applyEventsIO eventFn startWorld events
     case maybeUpdatedWorld >>= worldUpdate of
         Just updatedWorld -> do 
-            GL.clear [GL.ColorBuffer,GL.DepthBuffer]
+            --GL.clear [GL.ColorBuffer,GL.DepthBuffer]
-            worldSideEffects setup updatedWorld
+            --worldSideEffects setup updatedWorld
-            glSwapWindow window
+            --glSwapWindow window
             --GL.flush
             performGC
             endLoopTicks <- ticks -- it might be better to use System.Clock (monotonic)
             let delay = max 0 (10 + fromIntegral startLoopTicks - fromIntegral endLoopTicks)
             threadDelay (delay * 1000)
-            doLoop setup window updatedWorld worldSideEffects eventFn worldUpdate
+            doLoop setup window updatedWorld worldSideEffects storableFn eventFn worldUpdate
         Nothing -> return ()
 
 applyEvents :: (world0 -> Event -> Maybe world0)

src/Sound.hs

@@ -0,0 +1,7 @@
+module Sound
+    where
+
+-- ok, the problem here is that we need to be able to return the playing channel
+-- so this thread cannot be a simple observer
+
+

src/Sound/Preload.hs

@@ -0,0 +1,7 @@
+module Sound.Preload
+    where
+import qualified SDL.Mixer as Mix
+
+import qualified Data.IntMap as IM
+
+type LoadedSounds = IM.IntMap Mix.Chunk