Fix bug in flame wall damages, cleanup

src/Dodge/Flame.hs

@@ -1,166 +1,62 @@
 module Dodge.Flame (
-    aFlameParticle,
     makeFlame,
     updateFlame,
 ) where
 
-import Dodge.Flame.Size
 import Data.Foldable
-import Data.Tuple
+import Dodge.Base.Wall
 import Dodge.Data.World
+import Dodge.Flame.Size
 import Dodge.SoundLogic
 import Dodge.WorldEvent.Cloud
 import Dodge.WorldEvent.ThingsHit
-import Dodge.Zoning.Wall
 import Geometry
-import qualified IntMapHelp as IM
 import LensHelp
 import qualified ListHelp as List
 import Picture
 import RandomHelp
 
-aFlameParticle ::
-    -- | Timer
-    Int ->
-    -- | Position
-    Point2 ->
-    -- | Velocity
-    Point2 ->
-    Flame
-aFlameParticle t pos vel =
-    Flame
-        { _flVel = vel
-        , _flPos = pos
-        , _flTimer = t
---        , _flOriginalVel = vel
-        }
-
-expireAndDamageFL ::
-    Flame ->
-    [(Point2, Either Creature Wall)] ->
-    World ->
-    (World, Maybe Flame)
-expireAndDamageFL bt things w = case List.safeHead things of
-    Nothing -> (w, Just $ bt & flTimer -~ 1)
-    Just (_,x) -> (doDamagesFL x w, Nothing)
-
-doDamagesFL ::
-    Either Creature Wall ->
---    Flame ->
-    World ->
-    World
-doDamagesFL thhit = case thhit of
-    Left cr ->
-        cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage
-            .:~ Flaming 1
-    --Right wl -> cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
-    Right wl -> cWorld . lWorld . wallDamages . ix (_wlID wl) .:~ Flaming 1
-
-{- TODO: add generalised area damage particles/hiteffects.  -}
 updateFlame :: World -> Flame -> (World, Maybe Flame)
 updateFlame w pt
     | time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing)
