Refactor bullet particles
This commit is contained in:
@@ -0,0 +1,10 @@
|
||||
module Dodge.Particle.Bullet.Draw
|
||||
( drawBul
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Picture
|
||||
|
||||
drawBul :: Particle -> Picture
|
||||
drawBul pt = setLayer 1 . color thecolor $ thickLine (take 2 $ _btTrail' pt) (_btWidth' pt)
|
||||
where
|
||||
thecolor = _btColor' pt
|
||||
@@ -0,0 +1,211 @@
|
||||
{- |
|
||||
Effects of bullets upon impact with walls or creatures, and possibly force fields.
|
||||
-}
|
||||
module Dodge.Particle.Bullet.HitEffect
|
||||
where
|
||||
import Dodge.Data
|
||||
--import Dodge.Base
|
||||
import Dodge.WorldEvent
|
||||
import Dodge.Particle.Bullet.Spawn
|
||||
import Dodge.WorldEvent.DamageBlock
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.RandomHelp
|
||||
import Dodge.WorldEvent.Shockwave
|
||||
import Dodge.Creature.State.Data
|
||||
import Dodge.Creature.Property
|
||||
import Geometry
|
||||
import Picture
|
||||
|
||||
import System.Random
|
||||
import Control.Lens
|
||||
import Control.Monad.State
|
||||
--import Data.Maybe
|
||||
--import qualified Data.IntMap.Strict as IM
|
||||
-- | Basic bullet hit creature effect.
|
||||
bulHitCr :: Particle -> Point2 -> Creature -> World -> World
|
||||
bulHitCr bt p cr w
|
||||
| crIsArmouredFrom p cr
|
||||
= createSparkCol 8 colID p1 (argV (p1 -.- p) + d1) Nothing . addDamageArmoured $ w
|
||||
| otherwise = addDamage . makeHitSound . flashEff $ w
|
||||
where
|
||||
sp = head $ _btTrail' bt
|
||||
bulVel = _btVel' bt
|
||||
ep = sp +.+ bulVel
|
||||
mvDams = [ PushDam 1 $ 2 *.* bulVel ]
|
||||
addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
|
||||
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
|
||||
makeHitSound = soundMultiFrom [CrHitSound 0] 15 10 0
|
||||
flashEff = over worldEvents (bloodFlashAt p . )
|
||||
cid = _crID cr
|
||||
(d1,_) = randomR (-0.7,0.7) $ _randGen w
|
||||
colID = _btColor' bt
|
||||
--(colID,_) = randomR (0,11) $ _randGen w
|
||||
p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr)
|
||||
{- | Bounce off armoured creatures, otherwise do damage. -}
|
||||
bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World
|
||||
bulBounceArmCr' bt p cr w
|
||||
| crIsArmouredFrom p cr = addBouncer . addDamageArmoured $ w
|
||||
| otherwise = addDamage . makeHitSound . flashEff $ w
|
||||
where
|
||||
sp = head $ _btTrail' bt
|
||||
bulVel = _btVel' bt
|
||||
ep = sp +.+ bulVel
|
||||
mvDams = [ PushDam 1 $ 2 *.* bulVel ]
|
||||
addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
|
||||
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
|
||||
makeHitSound = soundMultiFrom [CrHitSound 0] 15 10 0
|
||||
flashEff = over worldEvents ((.) $ bloodFlashAt p)
|
||||
cid = _crID cr
|
||||
newDir = safeNormalizeV (p -.- _crPos cr)
|
||||
pOut = p +.+ 2 *.* newDir
|
||||
reflectVel = magV bulVel *.* newDir
|
||||
addBouncer = worldEvents %~ ( over particles (bouncer :) . )
|
||||
bouncer = (aGenBulAt Nothing (_btColor' bt) pOut reflectVel
|
||||
(_btHitEffect' bt) (_btWidth' bt)
|
||||
) {_btTimer' = _btTimer' bt - 1}
|
||||
{- | Bullet pass through creatures. -}
|
||||
bulPenCr' :: Particle -> Point2 -> Creature -> World -> World
|
||||
bulPenCr' bt p cr w
|
||||
= over (creatures . ix cid . crState . crDamage)
|
||||
([Piercing 50 sp p ep
|
||||
,Blunt 50 sp p ep
|
||||
,TorqueDam 1 d1
|
||||
,PushDam 1 $ 3 *.* (ep -.- sp)
|
||||
]
|
||||
++
|
||||
)
|
||||
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
||||
$ over worldEvents (addPiercer . )
|
||||
w
|
||||
where
|
||||
(d1,_) = randomR (-0.7,0.7) $ _randGen w
|
||||
cid = _crID cr
|
||||
sp = head $ _btTrail' bt
|
||||
ep = sp +.+ _btVel' bt
|
||||
addPiercer = over particles (piercer :)
|
||||
piercer = (aGenBulAt (Just cid) (_btColor' bt) p (_btVel' bt)
|
||||
(_btHitEffect' bt) (_btWidth' bt)
|
||||
) {_btTimer' = _btTimer' bt - 1}
|
||||
{- | Heavy bullet effects when hitting creature:
|
||||
piercing, blunt, twisting and pushback damage all applied. -}
|
||||
hvBulHitCr' :: Particle -> Point2 -> Creature -> World -> World
|
||||
hvBulHitCr' bt p cr w
|
||||
= over (creatures . ix cid . crState . crDamage)
|
||||
([Piercing 200 sp p ep
|
||||
,Blunt 100 sp p ep
|
||||
,TorqueDam 1 d1
|
||||
,PushDam 1 $ 3 *.* (ep -.- sp)
|
||||
]
|
||||
++
|
||||
)
|
||||
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
||||
w
|
||||
where
|
||||
(d1,_) = randomR (-0.7,0.7) $ _randGen w
|
||||
cid = _crID cr
|
||||
sp = head $ _btTrail' bt
|
||||
ep = sp +.+ _btVel' bt
|
||||
{- | Create a flamelet when hitting a creature. -}
|
||||
bulIncCr' :: Particle -> Point2 -> Creature -> World -> World
|
||||
bulIncCr' bt p cr w
|
||||
= over (creatures . ix cid . crState . crDamage)
|
||||
( Piercing 60 sp p ep : )
|
||||
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
||||
$ incFlamelets
|
||||
w
|
||||
where
|
||||
cid = _crID cr
|
||||
sp = head $ _btTrail' bt
|
||||
ep = sp +.+ _btVel' bt
|
||||
v = evalState (randInCirc 1) $ _randGen w
|
||||
incFlamelets = over worldEvents $ (.) (makeFlameletTimed p v Nothing 3 20)
|
||||
{- | Creates a shockwave when hitting a creature. -}
|
||||
bulConCr' :: Particle -> Point2 -> Creature -> World -> World
|
||||
bulConCr' bt p cr w
|
||||
= over (creatures . ix cid . crState . crDamage)
|
||||
( Piercing 60 sp p ep : )
|
||||
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
||||
$ mkwave
|
||||
w
|
||||
where
|
||||
cid = _crID cr
|
||||
sp = head $ _btTrail' bt
|
||||
ep = sp +.+ _btVel' bt
|
||||
mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
|
||||
{- | Hitting wall effects: create a spark, damage blocks. -}
|
||||
bulHitWall' :: Particle -> Point2 -> Wall -> World -> World
|
||||
bulHitWall' bt p x w = damageBlocksBy 5 x
|
||||
$ createSpark 8 12 pOut (reflectDir x) Nothing
|
||||
$ set randGen g
|
||||
w
|
||||
where
|
||||
sp = head $ _btTrail' bt
|
||||
pOut = p +.+ safeNormalizeV (sp -.- p)
|
||||
(a, g) = randomR (-0.2,0.2) $ _randGen w
|
||||
reflectDir wall = a + argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) )
|
||||
{- | Bounce off walls, do damage to blocks. -}
|
||||
bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World
|
||||
bulBounceWall' bt p wl w = damageBlocksBy 5 wl $ over worldEvents addBouncer w
|
||||
where
|
||||
sp = head $ _btTrail' bt
|
||||
pOut = p +.+ safeNormalizeV (sp -.- p)
|
||||
bouncer = (aGenBulAt Nothing (_btColor' bt) pOut reflectVel
|
||||
(_btHitEffect' bt) (_btWidth' bt)
|
||||
) {_btTimer' = _btTimer' bt - 1}
|
||||
wallV = uncurry (-.-) (_wlLine wl)
|
||||
reflectVel = reflectIn wallV (_btVel' bt)
|
||||
addBouncer = ( over particles (bouncer : ) . )
|
||||
-- the hack is to get around the fact that the particles list gets reset after
|
||||
-- all projectiles in it are checked, so we cannot add to it as we accumulate over
|
||||
-- this list
|
||||
|
||||
{- | Create flamelet on wall. -}
|
||||
bulIncWall'
|
||||
:: Particle
|
||||
-> Point2 -- Impact point
|
||||
-> Wall
|
||||
-> World
|
||||
-> World
|
||||
bulIncWall' bt p wl w = damageBlocksBy 5 wl $ incFlamelets w
|
||||
where
|
||||
sp = head $ _btTrail' bt
|
||||
pOut = p +.+ safeNormalizeV (sp -.- p)
|
||||
wallV = uncurry (-.-) (_wlLine wl)
|
||||
reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
|
||||
incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20)
|
||||
{- | Create a shockwave on wall-}
|
||||
bulConWall'
|
||||
:: Particle
|
||||
-> Point2 -- ^ Impact point
|
||||
-> Wall
|
||||
-> World
|
||||
-> World
|
||||
bulConWall' _ p wl = damageBlocksBy 1 wl .
|
||||
over worldEvents ( makeShockwaveAt [] p 15 4 1 white . )
|
||||
|
||||
hvBulHitWall'
|
||||
:: Particle
|
||||
-> Point2 -- ^ Impact point
|
||||
-> Wall
|
||||
-> World
|
||||
-> World
|
||||
hvBulHitWall' bt p x w = damageBlocksBy 5 x $ set randGen g $ foldr ($) w (sparks pOut sv)
|
||||
where
|
||||
sp = head $ _btTrail' bt
|
||||
pOut = p +.+ safeNormalizeV (sp -.- p)
|
||||
(a, g) = randomR (-0.2,0.2) $ _randGen w
|
||||
reflectDir wall = a +
|
||||
argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) )
|
||||
sv = unitVectorAtAngle $ reflectDir x
|
||||
cs = take 10 $ randomRs (0,11) $ _randGen w
|
||||
ds = randomRs (-0.7,0.7) $ _randGen w
|
||||
ts = randomRs (4,8) $ _randGen w
|
||||
sparks pos vel = zipWith3 (\t c d -> createSpark t c pos (argV vel + d) Nothing) ts cs ds
|
||||
|
||||
bulHitFF' :: Particle -> Point2 -> ForceField -> World -> World
|
||||
bulHitFF' _ _ _ = id
|
||||
{- | Typical effect: destroy on impact, damage creatures and blocks, create spark on walls. -}
|
||||
basicBulletEffect :: HitEffect
|
||||
basicBulletEffect = destroyOnImpact bulHitCr bulHitWall' bulHitFF'
|
||||
|
||||
|
||||
@@ -0,0 +1,53 @@
|
||||
module Dodge.Particle.Bullet.Spawn
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Particle.Bullet.Draw
|
||||
import Dodge.Particle.Bullet.Update
|
||||
import Geometry
|
||||
import Picture
|
||||
|
||||
import Control.Lens
|
||||
|
||||
aGenBulAt
|
||||
:: Maybe Int -- ^ Pass-through creature id
|
||||
-> Color
|
||||
-> Point2 -- ^ Start position
|
||||
-> Point2 -- ^ Velocity
|
||||
-> HitEffect
|
||||
-> Float -- ^ Bullet width
|
||||
-> Particle
|
||||
aGenBulAt maycid _ pos vel hiteff width = Bul'
|
||||
{ _ptDraw = drawBul
|
||||
, _ptUpdate' = mvGenBullet'
|
||||
, _btVel' = vel
|
||||
, _btColor' = white
|
||||
, _btTrail' = [pos]
|
||||
, _btPassThrough' = maycid
|
||||
, _btWidth' = width
|
||||
, _btTimer' = 100
|
||||
, _btHitEffect' = hiteff
|
||||
}
|
||||
|
||||
aCurveBulAt
|
||||
:: Maybe Int -- ^ Pass-through creature id
|
||||
-> Color
|
||||
-> Point2 -- ^ Start position
|
||||
-> Point2 -- ^ Control position
|
||||
-> Point2 -- ^ Target position
|
||||
-> HitEffect
|
||||
-> Float -- ^ Bullet width
|
||||
-> Particle
|
||||
aCurveBulAt maycid col pos control targ hiteff width = Bul'
|
||||
{ _ptDraw = drawBul
|
||||
, _ptUpdate' = \w -> mvGenBullet' w . setVel
|
||||
, _btVel' = (0,0)
|
||||
, _btColor' = col
|
||||
, _btTrail' = [pos]
|
||||
, _btPassThrough' = maycid
|
||||
, _btWidth' = width
|
||||
, _btTimer' = 100
|
||||
, _btHitEffect' = hiteff
|
||||
}
|
||||
where
|
||||
setVel pt = pt & btVel' .~ bf (fromIntegral $ _btTimer' pt - 1) -.- bf (fromIntegral $ _btTimer' pt)
|
||||
bf t = bQuadToF (pos,control,targ) $ (100 - t) * 0.05
|
||||
@@ -0,0 +1,34 @@
|
||||
{-
|
||||
Bullet update.
|
||||
-}
|
||||
module Dodge.Particle.Bullet.Update
|
||||
where
|
||||
import Dodge.Data
|
||||
--import Dodge.Base
|
||||
import Dodge.WorldEvent.ThingsHit
|
||||
--import Picture
|
||||
import Geometry
|
||||
|
||||
import Control.Lens
|
||||
--import Data.Maybe
|
||||
--import Data.List
|
||||
--import Data.Bifunctor
|
||||
--import qualified Data.IntMap.Strict as IM
|
||||
|
||||
{-
|
||||
Update for a generic bullet.
|
||||
-}
|
||||
mvGenBullet' :: World -> Particle -> (World, Maybe Particle)
|
||||
mvGenBullet' w bt
|
||||
| t <= 0 = (w, Nothing)
|
||||
| t < 4 = (w, Just $ set btPassThrough' Nothing
|
||||
$ set btTrail' (p:p:ps)
|
||||
$ set btTimer' (t-1) bt
|
||||
)
|
||||
| otherwise = hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w
|
||||
where
|
||||
mcr = _btPassThrough' bt
|
||||
(p:ps) = _btTrail' bt
|
||||
vel = _btVel' bt
|
||||
hiteff = _btHitEffect' bt
|
||||
t = _btTimer' bt
|
||||
Reference in New Issue
Block a user