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

Refactor bullet hit effect towards penetrating bullets

Browse Source
This commit is contained in:
justin
2021-03-22 13:11:08 +01:00
parent 3bee30895d
commit b50dd8605a
6 changed files with 57 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+8 -5
View File
@@ -447,7 +447,7 @@ data Particle' =
, _btPassThrough' :: Maybe Int , _btPassThrough' :: Maybe Int
, _btWidth' :: Float , _btWidth' :: Float
, _btTimer' :: Int , _btTimer' :: Int
, _btHitEffect' :: HitEffect' , _btHitEffect' :: HitEffect
} }
| Pt' { _ptPict' :: Drawing | Pt' { _ptPict' :: Drawing
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle') , _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
@@ -457,7 +457,7 @@ data Particle' =
, _btPassThrough' :: Maybe Int , _btPassThrough' :: Maybe Int
, _btWidth' :: Float , _btWidth' :: Float
, _btTimer' :: Int , _btTimer' :: Int
, _btHitEffect' :: HitEffect' , _btHitEffect' :: HitEffect
} }
| Shockwave' | Shockwave'
{ _ptPict' :: Drawing { _ptPict' :: Drawing
@@ -471,10 +471,14 @@ data Particle' =
, _btTimer' :: Int , _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
type HitEffect = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] -> World
-> (World,Maybe Particle')
data Particle = data Particle =
Particle { _ptPos :: Point2 Particle { _ptPos :: Point2
, _ptStartPos :: Point2 , _ptStartPos :: Point2
@@ -492,7 +496,6 @@ data Particle =
, _btPassThrough :: Maybe Int , _btPassThrough :: Maybe Int
, _btColor :: Color , _btColor :: Color
, _btWidth :: Float , _btWidth :: Float
-- , _btHitEffect :: Particle -> [(Point2, Either3 Creature Wall ForceField)] -> World -> World
} }
| Bullet' | Bullet'
{ _ptPos :: Point2 { _ptPos :: Point2
src/Dodge/Item/Weapon.hs
+2 -2
View File
@@ -908,7 +908,7 @@ moveFlame rotd w pt =
$ over worldEvents ((.) $ lowLightRadAt orange 0.05 8 50 ep) $ over worldEvents ((.) $ lowLightRadAt orange 0.05 8 50 ep)
damcrs damcrs
, mvPt') , 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 _ -> (soundFrom Flame fireSound 2 500
-- adding reflective glare is too intensive for this laptop -- adding reflective glare is too intensive for this laptop
$ over worldEvents ((.) $ lowLightRadAt orange 0.05 8 50 ep) $ 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 mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep, _ptPict' = thepic ep
, _btPassThrough' = Nothing , _btPassThrough' = Nothing
,_btVel' = 0.7 *.* vel} ,_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 $ IM.elems $ _creatures w
closeCrs cr = dist ep (_crPos cr) closeCrs cr = dist ep (_crPos cr)
< _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80)) < _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80))
src/Dodge/Item/Weapon/Bullet.hs
+4 -4
View File
@@ -217,14 +217,14 @@ hvBulHitWall' bt p x w = damageBlocks x
bulHitFF' :: Particle' -> Point2 -> ForceField -> World -> World bulHitFF' :: Particle' -> Point2 -> ForceField -> World -> World
bulHitFF' _ _ _ = id bulHitFF' _ _ _ = id
bulletEffect' :: HitEffect' bulletEffect' :: HitEffect
bulletEffect' = threeEff' bulHitCr' bulHitWall' bulHitFF' bulletEffect' = threeEff' bulHitCr' bulHitWall' bulHitFF'
bulletParticleSideEffect :: Particle' -> HitEffect' bulletParticleSideEffect :: Particle' -> HitEffect
bulletParticleSideEffect pt = threeEff' mkPt mkPt noEff bulletParticleSideEffect pt = threeEff' 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' aGenBulAt' maycid col pos vel hiteff width = Bul'
{ _ptPict' = blank { _ptPict' = blank
, _ptUpdate' = mvGenBullet' , _ptUpdate' = mvGenBullet'
@@ -237,7 +237,7 @@ aGenBulAt' maycid col pos vel hiteff width = Bul'
, _btHitEffect' = hiteff , _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' aCurveBulAt maycid col pos control targ hiteff width = Bul'
{ _ptPict' = blank { _ptPict' = blank
, _ptUpdate' = mvBulletTrajectory f , _ptUpdate' = mvBulletTrajectory f
src/Dodge/Item/Weapon/TriggerType.hs
+3 -3
View File
@@ -109,7 +109,7 @@ withRandomDir acc f cid w = over (creatures . ix cid . crDir) (\d -> d - a)
w w
where (a, g) = randomR (-acc,acc) $ _randGen 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 withVelWthHiteff vel width hiteff cid w
= over particles' ((:) newbul) = over particles' ((:) newbul)
-- . over tempLightSources ((:) (tLightAt 4 pos)) -- . 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)) rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . _Just . scopePos %~ rotateV rot . 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 spreadNumVelWthHiteff' spread num vel wth eff cid w
= over particles' (newbuls ++) = over particles' (newbuls ++)
$ flip (foldr muzFlareAt) poss $ flip (foldr muzFlareAt) poss
@@ -175,7 +175,7 @@ spreadNumVelWthHiteff' spread num vel wth eff cid w
-- $ randomRs (0,spreadGunSpread/5) (_randGen w) -- $ randomRs (0,spreadGunSpread/5) (_randGen w)
colids = take num $ randomRs (0,11) (_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 numVelWthHitEff' num vel wth eff cid w
= over particles' (newbuls ++) = over particles' (newbuls ++)
$ flip (foldr muzFlareAt) (take num poss) $ flip (foldr muzFlareAt) (take num poss)
src/Dodge/WorldActions.hs
+12 -5
View File
@@ -365,11 +365,18 @@ threeEff' ::
( Particle' -> Point2 -> Creature -> World -> World ) -> ( Particle' -> Point2 -> Creature -> World -> World ) ->
( Particle' -> Point2 -> Wall -> World -> World ) -> ( Particle' -> Point2 -> Wall -> World -> World ) ->
( Particle' -> Point2 -> ForceField -> World -> World ) -> ( Particle' -> Point2 -> ForceField -> World -> World ) ->
Particle' -> (Point2, Either3 Creature Wall ForceField) -> World -> World Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
threeEff' crEff wlEff ffEff pt thing w = case thing of threeEff' crEff wlEff ffEff pt hitThings w = case hitThings of
(p,E3x1 cr) -> crEff pt p cr w [] -> error "threeEff called without hitting anything"
(p,E3x2 wl) -> wlEff pt p wl w ((p,E3x1 cr):_) -> (crEff pt p cr w, updatePt p)
(p,E3x3 ff) -> ffEff pt p ff w ((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
src/Dodge/WorldActions/Bullet.hs
+27 -20
View File
@@ -25,24 +25,30 @@ mvBulletTrajectory velF w bt
$ set btTimer' (t-1) $ set btTimer' (t-1)
bt bt
) )
| otherwise = case firstThingHit $ thingsHitExceptCrCurve mcr (p:newPs) w of | otherwise = (w, Just $ set btPassThrough' Nothing
(_,Nothing) -> (w, Just $ set btPassThrough' Nothing
$ set btVel' newVel -- this may be useful for hit effects $ set btVel' newVel -- this may be useful for hit effects
$ set btTrail' (init (reverse newPs) ++ (p:ps)) $ set btTrail' (init (reverse newPs) ++ (p:ps))
$ set ptPict' (bulLineLen numPs col wth (init (reverse newPs) ++ (p:ps))) $ set ptPict' (bulLineLen numPs col wth (init (reverse newPs) ++ (p:ps)))
$ set btTimer' (t-1) bt $ set btTimer' (t-1) bt
) )
(mvPs,Just (hitp,thing)) -- | otherwise = case firstThingHit $ thingsHitExceptCrCurve mcr (p:newPs) w of
-> let newMvPs = leftPad numPs hitp (init $ reverse mvPs) -- (_,Nothing) -> (w, Just $ set btPassThrough' Nothing
hitVel = speed *.* normalizeV ( hitp -.- (head $ reverse mvPs) ) -- $ set btVel' newVel -- this may be useful for hit effects
in ( hiteff bt (hitp,thing) w -- $ set btTrail' (init (reverse newPs) ++ (p:ps))
--in ( w -- $ set ptPict' (bulLineLen numPs col wth (init (reverse newPs) ++ (p:ps)))
, Just $ set btPassThrough' Nothing -- $ set btTimer' (t-1) bt
$ set btVel' hitVel -- this may be useful for hit effects -- )
$ set btTrail' (newMvPs ++ (p:ps)) -- (mvPs,Just (hitp,thing))
$ set ptPict' (bulLineLen numPs col wth (newMvPs ++ (p:ps)) ) -- -> let newMvPs = leftPad numPs hitp (init $ reverse mvPs)
$ set btTimer' 3 bt -- 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 where mcr = _btPassThrough' bt
col = _btColor' bt col = _btColor' bt
(p:ps) = _btTrail' bt (p:ps) = _btTrail' bt
@@ -88,13 +94,14 @@ mvGenBullet' w bt
$ set ptPict' (bulLine col wth (p +.+ vel:p:ps)) $ set ptPict' (bulLine col wth (p +.+ vel:p:ps))
$ set btTimer' (t-1) bt $ set btTimer' (t-1) bt
) )
((hitp,thing):_) hits -> hiteff bt hits w
-> ( hiteff bt (hitp,thing) w -- hits@((hitp,thing):_)
, Just $ set btPassThrough' Nothing -- -> ( hiteff bt hits w
$ set btTrail' (hitp:p:ps) -- , Just $ set btPassThrough' Nothing
$ set ptPict' (bulLine col wth (hitp:p:ps)) -- $ set btTrail' (hitp:p:ps)
$ set btTimer' 3 bt -- $ set ptPict' (bulLine col wth (hitp:p:ps))
) -- $ set btTimer' 3 bt
-- )
where mcr = _btPassThrough' bt where mcr = _btPassThrough' bt
col = _btColor' bt col = _btColor' bt
(p:ps) = _btTrail' bt (p:ps) = _btTrail' bt