This commit is contained in:
2022-07-19 14:26:10 +01:00
parent 0a7922ec5e
commit 8ee4d2e0f2
6 changed files with 68 additions and 78 deletions
-10
View File
@@ -562,16 +562,6 @@ data Particle
, _ptPoints :: [Point2]
, _ptColor :: Color
}
| PtStaticBall
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptVel :: Point2
, _ptColor :: Color
, _ptPos :: Point2
, _ptWidth :: Float
, _ptTimer :: Int
, _ptHitEff :: HitEffect
, _ptZ :: Float
}
| Shockwave
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptColor :: Color
+14 -3
View File
@@ -5,10 +5,21 @@ import Picture
drawEnergyBall :: EnergyBall -> Picture
drawEnergyBall = drawFlameletEB
drawEnergyBall eb = case _ebEff eb of
(ELECTRICAL,_) -> drawStaticBall eb
(FLAMING,_) -> drawFlamelet eb
_ -> error "don't know how to draw an energy ball of this type"
drawFlameletEB :: EnergyBall -> Picture
drawFlameletEB pt = pictures
drawStaticBall
:: EnergyBall
-> Picture
drawStaticBall pt = setLayer BloomNoZWrite
. setDepth (_ebZ pt + 20)
. uncurryV translate (_ebPos pt)
$ circleSolidCol (_ebColor pt) (withAlpha 0.5 white) (_ebWidth pt+5)
drawFlamelet :: EnergyBall -> Picture
drawFlamelet pt = pictures
[ setLayer BloomLayer pic
, setLayer BloomNoZWrite piu
, setLayer BloomNoZWrite pi2
+6 -6
View File
@@ -2,12 +2,12 @@ module Dodge.Particle.Damage where
import Dodge.Data
import Geometry
simpleDam :: DamageType -> Int -> Particle -> Point2 -> [Damage]
simpleDam dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
where
sp = _ptPos bt
bulVel = _ptVel bt
ep = sp +.+ bulVel
--simpleDam :: DamageType -> Int -> Particle -> Point2 -> [Damage]
--simpleDam dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
-- where
-- sp = _ptPos bt
-- bulVel = _ptVel bt
-- ep = sp +.+ bulVel
simpleDam' :: DamageType -> Int -> Bullet -> Point2 -> [Damage]
simpleDam' dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
where
-10
View File
@@ -6,7 +6,6 @@ import Picture
drawParticle :: Particle -> Picture
drawParticle pt = case pt of
Shockwave {} -> drawShockwave pt
PtStaticBall {} -> drawStaticBall pt
PtInvShockwave {} -> drawInverseShockwave pt
PtTeslaArc {} -> drawTeslaArc pt
PtTargetLaser {} -> drawTargetLaser pt
@@ -27,15 +26,6 @@ drawShockwave pt = setDepth 20
rad = r - (3/4) * r * tFraction
tFraction = fromIntegral (_ptTimer pt) / fromIntegral (_ptMaxTime pt)
drawStaticBall
:: Particle
-> Picture
drawStaticBall pt = setLayer BloomNoZWrite
. setDepth (_ptZ pt + 20)
. uncurryV translate (_ptPos pt)
$ circleSolidCol (_ptColor pt) (withAlpha 0.5 white) (_ptWidth pt+5)
drawInverseShockwave :: Particle -> Picture
drawInverseShockwave pt
= setLayer BloomLayer $ setDepth 20 $ uncurryV translate p
+2 -1
View File
@@ -12,6 +12,7 @@ import Geometry
import LensHelp
import Color
import qualified Data.IntMap.Strict as IM
import Control.Monad.State
import System.Random
@@ -35,7 +36,7 @@ sparkDam
-> World
sparkDam sk sp ep mayEiCrWl = case mayEiCrWl of
(hitp,Left cr) -> creatures . ix (_crID cr) . crState . csDamage .:~ thedam hitp
(hitp,Right wl) -> wallDamages . ix (_wlID wl) .:~ thedam hitp
(hitp,Right wl) -> wallDamages %~ IM.insertWith (++) (_wlID wl) [thedam hitp]
where
thedam hitp = Damage (_skDamageType sk) 1 sp hitp ep NoDamageEffect
+46 -48
View File
@@ -6,29 +6,27 @@ module Dodge.WorldEvent.SpawnParticle
, randParticleAt
) where
import Dodge.Data
import Dodge.Zone
import Dodge.Particle.HitEffect.ExpireAndDamage
import Dodge.Particle.Damage
import Dodge.WorldEvent.Flash
import Dodge.WorldEvent.Shockwave
import RandomHelp
import Picture
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Data.Foldable
import qualified Streaming.Prelude as S
randParticleAt :: (Point2 -> State StdGen Particle) -> Point2 -> World -> World
randParticleAt f p w = w
& instantParticles .:~ thepart
& randGen .~ g
where
(thepart,g) = runState (f p) (_randGen w)
randEnergyBallAt :: (Point2 -> State StdGen EnergyBall) -> Point2 -> World -> World
randEnergyBallAt f p w = w
& energyBalls .:~ thepart
& randGen .~ g
where
(thepart,g) = runState (f p) (_randGen w)
makeStaticBall :: Point2 -> World -> World
makeStaticBall p = randParticleAt aStaticBall p . (posEvents .:~ thesparker)
makeStaticBall p = randEnergyBallAt aStaticBall p . (posEvents .:~ thesparker)
where
thesparker = PosEvent SparkSpawner 10 p
@@ -44,40 +42,40 @@ concBall p = return Shockwave
, _ptTimer = 10
}
aStaticBall :: Point2 -> State g Particle
aStaticBall p = return PtStaticBall
{ _ptUpdate = moveFlamelet
, _ptVel = 0
, _ptColor = blue
, _ptPos = p
, _ptWidth = 3
, _ptTimer = 20
, _ptHitEff = expireAndDamage $ simpleDam ELECTRICAL 20
, _ptZ = 20
aStaticBall :: Point2 -> State g EnergyBall
aStaticBall p = return EnergyBall
{ _ebVel = 0
, _ebColor = blue
, _ebPos = p
, _ebWidth = 3
, _ebTimer = 20
, _ebEff = (ELECTRICAL,1)
, _ebZ = 20
, _ebRot = 0
}
-- | Note damgeInRadius by itself never destroys the particle
damageInRadius :: Float -> Particle -> World -> World
damageInRadius size pt = damageInArea isClose closeWls pt
where
p = _ptPos pt
closeWls wl = uncurry segOnCirc (_wlLine wl) p size
isClose cr = dist p (_crPos cr) < _crRad cr + size
--damageInRadius :: Float -> Particle -> World -> World
--damageInRadius size pt = damageInArea isClose closeWls pt
-- where
-- p = _ptPos pt
-- closeWls wl = uncurry segOnCirc (_wlLine wl) p size
-- isClose cr = dist p (_crPos cr) < _crRad cr + size
damageInArea :: (Creature -> Bool) -> (Wall -> Bool) -> Particle -> World -> World
{-# INLINE damageInArea #-}
damageInArea crt wlt pt w = damwls damcrs
where
p = _ptPos pt
damcrs = foldl' (flip $ \cr -> fst . hiteff (S.yield (p,Left cr))) w $ IM.filter crt $ _creatures w
damwls w' = runIdentity
. S.fold_
(flip $ \wl -> fst . hiteff (S.yield (p,Right wl)))
w'
id
. S.filter wlt
$ wlsNearPoint p w'
hiteff = _ptHitEff pt pt
--damageInArea :: (Creature -> Bool) -> (Wall -> Bool) -> Particle -> World -> World
--{-# INLINE damageInArea #-}
--damageInArea crt wlt pt w = damwls damcrs
-- where
-- p = _ptPos pt
-- damcrs = foldl' (flip $ \cr -> fst . hiteff (S.yield (p,Left cr))) w $ IM.filter crt $ _creatures w
-- damwls w' = runIdentity
-- . S.fold_
-- (flip $ \wl -> fst . hiteff (S.yield (p,Right wl)))
-- w'
-- id
-- . S.filter wlt
-- $ wlsNearPoint p w'
-- hiteff = _ptHitEff pt pt
-- | At writing the radius is half the size of the effect area
makeGasCloud
@@ -107,12 +105,12 @@ makeGasCloud pos vel w = w
{- Update of a flamelet.
Applies movement and attaches damage to nearby creatures. -}
-- This should be unified in many ways with moveFlame
moveFlamelet :: World -> Particle -> (World, Maybe Particle)
moveFlamelet w pt
| _ptTimer pt <= 0 = ( w, Nothing)
| otherwise = (ptFlicker pt $ damageInRadius 5 mvPt' w, Just mvPt')
where
mvPt' = pt
& ptTimer -~ 1
& ptPos .~ _ptPos pt +.+ _ptVel pt
& ptVel .*.*~ 0.8
--moveFlamelet :: World -> Particle -> (World, Maybe Particle)
--moveFlamelet w pt
-- | _ptTimer pt <= 0 = ( w, Nothing)
-- | otherwise = (ptFlicker pt $ damageInRadius 5 mvPt' w, Just mvPt')
-- where
-- mvPt' = pt
-- & ptTimer -~ 1
-- & ptPos .~ _ptPos pt +.+ _ptVel pt
-- & ptVel .*.*~ 0.8