Tweak sound

src/Dodge/Data.hs

@@ -571,6 +571,7 @@ data SoundOrigin = InventorySound
     | BlockDegradeSound Int
     | CrHitSound Int
     | BarrelHiss Int
+    | GlassBreakSound Int
   deriving (Eq,Ord,Show)
 
 type Poly = [Point2]

src/Dodge/Item/Weapon/TriggerType.hs

@@ -54,7 +54,7 @@ withWarmUp t f cid w
                                             $ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
                                             $ set (pointerToItem . wpFireState) 2
                                             $ f cid
-                                            $ continueSoundFrom (CrWeaponSound cid) 28 2 0
+                                            $ soundFrom (CrWeaponSound cid) 28 2 0
                                                 w
     where cr = _creatures w IM.! cid
           itRef = _crInvSel cr

src/Dodge/SoundLogic.hs

@@ -15,29 +15,40 @@ resumeSound w = w
 soundOnce :: Int -> World -> World
 soundOnce i = over soundQueue ((:) i)
 
-continueSoundFrom :: SoundOrigin -> Int -> Int -> Int -> World -> World
+--continueSoundFrom :: SoundOrigin -> Int -> Int -> Int -> World -> World
-continueSoundFrom so sType time fadeTime w = over sounds (M.insertWith f so sound) w
+--continueSoundFrom so sType time fadeTime w = over sounds (M.insertWith f so sound) w
+--  where 
+--    sound = Sound 
+--        { _soundType = sType
+--        , _soundTime = time
+--        , _soundFadeTime = fadeTime
+--        , _soundChannel = Nothing
+--        , _soundPos = Nothing
+--        }
+--    f _ s = s {_soundTime = time, _soundFadeTime = fadeTime}
+
+soundOnceOrigin :: Int -> SoundOrigin -> World -> World
+soundOnceOrigin sType so = over sounds (M.insertWith (flip const) so sound)
   where 
     sound = Sound 
         { _soundType = sType
-        , _soundTime = time
+        , _soundTime = Nothing
-        , _soundFadeTime = fadeTime
+        , _soundFadeTime = 0
         , _soundChannel = Nothing
         , _soundPos = Nothing
         }
-    f _ s = s {_soundTime = time, _soundFadeTime = fadeTime}
 
 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
-        , _soundTime = time
+        , _soundTime = Just time
         , _soundFadeTime = fadeTime
         , _soundChannel = Nothing
         , _soundPos = Nothing
         }
-    f _ s = s {_soundTime = time, _soundFadeTime = fadeTime}
+    f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime}
 
 soundMultiFrom :: [SoundOrigin] -> Int -> Int -> Int -> World -> World
 soundMultiFrom [] _ _ _ w = w
@@ -45,14 +56,15 @@ 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
-                            , _soundTime = time
+                            , _soundTime = Nothing
                             , _soundFadeTime = fadeTime
                             , _soundChannel = Nothing
                             , _soundPos = Nothing
                             }
 
+
 stopSoundFrom :: SoundOrigin -> World -> World
-stopSoundFrom so = over (sounds . ix so . soundTime) (min 0)
+stopSoundFrom so = over (sounds . ix so . soundTime) (fmap $ min 0)
 
 -- idea: pass the id of the sound to the world and send it to some queue for
 -- playback

src/Dodge/WorldEvent/Sound.hs

@@ -8,11 +8,11 @@ import System.Random
 import Control.Lens
 
 mkSoundBreakGlass :: World -> World
-mkSoundBreakGlass w = soundOnce soundid $ set randGen g w
+mkSoundBreakGlass w = soundOnceOrigin soundid (GlassBreakSound 0) $ set randGen g w
   where
     (soundid,g) = _randGen w & randomR (37,40)
 
 mkSoundSplinterGlass :: World -> World
-mkSoundSplinterGlass w = soundOnce soundid $ set randGen g w
+mkSoundSplinterGlass w = soundOnceOrigin soundid (GlassBreakSound 1) $ set randGen g w
   where
     (soundid,g) = _randGen w & randomR (33,36)

