Unify and cleanup radars

2022-05-27 11:35:26 +01:00
parent 3234d6b86d
commit 60fc2d44e8
6 changed files with 88 additions and 78 deletions
@@ -185,6 +185,12 @@ inventoryB = IM.fromList $ zip [0..]
    , makeTypeCraftNum 2 PIPE
    , makeTypeCraftNum 1 CREATURESENSOR
    ]
+inventoryC :: IM.IntMap Item
+inventoryC = IM.fromList $ zip [0..] 
+    [ autoRadar
+    , autoSonar
+    , itemFinder
+    ]

 testInventory :: IM.IntMap Item
 testInventory = IM.fromList $ zip [0..] 
@@ -605,9 +605,16 @@ data BeamType
 Update themselves, perhaps with side effects.  -}
 data Particle
    = Particle
-        { _ptDraw :: Particle -> Picture
+        { _ptDraw   :: Particle -> Picture
        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
        }
+    | RadarCircleParticle
+        { _ptDraw   :: Particle -> Picture
+        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
+        , _ptTimer  :: Int
+        , _ptRad    :: Float
+        , _ptPos    :: Point2
+        }
    | LaserParticle
        { _ptDraw   :: Particle -> Picture
        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
@@ -25,6 +25,8 @@ applyTerminalString "LA" = (uvWorld . creatures . ix 0 . crInv .~ inventoryA)
    . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
 applyTerminalString "LB" = (uvWorld . creatures . ix 0 . crInv .~ inventoryB)
    . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
+applyTerminalString "LC" = (uvWorld . creatures . ix 0 . crInv .~ inventoryC)
+    . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
 applyTerminalString "GODON"  = uvWorld . creatures . ix 0 . crApplyDamage .~ applyNoDamage
 applyTerminalString "GODOFF" = uvWorld . creatures . ix 0 . crApplyDamage .~ defaultApplyDamage
 applyTerminalString "LOADTEST" = (uvWorld . creatures . ix 0 . crInv .~ testInventory)
@@ -46,7 +46,7 @@ autoEffect eff t sid itm cr w

 {- | Automatically send out radar pulses that detect walls.  -}
 autoRadarEffect :: Item -> Creature -> World -> World
-autoRadarEffect = autoEffect aRadarPulse 100 click1S
+autoRadarEffect = autoEffect aWallPulse 100 click1S
 {- | Automatically send out sonar pulses that detect creatures.  -}
 autoSonarEffect :: Item -> Creature -> World -> World
 autoSonarEffect = autoEffect aSonarPulse 50 click1S
@@ -29,7 +29,7 @@ radar = defaultGun
        , _ammoLoaded = 100
        , _reloadTime = 200
        }
-    , _itUse = ruseRate 120 (const aRadarPulse) upHammer
+    , _itUse = ruseRate 120 (const aWallPulse) upHammer
        [ ammoUseCheck
        ]
        & useAim . aimRange .~ 1
@@ -1,7 +1,11 @@
 {- |
 Effects centered on creatures.
 These are typically item effects, and typical occur when an item is explictly used.  -}
-module Dodge.Item.Weapon.UseEffect where
+module Dodge.Item.Weapon.UseEffect 
+    ( anItemFindPulse
+    , aWallPulse
+    , aSonarPulse
+    ) where
 import Dodge.Data
 import Dodge.Zone
 import Picture
@@ -12,102 +16,88 @@ 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)
-{- | Creates an outwardly increasing circle that displays walls, even those behind other walls.  -}
-aRadarPulse :: Creature -> World -> World
-aRadarPulse cr = instantParticles .:~ radarPulseAt (_crPos cr)
+--aSonarPulse cr = instantParticles .:~ sonarPulseAt (_crPos cr)
+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 cr = instantParticles .:~ itemFindPulseAt (_crPos cr)
-{- | Radar blip at a point.  -}
-blipAt :: Point2 -> Color -> Int -> Particle
-blipAt p col i = Particle
-    {_ptDraw = const blank
-    ,_ptUpdate = mvBlip p col i i
+anItemFindPulse = aRadarPulse itemBlips (blipAt 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
+    -> Creature 
+    -> World -> World
+aRadarPulse blipsF bf col cr = instantParticles .:~ RadarCircleParticle
+    { _ptDraw   = drawPulse col
+    , _ptUpdate = mvRadar blipsF bf col (_crPos cr)
+    , _ptTimer  = 100
+    , _ptRad    = 0
+    , _ptPos    = (_crPos cr)
    }
-mvBlip :: Point2 -> Color 
+drawPulse :: Color -> Particle -> Picture
+drawPulse col pt = setLayer DebugLayer $ pictures sweepPics
+  where
+    p = _ptPos pt
+    r = _ptRad pt
+    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
+                ]
+    colHelper y = color (withAlpha (y * globalAlpha) col)
+    globalAlpha | x > 10 = 1
+                | otherwise = fromIntegral x / 10
+    x = _ptTimer pt
+{- | Radar blip at a point.  -}
+blipAt :: Float -> Point2 -> Color -> Int -> Particle
+blipAt r p col i = Particle
+    {_ptDraw = const blank
+    ,_ptUpdate = mvBlip r p col i i
+    }
+mvBlip :: Float
+    -> Point2 -> Color 
    -> Int  -- ^ Max possible timer value
    -> Int  -- ^ Current timer value
    -> World -> Particle -> (World, Maybe Particle)
-mvBlip _ _   _    0 w _ = (w, Nothing)
-mvBlip p col maxt t w pt = 
+mvBlip _ _ _   _    0 w _ = (w, Nothing)
+mvBlip r p col maxt t w pt = 
    (w
-    , Just $ pt & ptUpdate .~ mvBlip p col maxt (t-1)
+    , Just $ pt & ptUpdate .~ mvBlip r p col maxt (t-1)
        & ptDraw .~ ( const 
            . setDepth (-0.5)
            . setLayer DebugLayer
            . uncurryV translate p 
            . color (withAlpha (fromIntegral t / fromIntegral maxt) col)
-            $ circleSolid 2 )
+            $ circleSolid r )
    )
