118 lines
3.3 KiB
Haskell
118 lines
3.3 KiB
Haskell
-- | Creation of particles in the world.
|
|
module Dodge.WorldEvent.SpawnParticle (
|
|
makeGasCloud,
|
|
makeStaticBall,
|
|
concBall,
|
|
) where
|
|
|
|
import Dodge.Data.World
|
|
import Geometry
|
|
import LensHelp
|
|
import Picture
|
|
import RandomHelp
|
|
|
|
randEnergyBallAt :: (Point2 -> State StdGen EnergyBall) -> Point2 -> World -> World
|
|
randEnergyBallAt f p w =
|
|
w
|
|
& cWorld . lWorld . energyBalls .:~ thepart
|
|
& randGen .~ g
|
|
where
|
|
(thepart, g) = runState (f p) (_randGen w)
|
|
|
|
makeStaticBall :: Point2 -> World -> World
|
|
makeStaticBall p = randEnergyBallAt aStaticBall p . (cWorld . lWorld . posEvents .:~ thesparker)
|
|
where
|
|
thesparker = PosEvent SparkSpawner 10 p
|
|
|
|
concBall :: Point2 -> Shockwave
|
|
concBall p =
|
|
Shockwave
|
|
{ _swDirection = OutwardShockwave
|
|
, _swInvulnerableCrs = []
|
|
, _swColor = white
|
|
, _swPos = p
|
|
, _swRad = 15
|
|
, _swDam = 4
|
|
, _swPush = 1
|
|
, _swMaxTime = 10
|
|
, _swTimer = 10
|
|
}
|
|
|
|
aStaticBall :: Point2 -> State g EnergyBall
|
|
aStaticBall p =
|
|
return
|
|
EnergyBall
|
|
{ _ebVel = 0
|
|
, _ebColor = blue
|
|
, _ebPos = p
|
|
, _ebWidth = 3
|
|
, _ebTimer = 20
|
|
, _ebEff = (ELECTRICAL, 10)
|
|
, _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
|
|
-}
|
|
|
|
--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 ::
|
|
-- | Position
|
|
Point2 ->
|
|
-- | Velocity
|
|
Point2 ->
|
|
World ->
|
|
World
|
|
makeGasCloud pos vel w =
|
|
w
|
|
& cWorld . lWorld . clouds .:~ theCloud
|
|
& randGen .~ g
|
|
where
|
|
theCloud =
|
|
Cloud
|
|
{ _clPos = addZ 20 pos
|
|
, _clVel = addZ 0 vel
|
|
, _clPict = CloudColor 3 50 (withAlpha 0.05 col)
|
|
, _clRad = 10
|
|
, _clAlt = 25
|
|
, _clTimer = 400
|
|
, _clType = GasCloud
|
|
}
|
|
(col, g) = runState (takeOne [green, yellow]) $ _randGen w
|
|
|
|
{- Attach poison cloud damage to creatures near cloud. -}
|
|
|
|
{- 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
|