-    | otherwise = case List.safeHead $ thingsHit sp ep w of
-        Just (_, Left _) -> (doSound $ dodamage, mvPt' 0.7)
-        Just (p, Right wl) -> (doSound $ dodamage, rfl wl p)
-        _ -> (flFlicker pt $ doSound $ dodamage, mvPt' 0.98)
+    | Just (_, Right wl) <- thit = (doupdate, Just $ reflame wl)
+    -- might want to move differently if we hit a creature?
+    | otherwise = (flFlicker pt doupdate, Just mvflame)
   where
+    reflame wl = pt & flTimer -~ 1 & flVel %~ reflVelWallDamp 0.9 wl
+    doupdate = soundContinue FlameSound sp fireLoudS (Just 2) dodamage
+    thit = List.safeHead $ thingsHit sp ep w
     time = _flTimer pt
-    doSound = soundContinue FlameSound (V2 x y) fireLoudS (Just 2)
-    sp@(V2 x y) = _flPos pt
-    vel = _flVel pt
-    ep = sp +.+ vel
-    mvPt' drag =
-        Just $
-            pt
-                & flTimer -~ 1
-                & flPos .~ ep
-                & flVel %~ (drag *.*)
-    dodamage :: World
-    dodamage = foldl' damcr
-        (foldl' damwl w (wlsHitRadial ep r w)) (crsHitRadial ep r w)
-    r = flameSize pt
-    damcr w' (_,cr) = w' & cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage 
-        .:~ Flaming 1
-    damwl w' (_,wl) = w' & cWorld . lWorld . wallDamages . ix (_wlID wl)
-        .:~ Flaming 1
-    closeWls wl = uncurry segOnCirc (_wlLine wl) ep 5
-    angleCoeff x' = abs $ 1 - abs ((x' * 2 - pi) / pi)
-    rfl wl p =
-        Just $
-            pt
-                { _flTimer = time - 1
-                , _flPos = pOut p
-                , _flVel = reflV wl
-                }
-    pOut p = p +.+ squashNormalizeV (sp -.- p)
-    reflV wall =
-        (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel)
-            +.+ (0.2 *.* vel)
---updateFlame w pt
---    | time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing)
---    | otherwise = case List.safeHead $ thingsHit sp ep w of
---        Just (_, Left _) -> (doSound $ dodamage w, mvPt' 0.7)
---        Just (p, Right wl) -> (doSound $ dodamage w, rfl wl p)
---        _ -> (flFlicker pt $ doSound $ dodamage w, mvPt' 0.98)
---  where
---    rotd = _flOriginalVel pt
---    time = _flTimer pt
---    doSound = soundContinue FlameSound (V2 x y) fireLoudS (Just 2)
---    sp@(V2 x y) = _flPos pt
---    vel = _flVel pt
---    ep = sp +.+ vel
---    mvPt' drag =
---        Just $
---            pt
---                & flTimer -~ 1
---                & flPos .~ ep
---                & flVel %~ (drag *.*)
---    dodamage = flDamageInArea closeCrs closeWls pt
---    closeWls wl = uncurry segOnCirc (_wlLine wl) ep 5
---    closeCrs cr =
---        dist ep (_crPos cr)
---            < crRad (cr ^. crType) + 10 - min 9 (max 0 (fromIntegral time - 80))
---                + 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd)
---    angleCoeff x' = abs $ 1 - abs ((x' * 2 - pi) / pi)
---    rfl wl p =
---        Just $
---            pt
---                { _flTimer = time - 1
---                , _flPos = pOut p
---                , _flVel = reflV wl
---                }
---    pOut p = p +.+ squashNormalizeV (sp -.- p)
---    reflV wall =
---        (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel)
---            +.+ (0.2 *.* vel)
-
-flDamageInArea :: (Creature -> Bool) -> (Wall -> Bool) -> Flame -> World -> World
-{-# INLINE flDamageInArea #-}
-flDamageInArea crt wlt pt w = damwls damcrs
-  where
-    p = _flPos pt
-    damcrs = foldl' (flip $ \cr -> fst . hiteff [(p, Left cr)]) w $ IM.filter crt $ w ^. cWorld . lWorld . creatures --_creatures (_cWorld w)
-    damwls w' =
+    sp = _flPos pt
+    ep = sp +.+ _flVel pt
+    mvflame =
+        pt
+            & flTimer -~ 1
+            & flPos .~ ep
+            & flVel *~ 0.98
+    dodamage =
         foldl'
-            (flip $ \wl -> fst . hiteff [(p, Right wl)])
-            w'
-            . filter wlt
-            $ wlsNearPoint p w'
-    hiteff = expireAndDamageFL pt
+            damcr
+            (foldl' damwl w (wlsHitRadial ep r w))
+            (crsHitRadial ep r w)
+    r = flameSize pt
+    damcr w' (_, cr) =
+        w' & cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage
+            .:~ Flaming 1
+    damwl w' (_, wl) =
+        w' & cWorld . lWorld . wallDamages . at (_wlID wl)
+            . non [] <>~ [Flaming 1]
 
 flFlicker :: Flame -> World -> World
 flFlicker pt
     | _flTimer pt `mod` 7 == 0 =
         cWorld . lWorld . lights
             .:~ LSParam (addZ 10 $ _flPos pt) 70 (0.5 *.*.* xyzV4 red)
-    --            .:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_flColor pt)) (addZ 10 $ _flPos pt)
     | otherwise = id
 
 makeFlame :: Point2 -> Point2 -> World -> World
-makeFlame pos vel w =
-    w
-        & cWorld . lWorld . flames .:~ aFlameParticle t pos vel
+makeFlame pos vel w = w
+        & cWorld . lWorld . flames .:~ Flame t pos vel
         & randGen .~ g
   where
-    (t, g) = randomR (99, 101) (_randGen w)
+    (t, g) = randomR (99, 102) (_randGen w)