Linting, refactor random angle walk for flamer

2021-04-30 13:21:37 +02:00
parent 619756dd73
commit c8e84c775f
14 changed files with 460 additions and 377 deletions
@@ -0,0 +1,110 @@
+{- |
+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.Base
+import Dodge.Item.Weapon.Decoration
+import Dodge.WorldEvent.Flash
+import Dodge.WorldEvent.ThingsHit
+import Picture
+import Geometry
+
+import Data.Maybe
+import Control.Lens
+import qualified Data.IntMap.Strict as IM
+{- |
+Creates an outwardly increasing circle that draws creatures, even those behind walls.  -}
+aSonarPulse :: Int -> World -> World
+aSonarPulse cid w = over particles ((:) $ sonarPulseAt (_crPos (_creatures w IM.! cid))) w
+
+{- |
+Creates an outwardly increasing circle that displays walls, even those behind other walls.  -}
+aRadarPulse :: Int -> World -> World
+aRadarPulse cid w = over particles ((:) $ radarPulseAt (_crPos (_creatures w IM.! cid))) w
+
+{- |
+Radar blip at a point.
+ -}
+blipAt :: Point2 -> Color -> Int -> Particle
+blipAt p col i = Particle
+    {_ptDraw = const blank
+    ,_ptUpdate' = mvBlip p col i i
+    }
+
+mvBlip :: Point2 -> Color 
+    -> Int  -- ^ Max possible timer value
+    -> Int  -- ^ Current timer value
+    -> World -> Particle -> (World, Maybe Particle)
+mvBlip p col maxt 0 w pt = (w, Nothing)
+mvBlip p col maxt t w pt 
+    = (w, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1)
+                    & ptDraw   .~ (const . setDepth (-0.5)
+                                    . setLayer 1
+                                    $ uncurry translate p 
+                                    $ color (withAlpha (fromIntegral t / fromIntegral maxt) col)
+                                    $ circleSolid 2)
+      )
+
+{- |
+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 = setDepth (-0.5) . setLayer 1 $ pictures crBlips
+    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))
+                         $ uncurry translate cpos $ circleSolid crad
+              | otherwise = Nothing
+          where crad = _crRad cr
+                cpos = _crPos cr
+    r = fromIntegral (500 - x*5)
+    sweepPics = [colHelper 0.05 $ uncurry 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.  -}
+radarPulseAt :: Point2 -> Particle
+radarPulseAt p = Particle
+    { _ptDraw = const blank
+    , _ptUpdate' = mvRadar 50 p
+    }
+
+mvRadar 
+    :: Int      -- ^ Timer
+    -> Point2   -- ^ Center of expanding circle
+    -> World -> Particle -> (World, Maybe Particle)
+mvRadar 0 _ w _  = (w, Nothing)
+mvRadar x p w pt = (putBlips w, Just $ pt {_ptDraw = const pic
+                              ,_ptUpdate' = mvRadar (x-1) p
+                              }
+                   )
+  where 
+    pic = onLayerL [levLayer ShadowLayer, 1] $ pictures $ sweepPics
+    putBlips = over worldEvents ((.) $ over particles ((++) blips))
+    blips = map (\p -> blipAt p (withAlpha (0.5*globalAlpha) red) 50) 
+                $ circPoints
+    circPoints = mapMaybe (\wl -> collidePointCircCorrect (_wlLine wl !! 0) (_wlLine wl !! 1) r p)
+                  $ (map (over wlLine reverse) $ IM.elems $ wallsAlongCirc p r w)
+                      ++ (IM.elems $ wallsAlongCirc p r w)
+    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)