Continue bullet refactor

This commit is contained in:
2022-07-17 23:02:07 +01:00
parent bf023a61ce
commit ce3154d311
14 changed files with 121 additions and 153 deletions
+75 -19
View File
@@ -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
+9 -9
View File
@@ -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
+1 -8
View File
@@ -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 }
+2 -4
View File
@@ -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
-2
View File
@@ -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
+31 -13
View File
@@ -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
]
+2 -2
View File
@@ -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
+1 -1
View File
@@ -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)
-11
View File
@@ -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 ]
-27
View File
@@ -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)
@@ -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
-25
View File
@@ -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
-12
View File
@@ -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
-1
View File
@@ -118,4 +118,3 @@ moveInverseShockwave w pt
where
cpos = _crPos cr
v = normalizeV (cpos -.- p)