97 lines
3.3 KiB
Haskell
97 lines
3.3 KiB
Haskell
{-
|
|
Explosions: creation of shockwave and particles at a given point.
|
|
-}
|
|
module Dodge.WorldEvent.Explosion
|
|
( makeExplosionAt
|
|
, makeFlameExplosionAt
|
|
, makePoisonExplosionAt
|
|
, makeTeslaExplosionAt
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.LightSource
|
|
import Dodge.Default
|
|
import Dodge.Zone
|
|
import Dodge.Base.Collide
|
|
import Dodge.WorldEvent.SpawnParticle
|
|
--import Dodge.WorldEvent.Flash
|
|
import Dodge.RandomHelp
|
|
import Dodge.SoundLogic
|
|
import Dodge.WorldEvent.Shockwave
|
|
import Geometry
|
|
import Geometry.Vector3D
|
|
import Picture
|
|
|
|
import Control.Monad.State
|
|
import Data.List
|
|
--import Data.Maybe
|
|
import System.Random
|
|
--import qualified Data.IntMap.Strict as IM
|
|
import Control.Lens
|
|
|
|
makePoisonExplosionAt
|
|
:: Point2 -- ^ Position
|
|
-> World
|
|
-> World
|
|
makePoisonExplosionAt p w
|
|
= soundMultiFrom [Explosion 0,Explosion 1] p bangS Nothing
|
|
$ foldr (makeGasCloud p) w vels
|
|
where
|
|
vels = replicateM 25 (randInCirc 2) & evalState $ _randGen w
|
|
-- just change the number after replicateM to get more or less clouds
|
|
-- suggested change: use random positions, offset from p, rather than velocities
|
|
-- so, p +.+ randomOffset
|
|
-- currently the clouds push away from each other rather hard if they are close
|
|
|
|
makeTeslaExplosionAt
|
|
:: Point2 -- ^ Position
|
|
-> World
|
|
-> World
|
|
makeTeslaExplosionAt = undefined
|
|
-- soundOncePos grenadeBang pos $ foldr ($) w listOfFunctions -- a bit shorter
|
|
-- where
|
|
-- xs = randomRs (0, 2*pi) $ _randGen w
|
|
-- j = newProjectileKey w
|
|
-- pks = [j..]
|
|
-- listOfFunctions = map
|
|
-- (\i -> over projectiles (IM.insert (pks!!i) (makeTeslaArcAt (pks!!i) pos (xs!!i))))
|
|
-- [1 .. 29]
|
|
|
|
makeFlameExplosionAt
|
|
:: Point2 -- ^ Position
|
|
-> World
|
|
-> World
|
|
makeFlameExplosionAt p w
|
|
= soundMultiFrom [Explosion 0,Explosion 1] p bangS Nothing
|
|
$ over particles (newFlames ++ ) w
|
|
where
|
|
newFlames = zipWith makeFlameWithVelAndTime velocities timers
|
|
makeFlameWithVelAndTime vel time = aFlameParticle time p vel Nothing
|
|
velocities = replicateM 15 (randInCirc 1) & evalState $ _randGen w
|
|
timers = randomRs (80,100) $ _randGen w
|
|
-- the ( Nthing :: Maybe Int ) here is "maybe" a creature id that the
|
|
-- particle passes through for the first frame of its existence
|
|
|
|
makeExplosionAt :: Point2 -> World -> World
|
|
makeExplosionAt p w
|
|
= soundMultiFrom [Explosion 0,Explosion 1] p bangS Nothing
|
|
. addFlames
|
|
-- . explosionFlashAt p
|
|
. over tempLightSources (theTLS :)
|
|
$ makeShockwaveAt [] p 50 50 1 white w
|
|
where
|
|
theTLS = tlsTimeRadColPos 20 150 (V3 1 0.5 0) (addZ 20 p)
|
|
fVs = replicateM 15 (randInCirc 1) & evalState $ _randGen w
|
|
fPs'' = replicateM 15 (fmap (15 *.*.*) randInHemisphere) & evalState $ _randGen w
|
|
(fPs',zs) = let (a,b,c) = unzip3 $ map fromV3 fPs''
|
|
in (zipWith V2 a b, c)
|
|
fPs = map (pushAgainstWalls . (+.+) p . (*.*) 0.5) fPs'
|
|
inversePushOut v = (15 - magV v) * 0.01 *.* v
|
|
fVs' = zipWith (+.+) fVs $ map inversePushOut fPs'
|
|
sizes = randomRs (2,9) $ _randGen w
|
|
times = randomRs (20,25) $ _randGen w
|
|
mF q z v size time = makeFlameletTimed q z v Nothing size time
|
|
newFs = zipWith5 mF fPs zs (fmap (3 *.*) fVs') sizes times
|
|
addFlames w' = foldr ($) w' newFs
|
|
pushAgainstWalls q = maybe q (uncurry (+.+)) $ reflectPointWalls p q $ wallsNearPoint q w
|
|
|