Improve detector equipment, various cleanup

src/Dodge/Combine/Data.hs

@@ -1,6 +1,8 @@
 module Dodge.Combine.Data
     (CombineType (..)
+    ,Detector (..)
     ) where
+import Dodge.Equipment.Data
 -- TODO make this an enum somehow...?
 data CombineType
     = NOTDEFINED
@@ -74,12 +76,13 @@ data CombineType
     | FORCEFIELDGUN
     | SHRINKER
     -- Equipment
-    | RADAR
+    | CLICKDETECTOR Detector
-    | ITEMFINDER
+    | AUTODETECTOR Detector
     | MAGSHIELD
     | FLAMESHIELD
     | FRONTARMOUR
     | WRISTARMOUR
+    | INVISIBILITYEQUIPMENT EquipSite
     | BRAINHAT
     | HEADLAMP
     | POWERLEGS
@@ -139,3 +142,9 @@ data CombineType
     --
     | NoCombineType
   deriving (Eq,Ord,Show)
+
+data Detector
+    = ITEMDETECTOR
+    | CREATUREDETECTOR
+    | WALLDETECTOR
+  deriving (Eq,Ord,Show)

src/Dodge/Creature.hs

@@ -1,14 +1,13 @@
 module Dodge.Creature 
     ( module Dodge.Creature
+    , module Dodge.Creature.ChaseCrit
     , module Dodge.Creature.Inanimate
     , launcherCrit
     , pistolCrit
     , ltAutoCrit
     , spreadGunCrit
     , autoCrit
-    , chaseCrit
     , armourChaseCrit
-    , smallChaseCrit
     ) where
 import Dodge.Creature.State.Data
 import Dodge.Creature.Update
@@ -166,7 +165,8 @@ startInventory :: IM.IntMap Item
 startInventory = IM.fromList $ zip [0..] startInvList
 inventoryA :: IM.IntMap Item
 inventoryA = IM.fromList $ zip [0..] 
-    [ makeTypeCraftNum 1 TRANSFORMER
+    [ clickDetector ITEMDETECTOR
+    , makeTypeCraftNum 1 TRANSFORMER
     , makeTypeCraftNum 2 CAN
     , makeTypeCraftNum 2 PIPE
     ]
@@ -187,9 +187,10 @@ inventoryB = IM.fromList $ zip [0..]
     ]
 inventoryC :: IM.IntMap Item
 inventoryC = IM.fromList $ zip [0..] 
-    [ autoRadar
+    [ autoDetector CREATUREDETECTOR
-    , autoSonar
+    , autoDetector WALLDETECTOR
-    , itemFinder
+    , autoDetector ITEMDETECTOR
+    , wristInvisibility
     ]
 
 testInventory :: IM.IntMap Item
@@ -197,8 +198,7 @@ testInventory = IM.fromList $ zip [0..]
     [ makeTypeCraftNum 9 PIPE
     , brainHat
     , headLamp
-    , autoSonar
+    , autoDetector WALLDETECTOR
-    , autoRadar
     , magShield
     , frontArmour
     , wristArmour

src/Dodge/Creature/ChaseCrit.hs

@@ -1,5 +1,6 @@
 module Dodge.Creature.ChaseCrit
     (smallChaseCrit
+    ,invisibleChaseCrit
     ,chaseCrit
     ) where
 import Dodge.Data
@@ -10,6 +11,7 @@ import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Action
 import Dodge.Creature.Perception
 import Dodge.Item.Consumable
+import Dodge.Item.Equipment
 import Dodge.SoundLogic
 --import Geometry
 import Picture
@@ -28,6 +30,12 @@ smallChaseCrit = chaseCrit
     , _crInv = IM.fromList [(0,medkit 200)]
     , _crCorpse = setDepth 5 $ color (greyN 0.5) $ circleSolid 4
     }
+invisibleChaseCrit :: Creature
+invisibleChaseCrit = chaseCrit
+    & crCamouflage .~ Invisible
+    & crInv . at 0 ?~ wristInvisibility
+    & crEquipment . at OnLeftWrist ?~ 0
+    & crInvEquipped . at 0 ?~ OnLeftWrist
 chaseCrit :: Creature
 chaseCrit = defaultCreature
     { _crUpdate = defaultImpulsive

src/Dodge/Creature/Picture.hs

@@ -61,12 +61,14 @@ basicCrShape
     :: Color    -- ^ Creature color
     -> Creature 
     -> Shape
-basicCrShape col cr = tr . scaleSH (V3 crsize crsize crsize) $ mconcat
+basicCrShape col cr 
-    [ --rotdir . _spShape $ drawEquipment cr
+    | _crCamouflage cr == Invisible = mempty
-     rotdir . dm . translateSHz 20 $ scalp cr
+    | otherwise = tr . scaleSH (V3 crsize crsize crsize) $ mconcat
-    , rotdir . dm $ upperBody col cr
+        [ --rotdir . _spShape $ drawEquipment cr
-    , dm . rotmdir $ feet cr
+         rotdir . dm . translateSHz 20 $ scalp cr
-    ]
+        , rotdir . dm $ upperBody col cr
+        , dm . rotmdir $ feet cr
+        ]
   where 
     crsize = 0.1 * _crRad cr
     dm = damageModSH cr

src/Dodge/Data.hs

@@ -20,6 +20,7 @@ module Dodge.Data
     , module Dodge.Item.Attachment.Data
     , module Dodge.Item.Data
     , module Dodge.Config.Data
+    , module Dodge.Equipment.Data
     ) where
 import Dodge.ShortShow
 import Dodge.Creature.State.Data
@@ -27,6 +28,7 @@ import Dodge.Creature.Stance.Data
 import Dodge.Creature.Perception.Data
 import Dodge.Creature.Memory.Data
 import Dodge.Distortion.Data
+import Dodge.Equipment.Data
 import Dodge.Data.SoundOrigin
 import Dodge.Data.DamageType
 import Dodge.Combine.Data
@@ -335,7 +337,12 @@ data Creature = Creature
     , _crHammerPosition :: HammerPosition
     , _crName           :: String
     , _crStatistics     :: CreatureStatistics
+    , _crCamouflage     :: CamouflageStatus
     }
