Improve radar/sonar

src/Dodge/Combine/Data.hs

@@ -75,6 +75,7 @@ data CombineType
     | SHRINKER
     -- Equipment
     | RADAR
+    | ITEMFINDER
     | MAGSHIELD
     | FLAMESHIELD
     | FRONTARMOUR

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -5,6 +5,7 @@ Extra weapon effects, supplementing explicit use effects.
 module Dodge.Item.Weapon.ExtraEffect
     (-- itemLaserScopeEffect
      autoSonarEffect
+    , autoEffect
     , autoRadarEffect
     , targetRBPress
     , targetRBCreature
@@ -26,33 +27,29 @@ import Geometry.Vector
 import Geometry.Data
 import LensHelp
 import qualified FoldlHelp as L
+import Sound.Data
 
 --import Data.Bifunctor
 import Data.Maybe
 --import qualified Control.Foldl as L
 import qualified Data.Set as S
 import qualified SDL
-{- | Automatically send out radar pulses that detect walls.  -}
+autoEffect :: (Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World
-autoRadarEffect :: Item -> Creature -> World -> World
+autoEffect eff t sid itm cr w
-autoRadarEffect itm cr w
+    | _eparamInt (_eqParams (_itUse itm)) < 1 = eff cr w 
-    | _eparamInt (_eqParams (_itUse itm)) < 1 = aRadarPulse cr w 
         & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm)
-                                     . itUse . eqParams . eparamInt .~ 100
+                                     . itUse . eqParams . eparamInt .~ t
-       & soundStart OnceSound (_crPos cr) click1S Nothing
+       & soundStart OnceSound (_crPos cr) sid Nothing
-    | otherwise = w 
-        & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm)
-                                     . itUse . eqParams . eparamInt -~ 1
-{- | Automatically send out sonar pulses that detect creatures.  -}
-autoSonarEffect :: Item -> Creature -> World -> World
-autoSonarEffect itm cr w
-    | _eparamInt (_eqParams (_itUse itm)) < 1 = aSonarPulse cr w 
-        & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm)
-                                     . itUse . eqParams . eparamInt .~ 50
-       & soundStart OnceSound (_crPos cr) click1S Nothing
     | otherwise = w 
         & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm)
                                      . itUse . eqParams . eparamInt -~ 1
 
+{- | Automatically send out radar pulses that detect walls.  -}
+autoRadarEffect :: Item -> Creature -> World -> World
+autoRadarEffect = autoEffect aRadarPulse 100 click1S
+{- | Automatically send out sonar pulses that detect creatures.  -}
+autoSonarEffect :: Item -> Creature -> World -> World
+autoSonarEffect = autoEffect aSonarPulse 50 click1S
 defaultTargeting :: Targeting
 defaultTargeting = Targeting
     { _tgPos = Nothing

src/Dodge/Item/Weapon/Radar.hs

@@ -9,6 +9,7 @@ import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.UseEffect
 --import Dodge.Item.Weapon.Remote
 import Dodge.Default.Weapon
+import Dodge.SoundLogic
 --import Dodge.Item.Weapon.Grenade
 import Geometry
 import Picture
@@ -70,8 +71,8 @@ Automatically sends out pulses that display walls.  -}
 autoRadar :: Item
 autoRadar = defaultEquipment
     { _itType = RADAR
-    , _itName = "AUTORADAR"
+    , _itName = "WALLFINDER"
-    , _itEquipPict = shapeForWrist (colorSH yellow $ upperPrismPoly 3 $ rectWH 2 2)
+    , _itEquipPict = shapeForWrist (colorSH red $ upperPrismPoly 3 $ rectWH 2 2)
 --    , _itEffect = autoRadarEffect
     , _itID = Nothing
     } 
@@ -79,5 +80,19 @@ autoRadar = defaultEquipment
     & itUse . eqUse  .~ autoRadarEffect
     & itUse . eqParams .~ EquipCounter 0
 
