Move towards incorporating sound into ai

appDodge/Main.hs

@@ -52,7 +52,7 @@ doSideEffects preData w = do
     --startTicks <- SDL.ticks
     void $ doDrawing (_renderData preData) w
     playPositionalSoundQueue (_loadedChunks $ _soundData preData) (_soundQueue w)
-    newPlayingSounds <- playAndUpdate (_soundData preData) (_sounds w)
+    newPlayingSounds <- playSoundAndUpdate (_soundData preData) (_sounds w)
     
     endTicks <- SDL.ticks
     let lastFrameTicks = _frameTimer preData

src/Dodge/Creature/AlertLevel.hs

@@ -1,57 +0,0 @@
-{-# LANGUAGE TupleSections #-}
-{- | Deals with changes in a creature's awareness of other creatures. -}
-module Dodge.Creature.AlertLevel
-    ( basicPerceptionUpdateR
-    )
-    where
-import Dodge.Data
-import Dodge.Creature.AlertLevel.Data
-import Dodge.Base.Collide
---import StrictHelp
-
-import Control.Lens
-import Control.Monad.Reader
-import qualified Data.IntMap.Strict as IM
-
-{- | Ties together (currently) an awareness and attention update -}
-basicPerceptionUpdateR
-    :: [Int]    -- ^ List of creature ids that may direct attention and awareness
-    -> Creature
-    -> Reader World Creature
-basicPerceptionUpdateR is cr = basicAttentionUpdate is cr >>= basicAwarenessUpdate
-
-{- | Update a creatures awareness based upon the creatures' current direction
- of attention -}
-basicAwarenessUpdate 
-    :: Creature -> Reader World Creature
-basicAwarenessUpdate cr = case _crAttentionDir cr of
-    AttentiveTo is  -> pure $ cr & crAwarenessLevel 
-        %~ (IM.unionWith combineAwareness is . IM.mapMaybe decreaseAwareness)
-    Fixated i       -> pure $ cr & crAwarenessLevel 
-                         %~ ( IM.insert i (Cognizant 100) . IM.mapMaybe decreaseAwareness)
-
-combineAwareness :: AwarenessLevel -> AwarenessLevel -> AwarenessLevel
-combineAwareness (AwarenessInt x) (AwarenessInt y) 
-    | x + y < 100 = AwarenessInt $ x + y
-    | otherwise   = Cognizant 50
-combineAwareness (AwarenessInt x) (Cognizant y) = Cognizant $ min 100 $ x + y
-combineAwareness (Cognizant x) (AwarenessInt y) = Cognizant $ min 100 $ x + y
-combineAwareness (Cognizant x) (Cognizant y)    = Cognizant $ min 100 $ x + y
-
-{- | Decrease awareness level. Returns 'Maybe' value for use with 'IM.mapMaybe'
- -}
-decreaseAwareness :: AwarenessLevel -> Maybe AwarenessLevel
-decreaseAwareness (AwarenessInt 0) = Nothing
-decreaseAwareness (AwarenessInt x) = Just $ AwarenessInt (x - 1)
-decreaseAwareness (Cognizant 0) = Just $ AwarenessInt 100
-decreaseAwareness (Cognizant x) = Just $ Cognizant $ x - 1
-{- | Given a fixed group of creatures, direct attention to those of them that
- - are in view. -}
-basicAttentionUpdate
-    :: [Int] -- ^ Creatures that may attract this creature's attention
-    -> Creature
-    -> Reader World Creature
-basicAttentionUpdate cids cr = do
-    w <- ask
-    pure $ cr & crAttentionDir .~
-        AttentiveTo (IM.fromList $ map (, AwarenessInt 2) $ filter (\cid -> canSeeIndirect (_crID cr) cid w) cids)

src/Dodge/Creature/AlertLevel/Data.hs

@@ -1,29 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE StrictData #-}
-module Dodge.Creature.AlertLevel.Data
-    ( AwakeLevel (..)
-    , AttentionDir (..)
-    , AwarenessLevel (..)
-    -- lenses
-    , getAttentiveTo
-    , getFixated
-    ) where
-import Control.Lens
-import qualified Data.IntMap as IM
-
-data AwakeLevel
-    = Comatose
-    | Asleep
-    | Lethargic
-    | Vigilant
-    | Overstrung
-
-data AttentionDir
-    = AttentiveTo {_getAttentiveTo :: IM.IntMap AwarenessLevel }
-    | Fixated {_getFixated :: Int }
-
-data AwarenessLevel
-    = AwarenessInt Int
-    | Cognizant Int
-
-makeLenses ''AttentionDir

src/Dodge/Creature/ArmourChase.hs

@@ -7,7 +7,7 @@ import Dodge.Default
 import Dodge.Creature.State
 import Dodge.Creature.State.Data
 import Dodge.Creature.ReaderUpdate
-import Dodge.Creature.AlertLevel
+import Dodge.Creature.Perception
 import Dodge.Creature.Picture
 import Dodge.Creature.Impulse
 import Dodge.Creature.Action
@@ -28,7 +28,7 @@ armourChaseCrit = defaultCreature
         targetYouWhenCognizantR  >=>
         setTargetMv (pure . _crTarget) >=> -- should be able to remove this?
         flockACCR >=>
-        basicPerceptionUpdateR [0] >=>
+        perceptionUpdate [0] >=>
         goToTarget >=>
         overrideMeleeCloseTargetR >=>
         return . (crMeleeCooldown %~ max 0 . subtract 1)

src/Dodge/Creature/ChaseCrit.hs

@@ -8,7 +8,7 @@ import Dodge.Creature.Picture
 import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Impulse
 import Dodge.Creature.Action
-import Dodge.Creature.AlertLevel
+import Dodge.Creature.Perception
 import Dodge.Creature.State
 import Dodge.Creature.State.Data
 import Dodge.Item.Consumable
@@ -38,9 +38,10 @@ chaseCrit = defaultCreature
         doStrategyActionsR >=>
         performActionsR >=>
         overrideMeleeCloseTargetR >=>
-        setTargetMv (pure . _crTarget) >=>
+        setMvPos >=>
+--        setTargetMv (pure . _crTarget) >=>
         goToTarget >=>
-        basicPerceptionUpdateR [0] >=>
+        perceptionUpdate [0] >=>
         targetYouWhenCognizantR >=>
         return . (crMeleeCooldown %~ max 0 . subtract 1)
     , _crHP = 300

src/Dodge/Creature/ChooseTarget.hs

@@ -3,7 +3,7 @@ module Dodge.Creature.ChooseTarget
 import Dodge.Data
 import Dodge.Base
 import Dodge.Base.Collide
-import Dodge.Creature.AlertLevel.Data
+import Dodge.Creature.Perception.Data
 
 import Control.Lens
 --import qualified Data.IntMap.Strict as IM
@@ -17,7 +17,8 @@ targetYouLOS cr w
 targetYouCognizant :: Creature -> World -> Maybe Creature
 targetYouCognizant cr w 
     | hasLOS (_crPos cr) (_crPos $ you w) w
-        && isCog (cr ^? crAwarenessLevel . ix 0) = Just $ you w
+        && isCog (cr ^? crPerception . crAwarenessLevel . ix 0) 
+                = Just $ you w
     | otherwise = Nothing
   where
     isCog x = case x of

src/Dodge/Creature/LauncherCrit.hs

@@ -9,7 +9,7 @@ import Dodge.Creature.Test
 import Dodge.Creature.Volition
 import Dodge.Creature.Strategy
 import Dodge.Creature.ReaderUpdate
-import Dodge.Creature.AlertLevel
+import Dodge.Creature.Perception
 import Dodge.Creature.State
 import Dodge.Item.Weapon.Launcher
 import Dodge.Creature.Impulse
@@ -30,7 +30,7 @@ launcherCrit = defaultCreature
             [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [retreatFire])
             , (crAwayFromPost, goToPostStrat)
             ]
-        >=> basicPerceptionUpdateR [0]
+        >=> perceptionUpdate [0]
         >=> doStrategyActionsR
         >=> reloadOverrideR
         >=> targetYouWhenCognizantR

src/Dodge/Creature/LtAutoCrit.hs

@@ -11,7 +11,7 @@ import Dodge.Creature.Volition
 import Dodge.Creature.Strategy
 --import Dodge.Creature.ChooseTarget
 import Dodge.Creature.ReaderUpdate
-import Dodge.Creature.AlertLevel
+import Dodge.Creature.Perception
 import Dodge.Creature.State
 --import Dodge.Creature.State.Data
 import Dodge.Item.Weapon
@@ -41,7 +41,7 @@ ltAutoCrit = defaultCreature
               )
             , (crAwayFromPost, goToPostStrat)
             ]