+data CamouflageStatus
+    = FullyVisible
+    | Invisible
+    deriving (Eq,Ord,Enum)
 data CreatureStatistics = CreatureStatistics
     { _crStrength       :: Int
     , _crDexterity      :: Int
@@ -432,23 +439,6 @@ data ItemUse
         , _eqParams     :: EquipParams
         }
     | NoUse
-data EquipSite
-    = GoesOnHead
-    | GoesOnChest
-    | GoesOnBack
-    | GoesOnWrist
-    | GoesOnLegs
-    | GoesOnSpecial
-    deriving (Eq,Ord,Show)
-data EquipPosition
-    = OnHead
-    | OnChest
-    | OnBack
-    | OnLeftWrist
-    | OnRightWrist
-    | OnLegs
-    | OnSpecial
-    deriving (Eq,Ord,Show)
 _itUseAimStance :: Item -> AimStance
 _itUseAimStance = _aimStance . _useAim . _itUse
 data ItemConsumption

src/Dodge/Default.hs

@@ -64,6 +64,7 @@ defaultCreature = Creature
     , _crHammerPosition = HammerUp
     , _crName = "DEFAULTCRNAME"
     , _crStatistics = CreatureStatistics 10 10 10
+    , _crCamouflage = FullyVisible
     }
 defaultInanimate :: Creature
 defaultInanimate = defaultCreature & crActionPlan .~ Inanimate

src/Dodge/Equipment/Data.hs

@@ -0,0 +1,18 @@
+module Dodge.Equipment.Data where
+data EquipSite
+    = GoesOnHead
+    | GoesOnChest
+    | GoesOnBack
+    | GoesOnWrist
+    | GoesOnLegs
+    | GoesOnSpecial
+    deriving (Eq,Ord,Show)
+data EquipPosition
+    = OnHead
+    | OnChest
+    | OnBack
+    | OnLeftWrist
+    | OnRightWrist
+    | OnLegs
+    | OnSpecial
+    deriving (Eq,Ord,Show)

src/Dodge/Floor.hs

