From ce36aa82954bb61c5e9d583909bc6000cc87f82f Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 18 Jul 2022 09:44:25 +0100 Subject: [PATCH] Refactor bouncing bullets --- src/Dodge/Bullet.hs | 159 +++++++++++------------- src/Dodge/Data/Bullet.hs | 1 + src/Dodge/Item/Weapon/BulletGun/Cane.hs | 2 +- src/Geometry.hs | 3 + 4 files changed, 81 insertions(+), 84 deletions(-) diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index 1987c7d9e..ab394b610 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -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 diff --git a/src/Dodge/Data/Bullet.hs b/src/Dodge/Data/Bullet.hs index 1d673cd65..fa7a4f961 100644 --- a/src/Dodge/Data/Bullet.hs +++ b/src/Dodge/Data/Bullet.hs @@ -27,6 +27,7 @@ data BulletEffect = DestroyBullet | BounceBullet | PenetrateBullet + deriving (Eq,Ord,Show,Read,Enum,Bounded) data BulletSpawn = BulBall EnergyBall | BulSpark data BulletTrajectory = BasicBulletTrajectory diff --git a/src/Dodge/Item/Weapon/BulletGun/Cane.hs b/src/Dodge/Item/Weapon/BulletGun/Cane.hs index d09539681..f05e8a650 100644 --- a/src/Dodge/Item/Weapon/BulletGun/Cane.hs +++ b/src/Dodge/Item/Weapon/BulletGun/Cane.hs @@ -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 diff --git a/src/Geometry.hs b/src/Geometry.hs index ea8eb21ee..b6e2e7bec 100644 --- a/src/Geometry.hs +++ b/src/Geometry.hs @@ -115,6 +115,9 @@ difference x y reflectIn :: Point2 -> Point2 -> Point2 reflectIn line vec = rotateV (2 * angleBetween line vec) vec +reflectIn' :: Point2 -> Point2 -> Point2 +reflectIn' line vec = rotateV (2 * angleBetween vec line) vec + -- | Find angle between two points. -- Not normalised, ranges from -2*pi to 2*pi. angleBetween :: Point2 -> Point2 -> Float