From f7e0b40cd5451790317ccd655cf17e93b302727a Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Mon, 5 Apr 2021 14:34:32 +0200
Subject: [PATCH] Tweak sound

---
 src/Dodge/SoundLogic.hs |  8 +++++---
 src/Sound.hs            | 33 ++++++++++++++++++++++++++++++++-
 src/Sound/Preload.hs    | 11 ++++++-----
 3 files changed, 43 insertions(+), 9 deletions(-)

diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs
index e61b646d1..27eae8a2f 100644
--- a/src/Dodge/SoundLogic.hs
+++ b/src/Dodge/SoundLogic.hs
@@ -19,9 +19,10 @@ soundOnceOrigin :: Int -> SoundOrigin -> World -> World
 soundOnceOrigin sType so = over sounds (M.insertWith (flip const) so sound)
   where 
     sound = Sound 
-        { _soundType = sType
+        { _soundChunkID = sType
         , _soundTime = Nothing
         , _soundFadeTime = 0
+        , _soundIsFadingOut = False
         , _soundChannel = Nothing
         , _soundPos = Nothing
         }
@@ -30,8 +31,9 @@ soundFrom :: SoundOrigin -> Int -> Int -> Int -> World -> World
 soundFrom so sType time fadeTime w = over sounds (M.insertWith f so sound) w
   where 
     sound = Sound 
-        { _soundType = sType
+        { _soundChunkID = sType
         , _soundTime = Just time
+        , _soundIsFadingOut = False
         , _soundFadeTime = fadeTime
         , _soundChannel = Nothing
         , _soundPos = Nothing
@@ -43,7 +45,7 @@ soundMultiFrom [] _ _ _ w = w
 soundMultiFrom (so:sos) sType time fadeTime w
     | so `M.member` _sounds w = soundMultiFrom sos sType time fadeTime w
     | otherwise = over sounds (M.insert so sound) w
-        where sound = Sound { _soundType = sType
+        where sound = Sound { _soundChunkID = sType
                             , _soundTime = Nothing
                             , _soundFadeTime = fadeTime
                             , _soundChannel = Nothing
diff --git a/src/Sound.hs b/src/Sound.hs
index c5b4c6274..08dac24e7 100644
--- a/src/Sound.hs
+++ b/src/Sound.hs
@@ -33,6 +33,33 @@ there may be a leak in the current typical usage.
 playAndUpdate :: Ord a => M.Map a Sound -> SoundData a -> IO (SoundData a)
 playAndUpdate new sd = playSounds $ over playingSounds (updatePlaying new) sd
 
+--updateSound :: Sound -> Sound -> IO Sound
+--updateSound newS oldS 
+--    | _soundIsFadingOut oldS 
+--                = Mix.playOn i times 
+--    | otherwise = newS & soundChannel .~ _soundChannel oldS
+
+startPlaying :: SoundData a -> Sound -> IO (Maybe Sound)
+startPlaying sd s = case _soundChannel s of
+    Just _  -> return $ Just s
+    Nothing -> playSoundIfFree (_loadedChunks sd IM.! _soundChunkID s) s
+
+decrimentTimer :: Sound -> IO Sound
+decrimentTimer s = case _soundTime s of
+    Just t | t > 0     -> return $ s & soundTime ?~ t - 1
+           | otherwise -> fadeOutMaybe (_soundChannel s) (_soundFadeTime s)
+                            >> return (s & soundTime .~ Nothing
+                                         & soundIsFadingOut .~ True)
+
+cleanupHalted :: Sound -> IO (Maybe Sound)
+cleanupHalted s = case _soundChannel s of
+    Nothing -> return Nothing
+    Just i  -> do
+        isPlaying <- Mix.playing i
+        if isPlaying
+            then return $ Just s
+            else return Nothing
+
 {- | Given a chunk, attempt to play this on a free channel a given number of
 times. Returns 'Just' the channel if succeeds.
 -}
@@ -61,6 +88,10 @@ haltMaybe :: Maybe Mix.Channel -> IO (Maybe Sound)
 haltMaybe (Just x) = Mix.halt x >> return Nothing
 haltMaybe Nothing = return Nothing
 
+fadeOutMaybe :: Maybe Mix.Channel -> Int -> IO ()
+fadeOutMaybe (Just x) fadeT = Mix.fadeOut (fromIntegral fadeT) x
+fadeOutMaybe _ _ = return ()
+
 {- | Play a sound according to it's specification.
 Logic: check if sound is playing:
 
@@ -79,7 +110,7 @@ updateOrStartSound sd s = case _soundChannel s of
                                             then return (Just s)
                                             else return Nothing
                                     )
-    Nothing -> playSoundIfFree (_loadedChunks sd IM.! _soundType s) s
+    Nothing -> playSoundIfFree (_loadedChunks sd IM.! _soundChunkID s) s
 
 {- | Play all sounds and create new sound data.
  -}
diff --git a/src/Sound/Preload.hs b/src/Sound/Preload.hs
index ee0e15de8..a8d26799c 100644
--- a/src/Sound/Preload.hs
+++ b/src/Sound/Preload.hs
@@ -12,11 +12,12 @@ data SoundData a = SoundData
     ,_playingSounds :: M.Map a Sound
     }
 data Sound = Sound 
-    { _soundTime :: Maybe Int
-    , _soundFadeTime :: Int
-    , _soundChannel :: Maybe Mix.Channel
-    , _soundPos :: Maybe Point2
-    , _soundType :: Int
+    { _soundTime        :: Maybe Int
+    , _soundFadeTime    :: Int
+    , _soundIsFadingOut :: Bool
+    , _soundChannel     :: Maybe Mix.Channel
+    , _soundPos         :: Maybe Point2
+    , _soundChunkID     :: Int
     }
   deriving (Eq,Ord,Show)