138 lines
4.0 KiB
Haskell
138 lines
4.0 KiB
Haskell
module Dodge.Flame (
|
|
aFlameParticle,
|
|
makeFlame,
|
|
updateFlame,
|
|
) where
|
|
|
|
import Dodge.Data.World
|
|
import Data.Foldable
|
|
import Data.Tuple
|
|
import Dodge.LightSource
|
|
import Dodge.SoundLogic
|
|
import Dodge.WorldEvent.Cloud
|
|
import Dodge.WorldEvent.ThingsHit
|
|
import Dodge.Zoning.Wall
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import LensHelp
|
|
import qualified ListHelp as List
|
|
import Picture
|
|
import RandomHelp
|
|
|
|
aFlameParticle ::
|
|
-- | Timer
|
|
Int ->
|
|
-- | Position
|
|
Point2 ->
|
|
-- | Velocity
|
|
Point2 ->
|
|
Flame
|
|
aFlameParticle t pos vel =
|
|
Flame
|
|
{ _flVel = vel
|
|
, _flColor = red
|
|
, _flPos = pos
|
|
, _flWidth = 4
|
|
, _flTimer = t
|
|
, _flZ = 20
|
|
, _flOriginalVel = vel
|
|
}
|
|
|
|
simpleDamFL :: DamageType -> Int -> Flame -> Point2 -> [Damage]
|
|
simpleDamFL dt amount bt p = [Damage dt amount sp p ep NoDamageEffect]
|
|
where
|
|
sp = _flPos bt
|
|
bulVel = _flVel bt
|
|
ep = sp +.+ bulVel
|
|
|
|
expireAndDamageFL ::
|
|
(Flame -> Point2 -> [Damage]) ->
|
|
Flame ->
|
|
[(Point2, Either Creature Wall)] ->
|
|
World ->
|
|
(World, Maybe Flame)
|
|
expireAndDamageFL fdm bt things w = case List.safeHead things of
|
|
Nothing -> (w, Just $ bt & flTimer -~ 1)
|
|
Just x -> (doDamagesFL fdm x bt w, Nothing)
|
|
|
|
doDamagesFL ::
|
|
(Flame -> Point2 -> [Damage]) ->
|
|
(Point2, Either Creature Wall) ->
|
|
Flame ->
|
|
World ->
|
|
World
|
|
doDamagesFL fdm (p, thhit) bt = case thhit of
|
|
Left cr -> cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
|
|
Right wl -> cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
|
|
where
|
|
dams = fdm bt p
|
|
|
|
{- TODO: add generalised area damage particles/hiteffects. -}
|
|
updateFlame :: World -> Flame -> (World, Maybe Flame)
|
|
updateFlame w pt
|
|
| time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing)
|
|
| otherwise = case List.safeHead $ thingsHit sp ep w of
|
|
Just (_, Left _) -> (doSound $ dodamage w, mvPt' 0.7)
|
|
Just (p, Right wl) -> (doSound $ dodamage w, rfl wl p)
|
|
_ -> (flFlicker pt $ doSound $ dodamage w, mvPt' 0.98)
|
|
where
|
|
rotd = _flOriginalVel pt
|
|
time = _flTimer pt
|
|
doSound = soundContinue FlameSound (V2 x y) fireLoudS (Just 2)
|
|
sp@(V2 x y) = _flPos pt
|
|
vel = _flVel pt
|
|
ep = sp +.+ vel
|
|
mvPt' drag =
|
|
Just $
|
|
pt
|
|
& flTimer -~ 1
|
|
& flPos .~ ep
|
|
& flVel %~ (drag *.*)
|
|
dodamage = flDamageInArea closeCrs closeWls pt
|
|
closeWls wl = uncurry segOnCirc (_wlLine wl) ep 5
|
|
closeCrs cr =
|
|
dist ep (_crPos cr)
|
|
< _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80))
|
|
+ 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd)
|
|
angleCoeff x' = abs $ 1 - abs ((x' * 2 - pi) / pi)
|
|
rfl wl p =
|
|
Just $
|
|
pt
|
|
{ _flTimer = time - 1
|
|
, _flPos = pOut p
|
|
, _flVel = reflV wl
|
|
}
|
|
pOut p = p +.+ squashNormalizeV (sp -.- p)
|
|
reflV wall =
|
|
(0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel)
|
|
+.+ (0.2 *.* vel)
|
|
|
|
flDamageInArea :: (Creature -> Bool) -> (Wall -> Bool) -> Flame -> World -> World
|
|
{-# INLINE flDamageInArea #-}
|
|
flDamageInArea crt wlt pt w = damwls damcrs
|
|
where
|
|
p = _flPos pt
|
|
damcrs = foldl' (flip $ \cr -> fst . hiteff [(p, Left cr)]) w $ IM.filter crt $ w ^. cWorld . lWorld . creatures--_creatures (_cWorld w)
|
|
damwls w' =
|
|
foldl'
|
|
(flip $ \wl -> fst . hiteff [(p, Right wl)])
|
|
w'
|
|
. filter wlt
|
|
$ wlsNearPoint p w'
|
|
hiteff = expireAndDamageFL (simpleDamFL FLAMING 1) pt
|
|
|
|
flFlicker :: Flame -> World -> World
|
|
flFlicker pt
|
|
| _flTimer pt `mod` 7 == 0 =
|
|
cWorld . lWorld . tempLightSources
|
|
.:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_flColor pt)) (addZ 10 $ _flPos pt)
|
|
| otherwise = id
|
|
|
|
makeFlame :: Point2 -> Point2 -> World -> World
|
|
makeFlame pos vel w =
|
|
w
|
|
& cWorld . lWorld . flames .:~ aFlameParticle t pos vel
|
|
& randGen .~ g
|
|
where
|
|
(t, g) = randomR (99, 101) (_randGen w)
|