src/Sound.hs

@@ -15,6 +15,7 @@ import Control.Lens
 playSoundQueue :: SoundData a -> [Int] -> IO ()
 playSoundQueue sd ns = forM_ ns $ \n -> playIfFree (_loadedChunks sd IM.! n) Mix.Once
 
+-- this can be cleaned up
 playIfFree :: Mix.Chunk -> Mix.Times -> IO (Maybe Mix.Channel)
 playIfFree c times = do
     mayChan <- Mix.getAvailable Mix.DefaultGroup
@@ -22,18 +23,33 @@ playIfFree c times = do
         Nothing -> return Nothing
         Just i  -> Just <$> Mix.playOn i times c
 
+playSoundIfFree :: Mix.Chunk -> Sound -> IO (Maybe Sound)
+playSoundIfFree c s = case _soundTime s of
+    Just _  -> (playIfFree c Mix.Forever) >>= return . f
+    Nothing -> playIfFree c Mix.Once    >>= return . f
+  where 
+    f :: Maybe Mix.Channel -> Maybe Sound
+    f = fmap (\chan -> (s & soundChannel .~ Just chan))
+
 haltMaybe :: Maybe Mix.Channel -> IO (Maybe Sound)
 haltMaybe (Just x) = Mix.halt x >> return Nothing
 haltMaybe Nothing = return Nothing
 
+-- logic: check if sound is playing:
+--   if so, decrement timers, and/or stop playing and remove
+--   if not, check if there is free channel:
+--     if so, start playing
+--     if not, remove sound
 playSound :: SoundData a -> Sound -> IO (Maybe Sound)
-playSound sd s
+playSound sd s = case _soundChannel s of
-    | _soundTime s <= 0 = haltMaybe (_soundChannel s)
+    Just i  -> case _soundTime s of
-    | otherwise = case _soundChannel s of
+        Just t | t > 0     -> return $ Just $ set soundTime (Just $ t - 1) s
-        Just i -> return $ Just $ over soundTime (\t -> t - 1) s
+               | otherwise -> haltMaybe (_soundChannel s)
-        Nothing -> do maychan <- playIfFree (_loadedChunks sd IM.! _soundType s) Mix.Forever
+        Nothing -> Mix.playing i >>= (\b -> if b 
-                      return $ Just $ s & soundTime -~ 1
+                                            then return (Just s)
-                                        & soundChannel .~ maychan
+                                            else return Nothing
+                                    )
+    Nothing -> playSoundIfFree (_loadedChunks sd IM.! _soundType s) s
 
 playSounds :: SoundData a -> IO (SoundData a)
 playSounds sd = do

src/Sound/Preload.hs

@@ -2,21 +2,17 @@
 module Sound.Preload
     where
 import qualified SDL.Mixer as Mix
-
 import qualified Data.IntMap as IM
 import qualified Data.Map as M
-
 import Control.Lens
-
 import Geometry
 
-
 data SoundData a = SoundData
     {_loadedChunks :: IM.IntMap Mix.Chunk
     ,_playingSounds :: M.Map a Sound
     }
 data Sound = Sound 
