justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Implement wall penetrating bullets

Browse Source
This commit is contained in:
jgk
2021-03-23 12:06:46 +01:00
parent 63a50f0e05
commit 941fef134d
7 changed files with 67 additions and 90 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/WorldEvent.hs
+43 -16
View File
@@ -25,6 +25,7 @@ import Control.Monad.State
import System.Random
import Data.Bifunctor
import Data.Maybe
import Data.Function
import Data.List
@@ -205,7 +206,7 @@ createSpark time colid pos dir maycid w = over worldEvents
, _btPassThrough' = maycid
, _btWidth' = 1
, _btTimer' = time
, _btHitEffect' = threeEff' sparkEff noEff noEff
, _btHitEffect' = destroyOnImpact sparkEff noEff noEff
}
x = fst $ randomR (0,20) $ _randGen w
pos' = pos +.+ rotateV dir (x,0)
@@ -228,7 +229,7 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents
, _btPassThrough' = maycid
, _btWidth' = 1
, _btTimer' = time
, _btHitEffect' = threeEff' sparkEff noEff noEff
, _btHitEffect' = destroyOnImpact sparkEff noEff noEff
}
x = fst $ randomR (0,20) $ _randGen w
pos' = pos +.+ rotateV dir (x,0)
@@ -243,22 +244,48 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents
noEff _ _ _ = id
threeEff' ::
( Particle' -> Point2 -> Creature -> World -> World ) ->
( Particle' -> Point2 -> Wall -> World -> World ) ->
( Particle' -> Point2 -> ForceField -> World -> World ) ->
type HitCreatureEffect = Particle' -> Point2 -> Creature -> World -> World
type HitWallEffect = Particle' -> Point2 -> Wall -> World -> World
type HitForceFieldEffect = Particle' -> Point2 -> ForceField -> World -> World
destroyOnImpact :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
threeEff' crEff wlEff ffEff pt hitThings w = case hitThings of
[] -> error "threeEff called without hitting anything"
((p,E3x1 cr):_) -> (crEff pt p cr w, updatePt p)
((p,E3x2 wl):_) -> (wlEff pt p wl w, updatePt p)
((p,E3x3 ff):_) -> (ffEff pt p ff w, updatePt p)
where updatePt hitp = Just $ pt & btTrail' .~ (hitp : trl)
& ptPict' .~ bulLine col wth (hitp: trl)
& btTimer' .~ 3
destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
[] -> ( w, mvPt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
& ptPict' .~ bulLine col wth (hitp: trl)
& btTimer' .~ 3
mvPt = Just $ pt & btTrail' .~ (newP : trl)
& ptPict' .~ bulLine col wth (newP : trl)
& btTimer' %~ (\t -> t - 1)
& btPassThrough' .~ Nothing
trl = _btTrail' pt
col = _btColor' pt
wth = _btWidth' pt
newP = head trl +.+ _btVel' pt
penWalls :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
[] -> ( w, mvPt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
((p,E3x2 wl):hs) | isJust (wl ^? blHP)
-> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w
((p,E3x2 wl):_) | otherwise -> (wlEff pt p wl w, destroyAt p)
where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
& ptPict' .~ bulLine col wth (hitp: trl)
& btTimer' .~ 3
mvPt = Just $ pt & btTrail' .~ (newP : trl)
& ptPict' .~ bulLine col wth (newP : trl)
& btTimer' %~ (\t -> t - 1)
& btPassThrough' .~ Nothing
trl = _btTrail' pt
col = _btColor' pt
wth = _btWidth' pt
newP = head trl +.+ _btVel' pt
makeFlameletTimed :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> Int -> World -> World
makeFlameletTimed pos vel levelInt maycid size time w
@@ -273,7 +300,7 @@ makeFlameletTimed pos vel levelInt maycid size time w
, _btPassThrough' = maycid
, _btWidth' = size
, _btTimer' = time
, _btHitEffect' = threeEff' (doFlameDam 1) noEff noEff
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
}
(rot ,g) = randomR (0,3) $ _randGen w
@@ -288,7 +315,7 @@ makeFlamelet pos vel levelInt maycid size w = set randGen g $ over particles' ((
, _btPassThrough' = maycid
, _btWidth' = size
, _btTimer' = 20
, _btHitEffect' = threeEff' (doFlameDam 1) noEff noEff
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
}
(rot ,g) = randomR (0.5,1.5) $ _randGen w
moveFlamelet :: Int -> Float -> World -> Particle' -> (World, Maybe Particle')