From bc5ad33652aed5b06328603eae39d2e2d64c0cf8 Mon Sep 17 00:00:00 2001 From: jgk Date: Wed, 24 Mar 2021 22:42:43 +0100 Subject: [PATCH] Refactor and improve flamelets --- src/Dodge/CreatureState.hs | 13 ++-- src/Dodge/Item/Weapon.hs | 11 +-- src/Dodge/Item/Weapon/Bullet.hs | 4 +- src/Dodge/WorldEvent.hs | 134 +++++++++++++++----------------- 4 files changed, 76 insertions(+), 86 deletions(-) diff --git a/src/Dodge/CreatureState.hs b/src/Dodge/CreatureState.hs index 8b07f9bab..7752e01ad 100644 --- a/src/Dodge/CreatureState.hs +++ b/src/Dodge/CreatureState.hs @@ -94,18 +94,17 @@ reducePastDamage = over (crState . crPastDamage) rdpdam | x > 0 = x - 1 | otherwise = 0 - - movementSideEff :: Creature -> World -> World movementSideEff cr w | hasJetPack = case cr ^? crState . stance . carriage of Just (Boosting v) - -> makeFlamelet (oldPos +.+ (_crRad cr + 3) *.* (unitVectorAtAngle $ _crDir cr + pi)) - (momentum +.+ 1 *.* rotateV randDir (vInverse v)) - 66 - Nothing - 1 + -> makeFlameletTimed + (oldPos +.+ (_crRad cr + 3) *.* (unitVectorAtAngle $ _crDir cr + pi)) + (momentum +.+ 1 *.* rotateV randDir (vInverse v)) + Nothing + 1 + 20 $ set randGen g w _ -> w diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index f28347858..76d2eb03b 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -130,7 +130,7 @@ autoFireMode = shootWithSound (fromIntegral autoGunSound) . withRandomDir (autogunSpread/2) . withMuzFlare . withVelWthHiteff (50,0) 3 - $ destroyOnImpact bulHitCr' bulHitWall' bulHitFF' + $ destroyOnImpact bulIncCr' bulIncWall' bulHitFF' singleFireMode = shootWithSound (fromIntegral autoGunSound) . withRecoil 40 . torqueAfter 0.03 @@ -139,6 +139,7 @@ singleFireMode = shootWithSound (fromIntegral autoGunSound) . withVelWthHiteff (50,0) 3 $ destroyOnImpact bulHitCr' bulHitWall' bulHitFF' + incMode :: Int -> World -> World incMode _ w = case newMode of @@ -754,9 +755,7 @@ moveShell time i cid rot accel w $ over (projectiles . ix i . ptVel) (\v -> accel +.+ frict *.* v) $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250 $ makeFlameletTimed oldPos - (0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20 - $ makeFlameletTimed (0.5 *.* (newPos +.+ oldPos)) - (0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20 + (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 $ smokeGen w | time > -200 = case thingHit of @@ -1394,9 +1393,7 @@ moveRemoteShell time i cid itid dir w $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250 $ smokeGen $ makeFlameletTimed oldPos - (0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20 - $ makeFlameletTimed (0.5 *.* (newPos +.+ oldPos)) - (0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20 + (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 $ setScope w | time > -200 = case thingHit of diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index d50e42400..c26b9c05e 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -106,7 +106,7 @@ bulIncCr' bt p cr w sp = head $ _btTrail' bt ep = sp +.+ _btVel' bt v = evalState (randInCirc 1) $ _randGen w - incFlamelets = over worldEvents $ (.) (makeFlamelet p v (levLayer UPtLayer) Nothing 3) + incFlamelets = over worldEvents $ (.) (makeFlameletTimed p v Nothing 3 20) bulConCr' :: Particle' -> Point2 -> Creature -> World -> World bulConCr' bt p cr w @@ -175,7 +175,7 @@ bulIncWall' bt p wl w = damageBlocks wl _ -> w wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0) reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt) - incFlamelets = over worldEvents $ (.) (makeFlamelet pOut reflectVel (levLayer UPtLayer) Nothing 3) + incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20) bulConWall' :: Particle' -> Point2 -> Wall -> World -> World bulConWall' bt p wl w = damageBlocks wl diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index 777ae5da9..b278aa1c6 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -48,7 +48,7 @@ makeExplosionAt p w = soundOnce grenadeBang fVs' = zipWith (+.+) fVs $ map inversePushOut fPs' sizes = randomRs (2,6) $ _randGen w times = randomRs (20,25) $ _randGen w - mF q v size time = makeFlameletTimed q v (levLayer GloomLayer - 1) Nothing size time + mF q v size time = makeFlameletTimed q v Nothing size time newFs = zipWith4 mF fPs (fmap (3 *.*) fVs') sizes times addFlames w = foldr ($) w newFs pushAgainstWalls q = fromMaybe q $ fmap (\(x,y)-> x +.+ y) @@ -219,79 +219,73 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents noEff _ _ _ = id -makeFlameletTimed :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> Int -> World -> World -makeFlameletTimed pos vel levelInt maycid size time w +makeFlameletTimed :: Point2 -> Point2 -> Maybe Int -> Float -> Int -> World -> World +makeFlameletTimed pos vel maycid size time w = set randGen g $ over particles' ((:) theFlamelet) w --- $ flareAt' white 0.01 0.1 pos w where theFlamelet = - Pt' { _ptDraw = const blank - , _ptUpdate' = moveFlamelet levelInt rot - , _btVel' = vel - , _btColor' = red - , _btPos' = pos - , _btPassThrough' = maycid - , _btWidth' = size - , _btTimer' = time - , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff - } + Pt' { _ptDraw = drawFlamelet rot + , _ptUpdate' = moveFlamelet + , _btVel' = vel + , _btColor' = red + , _btPos' = pos + , _btPassThrough' = maycid + , _btWidth' = size + , _btTimer' = time + , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff + } (rot ,g) = randomR (0,3) $ _randGen w -makeFlamelet :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> World -> World -makeFlamelet pos vel levelInt maycid size w = set randGen g $ over particles' ((:) theFlamelet) w - where theFlamelet = - Pt' { _ptDraw = const blank - , _ptUpdate' = moveFlamelet levelInt rot - , _btVel' = vel - , _btColor' = red - , _btPos' = pos - , _btPassThrough' = maycid - , _btWidth' = size - , _btTimer' = 20 - , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff - } - (rot ,g) = randomR (0.5,1.5) $ _randGen w -moveFlamelet :: Int -> Float -> World -> Particle' -> (World, Maybe Particle') -moveFlamelet levelInt rot w pt = - case _btTimer' pt of - time | time <= 0 -> (w, Nothing) - | otherwise -> (damcrs, mvPt) - where sp = _btPos' pt - vel = _btVel' pt - ep = sp +.+ vel - size = _btWidth' pt - siz2 = size + 0.2 - mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep, _ptDraw = const thepicture - , _btPassThrough' = Nothing - ,_btVel' = 0.8 *.* vel} - damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w - closeCrs cr = dist ep (_crPos cr) < _crRad cr + size - dodam cr = over (creatures . ix (_crID cr) . crState . crDamage) - ((:) $ Flaming 3 sp ep ep) - pic = onLayerL [levelInt,3] $ uncurry translate ep - $ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) - white (dark red) - ) - $ rotate (0 - ( 0.1 * fromIntegral time + rot)) - $ scale sc sc - $ polygon [(-size,-size),(size,-size),(size,size),(-size,size)] - piu = onLayerL [levelInt,1] $ uncurry translate ep - $ color (dark red) $ rotate (0 - (rot - 0.1 * fromIntegral time)) - $ scale s1 s1 - $ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2) - glow = onLayerL [levelInt,0] $ uncurry translate ep - $ color (withAlpha 0.01 red) - $ circleSolid 30 - sc = (*) 2 $ log $ 1 + fromIntegral time / 20 - s1 = (*) 2 $ log $ 2 + fromIntegral time / 40 - s2 = 0.5 * (sc + s1) - thepicture = pictures [pic , piu , pi2 , glow] - pi2 = onLayerL [levelInt,2] $ uncurry translate ep - $ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) - orange (dark red) - ) - $ rotate (0 - (rot + 0.2 * fromIntegral time)) - $ scale s2 s2 - $ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2) +drawFlamelet :: Float -> Particle' -> Picture +drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow] + where + sp = _btPos' pt + vel = _btVel' pt + ep = sp +.+ vel + size = _btWidth' pt + siz2 = size + 0.2 + time = _btTimer' pt + glow = setDepth 0.336 $ uncurry translate ep + $ circleSolidCol (withAlpha 0 red) (withAlpha 0.05 red) 30 + piu = setDepth 0.334 $ uncurry translate ep + $ color (dark red) $ rotate (0 - (rot - 0.1 * fromIntegral time)) + $ scale s1 s1 + $ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2) + pi2 = setDepth 0.332 $ uncurry translate ep + $ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) + orange (dark red) + ) + $ rotate (0 - (rot + 0.2 * fromIntegral time)) + $ scale s2 s2 + $ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2) + pic = setDepth 0.33 $ uncurry translate ep + $ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) + white (dark red) + ) + $ rotate (0 - ( 0.1 * fromIntegral time + rot)) + $ scale sc sc + $ polygon [(-size,-size),(size,-size),(size,size),(-size,size)] + sc = (*) 2 $ log $ 1 + fromIntegral time / 20 + s1 = (*) 2 $ log $ 2 + fromIntegral time / 40 + s2 = 0.5 * (sc + s1) + thepicture = pictures [pic , piu , pi2 , glow] + +moveFlamelet :: World -> Particle' -> (World, Maybe Particle') +moveFlamelet w pt + | _btTimer' pt <= 0 = ( w, Nothing) + | otherwise = (damcrs, mvPt) + where + sp = _btPos' pt + vel = _btVel' pt + ep = sp +.+ vel + size = _btWidth' pt + mvPt = Just $ pt & btTimer' -~ 1 + & btPos' .~ ep + & btPassThrough' .~ Nothing + & btVel' .~ 0.8 *.* vel + damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w + closeCrs cr = dist ep (_crPos cr) < _crRad cr + size + dodam cr = over (creatures . ix (_crID cr) . crState . crDamage) + ((:) $ Flaming 3 sp ep ep) doFlameDam :: Int -> Particle' -> Point2 -> Creature -> World -> World