-{- | An outwardly increasing circle that draws creatures, even those behind walls.  -}
-sonarPulseAt :: Point2 -> Particle
-sonarPulseAt p = Particle { _ptDraw = const blank , _ptUpdate = mvSonar 100 p }

-mvSonar 
-    :: Int      -- ^ Timer
-    -> Point2   -- ^ Center of expanding circle
-    -> World -> Particle -> (World, Maybe Particle)
-mvSonar 0 _ w _  = (w, Nothing)
-mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic
-                              ,_ptUpdate = mvSonar (x-1) p
-                              }
-                   )
-  where 
-    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))
-                         $ uncurryV translate cpos $ circleSolid crad
-              | otherwise = Nothing
-          where crad = _crRad cr
-                cpos = _crPos cr
-    r = fromIntegral (500 - x*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
-    , _ptUpdate = mvRadar 100 p
-    }
 mvRadar 
-    :: Int      -- ^ Timer
+    :: (Point2 -> Float -> World -> [Point2])
+    -> (Point2 -> Color -> Int -> Particle)
+    -> Color
    -> Point2   -- ^ Center of expanding circle
    -> World -> Particle -> (World, Maybe Particle)
-mvRadar 0 _ w _  = (w, Nothing)
--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
+mvRadar blipsF bf col p w pt
+    | x < 1 = (w, Nothing)
+    | otherwise =
+        ( putBlips w
+        , Just $ pt & ptRad .~ r & ptTimer .~ (x-1)
+        )
+  where
+    x = _ptTimer pt
    putBlips = over worldEvents ( over instantParticles (blips ++) . )
-    blips = map (\bp -> blipAt bp (withAlpha (0.5*globalAlpha) red) 50) circPoints
-    circPoints = wallBlips p r w
+    blips = map (\bp -> bf bp (withAlpha (0.5*globalAlpha) col) 50) circPoints
+    circPoints = blipsF p r w
    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)

-itemBlips :: Point2 -> Float -> World -> IM.IntMap Point2
-itemBlips p r = IM.filter f . fmap _flItPos . _floorItems
+itemBlips :: Point2 -> Float -> World -> [Point2]
+itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems
  where
    f q = dist p q <= r && dist p q > r - 4

@@ -117,3 +107,8 @@ wallBlips p r w = mapMaybe (\wl -> uncurry (intersectCircSegFirst p r) (_wlLine
                      ++ 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
+  where
+    f q = dist p q <= r && dist p q > r - 4