Defunction-ify item modules, requires more cleanup

This commit is contained in:
2022-06-08 12:28:11 +01:00
parent d91a53f76c
commit bcbfd7d2fa
48 changed files with 762 additions and 740 deletions
+62 -59
View File
@@ -12,6 +12,7 @@ import Dodge.Base
import Dodge.Zone
import Dodge.Particle.HitEffect.ExpireAndDamage
import Dodge.Particle.Damage
import Dodge.IncBall
--import Dodge.WorldEvent.HitEffect
import Dodge.WorldEvent.ThingsHit
import Dodge.WorldEvent.Cloud
@@ -114,21 +115,6 @@ moveFlame rotd w pt
reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel )
+.+ (0.2 *.* vel)
incBall :: RandomGen g => Point2 -> State g Particle
incBall p = do
rot <- state $ randomR (0,3)
return PtZ
{ _ptDraw = drawFlameletZ rot
, _ptUpdate = moveFlamelet
, _ptVel = 0
, _ptColor = red
, _ptPos = p
, _ptCrIgnore = Nothing
, _ptWidth = 3
, _ptTimer = 20
, _ptHitEff = expireAndDamage $ simpleDam FLAMING 20
, _ptZ = 20
}
concBall :: Point2 -> State g Particle
concBall p = return Shockwave
@@ -207,6 +193,67 @@ drawStaticBall pt = setLayer BloomNoZWrite
. uncurryV translate (_ptPos pt)
$ circleSolidCol (_ptColor pt) (withAlpha 0.5 white) (_ptWidth pt+5)
moveStaticBall :: World -> Particle -> (World, Maybe Particle)
moveStaticBall = moveFlamelet
-- | Note damgeInRadius by itself never destroys the particle
damageInRadius :: Float -> Particle -> World -> World
damageInRadius size pt w = damwls damcrs
where
p = _ptPos pt
damcrs = foldr (\cr -> fst . hiteff [(p,Left cr)]) w $ IM.filter isClose $ _creatures w
damwls w' = foldr (\wl -> fst . hiteff [(p,Right wl)]) w' $ IM.filter closeWls $ wallsNearPoint p w
closeWls wl = uncurry circOnSeg (_wlLine wl) p size
isClose cr = dist p (_crPos cr) < _crRad cr + size
hiteff = _ptHitEff pt pt
-- | At writing the radius is half the size of the effect area
makeGasCloud
:: Point2 -- ^ Position
-> Point2 -- ^ Velocity
-> World
-> World
makeGasCloud pos vel w = w
& clouds .:~ theCloud
& randGen .~ g
where
theCloud = Cloud
{ _clPos = addZ 20 pos
, _clVel = addZ 0 vel
, _clPict = \_ -> setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col)
$ circleSolid 20
, _clRad = 10
, _clAlt = 25
, _clTimer = 400
, _clType = GasCloud
, _clEffect = cloudPoisonDamage
}
(col, g) = runState (takeOne [green,yellow]) $ _randGen w
{- 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 clpos w
f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
doDam cr = cr & crState . crDamage .:~ Damage POISONDAM 1 clpos clpos clpos NoDamageEffect
clpos = stripZ $ _clPos c
incBall :: RandomGen g => Point2 -> State g Particle
incBall p = do
rot <- state $ randomR (0,3)
return PtZ
{ _ptDraw = drawFlameletZ rot
, _ptUpdate = moveFlamelet
, _ptVel = 0
, _ptColor = red
, _ptPos = p
, _ptCrIgnore = Nothing
, _ptWidth = 3
, _ptTimer = 20
, _ptHitEff = expireAndDamage $ simpleDam FLAMING 20
, _ptZ = 20
}
drawFlameletZ
:: Float -- ^ Rotation
-> Particle
@@ -252,8 +299,6 @@ drawFlameletZ rot pt = pictures
s1 = (*) 2 $ log $ 2 + fromIntegral time / 40
s2 = 0.5 * (sc + s1)
moveStaticBall :: World -> Particle -> (World, Maybe Particle)
moveStaticBall = moveFlamelet
{- Update of a flamelet.
Applies movement and attaches damage to nearby creatures. -}
-- This should be unified in many ways with moveFlame
@@ -267,45 +312,3 @@ moveFlamelet w pt
& ptPos .~ _ptPos pt +.+ _ptVel pt
& ptCrIgnore .~ Nothing
& ptVel .*.*~ 0.8
-- | Note damgeInRadius by itself never destroys the particle
damageInRadius :: Float -> Particle -> World -> World
damageInRadius size pt w = damwls damcrs
where
p = _ptPos pt
damcrs = foldr (\cr -> fst . hiteff [(p,Left cr)]) w $ IM.filter isClose $ _creatures w
damwls w' = foldr (\wl -> fst . hiteff [(p,Right wl)]) w' $ IM.filter closeWls $ wallsNearPoint p w
closeWls wl = uncurry circOnSeg (_wlLine wl) p size
isClose cr = dist p (_crPos cr) < _crRad cr + size
hiteff = _ptHitEff pt pt
-- | At writing the radius is half the size of the effect area
makeGasCloud
:: Point2 -- ^ Position
-> Point2 -- ^ Velocity
-> World
-> World
makeGasCloud pos vel w = w
& clouds .:~ theCloud
& randGen .~ g
where
theCloud = Cloud
{ _clPos = addZ 20 pos
, _clVel = addZ 0 vel
, _clPict = \_ -> setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col)
$ circleSolid 20
, _clRad = 10
, _clAlt = 25
, _clTimer = 400
, _clType = GasCloud
, _clEffect = cloudPoisonDamage
}
(col, g) = runState (takeOne [green,yellow]) $ _randGen w
{- 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 clpos w
f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
doDam cr = cr & crState . crDamage .:~ Damage POISONDAM 1 clpos clpos clpos NoDamageEffect
clpos = stripZ $ _clPos c