-        >=> basicPerceptionUpdateR [0]
+        >=> perceptionUpdate [0]
         >=> doStrategyActionsR
         >=> reloadOverrideR
         >=> targetYouWhenCognizantR

src/Dodge/Creature/Picture.hs

@@ -8,9 +8,12 @@ module Dodge.Creature.Picture
     , picAtCrPosNoRot
     ) where
 import Dodge.Data
+--import Dodge.Base
 --import Dodge.Creature.Stance.Data
+import Dodge.Creature.Perception.Data
 import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data
+import Dodge.Creature.Memory.Data
 import Dodge.Creature.Test
 --import Dodge.Creature.AlertLevel.Data
 --import Dodge.Picture.Layer
@@ -27,12 +30,13 @@ basicCrPict
     -> Creature 
     -> World
     -> Picture
-basicCrPict col cr w = setLayer 0 $ pictures $
+basicCrPict col cr w = pictures $
     targetingPic ++
     [ tr . dm . rotdir $ scalp cr
     , tr . dm . rotdir $ upperBody col cr
     , tr . dm . rotmdir $ feet cr
     , tr . rotdir $ drawEquipment cr
+    , creatureDisplayText w cr
     ]
   where 
     dm = damageMod cr
@@ -44,6 +48,34 @@ basicCrPict col cr w = setLayer 0 $ pictures $
         . setDepth 1 
         . color (greyN 0.3)
 
