117 lines
3.5 KiB
Haskell
117 lines
3.5 KiB
Haskell
{- | Creation of particles in the world. -}
|
|
module Dodge.WorldEvent.SpawnParticle
|
|
( makeGasCloud
|
|
, makeStaticBall
|
|
, concBall
|
|
, randParticleAt
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.WorldEvent.Shockwave
|
|
import RandomHelp
|
|
import Picture
|
|
import Geometry
|
|
import LensHelp
|
|
|
|
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 = randEnergyBallAt aStaticBall p . (posEvents .:~ thesparker)
|
|
where
|
|
thesparker = PosEvent SparkSpawner 10 p
|
|
|
|
concBall :: Point2 -> State g Particle
|
|
concBall p = return Shockwave
|
|
{ _ptUpdate = mvShockwave []
|
|
, _ptColor = white
|
|
, _ptPos = p
|
|
, _ptRad = 15
|
|
, _ptDam = 4
|
|
, _ptPush = 1
|
|
, _ptMaxTime = 10
|
|
, _ptTimer = 10
|
|
}
|
|
|
|
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
|
|
|
|
--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
|
|
:: Point2 -- ^ Position
|
|
-> Point2 -- ^ Velocity
|
|
-> World
|
|
-> World
|
|
makeGasCloud pos vel w = w
|
|
& clouds .:~ theCloud
|
|
-- & clouds %~ S.cons theCloud
|
|
& randGen .~ g
|
|
where
|
|
theCloud = Cloud
|
|
{ _clPos = addZ 20 pos
|
|
, _clVel = addZ 0 vel
|
|
, _clPict = \_ -> setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col)
|
|
$ circleSolid 20
|
|
, _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
|