Work on radar and sonar

2022-05-26 23:21:08 +01:00
parent 7d5edb4f41
commit 048b838e4b
4 changed files with 49 additions and 45 deletions
@@ -734,6 +734,7 @@ data GunBarrels
 data EquipParams
    = NoEquipParams
    | EquipID {_eparamID :: Int}
+    | EquipCounter {_eparamInt :: Int}
 data ItemParams
    = NoParams
    | ShellLauncher
@@ -14,6 +14,7 @@ module Dodge.Item.Weapon.ExtraEffect
    ) where
 import Dodge.Data
 import Dodge.Base
+import Dodge.SoundLogic
 --import Dodge.Item.Weapon.Decoration
 import Dodge.Item.Weapon.UseEffect
 import Dodge.Item.Weapon.LaserPath
@@ -32,28 +33,25 @@ import Data.Maybe
 import qualified Data.Set as S
 import qualified SDL
 {- | Automatically send out radar pulses that detect walls.  -}
-autoRadarEffect :: ItEffect
-autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
-  where 
-    f :: Int -> Item -> Creature -> World -> World
-    f 0 itm cr w = aRadarPulse cr w 
+autoRadarEffect :: Item -> Creature -> World -> World
+autoRadarEffect itm cr w
+    | _eparamInt (_eqParams (_itUse itm)) < 1 = aRadarPulse cr w 
        & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm)
-                                     . itEffect . itInvEffect .~ f 100
-    f t itm cr w = w 
+                                     . itUse . eqParams . eparamInt .~ 100
+       & soundStart OnceSound (_crPos cr) click1S Nothing
+    | otherwise = w 
        & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm)
-                                     . itEffect . itInvEffect .~ f (t-1)
+                                     . itUse . eqParams . eparamInt -~ 1
 {- | Automatically send out sonar pulses that detect creatures.  -}
-autoSonarEffect :: ItEffect
-autoSonarEffect = ItInvEffect {_itInvEffect = f ,_itEffectCounter = 50 }
-  where 
-    f :: Item -> Creature -> World -> World
-    f itm cr w 
-        | _itEffectCounter (_itEffect itm) == 0 = aSonarPulse cr w 
-            & decreasecounter
-        | otherwise = decreasecounter w
-      where
-        decreasecounter = creatures . ix (_crID cr) . crInv 
-            . ix (fromJust $ _itInvPos itm) . itEffect . itEffectCounter %~ (\i -> (i - 1) `mod` 50)
+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

 defaultTargeting :: Targeting
 defaultTargeting = Targeting
@@ -61,9 +61,10 @@ autoSonar = defaultEquipment
    { _itType = RADAR
    , _itName = "AUTOSONAR"
    , _itEquipPict = shapeForWrist (colorSH red $ upperPrismPoly 3 $ rectWH 2 2)
-    , _itEffect = autoSonarEffect
    , _itID = Nothing
    } & itUse . eqSite .~ GoesOnWrist
+    & itUse . eqUse  .~ autoSonarEffect
+    & itUse . eqParams .~ EquipCounter 0
 {- |
 Automatically sends out pulses that display walls.  -}
 autoRadar :: Item
@@ -71,9 +72,12 @@ autoRadar = defaultEquipment
    { _itType = RADAR
    , _itName = "AUTORADAR"
    , _itEquipPict = shapeForWrist (colorSH yellow $ upperPrismPoly 3 $ rectWH 2 2)
-    , _itEffect = autoRadarEffect
+--    , _itEffect = autoRadarEffect
    , _itID = Nothing
-    } & itUse . eqSite .~ GoesOnWrist
+    } 
+    & itUse . eqSite .~ GoesOnWrist
+    & itUse . eqUse  .~ autoRadarEffect
+    & itUse . eqParams .~ EquipCounter 0

 shapeForWrist :: Shape -> Creature -> Item -> SPic
 shapeForWrist = pictureOnEquip . noPic . translateSH (V3 0 4 (-4))
@@ -3,6 +3,7 @@ Effects centered on creatures.
 These are typically item effects, and typical occur when an item is explictly used.  -}
 module Dodge.Item.Weapon.UseEffect where
 import Dodge.Data
+import Dodge.Zone
 import Picture
 import Geometry
 import LensHelp
@@ -31,7 +32,7 @@ mvBlip p col maxt t w pt =
    , Just $ pt & ptUpdate .~ mvBlip p col maxt (t-1)
        & ptDraw .~ ( const 
            . setDepth (-0.5)
-            . setLayer BloomLayer
+            . setLayer DebugLayer
            . uncurryV translate p 
            . color (withAlpha (fromIntegral t / fromIntegral maxt) col)
            $ circleSolid 2 )
@@ -68,31 +69,31 @@ An outwardly increasing circle that displays walls, even those behind other wall
 radarPulseAt :: Point2 -> Particle
 radarPulseAt p = Particle
    { _ptDraw = const blank
-    , _ptUpdate = mvRadar 50 p
+    , _ptUpdate = mvRadar 100 p
    }
 mvRadar 
    :: Int      -- ^ Timer
    -> Point2   -- ^ Center of expanding circle
    -> World -> Particle -> (World, Maybe Particle)
 mvRadar 0 _ w _  = (w, Nothing)
-mvRadar _ _ w _  = (w, Nothing)
--mvRadar x p w pt = undefined
--    ( putBlips w
--    , Just $ pt {_ptDraw = const pic ,_ptUpdate = mvRadar (x-1) p }
--    )
--  where 
--    pic = onLayerL [levLayer ShadowLayer, 1] $ pictures sweepPics
--    putBlips = over worldEvents ( over instantParticles (blips ++) . )
--    blips = map (\bp -> blipAt bp (withAlpha (0.5*globalAlpha) red) 50) circPoints
--    circPoints = mapMaybe (\wl -> uncurry collidePointCircCorrect (_wlLine wl) r p)
--        $ map (over wlLine swp) (IM.elems $ wallsAlongCirc p r w)
--                      ++ IM.elems (wallsAlongCirc p r w)
--    swp (a,b) = (b,a)
--    r = fromIntegral (800 - x*16)
--    sweepPics = [--colHelper 0.1 $ uncurry translate p $ thickCircle r 15
--                 --,colHelper 0.06 $ uncurry translate p $ thickCircle (r-5) 5
--                 --,colHelper 0.03 $ uncurry translate p $ thickCircle (r-10) 5
--                ]
--    globalAlpha | x > 10 = 1
--                | otherwise = fromIntegral x / 10
--    --colHelper y = color (withAlpha (y * globalAlpha) red)
+--mvRadar _ _ w _  = (w, Nothing)
+mvRadar x p w pt =
+    ( putBlips w
+    , Just $ pt {_ptDraw = const pic ,_ptUpdate = mvRadar (x-1) p }
+    )
+  where 
+    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))
+        $ 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
+                ,colHelper 0.03 $ uncurryV translate p $ thickCircle (r-10) 5
+                ]
+    globalAlpha | x > 10 = 1
+                | otherwise = fromIntegral x / 10
+    colHelper y = color (withAlpha (y * globalAlpha) red)