+creatureDisplayText :: World -> Creature -> Picture
+creatureDisplayText w cr 
+    = setLayer 4 
+    . setDepth 50 
+    . translate x y 
+    . color white 
+    . rotate a 
+    . scale theScale theScale 
+    $ text $ creatureDisplayString cr
+  where
+    campos = _cameraViewFrom w
+    theScale = 0.2 / _cameraZoom w
+    cpos = _crPos cr
+    v = cpos -.- campos
+    a = argV v - 0.5 * pi
+    (V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v
+
+creatureDisplayString :: Creature -> String
+creatureDisplayString cr = show . _soundsToInvestigate $ _crMemory cr
+--    | isAsleep = "Z"
+--    | isSuspicious = "?"
+--    | otherwise = ""
+--  where
+--    isAsleep = _crAwakeLevel (_crPerception cr) == Asleep
+--    imAwarenesses = _crAwarenessLevel (_crPerception cr)
+--    isSuspicious = any f imAwarenesses && not (null imAwarenesses)
+--    f (Suspicious _) = True
+--    f _ = False
 damageMod :: Creature -> Picture -> Picture
 damageMod cr pic = piercingMod $ bluntScale pic
   where

src/Dodge/Creature/PistolCrit.hs

@@ -11,7 +11,7 @@ import Dodge.Creature.Volition
 import Dodge.Creature.Strategy
 import Dodge.Creature.ReaderUpdate
 --import Dodge.Creature.ChooseTarget
-import Dodge.Creature.AlertLevel
+import Dodge.Creature.Perception
 import Dodge.Creature.State
 --import Dodge.Creature.State.Data
 import Dodge.Item.Weapon
@@ -36,7 +36,7 @@ pistolCrit = defaultCreature
                     [DoActionIf (not . crIsAiming) drawWeapon,chooseMovement cr w])
               , (crAwayFromPost, goToPostStrat)
               ]