+{- |
+Automatically sends out pulses that display walls.  -}
+itemFinder :: Item
+itemFinder = defaultEquipment
+    { _itType = ITEMFINDER
+    , _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
 shapeForWrist = pictureOnEquip . noPic . translateSH (V3 0 4 (-4))

src/Dodge/Item/Weapon/UseEffect.hs

@@ -16,6 +16,9 @@ aSonarPulse cr = instantParticles .:~ sonarPulseAt (_crPos cr)
 {- | Creates an outwardly increasing circle that displays walls, even those behind other walls.  -}
 aRadarPulse :: Creature -> World -> World
 aRadarPulse cr = instantParticles .:~ radarPulseAt (_crPos cr)
+{- | Creates an outwardly increasing circle that displays items.  -}
+anItemFindPulse :: Creature -> World -> World
+anItemFindPulse cr = instantParticles .:~ itemFindPulseAt (_crPos cr)
 {- | Radar blip at a point.  -}
 blipAt :: Point2 -> Color -> Int -> Particle
 blipAt p col i = Particle
@@ -51,7 +54,8 @@ mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic
                               }
                    )
   where 
-    pic = setDepth (-0.5) . setLayer BloomLayer $ pictures crBlips
+    pic = setLayer DebugLayer $ pictures crBlips
+        <> sweepPics
     crBlips = mapMaybe crBlip $ IM.elems $ _creatures w
     crBlip cr | dist cpos p < r + crad && dist cpos p > r - (crad + 100)
                   = Just $ colHelper (0.5 * (1 - (r - dist cpos p) /100))
@@ -60,12 +64,19 @@ mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic
           where crad = _crRad cr
                 cpos = _crPos cr
     r = fromIntegral (500 - x*5)
-    --sweepPics = [colHelper 0.05 $ uncurry translate p $ thickCircle r 5 ]
+    sweepPics = colHelper 0.05 $ uncurryV translate p $ thickCircle r 5 
     globalAlpha | x > 10 = 1
                 | otherwise = fromIntegral x / 10
     colHelper y = color (withAlpha (y * globalAlpha) green)
 {- |
 An outwardly increasing circle that displays walls, even those behind other walls.  -}
+itemFindPulseAt :: Point2 -> Particle
+itemFindPulseAt p = Particle
+    { _ptDraw = const blank
+    , _ptUpdate = mvRadar 100 p
+    }
+{- |
+An outwardly increasing circle that displays walls, even those behind other walls.  -}
 radarPulseAt :: Point2 -> Particle
 radarPulseAt p = Particle
     { _ptDraw = const blank
@@ -85,10 +96,7 @@ mvRadar x p w pt =
     pic = setLayer DebugLayer $ pictures sweepPics
     putBlips = over worldEvents ( over instantParticles (blips ++) . )
     blips = map (\bp -> blipAt bp (withAlpha (0.5*globalAlpha) red) 50) circPoints
-    circPoints = mapMaybe (\wl -> uncurry (intersectCircSegFirst p r) (_wlLine wl))
+    circPoints = wallBlips p r w
-        $ map (over wlLine swp) (IM.elems $ wallsAlongCirc p r w)
-                      ++ IM.elems (wallsAlongCirc p r w)
-    swp (a,b) = (b,a)
     r = fromIntegral (400 - x*4)
     sweepPics = [colHelper 0.1 $ uncurryV translate p $ thickCircle r 15
                 ,colHelper 0.06 $ uncurryV translate p $ thickCircle (r-5) 5
@@ -97,3 +105,15 @@ mvRadar x p w pt =
     globalAlpha | x > 10 = 1
                 | otherwise = fromIntegral x / 10
     colHelper y = color (withAlpha (y * globalAlpha) red)
+
+itemBlips :: Point2 -> Float -> World -> IM.IntMap Point2
+itemBlips p r = IM.filter f . fmap _flItPos . _floorItems
+  where
+    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))
+        $ map (over wlLine swp) (IM.elems $ wallsAlongCirc p r w)
+                      ++ IM.elems (wallsAlongCirc p r w)
+  where
+    swp (a,b) = (b,a)