Refactor bouncing bullets
This commit is contained in:
+76
-83
@@ -1,10 +1,12 @@
|
||||
module Dodge.Bullet where
|
||||
module Dodge.Bullet
|
||||
( updateBullet
|
||||
, useAmmoParams
|
||||
) where
|
||||
import Dodge.WorldEvent.SpawnParticle
|
||||
import Dodge.Creature.Test
|
||||
import Dodge.Data
|
||||
import Dodge.Creature.HandPos
|
||||
import Dodge.Base.Coordinate
|
||||
import Dodge.Base.Wall
|
||||
import Geometry
|
||||
import LensHelp
|
||||
import StreamingHelp
|
||||
@@ -24,34 +26,6 @@ updateBullet w bu = case _buState bu of
|
||||
DelayedBullet x -> mvBulletSlow x w bu
|
||||
_ -> mvBullet w bu
|
||||
|
||||
aBulAt
|
||||
:: Maybe Float -- ^ Start velocity step factor
|
||||
-> Point2 -- ^ Start position
|
||||
-> Point2 -- ^ Velocity
|
||||
-> Float -- ^ Drag
|
||||
-> Float -- ^ Bullet width
|
||||
-> BulletTrajectory
|
||||
-> BulletEffect
|
||||
-> BulletSpawn
|
||||
-> [Damage]
|
||||
-> Bullet
|
||||
aBulAt vfact pos vel drag width butraj be bs dams = Bullet
|
||||
{ _buState = bulstate
|
||||
, _buSpawn = bs
|
||||
, _buEffect = be
|
||||
, _buUpdateMod = NoBulletUpdateMod
|
||||
, _buTrajectory = butraj
|
||||
, _buVel = vel
|
||||
, _buDrag = drag
|
||||
, _buPos = pos
|
||||
, _buOldPos = pos
|
||||
, _buWidth = width
|
||||
, _buTimer = 100
|
||||
, _buDamages = dams
|
||||
}
|
||||
where
|
||||
bulstate = maybe NormalBulletState DelayedBullet vfact
|
||||
|
||||
useAmmoParams :: Maybe Float -> Item -> Creature -> World -> World
|
||||
useAmmoParams vfact it cr w = w & instantBullets .:~ (_amBullet bultype
|
||||
& buPos .~ sp
|
||||
@@ -94,27 +68,40 @@ mvBullet w bt'
|
||||
let (thepart,g) = runState (partspawn hp) $ _randGen w'
|
||||
return $ w' & instantParticles .:~ thepart
|
||||
& randGen .~ g
|
||||
maybebounce = case _buEffect bt' of
|
||||
BounceBullet -> case runIdentity (S.head_ hitstream) of
|
||||
Just (hp, Left cr) | crIsArmouredFrom hp cr -> instantBullets .:~ bouncer
|
||||
where
|
||||
bouncer = (aBulAt Nothing pOut reflectVel (_buDrag bt) (_buWidth bt)
|
||||
BasicBulletTrajectory (_buEffect bt) (_buSpawn bt) (_buDamages bt)
|
||||
) {_buTimer = _buTimer bt - 1}
|
||||
pOut = hp +.+ 2 *.* newDir
|
||||
reflectVel = magV bulVel *.* newDir
|
||||
newDir = squashNormalizeV (hp -.- _crPos cr)
|
||||
bulVel = _buVel bt
|
||||
Just (hp, Right wl) -> instantBullets .:~ thebouncer
|
||||
where
|
||||
reflectVel = reflVelWall wl (_buVel bt)
|
||||
thebouncer = aBulAt Nothing --id
|
||||
pOut reflectVel (_buDrag bt) (_buWidth bt) BasicBulletTrajectory (_buEffect bt)
|
||||
(_buSpawn bt) (_buDamages bt)
|
||||
& buTimer .~ _buTimer bt - 1
|
||||
pOut = hp +.+ squashNormalizeV (p -.- hp)
|
||||
_ -> id
|
||||
_ -> id
|
||||
maybebounce = fromMaybe id $ do
|
||||
guard (_buEffect bt' == BounceBullet)
|
||||
(hp,crwl) <- runIdentity (S.head_ hitstream)
|
||||
dir <- bounceDir (hp,crwl)
|
||||
return $ instantBullets .:~ (bt
|
||||
& buPos .~ hp +.+ (normalizeV (_buPos bt' -.- hp))
|
||||
& buVel %~ reflectIn dir
|
||||
& buTrajectory .~ BasicBulletTrajectory
|
||||
& buTimer -~ 1
|
||||
)
|
||||
--maybebounce = case _buEffect bt' of
|
||||
-- BounceBullet -> case runIdentity (S.head_ hitstream) of
|
||||
-- Just (hp, Left cr) | crIsArmouredFrom hp cr -> instantBullets .:~ bouncer
|
||||
-- where
|
||||
-- bouncer = bt
|
||||
-- & buPos .~ pOut
|
||||
-- & buVel .~ reflectVel
|
||||
-- & buTrajectory .~ BasicBulletTrajectory
|
||||
-- & buTimer -~ 1
|
||||
-- pOut = hp +.+ 2 *.* newDir
|
||||
-- reflectVel = reflectIn newDir bulVel --magV bulVel *.* newDir
|
||||
-- newDir = squashNormalizeV (hp -.- _crPos cr)
|
||||
-- bulVel = _buVel bt
|
||||
-- Just (hp, Right wl) -> instantBullets .:~ bouncer
|
||||
-- where
|
||||
-- reflectVel = reflVelWall wl (_buVel bt)
|
||||
-- bouncer = bt
|
||||
-- & buPos .~ pOut
|
||||
-- & buVel .~ reflectVel
|
||||
-- & buTrajectory .~ BasicBulletTrajectory
|
||||
-- & buTimer -~ 1
|
||||
-- pOut = hp +.+ squashNormalizeV (p -.- hp)
|
||||
-- _ -> id
|
||||
-- _ -> id
|
||||
hitstream = thingsHit p (p +.+ vel) w
|
||||
bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w
|
||||
dodrag = case _buTrajectory bt of
|
||||
@@ -130,6 +117,11 @@ mvBullet w bt'
|
||||
hiteff = hitEffFromBul
|
||||
t = _buTimer bt
|
||||
|
||||
bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2
|
||||
bounceDir (_,Right wl) = Just $ uncurry (-.-) (_wlLine wl)
|
||||
bounceDir (p,Left cr) | crIsArmouredFrom p cr = Just $ vNormal $ p -.- _crPos cr
|
||||
bounceDir _ = Nothing
|
||||
|
||||
bulletSpawn :: Bullet -> Maybe (Point2 -> State StdGen Particle)
|
||||
bulletSpawn bu = case _buSpawn bu of
|
||||
BulSpark -> Nothing
|
||||
@@ -167,10 +159,11 @@ expireAndDamage' :: (Bullet -> Point2 -> [Damage])
|
||||
-> World
|
||||
-> (World, Maybe Bullet)
|
||||
expireAndDamage' fdm bt things w = case runIdentity $ S.head_ things of
|
||||
Nothing -> (w, mvPt bt)
|
||||
Nothing -> (w, moveBullet bt)
|
||||
Just x -> (doDamages' fdm x bt w, destroyAt' (fst x) bt)
|
||||
mvPt :: Bullet -> Maybe Bullet
|
||||
mvPt pt = Just $ pt
|
||||
|
||||
moveBullet :: Bullet -> Maybe Bullet
|
||||
moveBullet pt = Just $ pt
|
||||
& buPos %~ (+.+ _buVel pt)
|
||||
& buOldPos .~ _buPos pt
|
||||
& buTimer -~ 1
|
||||
@@ -182,22 +175,22 @@ destroyAt' hitp pt = Just $ pt
|
||||
& buOldPos .~ _buPos pt
|
||||
& buTimer %~ (min 3 . subtract 1)
|
||||
|
||||
penWalls
|
||||
:: HitCreatureEffect'
|
||||
-> HitWallEffect'
|
||||
-> Bullet
|
||||
-> [(Point2, Either Creature Wall)]
|
||||
-> World
|
||||
-> (World, Maybe Bullet)
|
||||
penWalls crEff wlEff pt hitThings w = case hitThings of
|
||||
[] -> ( w, mvPt pt)
|
||||
((p,Left cr):_) -> (crEff pt p cr w, destroyAt' p pt)
|
||||
((p,Right wl):hs) | _wlFireThrough wl
|
||||
-> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w
|
||||
((p,Right wl):_) -> (wlEff pt p wl w, destroyAt' p pt)
|
||||
--penWalls
|
||||
-- :: HitCreatureEffect'
|
||||
-- -> HitWallEffect'
|
||||
-- -> Bullet
|
||||
-- -> [(Point2, Either Creature Wall)]
|
||||
-- -> World
|
||||
-- -> (World, Maybe Bullet)
|
||||
--penWalls crEff wlEff pt hitThings w = case hitThings of
|
||||
-- [] -> ( w, moveBullet pt)
|
||||
-- ((p,Left cr):_) -> (crEff pt p cr w, destroyAt' p pt)
|
||||
-- ((p,Right wl):hs) | _wlFireThrough wl
|
||||
-- -> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w
|
||||
-- ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt' p pt)
|
||||
|
||||
type HitCreatureEffect' = Bullet -> Point2 -> Creature -> World -> World
|
||||
type HitWallEffect' = Bullet -> Point2 -> Wall -> World -> World
|
||||
--type HitCreatureEffect' = Bullet -> Point2 -> Creature -> World -> World
|
||||
--type HitWallEffect' = Bullet -> Point2 -> Wall -> World -> World
|
||||
|
||||
doDamages' :: (Bullet -> Point2 -> [Damage])
|
||||
-> (Point2, Either Creature Wall)
|
||||
@@ -210,17 +203,17 @@ doDamages' fdm (p,thhit) bt = case thhit of
|
||||
where
|
||||
dams = fdm bt p
|
||||
|
||||
penetrate
|
||||
:: ((Point2,Either Creature Wall) -> Bullet -> Maybe Bullet)
|
||||
-- | penetration test, can update particle if it penetrates
|
||||
-> (Bullet -> Point2 -> [Damage]) -- | damages when penetrating
|
||||
-> (Bullet -> Point2 -> [Damage]) -- | damages when not penetrating
|
||||
-> Bullet
|
||||
-> Stream (Of (Point2, Either Creature Wall)) Identity ()
|
||||
-> World
|
||||
-> (World, Maybe Bullet)
|
||||
penetrate t pendam stopdam pt hitThings w = case runIdentity $ S.uncons hitThings of
|
||||
Nothing -> (w, mvPt pt)
|
||||
Just (x,xs) -> case t x pt of
|
||||
Nothing -> expireAndDamage' stopdam pt hitThings w
|
||||
Just pt' -> first (doDamages' pendam x pt) $ penetrate t pendam stopdam pt' xs w
|
||||
--penetrate
|
||||
-- :: ((Point2,Either Creature Wall) -> Bullet -> Maybe Bullet)
|
||||
-- -- | penetration test, can update particle if it penetrates
|
||||
-- -> (Bullet -> Point2 -> [Damage]) -- | damages when penetrating
|
||||
-- -> (Bullet -> Point2 -> [Damage]) -- | damages when not penetrating
|
||||
-- -> Bullet
|
||||
-- -> Stream (Of (Point2, Either Creature Wall)) Identity ()
|
||||
-- -> World
|
||||
-- -> (World, Maybe Bullet)
|
||||
--penetrate t pendam stopdam pt hitThings w = case runIdentity $ S.uncons hitThings of
|
||||
-- Nothing -> (w, moveBullet pt)
|
||||
-- Just (x,xs) -> case t x pt of
|
||||
-- Nothing -> expireAndDamage' stopdam pt hitThings w
|
||||
-- Just pt' -> first (doDamages' pendam x pt) $ penetrate t pendam stopdam pt' xs w
|
||||
|
||||
@@ -27,6 +27,7 @@ data BulletEffect
|
||||
= DestroyBullet
|
||||
| BounceBullet
|
||||
| PenetrateBullet
|
||||
deriving (Eq,Ord,Show,Read,Enum,Bounded)
|
||||
data BulletSpawn = BulBall EnergyBall | BulSpark
|
||||
data BulletTrajectory
|
||||
= BasicBulletTrajectory
|
||||
|
||||
@@ -112,7 +112,7 @@ repeater :: Item
|
||||
repeater = rifle
|
||||
& itType . iyModules . at ModRifleMag ?~ EMPTYMODULE
|
||||
& itType . iyBase .~ HELD REPEATER
|
||||
& itConsumption . laCycle .~ [loadEject 50, loadInsert 40 ,loadPrime 20]
|
||||
& itConsumption . laCycle .~ [loadEject 20, loadInsert 20 ,loadPrime 20]
|
||||
& itConsumption . laMax .~ 15
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user