Reimplement continuous sounds (package dependencies should be reworked)

src/Dodge/Data.hs

@@ -245,7 +245,8 @@ data MenuState
 
 data Sound = Sound { _soundTime :: Int
                    , _soundFadeTime :: Int
-                   , _soundChannel :: Maybe Int
+                   --, _soundChannel :: Maybe Int
+                   , _soundChannel :: Maybe Mix.Channel
                    , _soundPos :: Maybe Point2
                    , _soundType :: Int
                    }

src/Dodge/Update.hs

@@ -63,6 +63,7 @@ update w
                   cid = _clID cr
 
 updateSoundQueue = set soundQueue []
+                    . set sounds M.empty
 
 --updateSound :: World -> World
 --updateSound = set soundQueue [] . stepSoundTimers

src/Sound.hs

@@ -6,8 +6,47 @@ import Control.Monad
 
 import qualified SDL.Mixer as Mix
 
+import Data.Maybe
 import qualified Data.IntMap as IM
+import qualified Data.Map as M
 
-playSoundQueue :: SoundData -> [Int] -> IO ()
+import Control.Lens
+
+import Dodge.Data
+
+playSoundQueue :: SoundData a -> [Int] -> IO ()
 playSoundQueue sd ns = 
-    forM_ ns $ \n -> Mix.play (sd IM.! n)
+    forM_ ns $ \n -> playIfFree (_loadedChunks sd IM.! n) Mix.Once
+
+playIfFree :: Mix.Chunk -> Mix.Times -> IO (Maybe Mix.Channel)
+playIfFree c times = do
+    mayChan <- Mix.getAvailable Mix.DefaultGroup
+    case mayChan of
+        Nothing -> return Nothing
+        Just i  -> fmap Just $ Mix.playOn i times c
+
+haltMaybe :: Maybe Mix.Channel -> IO (Maybe Sound)
+haltMaybe (Just x) = Mix.halt x >> return Nothing
+haltMaybe Nothing = return Nothing
+
+playSound :: SoundData a -> Sound -> IO (Maybe Sound)
+playSound sd s
+    | _soundTime s <= 0 = haltMaybe (_soundChannel s)
+    | otherwise = case _soundChannel s of
+        Just i -> return $ Just $ over soundTime (\t -> t - 1) s
+        Nothing -> do maychan <- playIfFree (_loadedChunks sd IM.! _soundType s) Mix.Forever
+                      return $ Just $ s & soundTime -~ 1
+                                        & soundChannel .~ maychan
+
+playSounds :: SoundData a -> IO (SoundData a)
+playSounds sd = do
+    newSounds <- mapM (playSound sd) (_playingSounds sd)
+    return $ sd & playingSounds .~ M.mapMaybe id newSounds
+
+updatePlaying :: Ord a => M.Map a Sound -> M.Map a Sound -> M.Map a Sound
+updatePlaying new old = M.unionWith f new old
+    where f newSound oldSound = newSound {_soundChannel = _soundChannel oldSound}
+
+playAndUpdate :: Ord a => M.Map a Sound -> SoundData a -> IO (SoundData a)
+playAndUpdate new sd = do
+    playSounds $ over playingSounds (updatePlaying new) sd

src/Sound/Preload.hs

@@ -1,16 +1,28 @@
+{-# LANGUAGE TemplateHaskell #-}
 module Sound.Preload
     where
 import qualified SDL.Mixer as Mix
 
 import qualified Data.IntMap as IM
+import qualified Data.Map as M
 
-type SoundData = IM.IntMap Mix.Chunk
+import Control.Lens
 
-cleanUpSoundPreload :: SoundData -> IO ()
+import Dodge.Data
+
+data SoundData a = SoundData
+    {_loadedChunks :: IM.IntMap Mix.Chunk
+    ,_playingSounds :: M.Map a Sound
+    }
+
+makeLenses ''SoundData
+
+
+cleanUpSoundPreload :: SoundData a -> IO ()
 cleanUpSoundPreload sd = Mix.closeAudio
 
 
-preloadSound :: IO SoundData
+preloadSound :: IO (SoundData a)
 preloadSound = do
     Mix.openAudio Mix.defaultAudio 256
 --    pFireSound <- Mix.loadWAV "./data/sound/tap3.wav"
@@ -56,7 +68,7 @@ preloadSound = do
     glass3' <- Mix.load "./data/sound/Small-Piece-Of-Glass-Shattering-A3.wav" 
     glass4' <- Mix.load "./data/sound/Small-Piece-Of-Glass-Shattering-A4.wav" 
     foamSpray' <- Mix.load "./data/sound/foamSprayLoop.wav" 
-    return $ IM.fromList $ zip [0..] 
+    let loadedS = IM.fromList $ zip [0..] 
                          $ [ pFireSound
                            , click
                            , reloadSound'
@@ -100,3 +112,4 @@ preloadSound = do
                            , glass4'    --40
                            , foamSpray'
                            ]
+    return $ SoundData {_loadedChunks = loadedS, _playingSounds = M.empty}