137 lines
3.8 KiB
Haskell
137 lines
3.8 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
module Dodge.EnergyBall
|
|
( updateEnergyBall
|
|
, incBallAt
|
|
, makeFlashBall
|
|
, makeFlamelet
|
|
) where
|
|
|
|
import Data.List (foldl')
|
|
import Dodge.WorldEvent.ThingsHit
|
|
import qualified Data.IntMap.Strict as IM
|
|
import Dodge.Base.Collide
|
|
import Data.Maybe
|
|
import Dodge.Data.World
|
|
import Geometry
|
|
import LensHelp
|
|
import Picture
|
|
import RandomHelp
|
|
|
|
makeFlamelet ::
|
|
-- | Position
|
|
Point2 ->
|
|
-- | Velocity
|
|
Point2 ->
|
|
-- | Size
|
|
Float ->
|
|
-- | Timer
|
|
Int ->
|
|
World ->
|
|
World
|
|
makeFlamelet (V2 x y) vel s t w =
|
|
w
|
|
& randGen .~ g
|
|
& cWorld . lWorld . energyBalls
|
|
.:~ EnergyBall
|
|
{ _ebVel = vel
|
|
, _ebPos = V2 x y
|
|
, _ebTimer = t
|
|
, _ebEff = FlameletBall s
|
|
, _ebRot = rot
|
|
}
|
|
where
|
|
(rot, g) = randomR (0, 3) $ _randGen w
|
|
|
|
updateEnergyBall :: World -> EnergyBall -> (World, Maybe EnergyBall)
|
|
updateEnergyBall w eb
|
|
| _ebTimer eb <= 0 = (w, Nothing)
|
|
| otherwise =
|
|
( ebFlicker eb $ damageCircle (_ebPos eb) (_ebEff eb) w
|
|
, Just $ eb & ebTimer -~ 1 & ebPos .~ bp & ebVel .~ 0.85 * bv
|
|
)
|
|
where
|
|
p = eb ^. ebPos + eb ^. ebVel
|
|
(bp,bv) = fromMaybe (p,eb^.ebVel) $ bouncePoint (const True) 0 (eb ^. ebPos) p w
|
|
-- (bp,bv) = fromMaybe (p,eb^.ebVel) $ bouncePoint (const True) 0.5 (eb ^. ebPos) p w
|
|
|
|
incBallAt :: Point2 -> World -> World
|
|
incBallAt p w =
|
|
w & cWorld . lWorld . energyBalls .:~ theincball
|
|
& randGen .~ g
|
|
where
|
|
(theincball, g) = runState thestate (_randGen w)
|
|
thestate = do
|
|
rot <- state $ randomR (0, 3)
|
|
return
|
|
EnergyBall
|
|
{ _ebVel = 0
|
|
, _ebPos = p
|
|
, _ebTimer = 20
|
|
, _ebEff = FlamingBall
|
|
, _ebRot = rot
|
|
}
|
|
|
|
makeFlashBall :: Point2 -> World -> World
|
|
makeFlashBall p w =
|
|
w & cWorld . lWorld . energyBalls .:~ theincball
|
|
& randGen .~ g
|
|
where
|
|
(theincball, g) = runState thestate (_randGen w)
|
|
thestate = do
|
|
rot <- state $ randomR (0, 3)
|
|
return
|
|
EnergyBall
|
|
{ _ebVel = 0
|
|
, _ebPos = p
|
|
, _ebTimer = 20
|
|
, _ebEff = FlashBall
|
|
, _ebRot = rot
|
|
}
|
|
|
|
ebFlicker :: EnergyBall -> World -> World
|
|
ebFlicker pt
|
|
| _ebTimer pt `mod` 7 == 0 =
|
|
cWorld . lWorld . lights
|
|
.:~ LSParam (addZ 20 $ _ebPos pt) 70 (0.5 *.*.* xyzV4 (ebColor pt))
|
|
| otherwise = id
|
|
|
|
ebColor :: EnergyBall -> Color
|
|
ebColor eb = case eb ^. ebEff of
|
|
FlamingBall -> red
|
|
FlameletBall {} -> red
|
|
ElectricalBall -> cyan
|
|
ExplosiveBall -> yellow
|
|
FlashBall -> white
|
|
|
|
damageCircle :: Point2 -> EnergyBallType -> World -> World
|
|
damageCircle sp dt w =
|
|
w
|
|
& cWorld . lWorld . wallDamages %~ addwalldamages
|
|
& cWorld . lWorld . creatures %~ addcreaturedamages
|
|
where
|
|
r = 5
|
|
addwalldamages wlds = foldl' (damageWlCircle wldam) wlds wlstodam
|
|
wlstodam = wlsHitRadial sp r w
|
|
wldam p = ebtToDamage p dt
|
|
addcreaturedamages crs = foldl' (damageCrCircle crdam) crs crstodam
|
|
crdam = ebtToDamage sp dt
|
|
crstodam = crsHitRadial sp r w
|
|
|
|
ebtToDamage :: Point2 -> EnergyBallType -> Damage
|
|
ebtToDamage p = \case
|
|
FlamingBall -> Flaming 10
|
|
FlameletBall _ -> Flaming 1
|
|
ElectricalBall -> Electrical 10
|
|
ExplosiveBall -> Explosive 10 p
|
|
FlashBall -> Flashing 10 p
|
|
|
|
damageWlCircle ::
|
|
(Point2 -> Damage) ->
|
|
IM.IntMap [Damage] ->
|
|
(Point2, Wall) ->
|
|
IM.IntMap [Damage]
|
|
damageWlCircle f wldams (p, wl) = IM.insertWith (++) (_wlID wl) [f p] wldams
|
|
|
|
damageCrCircle :: Damage -> IM.IntMap Creature -> (Point2, Creature) -> IM.IntMap Creature
|
|
damageCrCircle crdam crs (_, cr) = crs & ix (_crID cr) . crState . csDamage .:~ crdam
|