From b50dd8605a653a077d4b98965236ca65dcc9d12a Mon Sep 17 00:00:00 2001 From: jgk Date: Mon, 22 Mar 2021 13:11:08 +0100 Subject: [PATCH] Refactor bullet hit effect towards penetrating bullets --- src/Dodge/Data.hs | 13 +++++--- src/Dodge/Item/Weapon.hs | 4 +-- src/Dodge/Item/Weapon/Bullet.hs | 8 ++--- src/Dodge/Item/Weapon/TriggerType.hs | 6 ++-- src/Dodge/WorldActions.hs | 17 +++++++--- src/Dodge/WorldActions/Bullet.hs | 49 ++++++++++++++++------------ 6 files changed, 57 insertions(+), 40 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 4044bf911..aefecead1 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index f7039b9f6..1a630061f 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -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)) diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index 33473309c..8ccffbebd 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 97d3c7ae1..6d51caf4b 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -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) diff --git a/src/Dodge/WorldActions.hs b/src/Dodge/WorldActions.hs index a6ae192fb..046084101 100644 --- a/src/Dodge/WorldActions.hs +++ b/src/Dodge/WorldActions.hs @@ -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 diff --git a/src/Dodge/WorldActions/Bullet.hs b/src/Dodge/WorldActions/Bullet.hs index d65fbabf2..5da51acb2 100644 --- a/src/Dodge/WorldActions/Bullet.hs +++ b/src/Dodge/WorldActions/Bullet.hs @@ -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