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/Combine/Module.hs
+4 -4
View File
@@ -20,10 +20,10 @@ moduleModification imt = case imt of
DRUMMAG -> itConsumption . laMax .~ 45
BELTMAG -> itConsumption . laMax .~ 150
MAGNETMAG -> itUse . useDelay . rateMax .~ 4
INCENDBUL -> f $ expireAndDamage $ spawnAtBulDams incBall
BOUNCEBUL -> f $ expireAndDamage bounceBulDams
STATICBUL -> f $ expireAndDamage $ spawnAtBulDams aStaticBall
CONCUSBUL -> f $ expireAndDamage $ spawnAtBulDams concBall
INCENDBUL -> f $ expireAndDamage' $ spawnAtBulDams incBall
BOUNCEBUL -> f $ expireAndDamage' bounceBulDams
STATICBUL -> f $ expireAndDamage' $ spawnAtBulDams aStaticBall
CONCUSBUL -> f $ expireAndDamage' $ spawnAtBulDams concBall
TARGCR -> itTargeting .~ targetRBCreature
TARGLAS -> itTargeting .~ targetLaser
TARGPOS -> itTargeting .~ targetRBPress
src/Dodge/Creature/Damage.hs
+9 -5
View File
@@ -42,20 +42,24 @@ applyDamageEffect dm de cr w = case de of
& creatures . ix (_crID cr) . crPos .+.+~ (1/_crMass cr) *.* pback
TorqueDamage rot -> w
& creatures . ix (_crID cr) . crDir +~ rot
BounceBullet bt | crIsArmouredFrom p cr -> w & instantParticles .:~ bouncer
BounceBullet bt | crIsArmouredFrom p cr -> w & instantBullets .:~ bouncer
where
bouncer = (aBulAt Nothing id (Just (_ptColor bt)) pOut reflectVel (_btDrag bt)
(_ptHitEff bt) (_ptWidth bt)
) {_ptTimer = _ptTimer bt - 1}
bouncer = (aBulAt Nothing id (Just (_buColor bt)) pOut reflectVel (_buDrag bt)
(_buHitEff bt) (_buWidth bt)
) {_buTimer = _buTimer bt - 1}
pOut = p +.+ 2 *.* newDir
reflectVel = magV bulVel *.* newDir
newDir = squashNormalizeV (p -.- _crPos cr)
bulVel = _ptVel bt
bulVel = _buVel bt
BounceBullet _ -> w
DamageSpawn f -> w & instantParticles .:~ thepart
& randGen .~ g
where
(thepart,g) = runState (f (Left cr) dm) $ _randGen w
DamageSpawn' f -> w & instantBullets .:~ thepart
& randGen .~ g
where
(thepart,g) = runState (f (Left cr) dm) $ _randGen w
NoDamageEffect -> w
where
fromDir = _dmFrom dm
src/Dodge/Data.hs
+34 -13
View File
@@ -141,6 +141,8 @@ data World = World
, _gusts :: IM.IntMap Gust
, _gsZoning :: Zoning IM.IntMap Gust
, _props :: IM.IntMap Prop
, _instantBullets :: [Bullet]
, _bullets :: [Bullet]
, _instantParticles :: [Particle]
, _particles :: [Particle]
, _radarBlips :: [RadarBlip]
@@ -229,7 +231,7 @@ data Magnet = Magnet
{ _mgID :: Int
, _mgUpdate :: Magnet -> Maybe Magnet
, _mgPos :: Point2
, _mgField :: Magnet -> Particle -> Particle
, _mgField :: Magnet -> Bullet -> Bullet
}
data OptionScreenFlag = NormalOptions | GameOverOptions
@@ -522,6 +524,17 @@ data BeamType
{_beamCombine :: (Point2 , (Point2,Point2,Beam) , (Point2,Point2,Beam)) -> World -> World}
| BeamSimple
data Bullet = Bullet
{ _buUpdate :: World -> Bullet -> (World, Maybe Bullet)
, _buVel :: Point2
, _buDrag :: Float
, _buColor :: Color
, _buTrail :: [Point2]
, _buWidth :: Float
, _buTimer :: Int
, _buHitEff :: HitEffect'
}
{- Objects without ids.
Update themselves, perhaps with side effects. -}
data Particle
@@ -540,6 +553,16 @@ data Particle
, _ptPhaseV :: Float
, _ptPoints :: [Point2]
}
| PtSpark
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptVel :: Point2
, _ptDrag :: Float
, _ptColor :: Color
, _ptTrail :: [Point2]
, _ptWidth :: Float
, _ptTimer :: Int
, _ptHitEff :: HitEffect
}
| PtTeslaArc
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptPoints :: [Point2]
@@ -551,16 +574,6 @@ data Particle
, _ptPoints :: [Point2]
, _ptColor :: Color
}
| BulletPt
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptVel :: Point2
, _btDrag :: Float
, _ptColor :: Color
, _ptTrail :: [Point2]
, _ptWidth :: Float
, _ptTimer :: Int
, _ptHitEff :: HitEffect
}
| PtFlame
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptVel :: Point2
@@ -625,6 +638,11 @@ type HitEffect = Particle
-> World
-> (World,Maybe Particle)
type HitEffect' = Bullet
-> Stream (Of (Point2, Either Creature Wall)) Identity ()
-> World
-> (World,Maybe Bullet)
data BulletTrajectory
= BasicBulletTrajectory
| BezierTrajectory
@@ -641,7 +659,7 @@ data AmmoType
}
| BulletAmmo
{ _amString :: String
, _amBulEff :: HitEffect
, _amBulEff :: HitEffect'
, _amBulWth :: Float
, _amBulVel :: Point2
, _amBulTraj :: BulletTrajectory
@@ -1230,9 +1248,11 @@ data DamageEffect
}
| TorqueDamage { _deTorque :: Float }
| PushBackDamage {_dePushBack :: Point2 }
| BounceBullet {_bulToBounce :: Particle}
| BounceBullet {_bulToBounce :: Bullet}
| DamageSpawn {_spawnFunc
:: Either Creature Wall -> Damage -> State StdGen Particle}
| DamageSpawn' {_spawnFunc'
:: Either Creature Wall -> Damage -> State StdGen Bullet}
| NoDamageEffect
-- deriving (Eq,Ord,Show)
@@ -1388,6 +1408,7 @@ makeLenses ''TweakParam
makeLenses ''Prop
makeLenses ''Modification
makeLenses ''Particle
makeLenses ''Bullet
makeLenses ''PressPlate
makeLenses ''Button
makeLenses ''ActionPlan
src/Dodge/Default/World.hs
+2
View File
@@ -39,6 +39,8 @@ defaultWorld = World
, _gsZoning = Zoning IM.empty clZoneSize (zonePos _guPos)
, _itemPositions = IM.empty
, _props = IM.empty
, _instantBullets = []
, _bullets = []
, _instantParticles = []
, _particles = []
, _radarBlips = []
src/Dodge/Item/Weapon/AmmoParams.hs
+4 -4
View File
@@ -15,7 +15,7 @@ import Data.Maybe
--import Control.Lens
useAmmoParams :: Maybe Float -> Item -> Creature -> World -> World
useAmmoParams vfact it cr w = w & instantParticles .:~ aBulAt
useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt
vfact
thetraj -- extra update
Nothing -- color (default)
@@ -34,15 +34,15 @@ useAmmoParams vfact it cr w = w & instantParticles .:~ aBulAt
BasicBulletTrajectory -> id
MagnetTrajectory -> fromMaybe id $ do
tpos <- it ^? itTargeting . tgPos . _Just
return $ \pt -> pt & ptVel .+.+~ 5 *.* normalizeV (tpos -.- head (_ptTrail pt))
return $ \pt -> pt & buVel .+.+~ 5 *.* normalizeV (tpos -.- head (_buTrail pt))
FlechetteTrajectory -> fromMaybe id $ do
tpos <- it ^? itTargeting . tgPos . _Just
return $ \pt -> pt & ptVel %~ vecTurnTo 0.2 (head $ _ptTrail pt) tpos
return $ \pt -> pt & buVel %~ vecTurnTo 0.2 (head $ _buTrail pt) tpos
BezierTrajectory -> fromMaybe id $ do
tpos <- it ^? itTargeting . tgPos . _Just
let bf t = bQuadToF (sp,mouseWorldPos w,tpos) $ (100 - t) * 0.05
return $ \pt -> pt
& ptVel .~ bf (fromIntegral $ _ptTimer pt - 1) -.- bf (fromIntegral $ _ptTimer pt)
& buVel .~ bf (fromIntegral $ _buTimer pt - 1) -.- bf (fromIntegral $ _buTimer pt)
---- this shouldn't really be used
loadedAmmo :: Item -> Int
src/Dodge/Item/Weapon/Bullet.hs
+2 -2
View File
@@ -10,7 +10,7 @@ import Geometry.Data
basicBullet :: AmmoType
basicBullet = BulletAmmo
{ _amString = "BASIC"
, _amBulEff = expireAndDamage basicBulDams
, _amBulEff = expireAndDamage' basicBulDams
, _amBulWth = 2
, _amBulVel = V2 50 0
, _amBulTraj = BasicBulletTrajectory
@@ -18,7 +18,7 @@ basicBullet = BulletAmmo
hvBullet :: AmmoType
hvBullet = BulletAmmo
{ _amString = "HVBULLET"
, _amBulEff = expireAndDamage hvBulDams
, _amBulEff = expireAndDamage' hvBulDams
, _amBulWth = 6
, _amBulVel = V2 80 0
, _amBulTraj = BasicBulletTrajectory
src/Dodge/Item/Weapon/BulletGun/Rod.hs
+1 -1
View File
@@ -63,7 +63,7 @@ bangRod = defaultBulletWeapon
& itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1.5}
& itUse . useAim . aimHandlePos .~ 5
& itUse . useAim . aimMuzPos .~ 30
& itConsumption . laAmmoType . amBulEff .~ expireAndDamage heavyBulDams
& itConsumption . laAmmoType . amBulEff .~ expireAndDamage' heavyBulDams
elephantGun :: Item
elephantGun = bangRod
& itType . iyBase .~ HELD ELEPHANTGUN
src/Dodge/Magnet.hs
+7 -7
View File
@@ -4,23 +4,23 @@ import Geometry
import Control.Lens
dampField :: Magnet -> Particle -> Particle
dampField :: Magnet -> Bullet -> Bullet
dampField mg pt = case pt of
BulletPt{} | dist (head $ _ptTrail pt) (_mgPos mg) < 100 -> pt & ptVel *~ 0.5
Bullet{} | dist (head $ _buTrail pt) (_mgPos mg) < 100 -> pt & buVel *~ 0.5
_ -> pt
curveLeftField :: Magnet -> Particle -> Particle
curveLeftField :: Magnet -> Bullet -> Bullet
curveLeftField mg pt = case pt of
BulletPt{} | dist (head $ _ptTrail pt) (_mgPos mg) < 500 -> pt & ptVel %~ rotateV 0.2
Bullet{} | dist (head $ _buTrail pt) (_mgPos mg) < 500 -> pt & buVel %~ rotateV 0.2
_ -> pt
curveAroundField :: Float -> Float -> Magnet -> Particle -> Particle
curveAroundField :: Float -> Float -> Magnet -> Bullet -> Bullet
curveAroundField minrad maxrad mg pt = case pt of
BulletPt{} | thedist < maxrad -> pt & ptVel %~ rotateToCircle
Bullet{} | thedist < maxrad -> pt & buVel %~ rotateToCircle
where
thedist = dist btpos mgpos
mgpos = _mgPos mg
btpos = head $ _ptTrail pt
btpos = head $ _buTrail pt
rotateToCircle vel
| (isLHS mgpos btpos (btpos +.+ vel) && isRHS mgpos btpos (mgpos +.+ vNormal vel) )
|| (isRHS mgpos btpos (btpos +.+ vel) && isLHS mgpos btpos (mgpos +.+ vNormal vel) )
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
src/Dodge/Render/ShapePicture.hs
+1
View File
@@ -84,6 +84,7 @@ cullPoint cfig w p
extraPics :: Configuration -> World -> Picture
extraPics cfig w = pictures (_decorations w)
<> concatMapPic drawParticle (_particles w)
<> concatMapPic drawBul (_bullets w)
<> concatMapPic drawBlip (_radarBlips w)
<> concatMapPic drawFlare (_flares w)
<> concatMapPic (dbArg _bmDraw) (_positronBeams $ _beams w)
src/Dodge/Update.hs
+12
View File
@@ -81,6 +81,7 @@ functionalUpdate cfig w = checkEndGame
. dbArg _worldEvents
. updateIMl _modifications _mdUpdate
. updateParticles
. updateBullets
. updateRadarBlips
. updateFlares
. updateBeams
@@ -212,6 +213,12 @@ updateRadarBlips = radarBlips %~ mapMaybe updateRadarBlip
updateFlares :: World -> World
updateFlares = flares %~ mapMaybe updateFlare
{- Apply internal particle updates, delete 'Nothing's. -}
updateBullets :: World -> World
updateBullets w = updateInstantBullets $ set bullets (catMaybes ps) w'
where
(w',ps) = mapAccumR (\a b -> _buUpdate b a b) w $ _bullets w
{- Apply internal particle updates, delete 'Nothing's. -}
updateParticles :: World -> World
updateParticles w = updateInstantParticles $ set particles (catMaybes ps) w'
@@ -287,6 +294,11 @@ intersectSegSegs' _ _ _ = Nothing
-- Just
-- (intersectSegSegss x y ass)
--intersectSegsSegss _ _ = Nothing
updateInstantBullets :: World -> World
updateInstantBullets w = case _instantBullets w of
[] -> w
ps -> let (w',ps') = mapAccumR (\a b -> _buUpdate b a b) (w {_instantBullets=[]}) ps
in updateInstantBullets $ w' & bullets .++~ catMaybes ps'
updateInstantParticles :: World -> World
updateInstantParticles w = case _instantParticles w of
src/Dodge/Wall/DamageEffect.hs
+4 -4
View File
@@ -133,11 +133,11 @@ dirtWallDamage dm wl = case _dmType dm of
wallDamageEffect :: Damage -> Wall -> World -> World
wallDamageEffect dm wl w = case _dmEffect dm of
BounceBullet bt -> w & instantParticles .:~ thebouncer
BounceBullet bt -> w & instantBullets .:~ thebouncer
where
reflectVel = reflVelWall wl (_ptVel bt)
thebouncer = aBulAt Nothing id (Just (_ptColor bt)) pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt)
& ptTimer .~ _ptTimer bt - 1
reflectVel = reflVelWall wl (_buVel bt)
thebouncer = aBulAt Nothing id (Just (_buColor bt)) pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt)
& buTimer .~ _buTimer bt - 1
pOut = p +.+ squashNormalizeV (sp -.- p)
p = _dmAt dm
sp = _dmFrom dm