Unify curve bullets with straight
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
Reference in New Issue
Block a user