-        >=> basicPerceptionUpdateR [0]
+        >=> perceptionUpdate [0]
         >=> doStrategyActionsR
         >=> reloadOverrideR
         >=> targetYouWhenCognizantR

src/Dodge/Creature/ReaderUpdate.hs

@@ -9,13 +9,15 @@ module Dodge.Creature.ReaderUpdate
     , overrideInternalRRR
     , goToTarget
     , flockACCR
+    , setMvPos
     )
     where
 import Dodge.Data
 import Dodge.Creature.Stance.Data
+import Dodge.Creature.Memory.Data
 import Dodge.Creature.Test
 import Dodge.Creature.Volition
-import Dodge.Creature.AlertLevel.Data
+import Dodge.Creature.Perception.Data
 import Dodge.Base
 import Geometry
 import FoldableHelp
@@ -23,6 +25,8 @@ import FoldableHelp
 import qualified Data.IntMap.Strict as IM
 import Control.Monad.Reader
 import Control.Lens
+import Control.Applicative
+import Data.Maybe
 
 overrideMeleeCloseTargetR 
     :: Creature 
@@ -40,6 +44,11 @@ tryMeleeAttack cr tcr
   where
     cpos = _crPos cr
 
+setMvPos :: Creature -> Reader World Creature
+setMvPos cr = pure $ cr & crMvTarget .~ mpos
+  where
+    mpos = (_crPos <$> _crTarget cr) <|> listToMaybe (_soundsToInvestigate $ _crMemory cr)
+
 setTargetMv
     :: (Creature -> Reader World (Maybe Creature))    -- ^ Function for determining target
     -> Creature 
@@ -126,6 +135,6 @@ listGuard ( (test,y):ps, z ) x
 listGuard (_,z) _ = z
 
 targetYouWhenCognizantR :: Creature -> Reader World Creature
-targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crAwarenessLevel . ix 0 of
+targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crPerception . crAwarenessLevel . ix 0 of
     Just (Cognizant _)  -> cr {_crTarget = Just $! _creatures w IM.! 0}
     _                   -> cr & crTarget .~ Nothing

src/Dodge/Creature/SentinelAI.hs

@@ -8,7 +8,7 @@ import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Strategy
 import Dodge.Creature.Action
 --import Dodge.Creature.ChooseTarget
-import Dodge.Creature.AlertLevel
+import Dodge.Creature.Perception
 --import Dodge.Creature.State
 --import Dodge.Creature.State.Data
 import Geometry.Data
@@ -56,7 +56,7 @@ sentinelFireType f = performActionsR
         )
       , (crAwayFromPost, goToPostStrat)
       ] 
-    >=> basicPerceptionUpdateR [0]
+    >=> perceptionUpdate [0]
     >=> doStrategyActionsR
     >=> reloadOverrideR
     >=> targetYouWhenCognizantR
@@ -77,7 +77,7 @@ sentinelExtraWatchUpdate
 sentinelExtraWatchUpdate xs = performActionsR
     >=>  watchUpdateStratR
         ( xs ++ [(crAwayFromPost, goToPostStrat)] )
-    >=> basicPerceptionUpdateR [0]
+    >=> perceptionUpdate [0]
     >=> doStrategyActionsR
     >=> targetYouWhenCognizantR
     >=> overrideInternalRRR

src/Dodge/Creature/SetTarget.hs

@@ -4,7 +4,7 @@ Deals with setting a target for creatures
 module Dodge.Creature.SetTarget
     where
 import Dodge.Data
-import Dodge.Creature.AlertLevel.Data
+import Dodge.Creature.Perception.Data
 
 import Control.Lens
 import qualified Data.IntMap.Strict as IM
