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

Add bullet damages field, move bullet data into own file

Browse Source
This commit is contained in:
justin
2022-07-17 21:45:26 +01:00
parent 6c6fe43bc0
commit bf023a61ce
11 changed files with 137 additions and 180 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Bullet.hs
+28 -25
View File
@@ -1,5 +1,5 @@
module Dodge.Bullet where
import Dodge.Particle.Damage
import Dodge.WorldEvent.SpawnParticle
import Dodge.Creature.Test
import Dodge.Data
import Dodge.Particle.HitEffect.ExpireAndDamage
@@ -14,6 +14,8 @@ 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
@@ -33,8 +35,9 @@ aBulAt
-> BulletTrajectory
-> BulletEffect
-> BulletSpawn
-> [Damage]
-> Bullet
aBulAt vfact pos vel drag width butraj be bs = Bullet
aBulAt vfact pos vel drag width butraj be bs dams = Bullet
{ _buState = bulstate
, _buSpawn = bs
, _buEffect = be
@@ -46,6 +49,7 @@ aBulAt vfact pos vel drag width butraj be bs = Bullet
, _buOldPos = pos
, _buWidth = width
, _buTimer = 100
, _buDamages = dams
}
where
bulstate = maybe NormalBulletState DelayedBullet vfact
@@ -60,6 +64,7 @@ useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt
thetraj
(_amBulEffect bultype)
(_amBulSpawn bultype)
(_amBulDams bultype)
where
sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir
dir = _crDir cr
@@ -87,15 +92,21 @@ useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt
mvBullet :: World -> Bullet -> (World, Maybe Bullet)
mvBullet w bt'
| t <= 0 || magV (_buVel bt) < 1 = (w,Nothing)
| otherwise = bimap maybebounce (fmap dodrag) $
| otherwise = bimap (maybespawn . maybebounce) (fmap dodrag) $
hiteff bt hitstream w
where
maybespawn w' = fromMaybe w' $ do
(hp,_) <- runIdentity (S.head_ hitstream)
partspawn <- bulletSpawn 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)
BasicBulletTrajectory (_buEffect bt) (_buSpawn bt) (_buDamages bt)
) {_buTimer = _buTimer bt - 1}
pOut = hp +.+ 2 *.* newDir
reflectVel = magV bulVel *.* newDir
@@ -106,7 +117,7 @@ mvBullet w bt'
reflectVel = reflVelWall wl (_buVel bt)
thebouncer = aBulAt Nothing --id
pOut reflectVel (_buDrag bt) (_buWidth bt) BasicBulletTrajectory (_buEffect bt)
(_buSpawn bt)
(_buSpawn bt) (_buDamages bt)
& buTimer .~ _buTimer bt - 1
pOut = hp +.+ squashNormalizeV (p -.- hp)
_ -> id
@@ -125,31 +136,23 @@ mvBullet w bt'
vel = _buVel bt
hiteff = hitEffFromBul
t = _buTimer bt
--BounceBullet bt -> w & instantBullets .:~ thebouncer
-- where
-- reflectVel = reflVelWall wl (_buVel bt)
-- thebouncer = aBulAt Nothing --id
-- pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt) BasicBulletTrajectory
-- & buTimer .~ _buTimer bt - 1
-- pOut = p +.+ squashNormalizeV (sp -.- p)
-- p = _dmAt dm
-- sp = _dmFrom dm
-- BounceBullet bt | crIsArmouredFrom p cr -> w & instantBullets .:~ bouncer
-- where
-- bouncer = (aBulAt Nothing pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt)
-- BasicBulletTrajectory
-- ) {_buTimer = _buTimer bt - 1}
-- pOut = p +.+ 2 *.* newDir
-- reflectVel = magV bulVel *.* newDir
-- newDir = squashNormalizeV (p -.- _crPos cr)
-- bulVel = _buVel bt
-- BounceBullet _ -> w
bulletSpawn :: Bullet -> Maybe (Point2 -> State StdGen Particle)
bulletSpawn bu = case _buSpawn bu of
BulSpark -> Nothing
BulBall IncBall -> Just incBall
BulBall ConcBall -> Just concBall
BulBall TeslaBall -> Just aStaticBall
hitEffFromBul :: Bullet
-> Stream (Of (Point2, Either Creature Wall)) Identity ()
-> World
-> (World,Maybe Bullet)
hitEffFromBul = expireAndDamage' basicBulDams
hitEffFromBul = expireAndDamage' setfromtodams
where
setfromtodams bu p = map f (_buDamages bu)
where
f = (dmFrom .~ _buPos bu) . (dmAt .~ p) . (dmTo .~ _buPos bu +.+ _buVel bu)
mvBulletSlow :: Float -> World -> Bullet -> (World, Maybe Bullet)
mvBulletSlow x w bt'
src/Dodge/Combine/Module.hs
+3 -6
View File
@@ -1,8 +1,6 @@
module Dodge.Combine.Module where
import Dodge.Data
import Dodge.Tesla
import Dodge.WorldEvent.SpawnParticle
import Dodge.Particle.Damage
import Dodge.Item.Weapon.ExtraEffect
import Dodge.Item.Weapon.Launcher
import Dodge.Item.Weapon.TriggerType
@@ -19,10 +17,10 @@ moduleModification imt = case imt of
DRUMMAG -> itConsumption . laMax .~ 45
BELTMAG -> itConsumption . laMax .~ 150
MAGNETMAG -> itUse . useDelay . rateMax .~ 4
INCENDBUL -> f $ spawnAtBulDams incBall
INCENDBUL -> itConsumption . laAmmoType . amBulSpawn .~ BulBall IncBall
BOUNCEBUL -> itConsumption . laAmmoType . amBulEffect .~ BounceBullet
STATICBUL -> f $ spawnAtBulDams aStaticBall
CONCUSBUL -> f $ spawnAtBulDams concBall
STATICBUL -> itConsumption . laAmmoType . amBulSpawn .~ BulBall TeslaBall
CONCUSBUL -> itConsumption . laAmmoType . amBulSpawn .~ BulBall ConcBall
TARGCR -> itTargeting .~ targetRBCreature
TARGLAS -> itTargeting .~ targetLaser
TARGPOS -> itTargeting .~ targetRBPress
@@ -39,7 +37,6 @@ moduleModification imt = case imt of
EXTRABATTERY -> itConsumption . laMax +~ 1000
ATTACHTORCH -> id
where
f ameff = itConsumption . laAmmoType . amBulDams .~ ameff
makeDirectedTele it = it
& itTargeting .~ targetRBPress
& itUse . useMods .:~ withPosDirWallCheck directedTelPos
src/Dodge/Creature.hs
+2
View File
@@ -238,6 +238,8 @@ inventoryX c = case c of
, makeTypeCraftNum 1 HEATSENSOR
, makeTypeCraftNum 1 BOUNCEMODULE
, makeTypeCraftNum 1 INCENDIARYMODULE
, makeTypeCraftNum 1 CONCUSSMODULE
, makeTypeCraftNum 1 STATICMODULE
]
_ -> []
src/Dodge/Creature/Damage.hs
+5 -11
View File
@@ -7,8 +7,6 @@ import Color
import Geometry
import LensHelp
import Control.Monad.State
--import System.Random
import Data.List
applyNoDamage :: [Damage] -> Creature -> World -> World
@@ -39,17 +37,13 @@ applyDamageEffect dm de cr w = case de of
| dist (_crPos cr) fromDir == 0 = 0
| otherwise = min 5 $ (push*5*pushRad / (dist (_crPos cr) fromDir * _crMass cr))**pushexp
PushBackDamage pback -> w
& creatures . ix (_crID cr) . crPos .+.+~ (1/_crMass cr) *.* pback
& creatures . ix (_crID cr) . crPos .+.+~ (pback/_crMass cr) *.* (_dmTo dm -.- fromDir)
TorqueDamage rot -> w
& creatures . ix (_crID cr) . crDir +~ rot
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
-- DamageSpawn f -> w & instantParticles .:~ thepart
-- & randGen .~ g
-- where
-- (thepart,g) = runState (f (Left cr) dm) $ _randGen w
NoDamageEffect -> w
where
fromDir = _dmFrom dm
src/Dodge/Creature/Inanimate.hs
+1 -1
View File
@@ -96,7 +96,7 @@ damToExpBarrel' dm cr = case _dmType dm of
$ cr & crHP -~ div amount 200
POISONDAM -> cr
SPARKING -> cr
PUSHDAM -> cr LensHelp.& crPos .+.+~ (1 / _crMass cr *.* _dePushBack (_dmEffect dm))
-- PUSHDAM -> cr LensHelp.& crPos .+.+~ (1 / _crMass cr *.* _dePushBack (_dmEffect dm))
_ -> cr LensHelp.& crHP -~ amount
where
amount = _dmAmount dm
src/Dodge/Data.hs
+3 -76
View File
@@ -10,6 +10,7 @@ circular imports are probably not a good idea.
{-# LANGUAGE DerivingStrategies #-}
module Dodge.Data
( module Dodge.Data
, module Dodge.Data.Bullet
, module Dodge.Data.Door
, module Dodge.Data.Item
, module Dodge.Data.HUD
@@ -46,6 +47,7 @@ module Dodge.Data
, module Dodge.Data.RadarBlip
, module Dodge.Data.PathGraph
) where
import Dodge.Data.Bullet
import Dodge.Data.Door
import Dodge.Data.Item
import Dodge.Data.HUD
@@ -524,34 +526,6 @@ data BeamType
{_beamCombine :: (Point2 , (Point2,Point2,Beam) , (Point2,Point2,Beam)) -> World -> World}
| BeamSimple
data BulletState = NormalBulletState
| DyingBulletState
| DelayedBullet Float
data BulletUpdateMod = NoBulletUpdateMod
data BulletEffect = DestroyBullet
| BounceBullet
| PenetrateBullet
data BulletSpawn = BulBall EnergyBall | BulSpark
data Bullet = Bullet
{ _buState :: BulletState
, _buEffect :: BulletEffect
, _buSpawn :: BulletSpawn
, _buUpdateMod :: BulletUpdateMod
, _buTrajectory :: BulletTrajectory
, _buVel :: Point2
, _buDrag :: Float
, _buPos :: Point2
, _buOldPos :: Point2
, _buWidth :: Float
, _buTimer :: Int
-- , _buEffect :: BulletEffect
-- , _buHitEff :: HitEffect'
}
data EnergyBall = IncBall | TeslaBall | ConcBall
{- Objects without ids.
Update themselves, perhaps with side effects. -}
data Particle
@@ -655,17 +629,6 @@ 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 Point2 Point2 Point2
| FlechetteTrajectory Point2
| MagnetTrajectory Point2
data AmmoType
= ProjectileAmmo
{ _amPayload :: Point2 -> World -> World
@@ -677,7 +640,7 @@ data AmmoType
| BulletAmmo
{ _amString :: String
-- , _amBulEff :: HitEffect'
, _amBulDams :: Bullet -> Point2 -> [Damage]
, _amBulDams :: [Damage]
, _amBulWth :: Float
, _amBulVel :: Point2
, _amBulTraj :: BulletTrajectory
@@ -1260,39 +1223,6 @@ data Goal
| SentinelAt Point2 Float
deriving (Show)
data DamageEffect
= PushDamage
{ _dePush :: Float
, _dePushExp :: Float
, _dePushRadius :: Float
}
| TorqueDamage { _deTorque :: Float }
| PushBackDamage {_dePushBack :: Point2 }
| DamageSpawn {_spawnFunc
:: Either Creature Wall -> Damage -> State StdGen Particle}
| DamageSpawn' {_spawnFunc'
:: Either Creature Wall -> Damage -> State StdGen Bullet}
| NoDamageEffect
-- deriving (Eq,Ord,Show)
data Damage = Damage
{ _dmType :: DamageType
, _dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2
, _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
PUSHDAM -> True
_ -> False
data CreatureState = CrSt
{ _csDamage :: [Damage]
, _csSpState :: CrSpState
@@ -1413,8 +1343,6 @@ data InPlacement = InPlacement
}
makeLenses ''CreatureState
makeLenses ''Damage
makeLenses ''DamageEffect
makeLenses ''World
makeLenses ''Creature
makeLenses ''Item
@@ -1427,7 +1355,6 @@ makeLenses ''TweakParam
makeLenses ''Prop
makeLenses ''Modification
makeLenses ''Particle
makeLenses ''Bullet
makeLenses ''PressPlate
makeLenses ''Button
makeLenses ''ActionPlan
src/Dodge/Data/Bullet.hs
+38
View File
@@ -0,0 +1,38 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Bullet where
import Dodge.Data.DamageType
import Geometry.Data
import Control.Lens
data Bullet = Bullet
{ _buState :: BulletState
, _buEffect :: BulletEffect
, _buSpawn :: BulletSpawn
, _buUpdateMod :: BulletUpdateMod
, _buTrajectory :: BulletTrajectory
, _buVel :: Point2
, _buDrag :: Float
, _buPos :: Point2
, _buOldPos :: Point2
, _buWidth :: Float
, _buTimer :: Int
, _buDamages :: [Damage]
}
data EnergyBall = IncBall | TeslaBall | ConcBall
data BulletState = NormalBulletState
| DyingBulletState
| DelayedBullet Float
data BulletUpdateMod = NoBulletUpdateMod
data BulletEffect = DestroyBullet
| BounceBullet
| PenetrateBullet
data BulletSpawn = BulBall EnergyBall | BulSpark
data BulletTrajectory
= BasicBulletTrajectory
| BezierTrajectory Point2 Point2 Point2
| FlechetteTrajectory Point2
| MagnetTrajectory Point2
makeLenses ''Bullet
src/Dodge/Data/DamageType.hs
+33
View File
@@ -1,9 +1,12 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-
Datatypes describing the type of damage effects that are to be applied to
creatures.
-}
module Dodge.Data.DamageType where
import Geometry.Data
import Control.Lens
data DamageType
= PIERCING
| BLUNT
@@ -21,3 +24,33 @@ data DamageType
| POISONDAM
| ENTERREMENT
deriving (Eq,Ord,Show,Read)
data DamageEffect
= PushDamage
{ _dePush :: Float
, _dePushExp :: Float
, _dePushRadius :: Float
}
| TorqueDamage { _deTorque :: Float }
| PushBackDamage {_dePushBack :: Float }
| NoDamageEffect
deriving (Eq,Ord,Show)
data Damage = Damage
{ _dmType :: DamageType
, _dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2
, _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
PUSHDAM -> True
_ -> False
makeLenses ''Damage
makeLenses ''DamageEffect
src/Dodge/Particle/Damage.hs
+18 -46
View File
@@ -1,22 +1,6 @@
module Dodge.Particle.Damage where
import Dodge.Data
import Geometry
--import LensHelp
import System.Random
import Control.Monad.State
-- TODO unify particle position in a sensible manner
spawnAtBulDams :: (Point2 -> State StdGen Particle)
-> 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 = _buPos 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 ]
@@ -31,25 +15,17 @@ simpleDam' dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
bulVel = _buVel bt
ep = sp +.+ bulVel
heavyBulDams :: Bullet -> Point2 -> [Damage]
heavyBulDams bt p =
[ Damage PIERCING 300 sp p ep NoDamageEffect
, Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel
heavyBulDams :: [Damage]
heavyBulDams =
[ Damage PIERCING 300 0 0 0 NoDamageEffect
, Damage PUSHDAM 1 0 0 0 $ PushBackDamage 2
]
where
sp = _buPos bt
bulVel = _buVel bt
ep = sp +.+ bulVel
basicBulDams :: Bullet -> Point2 -> [Damage]
basicBulDams bt p =
[ Damage PIERCING 100 sp p ep NoDamageEffect
, Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel
basicBulDams :: [Damage]
basicBulDams =
[ Damage PIERCING 100 0 0 0 NoDamageEffect
, Damage PUSHDAM 1 0 0 0 . PushBackDamage $ 2
]
where
sp = _buPos bt
bulVel = _buVel bt
ep = sp +.+ bulVel
basicSparkDams :: Particle -> Point2 -> [Damage]
basicSparkDams bt p = [ Damage SPARKING 1 sp p ep NoDamageEffect ]
@@ -58,18 +34,14 @@ basicSparkDams bt p = [ Damage SPARKING 1 sp p ep NoDamageEffect ]
bulVel = _ptVel bt
ep = sp +.+ bulVel
hvBulDams :: Bullet -> Point2 -> [Damage]
hvBulDams bt p =
[ Damage PIERCING 25 sp p ep NoDamageEffect
, Damage PIERCING 25 sp p ep NoDamageEffect
, Damage PIERCING 25 sp p ep NoDamageEffect
, Damage PIERCING 25 sp p ep NoDamageEffect
, Damage PIERCING 25 sp p ep NoDamageEffect
, Damage PIERCING 25 sp p ep NoDamageEffect
, Damage TORQUEDAM 1 sp p ep $ TorqueDamage 0.7
, Damage PUSHDAM 1 sp p ep . PushBackDamage $ 3 *.* (ep -.- sp)
hvBulDams :: [Damage]
hvBulDams =
[ Damage PIERCING 25 0 0 0 NoDamageEffect
, Damage PIERCING 25 0 0 0 NoDamageEffect
, Damage PIERCING 25 0 0 0 NoDamageEffect
, Damage PIERCING 25 0 0 0 NoDamageEffect
, Damage PIERCING 25 0 0 0 NoDamageEffect
, Damage PIERCING 25 0 0 0 NoDamageEffect
, Damage TORQUEDAM 1 0 0 0 $ TorqueDamage 0.7
, Damage PUSHDAM 1 0 0 0 $ PushBackDamage 3
]
where
sp = _buPos bt
bulVel = _buVel bt
ep = sp +.+ bulVel
src/Dodge/Wall/DamageEffect.hs
+1 -12
View File
@@ -7,11 +7,8 @@ import Dodge.Block
import Geometry
import LensHelp
import Control.Monad.State
--import Data.Maybe
defaultWallDamage :: Damage -> Wall -> World -> (World,Int)
defaultWallDamage dm wl = flip (.) (wallDamageEffect dm wl) $ case _wlMaterial wl of
defaultWallDamage dm wl = case _wlMaterial wl of
Stone -> stoneWallDamage dm wl
Glass -> windowWallDamage dm wl
Dirt -> dirtWallDamage dm wl
@@ -128,11 +125,3 @@ dirtWallDamage dm wl = case _dmType dm of
sp = _dmFrom dm
p = _dmAt dm
outTo = p +.+ squashNormalizeV (sp -.- p)
wallDamageEffect :: Damage -> Wall -> World -> World
wallDamageEffect dm wl w = case _dmEffect dm of
DamageSpawn f -> w & instantParticles .:~ thepart
& randGen .~ g
where
(thepart,g) = runState (f (Right wl) dm) $ _randGen w
_ -> w
src/Dodge/WorldEvent/Shockwave.hs
+5 -3
View File
@@ -74,10 +74,11 @@ mvShockwave is w pt
damCr cr
| _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . csDamage .:~
Damage PUSHDAM dam cpos cpos cpos
(PushBackDamage (25 * push *.* squashNormalizeV (_crPos cr -.- p)))
Damage PUSHDAM dam (cpos -.- v) cpos (cpos +.+ v)
(PushBackDamage (25 * push))
where
cpos = _crPos cr
v = normalizeV (cpos -.- p)
{- Create a shockwave going from an outside circle into a center point. -}
inverseShockwaveAt
:: Point2 -- Center position
@@ -113,7 +114,8 @@ moveInverseShockwave w pt
damCr cr
| dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . csDamage .:~
Damage PUSHDAM 1 cpos cpos cpos (PushBackDamage $ 25 *.* squashNormalizeV (p -.- cpos))
Damage PUSHDAM 1 (cpos +.+ v) cpos (cpos -.- v) (PushBackDamage 25)
where
cpos = _crPos cr
v = normalizeV (cpos -.- p)