Reorganise modules. Broken layout-- to be diagnosed
This commit is contained in:
@@ -0,0 +1,146 @@
|
||||
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 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
|
||||
|
||||
makeShockwaveAt :: Point2 -> Float -> Int -> Float -> Color
|
||||
-> World -> World
|
||||
makeShockwaveAt p rad dam push col = over particles' ((:) theShockwave)
|
||||
where theShockwave = shockwaveAt p rad dam push col 10
|
||||
|
||||
shockwaveAt :: Point2 -> Float -> Int -> Float -> Color -> Int -> Particle'
|
||||
shockwaveAt p rad dam push col maxtime
|
||||
= Shockwave'
|
||||
{ _ptDraw = const blank
|
||||
, _ptUpdate' = mvShockwave'
|
||||
, _btColor' = col
|
||||
, _btPos' = p
|
||||
, _btRad' = rad
|
||||
, _btDam' = dam
|
||||
, _btPush' = push
|
||||
, _btMaxTime' = maxtime
|
||||
, _btTimer' = maxtime
|
||||
}
|
||||
|
||||
mvShockwave' :: World -> Particle' -> (World, Maybe Particle')
|
||||
mvShockwave' w pt
|
||||
| _btTimer' pt <= 0 = (w, Nothing)
|
||||
| otherwise
|
||||
= (dams w , Just $ set btTimer' (t - 1) $ set ptDraw (const pic) pt)
|
||||
where
|
||||
r = _btRad' pt
|
||||
p = _btPos' pt
|
||||
push = _btPush' pt
|
||||
dam = _btDam' pt
|
||||
t = _btTimer' pt
|
||||
tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
|
||||
pic = onLayer PtLayer $ uncurry translate p
|
||||
$ color (_btColor' pt) $ thickCircle rad thickness
|
||||
rad = r - (3/4) * r * tFraction
|
||||
thickness = tFraction**2 * r
|
||||
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 dam (25 * push *.* safeNormalizeV (_crPos cr -.- p)))
|
||||
cr
|
||||
| otherwise = cr
|
||||
moveShockWave :: Int -> Point2 -> Float -> Float -> Float -> World -> Particle' -> (World, Maybe Particle')
|
||||
moveShockWave 0 _ _ _ _ w _ = (w, Nothing)
|
||||
moveShockWave t p r push pushexp w pt
|
||||
= (dams w, Just $ newupdate $ newpic pt )
|
||||
where newupdate = set ptUpdate' $ moveShockWave (t-1) p r push pushexp
|
||||
newpic = set ptDraw (const $ onLayer PtLayer $ uncurry translate p
|
||||
$ color cyan $ thickCircle rad thickness)
|
||||
rad = r - (3/40) * r * fromIntegral t
|
||||
thickness = (fromIntegral 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 (_crPos cr -.- p)))
|
||||
cr
|
||||
| otherwise = cr
|
||||
Reference in New Issue
Block a user