@@ -13,7 +13,7 @@ targetYouWhenCognizant
     :: World
     -> Creature
     -> Creature
-targetYouWhenCognizant w cr = case cr ^? crAwarenessLevel . ix 0 of
+targetYouWhenCognizant w cr = case cr ^? crPerception . crAwarenessLevel . ix 0 of
     Just (Cognizant _)  -> cr & crTarget ?~ _creatures w IM.! 0
     _                   -> cr & crTarget .~ Nothing
 

src/Dodge/Creature/SpreadGunCrit.hs

@@ -11,7 +11,7 @@ import Dodge.Creature.Volition
 import Dodge.Creature.Strategy
 import Dodge.Creature.ReaderUpdate
 --import Dodge.Creature.ChooseTarget
-import Dodge.Creature.AlertLevel
+import Dodge.Creature.Perception
 import Dodge.Creature.State
 --import Dodge.Creature.State.Data
 import Dodge.Item.Weapon
@@ -42,7 +42,7 @@ spreadGunCrit = defaultCreature
             )
           , (crAwayFromPost, goToPostStrat)
           ]
-        >=> basicPerceptionUpdateR [0]
+        >=> perceptionUpdate [0]
         >=> doStrategyActionsR
         >=> reloadOverrideR
         >=> targetYouWhenCognizantR

src/Dodge/Creature/SwarmCrit.hs

@@ -7,7 +7,7 @@ import Dodge.Default
 import Dodge.Creature.Picture
 import Dodge.Creature.Boid
 import Dodge.Creature.ReaderUpdate
-import Dodge.Creature.AlertLevel
+import Dodge.Creature.Perception
 import Dodge.Creature.Impulse
 import Dodge.Creature.State
 import Dodge.Creature.State.Data
@@ -22,7 +22,7 @@ swarmCrit = defaultCreature
     { _crUpdate = stateUpdate $ impulsiveAIR $
         flockToPointUsing (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9)
         >=> return . (crMeleeCooldown %~ max 0 . subtract 1)
-        >=> basicPerceptionUpdateR [0]
+        >=> perceptionUpdate [0]
         >=> doStrategyActionsR
         >=> targetYouWhenCognizantR
 --        , doStrategyActions

src/Dodge/Data.hs

@@ -17,7 +17,8 @@ module Dodge.Data
     ) where
 import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data
-import Dodge.Creature.AlertLevel.Data
+import Dodge.Creature.Perception.Data
+import Dodge.Creature.Memory.Data
 import Dodge.Debug.Flag.Data
 import Dodge.Data.SoundOrigin
 import Dodge.Data.DamageType
@@ -214,9 +215,8 @@ data Creature = Creature
     , _crStance         :: Stance
     , _crActionPlan     :: ActionPlan
     , _crMeleeCooldown  :: !Int
-    , _crAwakeLevel     :: AwakeLevel
+    , _crPerception     :: PerceptionState
-    , _crAttentionDir   :: AttentionDir
+    , _crMemory         :: MemoryState
-    , _crAwarenessLevel :: IM.IntMap AwarenessLevel
     , _crFaction        :: Faction
     , _crGroup          :: CrGroup
     , _crTarget         :: Maybe Creature
@@ -578,7 +578,7 @@ data Impulse
     | DropItem
 --    | PickupNearby Int
 --    | UseWorldObject Int
---    | Bark -- placeholder for various communication types
+    | Bark -- placeholder for various communication types
 --    | UseIntrinsicAbility
     | Melee Int
     | ChangePosture Posture

src/Dodge/Default.hs

@@ -10,7 +10,8 @@ import Dodge.Data
 import Dodge.Item.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data
-import Dodge.Creature.AlertLevel.Data
+import Dodge.Creature.Perception.Data
+import Dodge.Creature.Memory.Data
 import Dodge.SoundLogic
 import Dodge.Picture.Layer
 import Geometry
