diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 76d2eb03b..8ce823e43 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -374,7 +374,7 @@ mkBezierBul :: Point2 -> Point2 -> Point2 -> Int -> World -> World mkBezierBul startp controlp targetp cid w = over particles' (bbul :) w where bbul = aCurveBulAt (Just cid) white startp (controlp +.+ randPos) (targetp +.+ randPos') - (destroyOnImpact bulHitCr' bulHitWall' bulHitFF') 5 + (passThroughAll bulHitCr' bulHitWall' bulHitFF') 5 (randPos,randPos') = flip evalState (_randGen w) $ do a <- randInCirc 10 b <- randInCirc 20 diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index c26b9c05e..8a0bfb163 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -237,7 +237,7 @@ aGenBulAt' maycid col pos vel hiteff width = Bul' aCurveBulAt :: Maybe Int -> Color -> Point2 -> Point2 -> Point2 -> HitEffect -> Float -> Particle' aCurveBulAt maycid col pos control targ hiteff width = Bul' { _ptDraw = drawBul - , _ptUpdate' = mvBulletTrajectory f + , _ptUpdate' = \w -> mvGenBullet' w . setVel , _btVel' = (0,0) , _btColor' = col , _btTrail' = [pos] @@ -246,7 +246,6 @@ aCurveBulAt maycid col pos control targ hiteff width = Bul' , _btTimer' = 100 , _btHitEffect' = hiteff } - where f i = g $ (100 - fromIntegral i) / den - g x = map (bf . (+ x)) [0,1 / (den * 10)..9 / (den * 10)] - bf = bQuadToF (pos,control,targ) - den = 20 + where + setVel pt = pt & btVel' .~ bf (fromIntegral $ _btTimer' pt - 1) -.- bf (fromIntegral $ _btTimer' pt) + bf t = bQuadToF (pos,control,targ) $ (100 - t) * 0.05 diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index b278aa1c6..64bd25d09 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -4,12 +4,10 @@ module Dodge.WorldEvent , module Dodge.WorldEvent.Flash , module Dodge.WorldEvent.ThingsHit , module Dodge.WorldEvent.HelperParticle - , module Dodge.WorldEvent.Projectile , module Dodge.WorldEvent.Cloud ) where -import Dodge.WorldEvent.Projectile import Dodge.WorldEvent.Bullet import Dodge.WorldEvent.Flash import Dodge.WorldEvent.ThingsHit diff --git a/src/Dodge/WorldEvent/Bullet.hs b/src/Dodge/WorldEvent/Bullet.hs index fe334d814..1ec9d5cff 100644 --- a/src/Dodge/WorldEvent/Bullet.hs +++ b/src/Dodge/WorldEvent/Bullet.hs @@ -16,65 +16,13 @@ import Data.Function (on) import Data.Bifunctor import qualified Data.IntMap.Strict as IM -mvBulletTrajectory :: (Int -> [Point2]) -> World -> Particle' -> (World, Maybe Particle') -mvBulletTrajectory velF w bt - | t <= 0 = (w, Nothing) - | t < 4 = (w, Just $ set btPassThrough' Nothing - $ set btTrail' (replicate numPs p ++ (p:ps) ) - $ set btTimer' (t-1) - bt - ) - | otherwise = (w, Just $ set btPassThrough' Nothing - $ set btVel' newVel -- this may be useful for hit effects - $ set btTrail' (init (reverse newPs) ++ (p:ps)) - $ set btTimer' (t-1) 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 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 btTimer' 3 bt --- ) - where mcr = _btPassThrough' bt - col = _btColor' bt - (p:ps) = _btTrail' bt - hiteff = _btHitEffect' bt - wth = _btWidth' bt - t = _btTimer' bt - newPs = velF t - numPs = (length $ newPs) - 1 - firstThingHit :: [[(Point2,(Either3 Creature Wall ForceField))]] - -> ([Point2], Maybe (Point2,Either3 Creature Wall ForceField)) - firstThingHit hitList = second last $ unzip $ zip newPs - $ takeUntil isJust - $ map listToMaybe hitList - newVel = speed *.* ( last newPs -.- (last $ init newPs) ) - speed = sum . map magV $ zipWith (-.-) (init newPs) (tail newPs) - - -thingsHitExceptCrCurve :: Maybe Int -> [Point2] -> World - -> [ [(Point2, (Either3 Creature Wall ForceField))] - ] -thingsHitExceptCrCurve mcid ps@(a:b:_) w - = zipWith (\x y -> thingsHitExceptCr mcid x y w) ps $ tail ps -thingsHitExceptCrLine _ _ _ = [] - thingsHitExceptCr :: Maybe Int -> Point2 -> Point2 -> World -> [(Point2, (Either3 Creature Wall ForceField))] thingsHitExceptCr Nothing sp ep = thingsHit sp ep thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep - where crNotCid (_,(E3x1 cr)) = _crID cr /= cid - crNotCid _ = True + where + crNotCid (_,(E3x1 cr)) = _crID cr /= cid + crNotCid _ = True mvGenBullet' :: World -> Particle' -> (World, Maybe Particle') mvGenBullet' w bt @@ -82,13 +30,61 @@ mvGenBullet' w bt | t < 4 = (w, Just $ set btPassThrough' Nothing $ set btTrail' (p:p:ps) $ set btTimer' (t-1) bt - ) + ) | otherwise = hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w - where mcr = _btPassThrough' bt - col = _btColor' bt - (p:ps) = _btTrail' bt - vel = _btVel' bt - hiteff = _btHitEffect' bt - wth = _btWidth' bt - t = _btTimer' bt + where + mcr = _btPassThrough' bt + col = _btColor' bt + (p:ps) = _btTrail' bt + vel = _btVel' bt + hiteff = _btHitEffect' bt + wth = _btWidth' bt + t = _btTimer' bt +type HitCreatureEffect = Particle' -> Point2 -> Creature -> World -> World +type HitWallEffect = Particle' -> Point2 -> Wall -> World -> World +type HitForceFieldEffect = Particle' -> Point2 -> ForceField -> World -> World + +passThroughAll :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect -> + Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle') +passThroughAll crEff wlEff ffEff pt hitThings w = (w, mvPt) + where + mvPt = Just $ pt & btTrail' .~ (newP : trl) + & btTimer' %~ (\t -> t - 1) + & btPassThrough' .~ Nothing + trl = _btTrail' pt + newP = head trl +.+ _btVel' pt + +destroyOnImpact :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect -> + Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle') +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) + & btTimer' .~ 3 + mvPt = Just $ pt & btTrail' .~ (newP : trl) + & btTimer' %~ (\t -> t - 1) + & btPassThrough' .~ Nothing + trl = _btTrail' 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) + & btTimer' .~ 3 + mvPt = Just $ pt & btTrail' .~ (newP : trl) + & btTimer' %~ (\t -> t - 1) + & btPassThrough' .~ Nothing + trl = _btTrail' pt + wth = _btWidth' pt + newP = head trl +.+ _btVel' pt diff --git a/src/Dodge/WorldEvent/Projectile.hs b/src/Dodge/WorldEvent/Projectile.hs deleted file mode 100644 index 0143ddc4a..000000000 --- a/src/Dodge/WorldEvent/Projectile.hs +++ /dev/null @@ -1,48 +0,0 @@ -module Dodge.WorldEvent.Projectile - where -import Dodge.Data -import Control.Lens - -import Data.Bifunctor -import Data.Maybe - -import Picture - -import Geometry - -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') -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) - & btTimer' .~ 3 - mvPt = Just $ pt & btTrail' .~ (newP : trl) - & btTimer' %~ (\t -> t - 1) - & btPassThrough' .~ Nothing - trl = _btTrail' 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) - & btTimer' .~ 3 - mvPt = Just $ pt & btTrail' .~ (newP : trl) - & btTimer' %~ (\t -> t - 1) - & btPassThrough' .~ Nothing - trl = _btTrail' pt - wth = _btWidth' pt - newP = head trl +.+ _btVel' pt