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