Reorganise modules. Broken layout-- to be diagnosed
This commit is contained in:
+4
-189
@@ -6,6 +6,8 @@ module Dodge.WorldEvent
|
||||
, module Dodge.WorldEvent.HelperParticle
|
||||
, module Dodge.WorldEvent.Cloud
|
||||
, module Dodge.WorldEvent.HitEffect
|
||||
, module Dodge.WorldEvent.Explosion
|
||||
, module Dodge.WorldEvent.SpawnParticle
|
||||
)
|
||||
where
|
||||
|
||||
@@ -15,6 +17,8 @@ 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
|
||||
@@ -34,25 +38,6 @@ import Data.Function
|
||||
import Data.List
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
|
||||
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
|
||||
|
||||
shockWaveDamage :: Point2 -> Float -> Int -> World -> World
|
||||
shockWaveDamage p rad amount w = flip (foldr damageBlocks) hitBlocks $ over creatures (IM.map f) w
|
||||
@@ -67,75 +52,6 @@ shockWaveDamage p rad amount w = flip (foldr damageBlocks) hitBlocks $ over crea
|
||||
(_blIDs wall)
|
||||
_ -> 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
|
||||
|
||||
inverseShockwaveAt :: Point2 -> Float -> Int -> Float -> Float -> World -> World
|
||||
inverseShockwaveAt p rad dam push pushexp = over particles' ((:) theShockwave)
|
||||
@@ -167,33 +83,6 @@ moveInverseShockWave t p r push pushexp w pt
|
||||
cr
|
||||
| otherwise = cr
|
||||
|
||||
-- if the spark is created by another Particle', it cannot be directly added to
|
||||
-- the list, hence the redirect through worldEvents
|
||||
createSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
|
||||
createSpark time colid pos dir maycid w = over worldEvents
|
||||
((.) $ ( over particles' ((:) spark)
|
||||
-- . flareAt' white 0.02 0.05 pos')
|
||||
. 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
|
||||
|
||||
drawBul :: Particle' -> Picture
|
||||
drawBul pt = setLayer 1 . color white $ thickLine (take 2 $ _btTrail' pt) (_btWidth' pt)
|
||||
|
||||
createBarrelSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
|
||||
createBarrelSpark time colid pos dir maycid w = over worldEvents
|
||||
@@ -217,83 +106,9 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents
|
||||
where sp = head (_btTrail' bt)
|
||||
ep = sp +.+ _btVel' bt
|
||||
|
||||
noEff _ _ _ = id
|
||||
|
||||
makeFlameletTimed :: Point2 -> Point2 -> Maybe Int -> Float -> Int -> World -> World
|
||||
makeFlameletTimed pos vel maycid size time w
|
||||
= set randGen g $ over particles' ((:) theFlamelet) w
|
||||
where theFlamelet =
|
||||
Pt' { _ptDraw = drawFlamelet rot
|
||||
, _ptUpdate' = moveFlamelet
|
||||
, _btVel' = vel
|
||||
, _btColor' = red
|
||||
, _btPos' = pos
|
||||
, _btPassThrough' = maycid
|
||||
, _btWidth' = size
|
||||
, _btTimer' = time
|
||||
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
|
||||
}
|
||||
(rot ,g) = randomR (0,3) $ _randGen w
|
||||
|
||||
drawFlamelet :: Float -> Particle' -> Picture
|
||||
drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow]
|
||||
where
|
||||
sp = _btPos' pt
|
||||
vel = _btVel' pt
|
||||
ep = sp +.+ vel
|
||||
size = _btWidth' pt
|
||||
siz2 = size + 0.2
|
||||
time = _btTimer' pt
|
||||
glow = setDepth 0.336 $ uncurry translate ep
|
||||
$ circleSolidCol (withAlpha 0 red) (withAlpha 0.05 red) 30
|
||||
piu = setDepth 0.334 $ uncurry translate ep
|
||||
$ color (dark red) $ rotate (0 - (rot - 0.1 * fromIntegral time))
|
||||
$ scale s1 s1
|
||||
$ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
|
||||
pi2 = setDepth 0.332 $ uncurry translate ep
|
||||
$ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
|
||||
orange (dark red)
|
||||
)
|
||||
$ rotate (0 - (rot + 0.2 * fromIntegral time))
|
||||
$ scale s2 s2
|
||||
$ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
|
||||
pic = setDepth 0.33 $ uncurry translate ep
|
||||
$ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
|
||||
white (dark red)
|
||||
)
|
||||
$ rotate (0 - ( 0.1 * fromIntegral time + rot))
|
||||
$ scale sc sc
|
||||
$ polygon [(-size,-size),(size,-size),(size,size),(-size,size)]
|
||||
sc = (*) 2 $ log $ 1 + fromIntegral time / 20
|
||||
s1 = (*) 2 $ log $ 2 + fromIntegral time / 40
|
||||
s2 = 0.5 * (sc + s1)
|
||||
thepicture = pictures [pic , piu , pi2 , glow]
|
||||
|
||||
moveFlamelet :: World -> Particle' -> (World, Maybe Particle')
|
||||
moveFlamelet w pt
|
||||
| _btTimer' pt <= 0 = ( w, Nothing)
|
||||
| otherwise = (damcrs, mvPt)
|
||||
where
|
||||
sp = _btPos' pt
|
||||
vel = _btVel' pt
|
||||
ep = sp +.+ vel
|
||||
size = _btWidth' pt
|
||||
mvPt = Just $ pt & btTimer' -~ 1
|
||||
& btPos' .~ ep
|
||||
& btPassThrough' .~ Nothing
|
||||
& btVel' .~ 0.8 *.* vel
|
||||
damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w
|
||||
closeCrs cr = dist ep (_crPos cr) < _crRad cr + size
|
||||
dodam cr = over (creatures . ix (_crID cr) . crState . crDamage)
|
||||
((:) $ Flaming 3 sp ep ep)
|
||||
|
||||
|
||||
doFlameDam :: Int -> Particle' -> Point2 -> Creature -> World -> World
|
||||
doFlameDam amount pt p cr = over (creatures . ix (_crID cr) . crState . crDamage)
|
||||
((:) $ Flaming amount sp p ep)
|
||||
where sp = _btPos' pt
|
||||
ep = sp +.+ _btVel' pt
|
||||
|
||||
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)
|
||||
|
||||
Reference in New Issue
Block a user