justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Move bullets into own data type

Browse Source
This commit is contained in:
justin
2022-07-16 21:15:25 +01:00
parent 22adcb89e0
commit 301946ff8f
21 changed files with 216 additions and 108 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Particle/Bullet/Draw.hs
+3 -3
View File
@@ -4,9 +4,9 @@ module Dodge.Particle.Bullet.Draw
import Dodge.Data
import Picture
drawBul :: Particle -> Picture
drawBul :: Bullet -> Picture
drawBul pt = setLayer BloomNoZWrite
. setDepth 20
. color (_ptColor pt)
. color (_buColor pt)
-- $ thickLine (_ptWidth pt) (take 3 $ _ptTrail pt)
$ thickLine (_ptWidth pt) (take 2 $ _ptTrail pt)
$ thickLine (_buWidth pt) (take 2 $ _buTrail pt)
src/Dodge/Particle/Bullet/Spawn.hs
+13 -14
View File
@@ -12,27 +12,26 @@ import Data.Bifunctor
aBulAt
:: Maybe Float -- ^ Start velocity step factor
-> (Particle -> Particle)
-> (Bullet -> Bullet)
-> Maybe Color
-> Point2 -- ^ Start position
-> Point2 -- ^ Velocity
-> Float -- ^ Drag
-> HitEffect
-> HitEffect'
-> Float -- ^ Bullet width
-> Particle
aBulAt vfact updatemod mcol pos vel drag hiteff width = BulletPt
{ _ptUpdate = theupdate
, _ptVel = fromMaybe 1 vfact *.* vel
, _btDrag = drag
, _ptColor = fromMaybe (V4 200 200 200 2) mcol
-- , _ptColor = V4 2 2 2 2
, _ptTrail = [pos]
, _ptWidth = width
, _ptTimer = 100
, _ptHitEff = hiteff
-> Bullet
aBulAt vfact updatemod mcol pos vel drag hiteff width = Bullet
{ _buUpdate = theupdate
, _buVel = fromMaybe 1 vfact *.* vel
, _buDrag = drag
, _buColor = fromMaybe (V4 200 200 200 2) mcol
, _buTrail = [pos]
, _buWidth = width
, _buTimer = 100
, _buHitEff = hiteff
}
where
theupdate = case vfact of
Just _ -> \w -> resetVel . mvBullet w . updatemod
Nothing -> \w -> mvBullet w . updatemod
resetVel = second $ fmap $ (ptUpdate .~ (\w -> mvBullet w . updatemod)) . (ptVel .~ vel)
resetVel = second $ fmap $ (buUpdate .~ (\w -> mvBullet w . updatemod)) . (buVel .~ vel)
src/Dodge/Particle/Bullet/Update.hs
+18 -3
View File
@@ -2,6 +2,7 @@
{- Bullet update. -}
module Dodge.Particle.Bullet.Update
( mvBullet
, mvSpark
) where
import Dodge.Data
--import Dodge.Base
@@ -12,15 +13,29 @@ import LensHelp
import Data.Bifunctor
{- Update for a generic bullet. -}
mvBullet :: World -> Particle -> (World, Maybe Particle)
mvBullet :: World -> Bullet -> (World, Maybe Bullet)
mvBullet w bt'
| t <= 0 || magV (_ptVel bt) < 1 = (w,Nothing)
| t <= 0 || magV (_buVel bt) < 1 = (w,Nothing)
| otherwise = second (fmap dodrag) $
hiteff bt (thingsHit p (p +.+ vel) w) w
where
bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w
dodrag = buVel .*.*~ drag
drag = _buDrag bt
(p:_) = _buTrail bt
vel = _buVel bt
hiteff = _buHitEff bt
t = _buTimer bt
mvSpark :: World -> Particle -> (World, Maybe Particle)
mvSpark w bt'
| t <= 0 || magV (_ptVel bt) < 1 = (w,Nothing)
| otherwise = second (fmap dodrag) $
hiteff bt (thingsHit p (p +.+ vel) w) w
where
bt = bt'
dodrag = ptVel .*.*~ drag
drag = _btDrag bt
drag = _ptDrag bt
(p:_) = _ptTrail bt
vel = _ptVel bt
hiteff = _ptHitEff bt
src/Dodge/Particle/Damage.hs
+24 -18
View File
@@ -8,43 +8,49 @@ import Control.Monad.State
-- TODO unify particle position in a sensible manner
spawnAtBulDams :: (Point2 -> State StdGen Particle)
-> Particle -> Point2 -> [Damage]
-> Bullet -> Point2 -> [Damage]
spawnAtBulDams thespawn bt p =
[ Damage PIERCING 50 sp p ep (DamageSpawn $ \_ dm -> thespawn (_dmAt dm))
, Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel
]
where
sp = head $ _ptTrail bt
bulVel = _ptVel bt
sp = head $ _buTrail bt
bulVel = _buVel bt
ep = sp +.+ bulVel
simpleDam :: DamageType -> Int -> Particle -> Point2 -> [Damage]
simpleDam dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
where
sp = case bt ^? ptTrail of
Nothing -> _ptPos bt
Just xs -> head xs
sp = _ptPos bt
bulVel = _ptVel bt
ep = sp +.+ bulVel
simpleDam' :: DamageType -> Int -> Bullet -> Point2 -> [Damage]
simpleDam' dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
where
sp = case bt ^? buTrail of
Nothing -> 0
Just xs -> head xs
bulVel = _buVel bt
ep = sp +.+ bulVel
heavyBulDams :: Particle -> Point2 -> [Damage]
heavyBulDams :: Bullet -> Point2 -> [Damage]
heavyBulDams bt p =
[ Damage PIERCING 300 sp p ep NoDamageEffect
, Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel
]
where
sp = head $ _ptTrail bt
bulVel = _ptVel bt
sp = head $ _buTrail bt
bulVel = _buVel bt
ep = sp +.+ bulVel
basicBulDams :: Particle -> Point2 -> [Damage]
basicBulDams :: Bullet -> Point2 -> [Damage]
basicBulDams bt p =
[ Damage PIERCING 100 sp p ep NoDamageEffect
, Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel
]
where
sp = head $ _ptTrail bt
bulVel = _ptVel bt
sp = head $ _buTrail bt
bulVel = _buVel bt
ep = sp +.+ bulVel
basicSparkDams :: Particle -> Point2 -> [Damage]
@@ -54,7 +60,7 @@ basicSparkDams bt p = [ Damage SPARKING 1 sp p ep NoDamageEffect ]
bulVel = _ptVel bt
ep = sp +.+ bulVel
hvBulDams :: Particle -> Point2 -> [Damage]
hvBulDams :: Bullet -> Point2 -> [Damage]
hvBulDams bt p =
[ Damage PIERCING 25 sp p ep NoDamageEffect
, Damage PIERCING 25 sp p ep NoDamageEffect
@@ -66,16 +72,16 @@ hvBulDams bt p =
, Damage PUSHDAM 1 sp p ep . PushBackDamage $ 3 *.* (ep -.- sp)
]
where
sp = head $ _ptTrail bt
bulVel = _ptVel bt
sp = head $ _buTrail bt
bulVel = _buVel bt
ep = sp +.+ bulVel
bounceBulDams :: Particle -> Point2 -> [Damage]
bounceBulDams :: Bullet -> Point2 -> [Damage]
bounceBulDams bt p =
[ Damage PIERCING 80 sp p ep (BounceBullet bt)
, Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel
]
where
sp = head $ _ptTrail bt
bulVel = _ptVel bt
sp = head $ _buTrail bt
bulVel = _buVel bt
ep = sp +.+ bulVel
src/Dodge/Particle/Draw.hs
+9 -2
View File
@@ -10,7 +10,7 @@ drawParticle pt = case pt of
PtStaticBall {} -> drawStaticBall pt
PtIncBall {} -> drawFlameletZ pt
PtInvShockwave {} -> drawInverseShockwave pt
BulletPt {} -> drawBul pt
PtSpark {} -> drawSpark pt
PtTeslaArc {} -> drawTeslaArc pt
PtTargetLaser {} -> drawTargetLaser pt
LaserParticle {} -> drawLaser pt
@@ -124,8 +124,15 @@ drawInverseShockwave pt
rad = r - 0.1 * r * fromIntegral (10 - t)
thickness = fromIntegral (10 - t) **2 * rad / 40
drawBul :: Particle -> Picture
drawBul :: Bullet -> Picture
drawBul pt = setLayer BloomNoZWrite
. setDepth 20
. color (_buColor pt)
-- $ thickLine (_ptWidth pt) (take 3 $ _ptTrail pt)
$ thickLine (_buWidth pt) (take 2 $ _buTrail pt)
drawSpark :: Particle -> Picture
drawSpark pt = setLayer BloomNoZWrite
. setDepth 20
. color (_ptColor pt)
-- $ thickLine (_ptWidth pt) (take 3 $ _ptTrail pt)
src/Dodge/Particle/HitEffect.hs
+9 -8
View File
@@ -8,19 +8,20 @@ import Dodge.Particle.HitEffect.ExpireAndDamage
import Geometry
import Data.Bifunctor
type HitCreatureEffect = Particle -> Point2 -> Creature -> World -> World
type HitWallEffect = Particle -> Point2 -> Wall -> World -> World
type HitCreatureEffect' = Bullet -> Point2 -> Creature -> World -> World
type HitWallEffect' = Bullet -> Point2 -> Wall -> World -> World
penWalls
:: HitCreatureEffect
-> HitWallEffect
-> Particle
:: HitCreatureEffect'
-> HitWallEffect'
-> Bullet
-> [(Point2, Either Creature Wall)]
-> World
-> (World, Maybe Particle)
-> (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,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)
((p,Right wl):_) -> (wlEff pt p wl w, destroyAt' p pt)
src/Dodge/Particle/HitEffect/ExpireAndDamage.hs
+21 -1
View File
@@ -14,9 +14,18 @@ expireAndDamage :: (Particle -> Point2 -> [Damage])
-> World
-> (World, Maybe Particle)
expireAndDamage fdm bt things w = case runIdentity $ S.head_ things of
Nothing -> (w, mvPt bt)
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)
-> Particle
@@ -27,3 +36,14 @@ 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
src/Dodge/Particle/HitEffect/Penetrate.hs
+7 -7
View File
@@ -10,16 +10,16 @@ import Streaming
import qualified Streaming.Prelude as S
penetrate
:: ((Point2,Either Creature Wall) -> Particle -> Maybe Particle)
:: ((Point2,Either Creature Wall) -> Bullet -> Maybe Bullet)
-- | penetration test, can update particle if it penetrates
-> (Particle -> Point2 -> [Damage]) -- | damages when penetrating
-> (Particle -> Point2 -> [Damage]) -- | damages when not penetrating
-> Particle
-> (Bullet -> Point2 -> [Damage]) -- | damages when penetrating
-> (Bullet -> Point2 -> [Damage]) -- | damages when not penetrating
-> Bullet
-> Stream (Of (Point2, Either Creature Wall)) Identity ()
-> World
-> (World, Maybe Particle)
-> (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
Nothing -> expireAndDamage' stopdam pt hitThings w
Just pt' -> first (doDamages' pendam x pt) $ penetrate t pendam stopdam pt' xs w
src/Dodge/Particle/Spark.hs
+9 -9
View File
@@ -19,10 +19,10 @@ import System.Random
--import Control.Lens
-- TODO remove/simplify this function
createBarrelSpark :: Point2 -> Float -> Int -> Int -> World -> World
createBarrelSpark pos dir time colid = instantParticles .:~ BulletPt
{ _ptUpdate = mvBullet
createBarrelSpark pos dir time colid = instantParticles .:~ PtSpark
{ _ptUpdate = mvSpark
, _ptVel = rotateV dir (V2 5 0)
, _btDrag = 0.9
, _ptDrag = 0.9
, _ptColor = numColor colid
, _ptTrail = [pos]
, _ptWidth = 1
@@ -48,9 +48,9 @@ randColDirTimeSpark randcol randdir randtime pos w = w
d <- randdir
t <- randtime
return (c,d,t)
spark = BulletPt
{ _ptUpdate = mvBullet
, _btDrag = 0.9
spark = PtSpark
{ _ptUpdate = mvSpark
, _ptDrag = 0.9
, _ptVel = rotateV dir (V2 5 0)
, _ptColor = col
, _ptTrail = [pos]
@@ -66,9 +66,9 @@ colSparkRandDir randDir time col pos baseDir w = w
where
(a,g) = randomR (-randDir,randDir) $ _randGen w
dir = a + baseDir
spark = BulletPt
{ _ptUpdate = mvBullet
, _btDrag = 0.9
spark = PtSpark
{ _ptUpdate = mvSpark
, _ptDrag = 0.9
, _ptVel = rotateV dir (V2 5 0)
, _ptColor = col
, _ptTrail = [pos]
src/Dodge/Particle/Update.hs
+23 -3
View File
@@ -3,8 +3,15 @@ import Dodge.Data
import LensHelp
import Geometry
mvPt :: Particle -> Maybe Particle
mvPt :: Bullet -> Maybe Bullet
mvPt pt = Just $ pt
& buTrail %~ f
& buTimer -~ 1
where
f trl = head trl +.+ _buVel pt : trl
mvPt' :: Particle -> Maybe Particle
mvPt' pt = Just $ pt
& ptTrail %~ f
& ptTimer -~ 1
where
@@ -12,12 +19,25 @@ mvPt pt = Just $ pt
destroyAt :: Point2 -> Particle -> Maybe Particle
destroyAt hitp pt = Just $ pt
& ptUpdate .~ killBulletUpdate
& ptUpdate .~ killParticleUpdate
& ptTrail .:~ hitp
& ptTimer %~ (min 3 . subtract 1)
destroyAt' :: Point2 -> Bullet -> Maybe Bullet
destroyAt' hitp pt = Just $ pt
& buUpdate .~ killBulletUpdate
& buTrail .:~ hitp
& buTimer %~ (min 3 . subtract 1)
killBulletUpdate :: World -> Particle -> (World,Maybe Particle)
killBulletUpdate :: World -> Bullet -> (World,Maybe Bullet)
killBulletUpdate w pt
| _buTimer pt <= 0 = (w,Nothing)
| otherwise = (w
, Just $ pt & buTimer -~ 1
& buTrail %~ (\(x:xs) -> x:x:xs)
)
killParticleUpdate :: World -> Particle -> (World,Maybe Particle)
killParticleUpdate w pt
| _ptTimer pt <= 0 = (w,Nothing)
| otherwise = (w
, Just $ pt & ptTimer -~ 1