Reimplement continuous sounds (package dependencies should be reworked)

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