From ce3154d31152c086f44eeca1d865ccb888431801 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 17 Jul 2022 23:02:07 +0100 Subject: [PATCH] Continue bullet refactor --- src/Dodge/Bullet.hs | 94 +++++++++++++++---- src/Dodge/Combine/Module.hs | 18 ++-- src/Dodge/Data.hs | 9 +- src/Dodge/Data/Bullet.hs | 6 +- src/Dodge/Data/DamageType.hs | 2 - src/Dodge/Item/Weapon/Bullet.hs | 44 ++++++--- src/Dodge/Item/Weapon/BulletGun/Rod.hs | 4 +- src/Dodge/Item/Weapon/BulletGuns.hs | 2 +- src/Dodge/Particle/Damage.hs | 11 --- src/Dodge/Particle/HitEffect.hs | 27 ------ .../Particle/HitEffect/ExpireAndDamage.hs | 19 ---- src/Dodge/Particle/HitEffect/Penetrate.hs | 25 ----- src/Dodge/Particle/Update.hs | 12 --- src/Dodge/WorldEvent/Shockwave.hs | 1 - 14 files changed, 121 insertions(+), 153 deletions(-) delete mode 100644 src/Dodge/Particle/HitEffect.hs delete mode 100644 src/Dodge/Particle/HitEffect/Penetrate.hs diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index e90531ae5..1987c7d9e 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -2,7 +2,6 @@ module Dodge.Bullet where import Dodge.WorldEvent.SpawnParticle import Dodge.Creature.Test import Dodge.Data -import Dodge.Particle.HitEffect.ExpireAndDamage import Dodge.Creature.HandPos import Dodge.Base.Coordinate import Dodge.Base.Wall @@ -10,13 +9,13 @@ import Geometry import LensHelp import StreamingHelp +import qualified Data.IntMap.Strict as IM import qualified Streaming.Prelude as S import Data.Maybe import Dodge.Movement.Turn import Dodge.WorldEvent.ThingsHit import Control.Monad.State import System.Random - --import Data.Bifunctor updateBullet :: World -> Bullet -> (World,Maybe Bullet) @@ -30,7 +29,6 @@ aBulAt -> Point2 -- ^ Start position -> Point2 -- ^ Velocity -> Float -- ^ Drag --- -> HitEffect' -> Float -- ^ Bullet width -> BulletTrajectory -> BulletEffect @@ -55,38 +53,33 @@ aBulAt vfact pos vel drag width butraj be bs dams = Bullet bulstate = maybe NormalBulletState DelayedBullet vfact useAmmoParams :: Maybe Float -> Item -> Creature -> World -> World -useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt - vfact - sp - (rotateV dir (muzvel *.* _amBulVel bultype)) -- vel - (_rifling $ _itParams it) -- drag - (_amBulWth bultype) - thetraj - (_amBulEffect bultype) - (_amBulSpawn bultype) - (_amBulDams bultype) +useAmmoParams vfact it cr w = w & instantBullets .:~ (_amBullet bultype + & buPos .~ sp + & buTrajectory %~ settrajectory + & buVel %~ (rotateV dir . (muzvel *.*)) + & buDrag *~ _rifling (_itParams it) + & buState %~ setstate + ) where + setstate = case vfact of + Nothing -> id + Just x -> const $ DelayedBullet x sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir dir = _crDir cr bultype = _laAmmoType $ _itConsumption it muzvel = _muzVel $ _itParams it muzlength = aimingMuzzlePos cr it - thetraj = case _amBulTraj bultype of + settrajectory traj = case traj of BasicBulletTrajectory -> BasicBulletTrajectory MagnetTrajectory{} -> fromMaybe BasicBulletTrajectory $ do tpos <- it ^? itTargeting . tgPos . _Just return $ MagnetTrajectory tpos - --return $ \pt -> pt & buVel .+.+~ 5 *.* normalizeV (tpos -.- _buPos pt) FlechetteTrajectory{} -> fromMaybe BasicBulletTrajectory $ do tpos <- it ^? itTargeting . tgPos . _Just return $ FlechetteTrajectory tpos - --return $ \pt -> pt & buVel %~ vecTurnTo 0.2 (_buPos pt) tpos BezierTrajectory{} -> fromMaybe BasicBulletTrajectory $ do tpos <- it ^? itTargeting . tgPos . _Just return $ BezierTrajectory sp tpos (mouseWorldPos w) --- let bf t = bQuadToF (sp,mouseWorldPos w,tpos) $ (100 - t) * 0.05 --- return $ \pt -> pt --- & buVel .~ bf (fromIntegral $ _buTimer pt - 1) -.- bf (fromIntegral $ _buTimer pt) {- Update for a generic bullet. -} mvBullet :: World -> Bullet -> (World, Maybe Bullet) @@ -168,3 +161,66 @@ mvBulletSlow x w bt' vel = x *.* _buVel bt hiteff = hitEffFromBul t = _buTimer bt +expireAndDamage' :: (Bullet -> Point2 -> [Damage]) + -> Bullet + -> Stream (Of (Point2, Either Creature Wall)) Identity () + -> World + -> (World, Maybe Bullet) +expireAndDamage' fdm bt things w = case runIdentity $ S.head_ things of + Nothing -> (w, mvPt bt) + Just x -> (doDamages' fdm x bt w, destroyAt' (fst x) bt) +mvPt :: Bullet -> Maybe Bullet +mvPt pt = Just $ pt + & buPos %~ (+.+ _buVel pt) + & buOldPos .~ _buPos pt + & buTimer -~ 1 + +destroyAt' :: Point2 -> Bullet -> Maybe Bullet +destroyAt' hitp pt = Just $ pt + & buState .~ DyingBulletState + & buPos .~ hitp + & 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) + +type HitCreatureEffect' = Bullet -> Point2 -> Creature -> World -> World +type HitWallEffect' = Bullet -> Point2 -> Wall -> World -> World + +doDamages' :: (Bullet -> Point2 -> [Damage]) + -> (Point2, Either Creature Wall) + -> Bullet + -> World + -> World +doDamages' fdm (p,thhit) bt = case thhit of + Left cr -> creatures . ix (_crID cr) . crState . csDamage .++~ dams + Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams + 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 diff --git a/src/Dodge/Combine/Module.hs b/src/Dodge/Combine/Module.hs index 425500348..2193f95ec 100644 --- a/src/Dodge/Combine/Module.hs +++ b/src/Dodge/Combine/Module.hs @@ -17,21 +17,21 @@ moduleModification imt = case imt of DRUMMAG -> itConsumption . laMax .~ 45 BELTMAG -> itConsumption . laMax .~ 150 MAGNETMAG -> itUse . useDelay . rateMax .~ 4 - INCENDBUL -> itConsumption . laAmmoType . amBulSpawn .~ BulBall IncBall - BOUNCEBUL -> itConsumption . laAmmoType . amBulEffect .~ BounceBullet - STATICBUL -> itConsumption . laAmmoType . amBulSpawn .~ BulBall TeslaBall - CONCUSBUL -> itConsumption . laAmmoType . amBulSpawn .~ BulBall ConcBall + INCENDBUL -> itConsumption . laAmmoType . amBullet . buSpawn .~ BulBall IncBall + BOUNCEBUL -> itConsumption . laAmmoType . amBullet . buEffect .~ BounceBullet + STATICBUL -> itConsumption . laAmmoType . amBullet . buSpawn .~ BulBall TeslaBall + CONCUSBUL -> itConsumption . laAmmoType . amBullet . buSpawn .~ BulBall ConcBall TARGCR -> itTargeting .~ targetRBCreature TARGLAS -> itTargeting .~ targetLaser TARGPOS -> itTargeting .~ targetRBPress - MAGNETTRAJ -> (itConsumption . laAmmoType . amBulTraj .~ MagnetTrajectory 0) - . (itConsumption . laAmmoType . amBulVel .~ V2 10 0) - FLECHETRAJ -> itConsumption . laAmmoType . amBulTraj .~ FlechetteTrajectory 0 - BEZIERTRAJ -> itConsumption . laAmmoType . amBulTraj .~ BezierTrajectory 0 0 0 + MAGNETTRAJ -> (itConsumption . laAmmoType . amBullet . buTrajectory .~ MagnetTrajectory 0) + . (itConsumption . laAmmoType . amBullet . buVel .~ V2 10 0) + FLECHETRAJ -> itConsumption . laAmmoType . amBullet . buTrajectory .~ FlechetteTrajectory 0 + BEZIERTRAJ -> itConsumption . laAmmoType . amBullet . buTrajectory .~ BezierTrajectory 0 0 0 INCENDLAS -> itParams . lasBeam .~ BeamCombine flameBeamCombine SPLITLAS -> itParams . lasBeam .~ BeamCombine splitBeamCombine STATICLAS -> (itParams . lasBeam .~ BeamCombine teslaBeamCombine) - . (itParams . subParams ?~ teslaParams) + . (itParams . subParams ?~ teslaParams) WEPTELE -> makeDirectedTele LAUNCHHOME -> itConsumption . laAmmoType . amPjCreation .~ fireTrackingShell EXTRABATTERY -> itConsumption . laMax +~ 1000 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 7fda4d516..751823ebf 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -635,17 +635,10 @@ data AmmoType , _amString :: String , _amPjDraw :: Prop -> SPic , _amPjCreation :: Item -> Creature -> World -> World --- , _aProjectile :: Ammo -> Prop } | BulletAmmo { _amString :: String --- , _amBulEff :: HitEffect' - , _amBulDams :: [Damage] - , _amBulWth :: Float - , _amBulVel :: Point2 - , _amBulTraj :: BulletTrajectory - , _amBulEffect :: BulletEffect - , _amBulSpawn :: BulletSpawn + , _amBullet :: Bullet } | DroneAmmo { _amString :: String } diff --git a/src/Dodge/Data/Bullet.hs b/src/Dodge/Data/Bullet.hs index f68001bbc..1d673cd65 100644 --- a/src/Dodge/Data/Bullet.hs +++ b/src/Dodge/Data/Bullet.hs @@ -23,16 +23,14 @@ data BulletState = NormalBulletState | DyingBulletState | DelayedBullet Float data BulletUpdateMod = NoBulletUpdateMod - -data BulletEffect = DestroyBullet +data BulletEffect + = DestroyBullet | BounceBullet | PenetrateBullet data BulletSpawn = BulBall EnergyBall | BulSpark - data BulletTrajectory = BasicBulletTrajectory | BezierTrajectory Point2 Point2 Point2 | FlechetteTrajectory Point2 | MagnetTrajectory Point2 - makeLenses ''Bullet diff --git a/src/Dodge/Data/DamageType.hs b/src/Dodge/Data/DamageType.hs index 75c4d374c..87e44b394 100644 --- a/src/Dodge/Data/DamageType.hs +++ b/src/Dodge/Data/DamageType.hs @@ -41,12 +41,10 @@ data Damage = Damage , _dmEffect :: DamageEffect } deriving (Eq,Ord,Show) - isElectrical :: Damage -> Bool isElectrical dm = case _dmType dm of ELECTRICAL -> True _ -> False - isMovementDam :: Damage -> Bool isMovementDam dm = case _dmType dm of TORQUEDAM -> True diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index a2d62f936..80191085b 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -3,26 +3,44 @@ module Dodge.Item.Weapon.Bullet , hvBullet ) where import Dodge.Data -import Dodge.Particle.Damage +import Control.Lens import Geometry.Data basicBullet :: AmmoType basicBullet = BulletAmmo { _amString = "BASIC" - , _amBulDams = basicBulDams - , _amBulWth = 2 - , _amBulVel = V2 50 0 - , _amBulTraj = BasicBulletTrajectory - , _amBulEffect = DestroyBullet - , _amBulSpawn = BulSpark + , _amBullet = defaultBullet } +defaultBullet :: Bullet +defaultBullet = Bullet + { _buState = NormalBulletState + , _buEffect = DestroyBullet + , _buSpawn = BulSpark + , _buUpdateMod = NoBulletUpdateMod + , _buTrajectory = BasicBulletTrajectory + , _buVel = V2 50 0 + , _buDrag = 1 + , _buPos = 0 + , _buOldPos = 0 + , _buWidth = 2 + , _buTimer = 100 + , _buDamages = basicBulDams + } +basicBulDams :: [Damage] +basicBulDams = + [ Damage PIERCING 100 0 0 0 NoDamageEffect + , Damage PUSHDAM 1 0 0 0 . PushBackDamage $ 2 + ] hvBullet :: AmmoType hvBullet = BulletAmmo { _amString = "HVBULLET" - , _amBulDams = hvBulDams - , _amBulWth = 6 - , _amBulVel = V2 80 0 - , _amBulTraj = BasicBulletTrajectory - , _amBulEffect = DestroyBullet - , _amBulSpawn = BulSpark + , _amBullet = defaultBullet + & buWidth .~ 6 + & buVel .~ V2 80 0 + & buDamages .~ heavyBulDams } +heavyBulDams :: [Damage] +heavyBulDams = + [ Damage PIERCING 300 0 0 0 NoDamageEffect + , Damage PUSHDAM 1 0 0 0 $ PushBackDamage 2 + ] diff --git a/src/Dodge/Item/Weapon/BulletGun/Rod.hs b/src/Dodge/Item/Weapon/BulletGun/Rod.hs index a6ecd62d4..77033af1a 100644 --- a/src/Dodge/Item/Weapon/BulletGun/Rod.hs +++ b/src/Dodge/Item/Weapon/BulletGun/Rod.hs @@ -8,8 +8,8 @@ module Dodge.Item.Weapon.BulletGun.Rod ) where import Dodge.Data import Dodge.Reloading.Action -import Dodge.Particle.Damage import Dodge.Default.Weapon +import Dodge.Item.Weapon.Bullet import Dodge.Default import Dodge.Item.Weapon.ZoomScope import Dodge.Item.Weapon.ExtraEffect @@ -57,7 +57,7 @@ bangRod = defaultBulletWeapon & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1.5} & itUse . useAim . aimHandlePos .~ 5 & itUse . useAim . aimMuzPos .~ 30 - & itConsumption . laAmmoType . amBulDams .~ heavyBulDams + & itConsumption . laAmmoType .~ hvBullet elephantGun :: Item elephantGun = bangRod & itType . iyBase .~ HELD ELEPHANTGUN diff --git a/src/Dodge/Item/Weapon/BulletGuns.hs b/src/Dodge/Item/Weapon/BulletGuns.hs index 86de6fce9..01aa0d24d 100644 --- a/src/Dodge/Item/Weapon/BulletGuns.hs +++ b/src/Dodge/Item/Weapon/BulletGuns.hs @@ -127,7 +127,7 @@ bangCone = defaultBulletWeapon coneRandItemUpdate :: State StdGen (Item -> Item) coneRandItemUpdate = do wth <- state $ randomR (1,5) - return (\it -> it & itConsumption . laAmmoType . amBulWth .~ wth) + return (itConsumption . laAmmoType . amBullet . buWidth .~ wth) coneRandItemParams :: State StdGen (ItemParams -> ItemParams) coneRandItemParams = do muzv <- state $ randomR (0.5,1) diff --git a/src/Dodge/Particle/Damage.hs b/src/Dodge/Particle/Damage.hs index 617148dfe..5fb49cac7 100644 --- a/src/Dodge/Particle/Damage.hs +++ b/src/Dodge/Particle/Damage.hs @@ -15,17 +15,6 @@ simpleDam' dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ] bulVel = _buVel bt ep = sp +.+ bulVel -heavyBulDams :: [Damage] -heavyBulDams = - [ Damage PIERCING 300 0 0 0 NoDamageEffect - , Damage PUSHDAM 1 0 0 0 $ PushBackDamage 2 - ] - -basicBulDams :: [Damage] -basicBulDams = - [ Damage PIERCING 100 0 0 0 NoDamageEffect - , Damage PUSHDAM 1 0 0 0 . PushBackDamage $ 2 - ] basicSparkDams :: Particle -> Point2 -> [Damage] basicSparkDams bt p = [ Damage SPARKING 1 sp p ep NoDamageEffect ] diff --git a/src/Dodge/Particle/HitEffect.hs b/src/Dodge/Particle/HitEffect.hs deleted file mode 100644 index 7ca1d185f..000000000 --- a/src/Dodge/Particle/HitEffect.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Dodge.Particle.HitEffect - ( penWalls - , module Dodge.Particle.HitEffect.ExpireAndDamage - ) where -import Dodge.Data -import Dodge.Particle.Update -import Dodge.Particle.HitEffect.ExpireAndDamage -import Geometry - -import Data.Bifunctor - -type HitCreatureEffect' = Bullet -> Point2 -> Creature -> World -> World -type HitWallEffect' = Bullet -> Point2 -> Wall -> World -> World - -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) diff --git a/src/Dodge/Particle/HitEffect/ExpireAndDamage.hs b/src/Dodge/Particle/HitEffect/ExpireAndDamage.hs index 0ef82f389..d4b908053 100644 --- a/src/Dodge/Particle/HitEffect/ExpireAndDamage.hs +++ b/src/Dodge/Particle/HitEffect/ExpireAndDamage.hs @@ -17,14 +17,6 @@ expireAndDamage fdm bt things w = case runIdentity $ S.head_ things of Nothing -> (w, mvPt' bt) Just x -> (doDamages fdm x bt w, destroyAt (fst x) bt) -expireAndDamage' :: (Bullet -> Point2 -> [Damage]) - -> Bullet - -> Stream (Of (Point2, Either Creature Wall)) Identity () - -> World - -> (World, Maybe Bullet) -expireAndDamage' fdm bt things w = case runIdentity $ S.head_ things of - Nothing -> (w, mvPt bt) - Just x -> (doDamages' fdm x bt w, destroyAt' (fst x) bt) doDamages :: (Particle -> Point2 -> [Damage]) -> (Point2, Either Creature Wall) @@ -36,14 +28,3 @@ doDamages fdm (p,thhit) bt = case thhit of Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams where dams = fdm bt p - -doDamages' :: (Bullet -> Point2 -> [Damage]) - -> (Point2, Either Creature Wall) - -> Bullet - -> World - -> World -doDamages' fdm (p,thhit) bt = case thhit of - Left cr -> creatures . ix (_crID cr) . crState . csDamage .++~ dams - Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams - where - dams = fdm bt p diff --git a/src/Dodge/Particle/HitEffect/Penetrate.hs b/src/Dodge/Particle/HitEffect/Penetrate.hs deleted file mode 100644 index 04afbdc94..000000000 --- a/src/Dodge/Particle/HitEffect/Penetrate.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Dodge.Particle.HitEffect.Penetrate where -import Dodge.Data -import Dodge.Particle.Update -import Dodge.Particle.HitEffect.ExpireAndDamage -import Geometry ---import LensHelp - -import Data.Bifunctor -import Streaming -import qualified Streaming.Prelude as S - -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 diff --git a/src/Dodge/Particle/Update.hs b/src/Dodge/Particle/Update.hs index 84b1b9e19..82cfed97a 100644 --- a/src/Dodge/Particle/Update.hs +++ b/src/Dodge/Particle/Update.hs @@ -3,12 +3,6 @@ import Dodge.Data import LensHelp import Geometry -mvPt :: Bullet -> Maybe Bullet -mvPt pt = Just $ pt - & buPos %~ (+.+ _buVel pt) - & buOldPos .~ _buPos pt - & buTimer -~ 1 - mvPt' :: Particle -> Maybe Particle mvPt' pt = Just $ pt & ptTrail %~ f @@ -21,12 +15,6 @@ destroyAt hitp pt = Just $ pt & ptUpdate .~ killParticleUpdate & ptTrail .:~ hitp & ptTimer %~ (min 3 . subtract 1) -destroyAt' :: Point2 -> Bullet -> Maybe Bullet -destroyAt' hitp pt = Just $ pt - & buState .~ DyingBulletState - & buPos .~ hitp - & buOldPos .~ _buPos pt - & buTimer %~ (min 3 . subtract 1) killParticleUpdate :: World -> Particle -> (World,Maybe Particle) killParticleUpdate w pt diff --git a/src/Dodge/WorldEvent/Shockwave.hs b/src/Dodge/WorldEvent/Shockwave.hs index ac57bf71a..0915f55cf 100644 --- a/src/Dodge/WorldEvent/Shockwave.hs +++ b/src/Dodge/WorldEvent/Shockwave.hs @@ -118,4 +118,3 @@ moveInverseShockwave w pt where cpos = _crPos cr v = normalizeV (cpos -.- p) -