120 lines
4.8 KiB
Haskell
120 lines
4.8 KiB
Haskell
module Dodge.WorldEvent
|
|
( module Dodge.WorldEvent
|
|
, module Dodge.WorldEvent.Bullet
|
|
, module Dodge.WorldEvent.Flash
|
|
, module Dodge.WorldEvent.ThingsHit
|
|
, module Dodge.WorldEvent.HelperParticle
|
|
, module Dodge.WorldEvent.Cloud
|
|
, module Dodge.WorldEvent.HitEffect
|
|
, module Dodge.WorldEvent.Explosion
|
|
, module Dodge.WorldEvent.SpawnParticle
|
|
)
|
|
where
|
|
|
|
import Dodge.WorldEvent.Bullet
|
|
import Dodge.WorldEvent.Flash
|
|
import Dodge.WorldEvent.ThingsHit
|
|
import Dodge.WorldEvent.HelperParticle
|
|
import Dodge.WorldEvent.Cloud
|
|
import Dodge.WorldEvent.HitEffect
|
|
import Dodge.WorldEvent.Explosion
|
|
import Dodge.WorldEvent.SpawnParticle
|
|
import Dodge.LightSources
|
|
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.SoundLogic
|
|
import Dodge.RandomHelp
|
|
import Geometry
|
|
import Picture
|
|
|
|
import Control.Lens
|
|
import Control.Monad.State
|
|
|
|
import System.Random
|
|
|
|
import Data.Maybe
|
|
import Data.Function
|
|
import Data.List
|
|
import qualified Data.IntMap.Strict as IM
|
|
|
|
|
|
shockWaveDamage :: Point2 -> Float -> Int -> World -> World
|
|
shockWaveDamage p rad amount w = flip (foldr damageBlocks) hitBlocks $ over creatures (IM.map f) w
|
|
where f cr | dist (_crPos cr) p < rad + _crRad cr = over (crState . crDamage)
|
|
((:) $ Concussive amount p 2 0.5 rad) cr
|
|
| otherwise = cr
|
|
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
|
|
damageBlocks wall w
|
|
= case wall ^? blHP of
|
|
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - (div amount 2)))
|
|
w
|
|
(_blIDs wall)
|
|
_ -> w
|
|
|
|
|
|
inverseShockwaveAt :: Point2 -> Float -> Int -> Float -> Float -> World -> World
|
|
inverseShockwaveAt p rad dam push pushexp = over particles' ((:) theShockwave)
|
|
where theShockwave
|
|
= Particle'
|
|
{ _ptDraw = const blank
|
|
, _ptUpdate' = moveInverseShockWave 10 p rad push pushexp
|
|
}
|
|
moveInverseShockWave :: Int -> Point2 -> Float -> Float -> Float -> World -> Particle' -> (World, Maybe Particle')
|
|
moveInverseShockWave 0 _ _ _ _ w _ = (w, Nothing)
|
|
moveInverseShockWave t p r push pushexp w pt
|
|
= (dams w, Just $ newupdate $ newpic pt )
|
|
where newupdate = set ptUpdate' $ moveInverseShockWave (t-1) p r push pushexp
|
|
newpic = set ptDraw (const $ onLayer PtLayer $ uncurry translate p
|
|
$ color cyan $ thickCircle rad thickness)
|
|
rad = r - (4/40) * r * fromIntegral (10 - t)
|
|
thickness = (fromIntegral (10 - t))**2 * rad / 40
|
|
dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks
|
|
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
|
|
damageBlocks wall w
|
|
= case wall ^? blHP of
|
|
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1))
|
|
w
|
|
(_blIDs wall)
|
|
_ -> w
|
|
damCr cr | dist (_crPos cr) p < rad + _crRad cr
|
|
= over (crState . crDamage)
|
|
((:) $ PushDam 1 (25 *.* safeNormalizeV (p -.- _crPos cr)))
|
|
cr
|
|
| otherwise = cr
|
|
|
|
|
|
createBarrelSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
|
|
createBarrelSpark time colid pos dir maycid w = over worldEvents
|
|
((.) $ ( over particles' ((:) spark)
|
|
. sparkFlashAt pos')
|
|
) w
|
|
where spark = Bul' { _ptDraw = drawBul
|
|
, _ptUpdate' = mvGenBullet'
|
|
, _btVel' = rotateV dir (5,0)
|
|
, _btColor' = numColor colid
|
|
, _btTrail' = [pos]
|
|
, _btPassThrough' = maycid
|
|
, _btWidth' = 1
|
|
, _btTimer' = time
|
|
, _btHitEffect' = destroyOnImpact sparkEff noEff noEff
|
|
}
|
|
x = fst $ randomR (0,20) $ _randGen w
|
|
pos' = pos +.+ rotateV dir (x,0)
|
|
sparkEff bt p cr = over (creatures . ix (_crID cr) . crState . crDamage)
|
|
((:) $ SparkDam 1 sp p ep)
|
|
where sp = head (_btTrail' bt)
|
|
ep = sp +.+ _btVel' bt
|
|
|
|
|
|
|
|
|
|
damCrsOnLine :: Int -> Point2 -> Point2 -> World -> World
|
|
damCrsOnLine dam p1 p2 = over creatures (IM.map damIfOnLine)
|
|
where damIfOnLine cr | circOnLine p1 p2 (_crPos cr) (_crRad cr)
|
|
= over crHP (\hp -> hp - dam) cr
|
|
| otherwise = cr
|
|
|
|
tempLightForAt :: Int -> Point2 -> World -> World
|
|
tempLightForAt i p w = w & tempLightSources %~ (:) (tLightAt i p)
|