77 lines
3.0 KiB
Haskell
77 lines
3.0 KiB
Haskell
module Dodge.WorldEvent.Explosion
|
|
where
|
|
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.WorldEvent.SpawnParticle
|
|
import Dodge.WorldEvent.Flash
|
|
import Dodge.RandomHelp
|
|
import Dodge.SoundLogic
|
|
import Dodge.WorldEvent.Shockwave
|
|
import Geometry
|
|
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
|
|
|
|
-- The following should be improved.... I've made a first pass
|
|
makePoisonExplosionAt :: Point2 -> World -> World
|
|
makePoisonExplosionAt p w = soundOnce grenadeBang $ foldr (makeGasCloud p) w vels
|
|
where
|
|
vels = evalState (sequence ( replicate 25 (randInCirc 2) )) (_randGen w)
|
|
-- just change the number after replicate 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 -> World -> World
|
|
makeTeslaExplosionAt pos w = soundOnce grenadeBang $ foldr ($) w listOfFunctions -- a bit shorter
|
|
where
|
|
-- rad or 360? Radians (hopefully) everywhere
|
|
xs = randomRs (0, 2*pi) $ _randGen w
|
|
p = newProjectileKey w
|
|
pks = [p..]
|
|
listOfFunctions = map
|
|
(\i -> over projectiles (IM.insert (pks!!i) (makeTeslaArcAt (pks!!i) pos (xs!!i))))
|
|
[1 .. 29]
|
|
|
|
-- slightly more work done on this one, want the flames to last for different
|
|
-- times
|
|
-- the new flames are directly added to the list of particles
|
|
makeFlameExplosionAt :: Point2 -> World -> World
|
|
makeFlameExplosionAt p w = soundOnce grenadeBang $ over particles' (newFlames ++ ) w
|
|
where
|
|
newFlames = zipWith makeFlameWithVelAndTime velocities timers
|
|
makeFlameWithVelAndTime vel time = aFlameParticle time p vel Nothing
|
|
velocities = evalState (sequence ( replicate 15 (randInCirc 1) )) (_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 = soundOnce grenadeBang
|
|
. addFlames
|
|
. explosionFlashAt p
|
|
$ makeShockwaveAt [] p 50 10 1 white
|
|
w
|
|
where
|
|
fVs = fst $ runState ((sequence . take 75 . repeat . randInCirc) 1) $ _randGen w
|
|
fPs' = evalState ((sequence . take 75 . repeat . randInCirc) 15) $ _randGen w
|
|
fPs = map (pushAgainstWalls . (+.+) p . (*.*) 0.5)
|
|
fPs'
|
|
inversePushOut v = (15 - magV v) * 0.01 *.* v
|
|
fVs' = zipWith (+.+) fVs $ map inversePushOut fPs'
|
|
sizes = randomRs (2,6) $ _randGen w
|
|
times = randomRs (20,25) $ _randGen w
|
|
mF q v size time = makeFlameletTimed q v Nothing size time
|
|
newFs = zipWith4 mF fPs (fmap (3 *.*) fVs') sizes times
|
|
addFlames w = foldr ($) w newFs
|
|
pushAgainstWalls q = fromMaybe q $ fmap (\(x,y)-> x +.+ y)
|
|
$ collidePointWalls p q $ wallsNearPoint q w
|
|
|