@@ -49,16 +50,42 @@ defaultCreature = Creature
         ,_strideLength = 40
         }
     , _crActionPlan = ActionPlan [] [] WatchAndWait [LiveLongAndProsper]
+    , _crPerception = defaultPerceptionState
+    , _crMemory     = defaultCreatureMemory
     , _crMeleeCooldown = 0
-    , _crAwakeLevel = Vigilant
-    , _crAttentionDir = AttentiveTo IM.empty
-    , _crAwarenessLevel = IM.empty
     , _crFaction = NoFaction
     , _crTarget  = Nothing
     , _crMvTarget= Nothing
     , _crGroup   = LoneWolf
     , _crMvType  = defaultAimMvType
     }
+defaultCreatureMemory :: MemoryState
+defaultCreatureMemory = MemoryState
+    { _soundsToInvestigate = []
+    }
+
+defaultPerceptionState :: PerceptionState
+defaultPerceptionState = PerceptionState
+    { _crAwakeLevel = Lethargic
+    , _crAttentionDir = AttentiveTo IM.empty
+    , _crAwarenessLevel = IM.empty
+    , _crVision = defaultVision
+    , _crAudition = defaultAudition
+    }
+defaultVision :: Vision
+defaultVision = Eyes
+    { _viFOV = f
+    , _viDist = g
+    }
+  where
+    f x | abs x < 0.5 * pi = 1
+        | otherwise        = 0
+    g x | x > 500 = 0
+        | otherwise = 1
+defaultAudition :: Audition
+defaultAudition = Ears
+    { _auDist = \x -> 1 / (x * x)
+    }
 defaultChaseMvType :: CrMvType
 defaultChaseMvType = ChaseMvType
     { _mvSpeed = 3

src/Dodge/Initialisation.hs

@@ -9,6 +9,7 @@ import Dodge.Story
 import Dodge.WorldEvent.Cloud
 import Dodge.SoundLogic
 import Dodge.SoundLogic.Synonyms
+import Dodge.Creature.Perception
 import Geometry.Data
 --import Dodge.GameRoom
 --import Geometry
@@ -52,7 +53,8 @@ initialWorld = defaultWorld
     , _worldState = M.empty
     }
 testStringInit :: World -> [String]
-testStringInit _ = []
+--testStringInit _ = []
+testStringInit w = [show $ newSounds w]
 --testStringInit w = (show . _crPos $ _creatures w IM.! 0) 
 --    : (map show . _grBound . last $ sortOn _grName grs) 
 --    ++ closeRooms

src/Dodge/Render.hs

@@ -198,11 +198,12 @@ doDrawing pdata w = do
             zipWithM_ (>>) bindings $ map bindDrawDist rds
             activeTexture $= TextureUnit 0
     -- draw overlay
-    bufferUBO $ isoMatrix 0 1 (V2 0 0) (V2 2 2)
     depthFunc $= Just Always
     depthMask $= Disabled
     blend $= Enabled
     blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
+    renderLayer 4 shadV layerCounts
+    bufferUBO $ isoMatrix 0 1 (V2 0 0) (V2 2 2)
     renderFoldable shadV $ fixedCoordPictures w
     depthMask $= Enabled
     eTicks <- SDL.ticks

src/Dodge/SoundLogic.hs

@@ -23,6 +23,7 @@ module Dodge.SoundLogic (
 import Dodge.Data
 import Sound.Data (SoundStatus (..))
 import Geometry.Vector
+import Dodge.SoundLogic.Synonyms
 
 import Control.Lens
 import qualified Data.Map as M
@@ -61,7 +62,8 @@ soundOnceOrigin
     :: Int          -- ^ ID of the sound to be played
     -> SoundOrigin  -- ^ The \"creator\" of the sound
     -> Point2       -- ^ The position of the sound in the world
-    -> World -> World
+    -> World 
+    -> World
 soundOnceOrigin sType so p w = w & sounds %~ M.insertWith (\ _ x -> x) so theSound
   where 
     theSound = Sound 
@@ -70,7 +72,9 @@ soundOnceOrigin sType so p w = w & sounds %~ M.insertWith (\ _ x -> x) so theSou
         , _soundFadeTime    = 0
         , _soundStatus      = ToStart
         , _soundChannel     = Nothing
-        , _soundPos         = Just (a,0)
+        , _soundAngDist     = Just (a,0)
+        , _soundPos         = p
+        , _soundVolume      = soundVolID sType
         }
     a = soundAngle p w
 
