Cleanup
This commit is contained in:
@@ -6,29 +6,13 @@ module Dodge.WorldEvent.HitEffect
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Geometry
|
||||
import LensHelp
|
||||
|
||||
import Data.Bifunctor
|
||||
import Control.Lens
|
||||
|
||||
type HitCreatureEffect = Particle -> Point2 -> Creature -> World -> World
|
||||
type HitWallEffect = Particle -> Point2 -> Wall -> World -> World
|
||||
|
||||
--passThroughAll
|
||||
-- :: HitCreatureEffect
|
||||
-- -> HitWallEffect
|
||||
-- -> HitForceFieldEffect
|
||||
-- -> Particle
|
||||
-- -> [(Point2, Either3 Creature Wall ForceField)] -- ^ hit things
|
||||
-- -> World
|
||||
-- -> (World, Maybe Particle)
|
||||
--passThroughAll _ _ _ pt _ w = (w, mvPt)
|
||||
-- where
|
||||
-- mvPt = Just $ pt & btTrail' .~ (newP : trl)
|
||||
-- & btTimer' %~ (\t -> t - 1)
|
||||
-- & btPassThrough' .~ Nothing
|
||||
-- trl = _btTrail' pt
|
||||
-- newP = head trl +.+ _btVel' pt
|
||||
|
||||
destroyOnImpact
|
||||
:: HitCreatureEffect
|
||||
-> HitWallEffect
|
||||
@@ -43,7 +27,7 @@ destroyOnImpact crEff wlEff pt hitThings w = case hitThings of
|
||||
|
||||
mvPt :: Particle -> Maybe Particle
|
||||
mvPt pt = Just $ pt
|
||||
& btTrail' %~ f
|
||||
& ptTrail %~ f
|
||||
& btTimer' -~ 1
|
||||
& btPassThrough' .~ Nothing
|
||||
where
|
||||
@@ -52,15 +36,15 @@ mvPt pt = Just $ pt
|
||||
destroyAt :: Point2 -> Particle -> Maybe Particle
|
||||
destroyAt hitp pt = Just $ pt
|
||||
& ptUpdate .~ killBulletUpdate
|
||||
& btTrail' %~ (hitp :)
|
||||
& btTimer' %~ (\t -> min 3 (t-1))
|
||||
& ptTrail .:~ hitp
|
||||
& btTimer' %~ (min 3 . subtract 1)
|
||||
|
||||
killBulletUpdate :: World -> Particle -> (World,Maybe Particle)
|
||||
killBulletUpdate w pt
|
||||
| _btTimer' pt <= 0 = (w,Nothing)
|
||||
| otherwise = (w
|
||||
,Just $ pt & btTimer' -~ 1
|
||||
& btTrail' %~ (\(x:xs) -> x:x:xs)
|
||||
& ptTrail %~ (\(x:xs) -> x:x:xs)
|
||||
)
|
||||
|
||||
penWalls
|
||||
@@ -78,8 +62,8 @@ penWalls crEff wlEff pt hitThings w = case hitThings of
|
||||
((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt)
|
||||
|
||||
doFlameDam :: Int -> Particle -> Point2 -> Creature -> World -> World
|
||||
doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage %~
|
||||
(Flaming amount sp p ep :)
|
||||
doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage .:~
|
||||
Flaming amount sp p ep
|
||||
where
|
||||
sp = _btPos' pt
|
||||
ep = sp +.+ _ptVel pt
|
||||
|
||||
@@ -1,8 +1,7 @@
|
||||
module Dodge.WorldEvent.Shockwave
|
||||
( makeShockwaveAt
|
||||
, inverseShockwaveAt
|
||||
)
|
||||
where
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Wall.Damage
|
||||
import Dodge.Base
|
||||
@@ -10,10 +9,9 @@ import Dodge.Zone
|
||||
import Dodge.Picture.Layer
|
||||
import Geometry
|
||||
import Picture
|
||||
import LensHelp
|
||||
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Control.Lens
|
||||
|
||||
-- currently very effective against walls
|
||||
makeShockwaveAt
|
||||
:: [Int] -- ^ IDs of invulnerable creatures.
|
||||
@@ -24,25 +22,23 @@ makeShockwaveAt
|
||||
-> Color -- ^ Color of shockwave.
|
||||
-> World -- ^ Start world.
|
||||
-> World
|
||||
makeShockwaveAt is p rad dam push col = over particles (theShockwave :)
|
||||
where
|
||||
theShockwave = Shockwave'
|
||||
{ _ptDraw = drawShockwave
|
||||
, _ptUpdate = mvShockwave is
|
||||
, _btColor' = col
|
||||
, _btPos' = p
|
||||
, _btRad' = rad
|
||||
, _btDam' = dam
|
||||
, _btPush' = push
|
||||
, _btMaxTime' = 10
|
||||
, _btTimer' = 10
|
||||
}
|
||||
makeShockwaveAt is p rad dam push col = instantParticles .:~ Shockwave
|
||||
{ _ptDraw = drawShockwave
|
||||
, _ptUpdate = mvShockwave is
|
||||
, _ptColor = col
|
||||
, _btPos' = p
|
||||
, _btRad' = rad
|
||||
, _btDam' = dam
|
||||
, _btPush' = push
|
||||
, _btMaxTime' = 10
|
||||
, _btTimer' = 10
|
||||
}
|
||||
{- Shockwave picture. -}
|
||||
drawShockwave :: Particle -> Picture
|
||||
drawShockwave pt = setDepth 20
|
||||
. setLayer 1
|
||||
. setLayer 1
|
||||
. uncurryV translate (_btPos' pt)
|
||||
. color (_btColor' pt)
|
||||
. color (_ptColor pt)
|
||||
$ thickCircle rad thickness
|
||||
where
|
||||
r = _btRad' pt
|
||||
@@ -69,8 +65,8 @@ mvShockwave is w pt
|
||||
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
|
||||
damCr cr
|
||||
| _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr = cr
|
||||
| otherwise = cr & crState . crDamage %~
|
||||
(PushDam dam (25 * push *.* squashNormalizeV (_crPos cr -.- p)) : )
|
||||
| otherwise = cr & crState . crDamage .:~
|
||||
PushDam dam (25 * push *.* squashNormalizeV (_crPos cr -.- p))
|
||||
{- Create a shockwave going from an outside circle into a center point. -}
|
||||
inverseShockwaveAt
|
||||
:: Point2 -- Center position
|
||||
@@ -79,19 +75,17 @@ inverseShockwaveAt
|
||||
-> Float -- Push amount
|
||||
-> World
|
||||
-> World
|
||||
inverseShockwaveAt p rad dam push = over particles (theShockwave :)
|
||||
where
|
||||
theShockwave = Shockwave'
|
||||
{ _ptDraw = drawInverseShockwave
|
||||
, _ptUpdate = moveInverseShockwave
|
||||
, _btColor' = cyan
|
||||
, _btPos' = p
|
||||
, _btRad' = rad
|
||||
, _btDam' = dam
|
||||
, _btPush' = push
|
||||
, _btMaxTime' = 10
|
||||
, _btTimer' = 10
|
||||
}
|
||||
inverseShockwaveAt p rad dam push = particles .:~ Shockwave
|
||||
{ _ptDraw = drawInverseShockwave
|
||||
, _ptUpdate = moveInverseShockwave
|
||||
, _ptColor = cyan
|
||||
, _btPos' = p
|
||||
, _btRad' = rad
|
||||
, _btDam' = dam
|
||||
, _btPush' = push
|
||||
, _btMaxTime' = 10
|
||||
, _btTimer' = 10
|
||||
}
|
||||
moveInverseShockwave
|
||||
:: World
|
||||
-> Particle
|
||||
@@ -108,8 +102,8 @@ moveInverseShockwave w pt
|
||||
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
|
||||
damCr cr
|
||||
| dist (_crPos cr) p >= rad + _crRad cr = cr
|
||||
| otherwise = cr & crState . crDamage %~
|
||||
(PushDam 1 (25 *.* squashNormalizeV (p -.- _crPos cr)) :)
|
||||
| otherwise = cr & crState . crDamage .:~
|
||||
PushDam 1 (25 *.* squashNormalizeV (p -.- _crPos cr))
|
||||
|
||||
drawInverseShockwave :: Particle -> Picture
|
||||
drawInverseShockwave pt
|
||||
|
||||
@@ -1,6 +1,4 @@
|
||||
{- |
|
||||
Creation of particles in the world.
|
||||
-}
|
||||
{- | Creation of particles in the world. -}
|
||||
module Dodge.WorldEvent.SpawnParticle
|
||||
( makeGasCloud
|
||||
, aFlameParticle
|
||||
@@ -14,11 +12,8 @@ import Dodge.WorldEvent.Cloud
|
||||
import Dodge.WorldEvent.Flash
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.RandomHelp
|
||||
--import Dodge.Debug
|
||||
import Picture
|
||||
import Geometry
|
||||
--import Geometry.Vector3D
|
||||
--import Geometry.Data
|
||||
import qualified IntMapHelp as IM
|
||||
import LensHelp
|
||||
|
||||
@@ -35,7 +30,7 @@ aFlameParticle t pos vel maycid = PtZ
|
||||
{ _ptDraw = drawFlame vel
|
||||
, _ptUpdate = moveFlame vel
|
||||
, _ptVel = vel
|
||||
, _btColor' = red
|
||||
, _ptColor = red
|
||||
, _btPos' = pos
|
||||
, _btPassThrough' = maycid
|
||||
, _btWidth' = 4
|
||||
@@ -47,15 +42,14 @@ drawFlame
|
||||
:: Point2 -- ^ Rotate direction
|
||||
-> Particle
|
||||
-> Picture
|
||||
drawFlame rotd pt = thePic
|
||||
drawFlame rotd pt = pictures
|
||||
[ glow
|
||||
, aPic 3 prot2 25 (V2 (scaleChange + 1) 2 ) $ V4 2 (-1) (-1) 0.5
|
||||
, aPic 3 prot 22 (V2 (scaleChange + 0.5) 1) $ V4 1 0.5 0 2
|
||||
, aPic 1 prot3 20 (V2 scaleChange 0.5 ) $ V4 1 1 1 1
|
||||
]
|
||||
where
|
||||
ep = _btPos' pt
|
||||
thePic = pictures
|
||||
[ glow
|
||||
, aPic 3 prot2 25 (V2 (scaleChange + 1) 2 ) $ V4 2 (-1) (-1) 0.5
|
||||
, aPic 3 prot 22 (V2 (scaleChange + 0.5) 1) $ V4 1 0.5 0 2
|
||||
, aPic 1 prot3 20 (V2 scaleChange 0.5 ) $ V4 1 1 1 1
|
||||
]
|
||||
aPic :: Int -> (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
|
||||
aPic lay offset depth (V2 scalex scaley) col
|
||||
= setLayer lay
|
||||
@@ -124,11 +118,11 @@ makeFlameletTimed
|
||||
-> World
|
||||
makeFlameletTimed (V2 x y) z vel maycid size time w = w
|
||||
& randGen .~ g
|
||||
& particles .:~ PtZ
|
||||
& instantParticles .:~ PtZ
|
||||
{ _ptDraw = drawFlameletZ rot
|
||||
, _ptUpdate = moveFlamelet
|
||||
, _ptVel = vel
|
||||
, _btColor' = red
|
||||
, _ptVel = vel
|
||||
, _ptColor = red
|
||||
, _btPos' = V2 x y
|
||||
, _btPassThrough' = maycid
|
||||
, _btWidth' = size
|
||||
@@ -202,7 +196,7 @@ moveFlamelet w pt
|
||||
damcrs = w & creatures %~ IM.map damifclose
|
||||
isClose cr = dist ep (_crPos cr) < _crRad cr + size
|
||||
damifclose cr
|
||||
| isClose cr = cr & crState . crDamage %~ ( Flaming 3 sp ep ep : )
|
||||
| isClose cr = cr & crState . crDamage .:~ Flaming 3 sp ep ep
|
||||
| otherwise = cr
|
||||
-- | At writing the radius is half the size of the effect area
|
||||
makeGasCloud
|
||||
@@ -211,7 +205,7 @@ makeGasCloud
|
||||
-> World
|
||||
-> World
|
||||
makeGasCloud pos vel w = w
|
||||
& clouds %~ (theCloud :)
|
||||
& clouds .:~ theCloud
|
||||
& randGen .~ g
|
||||
where
|
||||
theCloud = Cloud
|
||||
@@ -226,12 +220,10 @@ makeGasCloud pos vel w = w
|
||||
, _clEffect = cloudPoisonDamage
|
||||
}
|
||||
(col, g) = runState (takeOne [green,yellow]) $ _randGen w
|
||||
{-
|
||||
Attach poison cloud damage to creatures near cloud.
|
||||
-}
|
||||
{- Attach poison cloud damage to creatures near cloud. -}
|
||||
cloudPoisonDamage :: Cloud -> World -> World
|
||||
cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs
|
||||
where
|
||||
damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (stripZ $ _clPos c) w
|
||||
f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
|
||||
doDam cr = cr & crState . crDamage %~ (PoisonDam 1 :)
|
||||
doDam cr = cr & crState . crDamage .:~ PoisonDam 1
|
||||
|
||||
Reference in New Issue
Block a user