@@ -40,7 +40,7 @@ initialAnoTree :: Tree [Annotation]
 initialAnoTree = padSucWithDoors $ treeFromPost 
     [[AnoApplyInt 0 startRoom]
     , [SpecificRoom $ return (return . UseAll $ roomRectAutoLinks 400 400
-        & rmPmnts .++~ [spNoID anyUnusedSpot (PutCrit chaseCrit)
+        & rmPmnts .++~ [spNoID anyUnusedSpot (PutCrit invisibleChaseCrit)
                 , spNoID anyUnusedSpot (PutCrit armourChaseCrit)
                 ]
             , TreeSubLabelling "chaseCrit+armourChaseCrit rectRoom" Nothing)

src/Dodge/Item/Equipment.hs

@@ -1,6 +1,7 @@
 module Dodge.Item.Equipment where
 import Dodge.Data
 import Dodge.Item.Draw
+import Dodge.Item.Equipment.Shape
 import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.LightSource
 import Dodge.Default
@@ -58,7 +59,6 @@ frontArmour = defaultEquipment
         [color thecol $ thickArc 0        (pi/2) 10 5
         ,color thecol $ thickArc (3*pi/2) (2*pi) 10 5
         ])
-    , _itEffect = NoItEffect
     , _itID = Nothing
     }
     & itUse . eqSite .~ GoesOnChest
@@ -70,7 +70,6 @@ wristArmour = defaultEquipment
     { _itType = WRISTARMOUR
     , _itName = "WRISTARMOUR"
     , _itEquipPict = spicForWrist mempty
-    , _itEffect = NoItEffect
     , _itID = Nothing
     }
     & itUse . eqSite .~ GoesOnWrist
@@ -109,22 +108,6 @@ setWristShieldPos itm cr w = w
       | otherwise = id
     f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
 
-spicForWrist :: SPic -> Creature -> Item -> SPic
-spicForWrist = pictureOnEquip . translateSP (V3 0 4 (-4))
-pictureOnEquip :: SPic -> Creature -> Item -> SPic
-pictureOnEquip sp cr itm = fromMaybe mempty $ do
-    i <- _itInvPos itm
-    epos <- cr^? crInvEquipped . ix i
-    return $ equipPosition epos cr sp
-equipPosition :: EquipPosition -> Creature -> SPic -> SPic
-equipPosition epos cr sh = case epos of
-    OnLeftWrist -> translateToLeftHand cr sh
-    OnRightWrist -> translateToRightHand cr sh
-    OnLegs -> translateToLeftLeg cr sh <> 
-        translateToRightLeg cr (mirrorSPxz sh)
-    OnHead -> translateToHead cr sh
-    OnChest -> translateToChest cr sh
-    _ -> sh
 
 flatShield :: Item
 flatShield = defaultEquipment
@@ -306,3 +289,17 @@ jumpLegs = powerLegs
     { _itType = JUMPLEGS
     , _itName = "JUMPLEGS"
     }
+
+wristInvisibility :: Item
+wristInvisibility = defaultEquipment
+    { _itType = INVISIBILITYEQUIPMENT GoesOnWrist
+    , _itName = "WRISTINVISIBILITY"
+    , _itEquipPict = shapeForWrist (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2)
+    , _itID = Nothing
+    }
+    & itUse . eqSite .~ GoesOnWrist
+    & itUse . eqOnEquip  .~ overCID (crCamouflage .~ Invisible)
+    & itUse . eqOnRemove .~ overCID (crCamouflage .~ FullyVisible)
+
+overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
+overCID f _ cr = creatures . ix (_crID cr) %~ f

src/Dodge/Item/Equipment/Shape.hs

@@ -0,0 +1,29 @@
+module Dodge.Item.Equipment.Shape where
+import Dodge.Data
+import Dodge.Creature.HandPos
+import Shape
+import ShapePicture
+import Geometry
+import LensHelp
+
+import Data.Maybe
+
+shapeForWrist :: Shape -> Creature -> Item -> SPic
+shapeForWrist = pictureOnEquip . noPic . translateSH (V3 0 4 (-4))
+
+spicForWrist :: SPic -> Creature -> Item -> SPic
+spicForWrist = pictureOnEquip . translateSP (V3 0 4 (-4))
+pictureOnEquip :: SPic -> Creature -> Item -> SPic
+pictureOnEquip sp cr itm = fromMaybe mempty $ do
+    i <- _itInvPos itm
+    epos <- cr^? crInvEquipped . ix i
+    return $ equipPosition epos cr sp
+equipPosition :: EquipPosition -> Creature -> SPic -> SPic
+equipPosition epos cr sh = case epos of
+    OnLeftWrist -> translateToLeftHand cr sh
+    OnRightWrist -> translateToRightHand cr sh
+    OnLegs -> translateToLeftLeg cr sh <> 
+        translateToRightLeg cr (mirrorSPxz sh)
+    OnHead -> translateToHead cr sh
+    OnChest -> translateToChest cr sh
+    _ -> sh

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -34,9 +34,9 @@ import Data.Maybe
 --import qualified Control.Foldl as L
 import qualified Data.Set as S
 import qualified SDL
-autoEffect :: (Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World
+autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World
 autoEffect eff t sid itm cr w
-    | _eparamInt (_eqParams (_itUse itm)) < 1 = eff cr w 
+    | _eparamInt (_eqParams (_itUse itm)) < 1 = eff itm cr w 
         & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm)
                                      . itUse . eqParams . eparamInt .~ t
        & soundStart OnceSound (_crPos cr) sid Nothing
@@ -46,10 +46,10 @@ autoEffect eff t sid itm cr w
 
 {- | Automatically send out radar pulses that detect walls.  -}
 autoRadarEffect :: Item -> Creature -> World -> World
-autoRadarEffect = autoEffect aWallPulse 100 click1S
+autoRadarEffect = autoEffect (const aWallPulse) 100 click1S
 {- | Automatically send out sonar pulses that detect creatures.  -}
 autoSonarEffect :: Item -> Creature -> World -> World
-autoSonarEffect = autoEffect aSonarPulse 50 click1S
+autoSonarEffect = autoEffect (const aSonarPulse) 50 click1S
 defaultTargeting :: Targeting
 defaultTargeting = Targeting
     { _tgPos = Nothing

src/Dodge/Item/Weapon/Radar.hs

@@ -3,7 +3,8 @@ import Dodge.Data
 --import Dodge.Picture.Layer
 import Dodge.Default
 import Dodge.Item.Draw
-import Dodge.Item.Equipment
+--import Dodge.Item.Equipment
+import Dodge.Item.Equipment.Shape
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.UseEffect
@@ -14,22 +15,22 @@ import Dodge.SoundLogic
 import Geometry
 import Picture
 import Shape
-import ShapePicture
+--import ShapePicture
 
 import Control.Lens
 
 {- |
 Sends out pulses that display walls.  -}
-radar :: Item
+clickDetector :: Detector -> Item
-radar = defaultGun 
+clickDetector dt = defaultGun 
-    { _itName = "RADAR"
+    { _itName = show dt
-    , _itType = RADAR
+    , _itType = CLICKDETECTOR dt
     , _itConsumption = defaultAmmo
         { _ammoBaseMax = 100
         , _ammoLoaded = 100
         , _reloadTime = 200
         }
-    , _itUse = ruseRate 120 (const aWallPulse) upHammer
+    , _itUse = ruseRate 20 (detectorEffect dt) upHammer
         [ ammoUseCheck
         ]
         & useAim . aimRange .~ 1
@@ -37,62 +38,27 @@ radar = defaultGun
 --    , _itZoom       = defaultItZoom { _itZoomMax = 1}
     , _itEquipPict = pictureWeaponAim $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
     }
-{- |
+
-Sends out pulses that display creatures.  -}
+autoDetector :: Detector -> Item
-sonar :: Item
+autoDetector dt = defaultEquipment
-sonar = defaultGun 
+    { _itType = AUTODETECTOR dt
-    { _itName = "SONAR"
+    , _itName = "AUTO-" ++ show dt
-    , _itType = RADAR
+    , _itEquipPict = shapeForWrist (colorSH (detectorColor dt) $ upperPrismPoly 3 $ rectWH 2 2)
-    , _itConsumption = defaultAmmo
-        { _ammoBaseMax = 100
-        , _ammoLoaded = 100
-        , _reloadTime = 200
-        }
-    , _itUse = ruseRate 120 (const aSonarPulse) upHammer
-        [ ammoUseCheck
-        ]
-        & useAim . aimRange .~ 1
-        & useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1}
-    , _itEquipPict = pictureWeaponAim $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
-    }
-{- |
-Automatically sends out pulses that display creatures.  -}
-autoSonar :: Item
-autoSonar = defaultEquipment
-    { _itType = RADAR
-    , _itName = "AUTOSONAR"
-    , _itEquipPict = shapeForWrist (colorSH red $ upperPrismPoly 3 $ rectWH 2 2)
-    , _itID = Nothing
-    } & itUse . eqSite .~ GoesOnWrist
-    & itUse . eqUse  .~ autoSonarEffect
-    & itUse . eqParams .~ EquipCounter 0
-{- |
-Automatically sends out pulses that display walls.  -}
-autoRadar :: Item
-autoRadar = defaultEquipment
-    { _itType = RADAR
-    , _itName = "WALLFINDER"
-    , _itEquipPict = shapeForWrist (colorSH red $ upperPrismPoly 3 $ rectWH 2 2)
 --    , _itEffect = autoRadarEffect
     , _itID = Nothing
     } 
     & itUse . eqSite .~ GoesOnWrist
-    & itUse . eqUse  .~ autoRadarEffect
+    & itUse . eqUse  .~ autoEffect (detectorEffect dt) 100 click1S
     & itUse . eqParams .~ EquipCounter 0
 
-{- |
+detectorColor :: Detector -> Color
-Automatically sends out pulses that display walls.  -}
+detectorColor dt = case dt of
-itemFinder :: Item
+    ITEMDETECTOR        -> blue
-itemFinder = defaultEquipment
+    CREATUREDETECTOR    -> green
-    { _itType = ITEMFINDER
+    WALLDETECTOR        -> red
-    , _itName = "ITEMFINDER"
-    , _itEquipPict = shapeForWrist (colorSH blue $ upperPrismPoly 3 $ rectWH 2 2)
---    , _itEffect = autoRadarEffect
-    , _itID = Nothing
-    } 
-    & itUse . eqSite .~ GoesOnWrist
-    & itUse . eqUse  .~ autoEffect anItemFindPulse 100 click1S
-    & itUse . eqParams .~ EquipCounter 0
 
-shapeForWrist :: Shape -> Creature -> Item -> SPic
+detectorEffect :: Detector -> Item -> Creature -> World -> World
-shapeForWrist = pictureOnEquip . noPic . translateSH (V3 0 4 (-4))
+detectorEffect dt = case dt of
+    ITEMDETECTOR        -> const anItemFindPulse
+    CREATUREDETECTOR    -> const aSonarPulse
+    WALLDETECTOR        -> const aWallPulse

src/Dodge/Item/Weapon/UseEffect.hs

@@ -16,17 +16,15 @@ import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 {- | Creates an outwardly increasing circle that draws creatures, even those behind walls.  -}
 aSonarPulse :: Creature -> World -> World
---aSonarPulse cr = instantParticles .:~ sonarPulseAt (_crPos cr)
+aSonarPulse = aRadarPulse crBlips (blipAt 8) (withAlpha 0.2 green)
-aSonarPulse = aRadarPulse crBlips (blipAt 8) green
 
 aWallPulse :: Creature -> World -> World
 aWallPulse = aRadarPulse wallBlips (blipAt 2) red
 
 {- | Creates an outwardly increasing circle that displays items.  -}
 anItemFindPulse :: Creature -> World -> World
-anItemFindPulse = aRadarPulse itemBlips (blipAt 6) blue
+anItemFindPulse = aRadarPulse itemBlips (openBlipAt 6) blue
 
-{- | Creates an outwardly increasing circle that displays walls, even those behind other walls.  -}
 aRadarPulse :: (Point2 -> Float -> World -> [Point2]) 
     -> (Point2 -> Color -> Int -> Particle)
     -> Color
@@ -37,7 +35,7 @@ aRadarPulse blipsF bf col cr = instantParticles .:~ RadarCircleParticle
     , _ptUpdate = mvRadar blipsF bf col (_crPos cr)
     , _ptTimer  = 100
     , _ptRad    = 0
-    , _ptPos    = (_crPos cr)
+    , _ptPos    = _crPos cr
     }
 drawPulse :: Color -> Particle -> Picture
 drawPulse col pt = setLayer DebugLayer $ pictures sweepPics
@@ -63,17 +61,39 @@ mvBlip :: Float
     -> Int  -- ^ Max possible timer value
     -> Int  -- ^ Current timer value
     -> World -> Particle -> (World, Maybe Particle)
-mvBlip _ _ _   _    0 w _ = (w, Nothing)
+mvBlip r p col maxt t w pt = case t of
-mvBlip r p col maxt t w pt = 
+    0 -> (w, Nothing)
-    (w
+    _ -> (w
-    , Just $ pt & ptUpdate .~ mvBlip r p col maxt (t-1)
+        , Just $ pt & ptUpdate .~ mvBlip r p col maxt (t-1)
-        & ptDraw .~ ( const 
+            & ptDraw .~ ( const 
-            . setDepth (-0.5)
+                . setDepth (-0.5)
-            . setLayer DebugLayer
+                . setLayer DebugLayer
-            . uncurryV translate p 
+                . uncurryV translate p 
-            . color (withAlpha (fromIntegral t / fromIntegral maxt) col)
+                . color (withAlpha (fromIntegral t / fromIntegral maxt) col)
-            $ circleSolid r )
+                $ circleSolid r )
-    )
+        )
+{- | Radar blip at a point.  -}
+openBlipAt :: Float -> Point2 -> Color -> Int -> Particle
+openBlipAt r p col i = Particle
+    {_ptDraw = const blank
+    ,_ptUpdate = mvOpenBlip r p col i i
+    }
+mvOpenBlip :: Float
+    -> Point2 -> Color 
+    -> Int  -- ^ Max possible timer value
+    -> Int  -- ^ Current timer value
+    -> World -> Particle -> (World, Maybe Particle)
+mvOpenBlip r p col maxt t w pt = case t of
+    0 -> (w, Nothing)
+    _ -> (w
+        , Just $ pt & ptUpdate .~ mvOpenBlip r p col maxt (t-1)
+            & ptDraw .~ ( const 
+                . setDepth (-0.5)
+                . setLayer DebugLayer
+                . uncurryV translate p 
+                . color (withAlpha (fromIntegral t / fromIntegral maxt) col)
+                $ thickCircle r 3)
+        )
 
 mvRadar 
     :: (Point2 -> Float -> World -> [Point2])
@@ -102,13 +122,14 @@ itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems
     f q = dist p q <= r && dist p q > r - 4
 
 wallBlips :: Point2 -> Float -> World -> [Point2]
-wallBlips p r w = mapMaybe (\wl -> uncurry (intersectCircSegFirst p r) (_wlLine wl))
+wallBlips p r w = mapMaybe (uncurry (intersectCircSegFirst p r) . _wlLine)
         $ map (over wlLine swp) (IM.elems $ wallsAlongCirc p r w)
                       ++ IM.elems (wallsAlongCirc p r w)
   where
     swp (a,b) = (b,a)
 
 crBlips :: Point2 -> Float -> World -> [Point2]
-crBlips p r = IM.elems . IM.filter f . fmap _crPos . _creatures
+crBlips p r = IM.elems . IM.filter f . fmap _crPos .  IM.filter g . _creatures
   where
-    f q = dist p q <= r && dist p q > r - 4
+    f q = dist p q <= r && dist p q > r - 100
+    g cr = _crID cr /= 0

src/Dodge/Machine.hs

@@ -35,8 +35,9 @@ machineUpdateDeathEff f mc
 
 machineAddSound :: SoundID -> (Machine -> World -> World) -> Machine -> World -> World
 machineAddSound sid f mc w
-    | dist (_crPos $ you w) (_mcPos mc) < 100 
+    | d < 200 
-        = soundContinue (MachineSound mid) (_mcPos mc) sid (Just 2) $ f mc w
+        = soundContinueVol (1-0.005*d) (MachineSound mid) (_mcPos mc) sid (Just 2) $ f mc w
     | otherwise = f mc w
   where
+    d = dist (_crPos $ you w) (_mcPos mc)
     mid = _mcID mc

src/Dodge/SoundLogic.hs

@@ -54,7 +54,7 @@ soundWithStatusVolume
     -> Maybe Int    -- ^ Frames to play sound for, Nothing for until finished
     -> World 
     -> World
-soundWithStatusVolume vol status so pos sType mtime w = over toPlaySounds (M.insertWith f so sound) w
+soundWithStatusVolume vol status so pos sType mtime w = w & toPlaySounds %~ M.insertWith f so sound
   where 
     sound = Sound 
         { _soundChunkID     = sType
@@ -90,7 +90,7 @@ soundStart
     -> World 
     -> World
 soundStart = soundWithStatus ToStart
-soundContinue 
+soundContinue
     :: SoundOrigin  -- ^ \"Creator\" of sound
     -> Point2       -- ^ Position of sound
     -> SoundID      -- ^ ID of sound to be played