@@ -89,7 +93,9 @@ soundFromPos so pos sType time fadeTime w = over sounds (M.insertWith f so sound
         , _soundStatus      = ToStart
         , _soundFadeTime    = fadeTime
         , _soundChannel     = Nothing
-        , _soundPos         = Just (a,0)
+        , _soundAngDist     = Just (a,0)
+        , _soundPos         = pos
+        , _soundVolume      = soundVolID sType
         }
     f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime}
     a = soundAngle pos w
@@ -114,8 +120,9 @@ soundFrom
     -> Int -- ^ Sound ID
     -> Int -- ^ Frames to play
     -> Int -- ^ Fade out time (ms)
-    -> World -> World
+    -> World 
-soundFrom so sType time fadeTime = sounds %~ M.insertWith f so sound
+    -> World
+soundFrom so sType time fadeTime w = w & sounds %~ M.insertWith f so sound
   where 
     sound = Sound 
         { _soundChunkID     = sType
@@ -123,7 +130,9 @@ soundFrom so sType time fadeTime = sounds %~ M.insertWith f so sound
         , _soundStatus      = ToStart
         , _soundFadeTime    = fadeTime
         , _soundChannel     = Nothing
-        , _soundPos         = Nothing
+        , _soundAngDist     = Nothing
+        , _soundPos         = _cameraCenter w
+        , _soundVolume      = soundVolID sType
         }
     f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime} 
 {-| Uses the first free origin from a list.
@@ -147,7 +156,9 @@ soundMultiFrom (so:sos) sType time fadeTime w
         , _soundStatus      = ToStart
         , _soundFadeTime    = fadeTime
         , _soundChannel     = Nothing
-        , _soundPos         = Nothing
+        , _soundAngDist     = Nothing
+        , _soundPos         = _cameraCenter w
+        , _soundVolume      = soundVolID sType
         }
 {-| Uses the first free origin from a list.
 Does nothing if all origins are already creating sounds.  -}
@@ -157,7 +168,8 @@ soundMultiFromPos
     -> Int -- ^ Frames to play for
     -> Int -- ^ Fade out time (ms)
     -> Point2 -- ^ Position
-    -> World -> World
+    -> World 
+    -> World
 soundMultiFromPos [] _ _ _ _ w = w
 soundMultiFromPos (so:sos) sType time fadeTime pos w
     | so `M.member` _sounds w = soundMultiFromPos sos sType time fadeTime pos w
@@ -169,7 +181,9 @@ soundMultiFromPos (so:sos) sType time fadeTime pos w
         , _soundStatus      = ToStart
         , _soundFadeTime    = fadeTime
         , _soundChannel     = Nothing
-        , _soundPos         = Just (a,0)
+        , _soundAngDist     = Just (a,0)
+        , _soundPos         = pos
+        , _soundVolume      = soundVolID sType
         }
     a = soundAngle pos w
 {- | Sets '_soundTime' to 0.  -}

src/Dodge/SoundLogic/Synonyms.hs

@@ -38,3 +38,5 @@ skwareFadeTwoSecSound = 45
 drawWeaponSound = 4
 holsterWeaponSound = 5
 
+soundVolID :: Int -> Float
+soundVolID _ = 10000

src/Dodge/Update.hs

@@ -265,4 +265,3 @@ visibleWalls p1 p2 ws
     $ IM.toList ws
   where 
     f (i,wl) = (uncurry intersectSegSeg (_wlLine wl) p1 p2, (i,wl))