-    { _soundTime :: Int
+    { _soundTime :: Maybe Int
     , _soundFadeTime :: Int
     , _soundChannel :: Maybe Mix.Channel
     , _soundPos :: Maybe Point2
@@ -29,94 +25,3 @@ makeLenses ''Sound
 
 cleanUpSoundPreload :: SoundData a -> IO ()
 cleanUpSoundPreload sd = Mix.closeAudio
-
---preloadSound :: IO (SoundData a)
---preloadSound = do
---    Mix.openAudio Mix.defaultAudio 256
---    pFireSound <- Mix.load "./data/sound/tap3.wav"
---    click <- Mix.load "./data/sound/click1.wav"
---    reloadSound' <- Mix.load "./data/sound/reload1.wav"
---    tone440 <- Mix.load "./data/sound/tone440.wav"
---    pickupSound' <- Mix.load "./data/sound/pickUp.wav"
---    putdownSound' <- Mix.load "./data/sound/whiteNoiseFadeOut.wav"
---    fireSound' <- Mix.load "./data/sound/fire1.wav"
---    grenadeBang' <- Mix.load "./data/sound/grenade.wav"
---    tapQuiet' <- Mix.load "./data/sound/tapQuiet.wav"
---    twoStep' <- Mix.load "./data/sound/twoStep.wav"
---    healSound' <- Mix.load "./data/sound/heal.wav"
---    doorSound' <- Mix.load "./data/sound/slideDoor.wav"
---    twoStepSlow' <- Mix.load "./data/sound/twoStepSlow.wav"
---    knifeSound' <- Mix.load "./data/sound/knife.wav"
---    buzzSound' <- Mix.load "./data/sound/buzz.wav"
---    hitSound' <- Mix.load "./data/sound/hit1.wav"
---    autoGunSound' <- Mix.load "./data/sound/autoGun.wav"
---    shotgunSound' <- Mix.load "./data/sound/shotgun.wav"
---    teleSound' <- Mix.load "./data/sound/tele.wav"
---    longGunSound' <- Mix.load "./data/sound/longTap.wav"
---    launcherSound' <- Mix.load "./data/sound/tap4.wav"
---    smokeTrailSound' <- Mix.load "./data/sound/missileLaunch.wav"
---    foot1Sound' <- Mix.load "./data/sound/foot1.wav"
---    foot2Sound' <- Mix.load "./data/sound/foot2.wav"
---    lasSound' <- Mix.load "./data/sound/tone440sawtooth.wav"
---    teslaSound' <- Mix.load "./data/sound/Electrical-Welding.wav" 
---    crankSlow' <- Mix.load "./data/sound/crankSlow.wav" 
---    autoB' <- Mix.load "./data/sound/autoB.wav" 
---    mini' <- Mix.load "./data/sound/mini1.wav" 
---    impactA' <- Mix.load "./data/sound/Impact-A.wav" 
---    impactB' <- Mix.load "./data/sound/Impact-B.wav" 
---    impactC' <- Mix.load "./data/sound/Impact-C.wav" 
---    impactD' <- Mix.load "./data/sound/Impact-D.wav" 
---    glassShat1' <- Mix.load "./data/sound/Glass-Bottle-Shattering-A1.wav" 
---    glassShat2' <- Mix.load "./data/sound/Glass-Bottle-Shattering-A2.wav" 
---    glassShat3' <- Mix.load "./data/sound/Glass-Bottle-Shattering-A3.wav" 
---    glassShat4' <- Mix.load "./data/sound/Glass-Bottle-Shattering-A4.wav" 
---    glass1' <- Mix.load "./data/sound/Small-Piece-Of-Glass-Shattering-A1.wav" 
---    glass2' <- Mix.load "./data/sound/Small-Piece-Of-Glass-Shattering-A2.wav" 
---    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" 
---    let loadedS = IM.fromList $ zip [0..] $ 
---            [ pFireSound
---            , click
---            , reloadSound'
---            , tone440
---            , pickupSound'
---            , putdownSound'
---            , fireSound'
---            , grenadeBang'
---            , tapQuiet'
---            , twoStep'
---            , healSound'
---            , doorSound'
---            , twoStepSlow'
---            , knifeSound'
---            , buzzSound'
---            , hitSound'      --15
---            , autoGunSound'
---            , shotgunSound'
---            , teleSound'
---            , longGunSound'
---            , launcherSound'
---            , smokeTrailSound'
---            , foot1Sound'
---            , foot2Sound'
---            , lasSound'
---            , teslaSound'  --25
---            , crankSlow'  
---            , autoB'
---            , mini'
---            , impactA'
---            , impactB'  --30
---            , impactC'
---            , impactD'
---            , glassShat1' --33
---            , glassShat2'
---            , glassShat3'
---            , glassShat4'
---            , glass1'    --37
---            , glass2'
---            , glass3'
---            , glass4'    --40
---            , foamSpray'
---            ]
---    return $ SoundData {_loadedChunks = loadedS, _playingSounds = M.empty}