Refactor bullet hit effect towards penetrating bullets
This commit is contained in:
+8
-5
@@ -447,7 +447,7 @@ data Particle' =
|
||||
, _btPassThrough' :: Maybe Int
|
||||
, _btWidth' :: Float
|
||||
, _btTimer' :: Int
|
||||
, _btHitEffect' :: HitEffect'
|
||||
, _btHitEffect' :: HitEffect
|
||||
}
|
||||
| Pt' { _ptPict' :: Drawing
|
||||
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
|
||||
@@ -457,7 +457,7 @@ data Particle' =
|
||||
, _btPassThrough' :: Maybe Int
|
||||
, _btWidth' :: Float
|
||||
, _btTimer' :: Int
|
||||
, _btHitEffect' :: HitEffect'
|
||||
, _btHitEffect' :: HitEffect
|
||||
}
|
||||
| Shockwave'
|
||||
{ _ptPict' :: Drawing
|
||||
@@ -471,10 +471,14 @@ data Particle' =
|
||||
, _btTimer' :: Int
|
||||
}
|
||||
|
||||
type HitEffect = Particle' -> [( Point2, [(Point2, (Either3 Creature Wall ForceField))] )]
|
||||
-> World -> World
|
||||
type HitEffect' = Particle' -> (Point2, (Either3 Creature Wall ForceField)) -> World -> World
|
||||
|
||||
type HitEffect'' = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] -> World -> World
|
||||
|
||||
type HitEffect = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] -> World
|
||||
-> (World,Maybe Particle')
|
||||
|
||||
|
||||
data Particle =
|
||||
Particle { _ptPos :: Point2
|
||||
, _ptStartPos :: Point2
|
||||
@@ -492,7 +496,6 @@ data Particle =
|
||||
, _btPassThrough :: Maybe Int
|
||||
, _btColor :: Color
|
||||
, _btWidth :: Float
|
||||
-- , _btHitEffect :: Particle -> [(Point2, Either3 Creature Wall ForceField)] -> World -> World
|
||||
}
|
||||
| Bullet'
|
||||
{ _ptPos :: Point2
|
||||
|
||||
@@ -908,7 +908,7 @@ moveFlame rotd w pt =
|
||||
$ over worldEvents ((.) $ lowLightRadAt orange 0.05 8 50 ep)
|
||||
damcrs
|
||||
, mvPt')
|
||||
(thing@(p,(E3x2 wl)):_) -> (hiteff thing damcrs, rfl wl p)
|
||||
(thing@(p,(E3x2 wl)):_) -> (fst $ hiteff [thing] damcrs, rfl wl p)
|
||||
_ -> (soundFrom Flame fireSound 2 500
|
||||
-- adding reflective glare is too intensive for this laptop
|
||||
$ over worldEvents ((.) $ lowLightRadAt orange 0.05 8 50 ep)
|
||||
@@ -923,7 +923,7 @@ moveFlame rotd w pt =
|
||||
mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep, _ptPict' = thepic ep
|
||||
, _btPassThrough' = Nothing
|
||||
,_btVel' = 0.7 *.* vel}
|
||||
damcrs = foldr ($) w $ map (\cr -> hiteff (ep,E3x1 cr)) $ filter closeCrs
|
||||
damcrs = foldr ($) w $ map (\cr -> fst . hiteff [(ep,E3x1 cr)]) $ filter closeCrs
|
||||
$ IM.elems $ _creatures w
|
||||
closeCrs cr = dist ep (_crPos cr)
|
||||
< _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80))
|
||||
|
||||
@@ -217,14 +217,14 @@ hvBulHitWall' bt p x w = damageBlocks x
|
||||
bulHitFF' :: Particle' -> Point2 -> ForceField -> World -> World
|
||||
bulHitFF' _ _ _ = id
|
||||
|
||||
bulletEffect' :: HitEffect'
|
||||
bulletEffect' :: HitEffect
|
||||
bulletEffect' = threeEff' bulHitCr' bulHitWall' bulHitFF'
|
||||
|
||||
bulletParticleSideEffect :: Particle' -> HitEffect'
|
||||
bulletParticleSideEffect :: Particle' -> HitEffect
|
||||
bulletParticleSideEffect pt = threeEff' mkPt mkPt noEff
|
||||
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'
|
||||
{ _ptPict' = blank
|
||||
, _ptUpdate' = mvGenBullet'
|
||||
@@ -237,7 +237,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'
|
||||
{ _ptPict' = blank
|
||||
, _ptUpdate' = mvBulletTrajectory f
|
||||
|
||||
@@ -109,7 +109,7 @@ withRandomDir acc f cid w = over (creatures . ix cid . crDir) (\d -> d - a)
|
||||
w
|
||||
where (a, g) = randomR (-acc,acc) $ _randGen w
|
||||
|
||||
withVelWthHiteff :: Point2 -> Float -> HitEffect' -> Int -> World -> World
|
||||
withVelWthHiteff :: Point2 -> Float -> HitEffect -> Int -> World -> World
|
||||
withVelWthHiteff vel width hiteff cid w
|
||||
= over particles' ((:) newbul)
|
||||
-- . over tempLightSources ((:) (tLightAt 4 pos))
|
||||
@@ -157,7 +157,7 @@ torqueAfter torque feff cid w
|
||||
rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
||||
. itAttachment . _Just . scopePos %~ rotateV rot
|
||||
|
||||
spreadNumVelWthHiteff' :: Float -> Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World
|
||||
spreadNumVelWthHiteff' :: Float -> Int -> Point2 -> Float -> HitEffect -> Int -> World -> World
|
||||
spreadNumVelWthHiteff' spread num vel wth eff cid w
|
||||
= over particles' (newbuls ++)
|
||||
$ flip (foldr muzFlareAt) poss
|
||||
@@ -175,7 +175,7 @@ spreadNumVelWthHiteff' spread num vel wth eff cid w
|
||||
-- $ randomRs (0,spreadGunSpread/5) (_randGen w)
|
||||
colids = take num $ randomRs (0,11) (_randGen w)
|
||||
|
||||
numVelWthHitEff' :: Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World
|
||||
numVelWthHitEff' :: Int -> Point2 -> Float -> HitEffect -> Int -> World -> World
|
||||
numVelWthHitEff' num vel wth eff cid w
|
||||
= over particles' (newbuls ++)
|
||||
$ flip (foldr muzFlareAt) (take num poss)
|
||||
|
||||
@@ -365,11 +365,18 @@ threeEff' ::
|
||||
( Particle' -> Point2 -> Creature -> World -> World ) ->
|
||||
( Particle' -> Point2 -> Wall -> World -> World ) ->
|
||||
( Particle' -> Point2 -> ForceField -> World -> World ) ->
|
||||
Particle' -> (Point2, Either3 Creature Wall ForceField) -> World -> World
|
||||
threeEff' crEff wlEff ffEff pt thing w = case thing of
|
||||
(p,E3x1 cr) -> crEff pt p cr w
|
||||
(p,E3x2 wl) -> wlEff pt p wl w
|
||||
(p,E3x3 ff) -> ffEff pt p ff w
|
||||
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
|
||||
trl = _btTrail' pt
|
||||
col = _btColor' pt
|
||||
wth = _btWidth' pt
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -25,24 +25,30 @@ mvBulletTrajectory velF w bt
|
||||
$ set btTimer' (t-1)
|
||||
bt
|
||||
)
|
||||
| otherwise = case firstThingHit $ thingsHitExceptCrCurve mcr (p:newPs) w of
|
||||
(_,Nothing) -> (w, Just $ set btPassThrough' Nothing
|
||||
| otherwise = (w, Just $ set btPassThrough' Nothing
|
||||
$ set btVel' newVel -- this may be useful for hit effects
|
||||
$ set btTrail' (init (reverse newPs) ++ (p:ps))
|
||||
$ set ptPict' (bulLineLen numPs col wth (init (reverse newPs) ++ (p:ps)))
|
||||
$ set btTimer' (t-1) bt
|
||||
)
|
||||
(mvPs,Just (hitp,thing))
|
||||
-> let newMvPs = leftPad numPs hitp (init $ reverse mvPs)
|
||||
hitVel = speed *.* normalizeV ( hitp -.- (head $ reverse mvPs) )
|
||||
in ( hiteff bt (hitp,thing) w
|
||||
--in ( w
|
||||
, Just $ set btPassThrough' Nothing
|
||||
$ set btVel' hitVel -- this may be useful for hit effects
|
||||
$ set btTrail' (newMvPs ++ (p:ps))
|
||||
$ set ptPict' (bulLineLen numPs col wth (newMvPs ++ (p:ps)) )
|
||||
$ set btTimer' 3 bt
|
||||
)
|
||||
)
|
||||
-- | otherwise = case firstThingHit $ thingsHitExceptCrCurve mcr (p:newPs) w of
|
||||
-- (_,Nothing) -> (w, Just $ set btPassThrough' Nothing
|
||||
-- $ set btVel' newVel -- this may be useful for hit effects
|
||||
-- $ set btTrail' (init (reverse newPs) ++ (p:ps))
|
||||
-- $ set ptPict' (bulLineLen numPs col wth (init (reverse newPs) ++ (p:ps)))
|
||||
-- $ set btTimer' (t-1) bt
|
||||
-- )
|
||||
-- (mvPs,Just (hitp,thing))
|
||||
-- -> let newMvPs = leftPad numPs hitp (init $ reverse mvPs)
|
||||
-- hitVel = speed *.* normalizeV ( hitp -.- (head $ reverse mvPs) )
|
||||
-- in ( hiteff bt (hitp,thing) w
|
||||
-- --in ( w
|
||||
-- , Just $ set btPassThrough' Nothing
|
||||
-- $ set btVel' hitVel -- this may be useful for hit effects
|
||||
-- $ set btTrail' (newMvPs ++ (p:ps))
|
||||
-- $ set ptPict' (bulLineLen numPs col wth (newMvPs ++ (p:ps)) )
|
||||
-- $ set btTimer' 3 bt
|
||||
-- )
|
||||
where mcr = _btPassThrough' bt
|
||||
col = _btColor' bt
|
||||
(p:ps) = _btTrail' bt
|
||||
@@ -88,13 +94,14 @@ mvGenBullet' w bt
|
||||
$ set ptPict' (bulLine col wth (p +.+ vel:p:ps))
|
||||
$ set btTimer' (t-1) bt
|
||||
)
|
||||
((hitp,thing):_)
|
||||
-> ( hiteff bt (hitp,thing) w
|
||||
, Just $ set btPassThrough' Nothing
|
||||
$ set btTrail' (hitp:p:ps)
|
||||
$ set ptPict' (bulLine col wth (hitp:p:ps))
|
||||
$ set btTimer' 3 bt
|
||||
)
|
||||
hits -> hiteff bt hits w
|
||||
-- hits@((hitp,thing):_)
|
||||
-- -> ( hiteff bt hits w
|
||||
-- , Just $ set btPassThrough' Nothing
|
||||
-- $ set btTrail' (hitp:p:ps)
|
||||
-- $ set ptPict' (bulLine col wth (hitp:p:ps))
|
||||
-- $ set btTimer' 3 bt
|
||||
-- )
|
||||
where mcr = _btPassThrough' bt
|
||||
col = _btColor' bt
|
||||
(p:ps) = _btTrail' bt
|
||||
|
||||
Reference in New Issue
Block a user