Simplify flames

src/Dodge/Data/Flame.hs

@@ -13,10 +13,8 @@ import Geometry.Data
 data Flame = Flame
     { _flVel :: Point2
     , _flPos :: Point2
-    , _flWidth :: Float
     , _flTimer :: Int
-    , _flZ :: Float
-    , _flOriginalVel :: Point2
+--    , _flOriginalVel :: Point2
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/Flame.hs

@@ -4,9 +4,9 @@ module Dodge.Flame (
     updateFlame,
 ) where
 
+import Dodge.Flame.Size
 import Data.Foldable
 import Data.Tuple
-import Dodge.Creature.Radius
 import Dodge.Data.World
 import Dodge.SoundLogic
 import Dodge.WorldEvent.Cloud
@@ -31,10 +31,8 @@ aFlameParticle t pos vel =
     Flame
         { _flVel = vel
         , _flPos = pos
-        , _flWidth = 4
         , _flTimer = t
-        , _flZ = 20
-        , _flOriginalVel = vel
+--        , _flOriginalVel = vel
         }
 
 expireAndDamageFL ::
@@ -63,11 +61,10 @@ 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 w, mvPt' 0.7)
-        Just (p, Right wl) -> (doSound $ dodamage w, rfl wl p)
-        _ -> (flFlicker pt $ doSound $ dodamage w, mvPt' 0.98)
+        Just (_, Left _) -> (doSound $ dodamage, mvPt' 0.7)
+        Just (p, Right wl) -> (doSound $ dodamage, rfl wl p)
+        _ -> (flFlicker pt $ doSound $ dodamage, 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
@@ -79,12 +76,15 @@ updateFlame w pt
                 & flTimer -~ 1
                 & flPos .~ ep
                 & flVel %~ (drag *.*)
-    dodamage = flDamageInArea closeCrs closeWls pt
+    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
-    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 $
@@ -97,6 +97,43 @@ updateFlame w pt
     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 #-}

src/Dodge/Flame/Draw.hs

@@ -1,40 +1,46 @@
-module Dodge.Flame.Draw where
+module Dodge.Flame.Draw (drawFlame) where
 
+import Dodge.Flame.Size
 import Dodge.Data.Flame
 import Geometry
 import Picture
 
-drawFlame ::
-    Flame ->
-    Picture
-drawFlame pt =
-    fold
-        [ glow
-        , aPic BloomNoZWrite prot2 25 (V2 (scaleChange + 1) 2) $ V4 2 (-1) (-1) 0.5
-        , aPic BloomNoZWrite prot 22 (V2 (scaleChange + 0.5) 1) $ V4 1 0.5 0 2
-        , aPic BloomLayer prot3 20 (V2 scaleChange 0.5) $ V4 1 1 1 1
-        ]
-  where
-    rotd = _flOriginalVel pt -- rotate direction
-    ep = _flPos pt
-    aPic :: Layer -> (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
-    aPic lay offset depth (V2 scalex scaley) col =
-        setLayer lay
-            . setDepth depth
-            . uncurryV translate (offset ep)
-            . rotate (pi * 0.5 + argV rotd)
-            . scale scalex scaley
-            . color col
-            $ circleSolid 5
-    glow =
-        setLayer BloomNoZWrite $
-            setDepth 0.3 $
-                uncurryV translate ep $
-                    circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50
-    time = _flTimer pt
-    scaleChange
-        | time < 80 = 3
-        | otherwise = 3 - (fromIntegral time - 80) * 0.2
-    prot p' = p' +.+ rotateV (fromIntegral time) (V2 0 1)
-    prot2 p' = p' +.+ rotateV (negate $ fromIntegral time) (V2 0 1)
-    prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (V2 0 2)
+drawFlame :: Flame -> Picture
+drawFlame fl = setLayer BloomLayer . setDepth 25 
+    . uncurryV translate (_flPos fl + rotateV (fromIntegral (_flTimer fl)) (V2 1 0)) 
+    $ circleSolidCol (V4 1 1 1 0.5) (V4 5 2 0 2) . flameSize $ fl
+
+
+--drawFlame :: Flame -> Picture
+--drawFlame pt =
+--    fold
+--        [ glow
+--        , aPic BloomNoZWrite prot2 25 (V2 (scaleChange + 1) 2) $ V4 2 (-1) (-1) 0.5
+--        , aPic BloomNoZWrite prot 22 (V2 (scaleChange + 0.5) 1) $ V4 1 0.5 0 2
+--        , aPic BloomLayer prot3 20 (V2 scaleChange 0.5) $ V4 1 1 1 1
+--        ]
+--  where
+--    rotd = _flOriginalVel pt -- rotate direction
+--    ep = _flPos pt
+--    aPic :: Layer -> (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
+--    aPic lay offset depth (V2 scalex scaley) col =
+--        setLayer lay
+--            . setDepth depth
+--            . uncurryV translate (offset ep)
+--            . rotate (pi * 0.5 + argV rotd)
+--            . scale scalex scaley
+----            . scale scalex scalex
+--            . color col
+--            $ circleSolid 5
+--    glow =
+--        setLayer BloomNoZWrite $
+--            setDepth 0.3 $
+--                uncurryV translate ep $
+--                    circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50
+--    time = _flTimer pt
+--    scaleChange
+--        | time < 80 = 3
+--        | otherwise = 3 - (fromIntegral time - 80) * 0.2
+--    prot p' = p' +.+ rotateV (fromIntegral time) (V2 0 1)
+--    prot2 p' = p' +.+ rotateV (negate $ fromIntegral time) (V2 0 1)
+--    prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (V2 0 2)