-

src/Render.hs

@@ -130,4 +130,3 @@ bindTO t = textureBinding Texture2D $= Just t
 
 bindFBO :: FramebufferObject -> IO ()
 bindFBO fb = bindFramebuffer Framebuffer $= fb
-

src/Sound.hs

@@ -13,7 +13,7 @@ module Sound (
       playSoundQueue
     , playPositionalSoundQueue
     -- * Complex Playback
-    , playAndUpdate
+    , playSoundAndUpdate
     -- * Volume Control
     , setSoundVolume
     , setMusicVolume
@@ -49,8 +49,8 @@ In the update:
     3. apply 'Just' sound position effects, set value to 'Nothing'
     4. remove sounds that have stopped playing from the map.
  -}
-playAndUpdate :: Ord a => SoundData a -> M.Map a Sound -> IO (M.Map a Sound)
+playSoundAndUpdate :: Ord a => SoundData a -> M.Map a Sound -> IO (M.Map a Sound)
-playAndUpdate sData newSounds 
+playSoundAndUpdate sData newSounds 
     = updateSounds (_loadedChunks sData) (M.unionWith mergeSound (_playingSounds sData) newSounds)
 
 mergeSound :: Sound -> Sound -> Sound
@@ -74,6 +74,7 @@ updateSound sd s =
 initialisePlaying :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound
 initialisePlaying sd s = case _soundStatus s of
     ToStart -> tryPlay sd s
+    JustStartedPlaying -> return $ s & soundStatus .~ Playing
     _ -> return s
 
 tryPlay :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound
@@ -84,7 +85,7 @@ tryPlay sd s = do
         Mix.playOn i Mix.Once (sd IM.! _soundChunkID s)
     return $ s 
         & soundChannel  ?~ i
-        & soundStatus   .~ Playing
+        & soundStatus   .~ JustStartedPlaying
 
 --repetitions :: Sound -> Mix.Times
 --repetitions s = case _soundTime s of
@@ -96,6 +97,8 @@ tryGetChannel s = case _soundChannel s of
     Just i  -> return i
     Nothing -> MaybeT $ Mix.getAvailable Mix.DefaultGroup
 
+
+
 decrementTimer :: Sound -> IO Sound
 decrementTimer s = case _soundTime s of
     Just t 
@@ -106,10 +109,10 @@ decrementTimer s = case _soundTime s of
     Nothing -> return s
 
 applyPosition :: Sound -> IO Sound
-applyPosition s = case _soundPos s of
+applyPosition s = case _soundAngDist s of
     Nothing     -> return s
     Just (a,d)  -> Mix.effectPosition (fromJust $ _soundChannel s) a d
-                    >> return (s & soundPos .~ Nothing)
+                    >> return (s & soundAngDist .~ Nothing)
 
 fadeOutMaybe 
     :: Maybe Mix.Channel 

src/Sound/Data.hs

@@ -5,12 +5,13 @@ import qualified SDL.Mixer as Mix
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Map.Strict as M
 import Control.Lens
---import Geometry
+import Geometry.Data
 import Data.Word (Word8)
 import Data.Int (Int16)
 
 data SoundStatus 
-    = Playing
+    = JustStartedPlaying
+    | Playing
     | FadingOut
     | ToStart
   deriving (Eq,Ord,Show)
@@ -24,11 +25,12 @@ data Sound = Sound
     , _soundFadeTime    :: Int
     , _soundStatus      :: SoundStatus
     , _soundChannel     :: Maybe Mix.Channel
-    , _soundPos         :: Maybe (Int16,Word8)
+    , _soundAngDist     :: Maybe (Int16,Word8)
+    , _soundPos         :: Point2
+    , _soundVolume      :: Float
     , _soundChunkID     :: Int
     }
   deriving (Eq,Ord,Show)
 
 makeLenses ''SoundData
 makeLenses ''Sound
-