This commit is contained in:
2021-04-27 11:45:43 +02:00
parent f8351fb150
commit 64b5b9e2a5
34 changed files with 974 additions and 761 deletions
+116 -95
View File
@@ -20,12 +20,11 @@ import qualified Data.IntMap.Strict as IM
import Picture
-- bullet effects
bulHitCr' :: Particle' -> Point2 -> Creature -> World -> World
-- | bullet effects
bulHitCr' :: Particle -> Point2 -> Creature -> World -> World
bulHitCr' bt p cr w
| crIsArmouredFrom p cr
= createSpark 8 colID p1 (argV (p1 -.- p) + d1) Nothing
. addDamageArmoured $ w
= createSpark 8 colID p1 (argV (p1 -.- p) + d1) Nothing . addDamageArmoured $ w
| otherwise
= addDamage . hitSound . flashEff $ w
where
@@ -42,7 +41,10 @@ bulHitCr' bt p cr w
(colID,_) = randomR (0,11) $ _randGen w
p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr)
bulBounceArmCr' :: Particle' -> Point2 -> Creature -> World -> World
{-
Bounce off armoured creatures, otherwise do damage.
-}
bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World
bulBounceArmCr' bt p cr w
| crIsArmouredFrom p cr
= addBouncer . addDamageArmoured $ w
@@ -61,12 +63,15 @@ bulBounceArmCr' bt p cr w
newDir = safeNormalizeV (p -.- _crPos cr)
pOut = p +.+ 2 *.* newDir
reflectVel = magV bulVel *.* newDir
addBouncer = worldEvents %~ ((over particles' (bouncer :) ) . )
addBouncer = worldEvents %~ ((over particles (bouncer :) ) . )
bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel
(_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
bulPenCr' :: Particle' -> Point2 -> Creature -> World -> World
{-
Bullet pass through creatures.
-}
bulPenCr' :: Particle -> Point2 -> Creature -> World -> World
bulPenCr' bt p cr w
= over (creatures . ix cid . crState . crDamage)
(\dams -> [Piercing 50 sp p ep
@@ -82,14 +87,16 @@ bulPenCr' bt p cr w
cid = _crID cr
sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
addPiercer = (.) $ over particles' ((:) piercer)
addPiercer = (.) $ over particles (piercer :)
piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt)
(_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
hvBulHitCr' :: Particle' -> Point2 -> Creature -> World -> World
hvBulHitCr' bt p cr w
= over (creatures . ix cid . crState . crDamage)
{- 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)
(\dams -> [Piercing 200 sp p ep
,Blunt 100 sp p ep
,TorqueDam 1 d1
@@ -98,12 +105,13 @@ hvBulHitCr' bt p cr w
)
$ soundMultiFrom [CrHitSound 0] 15 10 0
w
where (d1,g) = randomR (-0.7,0.7) $ _randGen w
cid = _crID cr
sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
where
(d1,g) = randomR (-0.7,0.7) $ _randGen w
cid = _crID cr
sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
bulIncCr' :: Particle' -> Point2 -> Creature -> World -> World
bulIncCr' :: Particle -> Point2 -> Creature -> World -> World
bulIncCr' bt p cr w
= over (creatures . ix cid . crState . crDamage)
(\dams -> [Piercing 60 sp p ep
@@ -112,13 +120,17 @@ bulIncCr' bt p cr w
$ 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)
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)
bulConCr' :: Particle' -> Point2 -> Creature -> World -> World
{-
Creates a shockwave when hitting a creature.
-}
bulConCr' :: Particle -> Point2 -> Creature -> World -> World
bulConCr' bt p cr w
= over (creatures . ix cid . crState . crDamage)
(\dams -> [Piercing 60 sp p ep
@@ -127,31 +139,39 @@ bulConCr' bt p cr w
$ 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)
where
cid = _crID cr
sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
bulHitWall' :: Particle' -> Point2 -> Wall -> World -> World
{-
Hitting wall effects: create a spark, damage blocks.
-}
bulHitWall' :: Particle -> Point2 -> Wall -> World -> World
bulHitWall' bt p x w = damageBlocks x
$ createSpark 8 colID pOut (reflectDir x) Nothing
$ set randGen g
w
where sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
(colID,g) = randomR (0,11) $ _randGen w
(a, _) = randomR (-0.1,0.1) $ _randGen w
spid = newKey $ _projectiles w
reflectDir wall = a + (argV $ reflectIn
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
(p -.- sp)
)
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
_ -> w
where
sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
(colID,g) = randomR (0,11) $ _randGen w
(a, _) = randomR (-0.1,0.1) $ _randGen w
spid = newKey $ _projectiles w
reflectDir wall = a + (argV $ reflectIn
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
(p -.- sp)
)
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
_ -> w
bulBounceWall' :: Particle' -> Point2 -> Wall -> World -> World
{-
Bounce off walls, do damage to blocks.
-}
bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World
bulBounceWall' bt p wl w = damageBlocks wl $ over worldEvents addBouncer w
where
sp = head $ _btTrail' bt
@@ -165,71 +185,72 @@ bulBounceWall' bt p wl w = damageBlocks wl $ over worldEvents addBouncer w
) {_btTimer' = _btTimer' bt - 1}
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
reflectVel = (reflectIn wallV (_btVel' bt))
addBouncer = (.) (over particles' ((:) bouncer))
-- the hack is to get around the fact that the particles' list gets reset after
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
bulIncWall' :: Particle' -> Point2 -> Wall -> World -> World
bulIncWall' bt p wl w = damageBlocks wl
$ incFlamelets
-- yay for hack -- should have used this before? or never?
w
where sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
_ -> w
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20)
{- Create flamelet on wall.
-}
bulIncWall' :: Particle -> Point2 -> Wall -> World -> World
bulIncWall' bt p wl w = damageBlocks wl $ incFlamelets w
where
sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
_ -> w
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20)
bulConWall' :: Particle' -> Point2 -> Wall -> World -> World
bulConWall' bt p wl w = damageBlocks wl
$ mkwave
w
where sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
_ -> w
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
{- Create a shockwave on wall-}
bulConWall' :: Particle -> Point2 -> Wall -> World -> World
bulConWall' bt p wl w = damageBlocks wl $ mkwave w
where
sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
_ -> w
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
hvBulHitWall' :: Particle' -> Point2 -> Wall -> World -> World
hvBulHitWall' bt p x w = damageBlocks x
$ set randGen g
$ foldr ($) w (sparks pOut sv)
where sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
(a, g) = randomR (-0.1,0.1) $ _randGen w
spid = newKey $ _projectiles w
reflectDir wall = a + (argV $ reflectIn
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
(p -.- sp)
)
sv = unitVectorAtAngle $ reflectDir x
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 20)) w (_blIDs wall)
_ -> w
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
hvBulHitWall' :: Particle -> Point2 -> Wall -> World -> World
hvBulHitWall' bt p x w = damageBlocks x $ set randGen g $ foldr ($) w (sparks pOut sv)
where
sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
(a, g) = randomR (-0.1,0.1) $ _randGen w
spid = newKey $ _projectiles w
reflectDir wall = a + (argV $ reflectIn
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
(p -.- sp)
)
sv = unitVectorAtAngle $ reflectDir x
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 20)) w (_blIDs wall)
_ -> w
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
bulletEffect' :: HitEffect
bulletEffect' = destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
bulletParticleSideEffect :: Particle' -> HitEffect
bulletParticleSideEffect :: Particle -> HitEffect
bulletParticleSideEffect pt = destroyOnImpact mkPt mkPt noEff
where mkPt _ p _ = over particles' ((:) pt {_btTrail' = [p]})
where
mkPt _ p _ = over particles ((pt {_btTrail' = [p]}) :)
aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect -> Float -> Particle'
aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect -> Float -> Particle
aGenBulAt' maycid col pos vel hiteff width = Bul'
{ _ptDraw = drawBul
, _ptUpdate' = mvGenBullet'
@@ -242,7 +263,7 @@ aGenBulAt' maycid col pos vel hiteff width = Bul'
, _btHitEffect' = hiteff
}
aCurveBulAt :: Maybe Int -> Color -> Point2 -> Point2 -> Point2 -> HitEffect -> Float -> Particle'
aCurveBulAt :: Maybe Int -> Color -> Point2 -> Point2 -> Point2 -> HitEffect -> Float -> Particle
aCurveBulAt maycid col pos control targ hiteff width = Bul'
{ _ptDraw = drawBul
, _ptUpdate' = \w -> mvGenBullet' w . setVel
+3 -3
View File
@@ -192,7 +192,7 @@ withVelWthHiteff
-> World
-> World
withVelWthHiteff vel width hiteff cid w
= over particles' ((:) newbul) $ set randGen g w
= over particles (newbul : ) $ set randGen g w
where
cr = _creatures w IM.! cid
newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
@@ -281,7 +281,7 @@ spreadNumVelWthHiteff
-> World
-> World
spreadNumVelWthHiteff spread num vel wth eff cid w
= over particles' (newbuls ++) w
= over particles (newbuls ++) w
where
cr = _creatures w IM.! cid
newbuls = zipWith3 (\pos d colid -> aGenBulAt' (Just cid) (numColor colid)
@@ -306,7 +306,7 @@ numVelWthHitEff
-> World
-> World
numVelWthHitEff num vel wth eff cid w
= over particles' (newbuls ++) w
= over particles (newbuls ++) w
where
cr = _creatures w IM.! cid
newbuls = zipWith (\pos colid -> aGenBulAt' (Just cid) (numColor colid)