Add (ugly) support for fractional volumes

src/Dodge/SoundLogic.hs

@@ -8,6 +8,7 @@ module Dodge.SoundLogic (
     -- * Manipulation of individual sounds
       soundStart
     , soundContinue
+    , soundContinueVol
     , soundFromGeneral
     , soundMultiFrom
     , stopSoundFrom
@@ -44,15 +45,16 @@ pauseSound w = w
 resumeSound :: Universe -> Universe
 resumeSound w = w
 
-soundWithStatus
-    :: PlayStatus
+soundWithStatusVolume
+    :: Float        -- ^ Volume factor, 0 - 1
+    -> PlayStatus
     -> SoundOrigin  -- ^ \"Creator\" of sound
     -> Point2       -- ^ Position of sound
     -> SoundID      -- ^ ID of sound to be played
     -> Maybe Int    -- ^ Frames to play sound for, Nothing for until finished
     -> World 
     -> World
-soundWithStatus status so pos sType mtime w = over toPlaySounds (M.insertWith f so sound) w
+soundWithStatusVolume vol status so pos sType mtime w = over toPlaySounds (M.insertWith f so sound) w
   where 
     sound = Sound 
         { _soundChunkID     = sType
@@ -62,13 +64,24 @@ soundWithStatus status so pos sType mtime w = over toPlaySounds (M.insertWith f
             ,_isLooping  = isJust mtime
             }
         , _soundChannel     = Nothing
-        , _soundAngDist     = Just (a,0)
+        , _soundAngDist     = Just (a,floor (225 * (1 - vol)))
         , _soundPos         = pos
-        , _soundVolume      = soundToVol sType
+        , _soundVolume      = soundToVol sType * vol
+        , _soundVolumeFraction = vol
         }
     f _ s = s {_soundTime = mtime }
     a = soundAngle pos w
 
+soundWithStatus
+    :: PlayStatus
+    -> SoundOrigin  -- ^ \"Creator\" of sound
+    -> Point2       -- ^ Position of sound
+    -> SoundID      -- ^ ID of sound to be played
+    -> Maybe Int    -- ^ Frames to play sound for, Nothing for until finished
+    -> World 
+    -> World
+soundWithStatus = soundWithStatusVolume 1
+
 soundStart 
     :: SoundOrigin  -- ^ \"Creator\" of sound
     -> Point2       -- ^ Position of sound
@@ -86,6 +99,17 @@ soundContinue
     -> World
 soundContinue = soundWithStatus ToContinueStart
 
+-- this needs to all be cleaned up, moved to general sounds
+soundContinueVol
+    :: Float        -- ^ volume
+    -> SoundOrigin  -- ^ \"Creator\" of sound
+    -> Point2       -- ^ Position of sound
+    -> SoundID      -- ^ ID of sound to be played
+    -> Maybe Int    -- ^ Frames to play sound for, Nothing for until finished
+    -> World 
+    -> World
+soundContinueVol vol = soundWithStatusVolume vol ToContinueStart
+
 soundFromGeneral
     :: SoundOrigin  -- ^ \"Creator\" of sound
     -> (World -> Point2)       -- ^ Position of sound
@@ -106,6 +130,7 @@ soundFromGeneral so fpos sType mtime w = over toPlaySounds (M.insertWith f so so
         , _soundAngDist     = Just (a,0)
         , _soundPos         = fpos w
         , _soundVolume      = soundToVol sType
+        , _soundVolumeFraction = 1
         }
     f _ s = s {_soundTime = mtime }
     a = soundAngle (fpos w) w
@@ -149,6 +174,7 @@ soundMultiFrom [so] pos sType mtime w
         , _soundAngDist     = Just (a,0)
         , _soundPos         = pos
         , _soundVolume      = soundToVol sType
+        , _soundVolumeFraction     = 1
         }
     a = soundAngle pos w
 soundMultiFrom (so:sos) pos sType mtime w
@@ -166,6 +192,7 @@ soundMultiFrom (so:sos) pos sType mtime w
         , _soundAngDist     = Just (a,0)
         , _soundPos         = pos
         , _soundVolume      = soundToVol sType
+        , _soundVolumeFraction = 1
         }
     a = soundAngle pos w
 {- | Sets '_soundTime' to 0.  -}