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

Continue bullet refactor

Browse Source
This commit is contained in:
justin
2022-07-16 22:02:01 +01:00
parent 301946ff8f
commit c9f7f39f22
12 changed files with 31 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Damage.hs
+1 -1
View File
@@ -44,7 +44,7 @@ applyDamageEffect dm de cr w = case de of
& creatures . ix (_crID cr) . crDir +~ rot & creatures . ix (_crID cr) . crDir +~ rot
BounceBullet bt | crIsArmouredFrom p cr -> w & instantBullets .:~ bouncer BounceBullet bt | crIsArmouredFrom p cr -> w & instantBullets .:~ bouncer
where where
bouncer = (aBulAt Nothing id (Just (_buColor bt)) pOut reflectVel (_buDrag bt) bouncer = (aBulAt Nothing id pOut reflectVel (_buDrag bt)
(_buHitEff bt) (_buWidth bt) (_buHitEff bt) (_buWidth bt)
) {_buTimer = _buTimer bt - 1} ) {_buTimer = _buTimer bt - 1}
pOut = p +.+ 2 *.* newDir pOut = p +.+ 2 *.* newDir
src/Dodge/Data.hs
+2 -2
View File
@@ -528,8 +528,8 @@ data Bullet = Bullet
{ _buUpdate :: World -> Bullet -> (World, Maybe Bullet) { _buUpdate :: World -> Bullet -> (World, Maybe Bullet)
, _buVel :: Point2 , _buVel :: Point2
, _buDrag :: Float , _buDrag :: Float
, _buColor :: Color , _buPos :: Point2
, _buTrail :: [Point2] , _buOldPos :: Point2
, _buWidth :: Float , _buWidth :: Float
, _buTimer :: Int , _buTimer :: Int
, _buHitEff :: HitEffect' , _buHitEff :: HitEffect'
src/Dodge/Item/Weapon/AmmoParams.hs
+2 -3
View File
@@ -18,7 +18,6 @@ useAmmoParams :: Maybe Float -> Item -> Creature -> World -> World
useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt
vfact vfact
thetraj -- extra update thetraj -- extra update
Nothing -- color (default)
sp sp
(rotateV dir (muzvel *.* _amBulVel bultype)) -- vel (rotateV dir (muzvel *.* _amBulVel bultype)) -- vel
(_rifling $ _itParams it) -- drag (_rifling $ _itParams it) -- drag
@@ -34,10 +33,10 @@ useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt
BasicBulletTrajectory -> id BasicBulletTrajectory -> id
MagnetTrajectory -> fromMaybe id $ do MagnetTrajectory -> fromMaybe id $ do
tpos <- it ^? itTargeting . tgPos . _Just tpos <- it ^? itTargeting . tgPos . _Just
return $ \pt -> pt & buVel .+.+~ 5 *.* normalizeV (tpos -.- head (_buTrail pt)) return $ \pt -> pt & buVel .+.+~ 5 *.* normalizeV (tpos -.- _buPos pt)
FlechetteTrajectory -> fromMaybe id $ do FlechetteTrajectory -> fromMaybe id $ do
tpos <- it ^? itTargeting . tgPos . _Just tpos <- it ^? itTargeting . tgPos . _Just
return $ \pt -> pt & buVel %~ vecTurnTo 0.2 (head $ _buTrail pt) tpos return $ \pt -> pt & buVel %~ vecTurnTo 0.2 (_buPos pt) tpos
BezierTrajectory -> fromMaybe id $ do BezierTrajectory -> fromMaybe id $ do
tpos <- it ^? itTargeting . tgPos . _Just tpos <- it ^? itTargeting . tgPos . _Just
let bf t = bQuadToF (sp,mouseWorldPos w,tpos) $ (100 - t) * 0.05 let bf t = bQuadToF (sp,mouseWorldPos w,tpos) $ (100 - t) * 0.05
src/Dodge/Magnet.hs
+3 -3
View File
@@ -6,12 +6,12 @@ import Control.Lens
dampField :: Magnet -> Bullet -> Bullet dampField :: Magnet -> Bullet -> Bullet
dampField mg pt = case pt of dampField mg pt = case pt of
Bullet{} | dist (head $ _buTrail pt) (_mgPos mg) < 100 -> pt & buVel *~ 0.5 Bullet{} | dist (_buPos pt) (_mgPos mg) < 100 -> pt & buVel *~ 0.5
_ -> pt _ -> pt
curveLeftField :: Magnet -> Bullet -> Bullet curveLeftField :: Magnet -> Bullet -> Bullet
curveLeftField mg pt = case pt of curveLeftField mg pt = case pt of
Bullet{} | dist (head $ _buTrail pt) (_mgPos mg) < 500 -> pt & buVel %~ rotateV 0.2 Bullet{} | dist (_buPos pt) (_mgPos mg) < 500 -> pt & buVel %~ rotateV 0.2
_ -> pt _ -> pt
curveAroundField :: Float -> Float -> Magnet -> Bullet -> Bullet curveAroundField :: Float -> Float -> Magnet -> Bullet -> Bullet
@@ -20,7 +20,7 @@ curveAroundField minrad maxrad mg pt = case pt of
where where
thedist = dist btpos mgpos thedist = dist btpos mgpos
mgpos = _mgPos mg mgpos = _mgPos mg
btpos = head $ _buTrail pt btpos = _buPos pt
rotateToCircle vel rotateToCircle vel
| (isLHS mgpos btpos (btpos +.+ vel) && isRHS mgpos btpos (mgpos +.+ vNormal vel) ) | (isLHS mgpos btpos (btpos +.+ vel) && isRHS mgpos btpos (mgpos +.+ vNormal vel) )
|| (isRHS mgpos btpos (btpos +.+ vel) && isLHS mgpos btpos (mgpos +.+ vNormal vel) ) || (isRHS mgpos btpos (btpos +.+ vel) && isLHS mgpos btpos (mgpos +.+ vNormal vel) )
src/Dodge/Particle/Bullet/Draw.hs
+4 -3
View File
@@ -4,9 +4,10 @@ module Dodge.Particle.Bullet.Draw
import Dodge.Data import Dodge.Data
import Picture import Picture
import Linear
drawBul :: Bullet -> Picture drawBul :: Bullet -> Picture
drawBul pt = setLayer BloomNoZWrite drawBul pt = setLayer BloomNoZWrite
. setDepth 20 . setDepth 20
. color (_buColor pt) . color (V4 200 200 200 2)
-- $ thickLine (_ptWidth pt) (take 3 $ _ptTrail pt) $ thickLine (_buWidth pt) [_buOldPos pt, _buPos pt]
$ thickLine (_buWidth pt) (take 2 $ _buTrail pt)
src/Dodge/Particle/Bullet/Spawn.hs
+3 -5
View File
@@ -4,7 +4,6 @@ module Dodge.Particle.Bullet.Spawn
import Dodge.Data import Dodge.Data
import Dodge.Particle.Bullet.Update import Dodge.Particle.Bullet.Update
import Geometry import Geometry
import Picture
import LensHelp import LensHelp
import Data.Maybe import Data.Maybe
@@ -13,19 +12,18 @@ import Data.Bifunctor
aBulAt aBulAt
:: Maybe Float -- ^ Start velocity step factor :: Maybe Float -- ^ Start velocity step factor
-> (Bullet -> Bullet) -> (Bullet -> Bullet)
-> Maybe Color
-> Point2 -- ^ Start position -> Point2 -- ^ Start position
-> Point2 -- ^ Velocity -> Point2 -- ^ Velocity
-> Float -- ^ Drag -> Float -- ^ Drag
-> HitEffect' -> HitEffect'
-> Float -- ^ Bullet width -> Float -- ^ Bullet width
-> Bullet -> Bullet
aBulAt vfact updatemod mcol pos vel drag hiteff width = Bullet aBulAt vfact updatemod pos vel drag hiteff width = Bullet
{ _buUpdate = theupdate { _buUpdate = theupdate
, _buVel = fromMaybe 1 vfact *.* vel , _buVel = fromMaybe 1 vfact *.* vel
, _buDrag = drag , _buDrag = drag
, _buColor = fromMaybe (V4 200 200 200 2) mcol , _buPos = pos
, _buTrail = [pos] , _buOldPos = pos
, _buWidth = width , _buWidth = width
, _buTimer = 100 , _buTimer = 100
, _buHitEff = hiteff , _buHitEff = hiteff
src/Dodge/Particle/Bullet/Update.hs
+1 -1
View File
@@ -22,7 +22,7 @@ mvBullet w bt'
bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w
dodrag = buVel .*.*~ drag dodrag = buVel .*.*~ drag
drag = _buDrag bt drag = _buDrag bt
(p:_) = _buTrail bt p = _buPos bt
vel = _buVel bt vel = _buVel bt
hiteff = _buHitEff bt hiteff = _buHitEff bt
t = _buTimer bt t = _buTimer bt
src/Dodge/Particle/Damage.hs
+7 -9
View File
@@ -1,7 +1,7 @@
module Dodge.Particle.Damage where module Dodge.Particle.Damage where
import Dodge.Data import Dodge.Data
import Geometry import Geometry
import LensHelp --import LensHelp
import System.Random import System.Random
import Control.Monad.State import Control.Monad.State
@@ -14,7 +14,7 @@ spawnAtBulDams thespawn bt p =
, Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel , Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel
] ]
where where
sp = head $ _buTrail bt sp = _buPos bt
bulVel = _buVel bt bulVel = _buVel bt
ep = sp +.+ bulVel ep = sp +.+ bulVel
@@ -27,9 +27,7 @@ simpleDam dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
simpleDam' :: DamageType -> Int -> Bullet -> Point2 -> [Damage] simpleDam' :: DamageType -> Int -> Bullet -> Point2 -> [Damage]
simpleDam' dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ] simpleDam' dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
where where
sp = case bt ^? buTrail of sp = _buPos bt
Nothing -> 0
Just xs -> head xs
bulVel = _buVel bt bulVel = _buVel bt
ep = sp +.+ bulVel ep = sp +.+ bulVel
@@ -39,7 +37,7 @@ heavyBulDams bt p =
, Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel , Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel
] ]
where where
sp = head $ _buTrail bt sp = _buPos bt
bulVel = _buVel bt bulVel = _buVel bt
ep = sp +.+ bulVel ep = sp +.+ bulVel
@@ -49,7 +47,7 @@ basicBulDams bt p =
, Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel , Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel
] ]
where where
sp = head $ _buTrail bt sp = _buPos bt
bulVel = _buVel bt bulVel = _buVel bt
ep = sp +.+ bulVel ep = sp +.+ bulVel
@@ -72,7 +70,7 @@ hvBulDams bt p =
, Damage PUSHDAM 1 sp p ep . PushBackDamage $ 3 *.* (ep -.- sp) , Damage PUSHDAM 1 sp p ep . PushBackDamage $ 3 *.* (ep -.- sp)
] ]
where where
sp = head $ _buTrail bt sp = _buPos bt
bulVel = _buVel bt bulVel = _buVel bt
ep = sp +.+ bulVel ep = sp +.+ bulVel
@@ -82,6 +80,6 @@ bounceBulDams bt p =
, Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel , Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel
] ]
where where
sp = head $ _buTrail bt sp = _buPos bt
bulVel = _buVel bt bulVel = _buVel bt
ep = sp +.+ bulVel ep = sp +.+ bulVel
src/Dodge/Particle/Draw.hs
-8
View File
@@ -124,18 +124,10 @@ drawInverseShockwave pt
rad = r - 0.1 * r * fromIntegral (10 - t) rad = r - 0.1 * r * fromIntegral (10 - t)
thickness = fromIntegral (10 - t) **2 * rad / 40 thickness = fromIntegral (10 - t) **2 * rad / 40
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 :: Particle -> Picture
drawSpark pt = setLayer BloomNoZWrite drawSpark pt = setLayer BloomNoZWrite
. setDepth 20 . setDepth 20
. color (_ptColor pt) . color (_ptColor pt)
-- $ thickLine (_ptWidth pt) (take 3 $ _ptTrail pt)
$ thickLine (_ptWidth pt) (take 2 $ _ptTrail pt) $ thickLine (_ptWidth pt) (take 2 $ _ptTrail pt)
drawTeslaArc :: Particle -> Picture drawTeslaArc :: Particle -> Picture
src/Dodge/Particle/Update.hs
+6 -14
View File
@@ -5,10 +5,9 @@ import Geometry
mvPt :: Bullet -> Maybe Bullet mvPt :: Bullet -> Maybe Bullet
mvPt pt = Just $ pt mvPt pt = Just $ pt
& buTrail %~ f & buPos %~ (+.+ _buVel pt)
& buOldPos .~ _buPos pt
& buTimer -~ 1 & buTimer -~ 1
where
f trl = head trl +.+ _buVel pt : trl
mvPt' :: Particle -> Maybe Particle mvPt' :: Particle -> Maybe Particle
mvPt' pt = Just $ pt mvPt' pt = Just $ pt
@@ -24,17 +23,10 @@ destroyAt hitp pt = Just $ pt
& ptTimer %~ (min 3 . subtract 1) & ptTimer %~ (min 3 . subtract 1)
destroyAt' :: Point2 -> Bullet -> Maybe Bullet destroyAt' :: Point2 -> Bullet -> Maybe Bullet
destroyAt' hitp pt = Just $ pt destroyAt' hitp pt = Just $ pt
& buUpdate .~ killBulletUpdate & buUpdate .~ (\w -> const (w,Nothing))
& buTrail .:~ hitp & buPos .~ hitp
& buTimer %~ (min 3 . subtract 1) & buOldPos .~ _buPos pt
& buTimer %~ (min 3 . subtract 1)
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 :: World -> Particle -> (World,Maybe Particle)
killParticleUpdate w pt killParticleUpdate w pt
src/Dodge/Render/ShapePicture.hs
+1
View File
@@ -5,6 +5,7 @@ import Dodge.Item.Draw.SPic
import Dodge.Creature.Picture.Awareness import Dodge.Creature.Picture.Awareness
import Dodge.Creature.Picture import Dodge.Creature.Picture
import Dodge.Particle.Draw import Dodge.Particle.Draw
import Dodge.Particle.Bullet.Draw
import Dodge.RadarBlip import Dodge.RadarBlip
import Dodge.Flare import Dodge.Flare
import Dodge.ShortShow import Dodge.ShortShow
src/Dodge/Wall/DamageEffect.hs
+1 -2
View File
@@ -106,7 +106,6 @@ crystalWallDamage dm wl = case _dmType dm of
pSparkCol = V4 5 1 0.5 2 pSparkCol = V4 5 1 0.5 2
lSparkCol = V4 20 (-5) 0 1 lSparkCol = V4 20 (-5) 0 1
dirtWallDamage :: Damage -> Wall -> World -> (World,Int) dirtWallDamage :: Damage -> Wall -> World -> (World,Int)
dirtWallDamage dm wl = case _dmType dm of dirtWallDamage dm wl = case _dmType dm of
LASERING -> a d $ wlDustAt wl outTo LASERING -> a d $ wlDustAt wl outTo
@@ -136,7 +135,7 @@ wallDamageEffect dm wl w = case _dmEffect dm of
BounceBullet bt -> w & instantBullets .:~ thebouncer BounceBullet bt -> w & instantBullets .:~ thebouncer
where where
reflectVel = reflVelWall wl (_buVel bt) reflectVel = reflVelWall wl (_buVel bt)
thebouncer = aBulAt Nothing id (Just (_buColor bt)) pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt) thebouncer = aBulAt Nothing id pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt)
& buTimer .~ _buTimer bt - 1 & buTimer .~ _buTimer bt - 1
pOut = p +.+ squashNormalizeV (sp -.- p) pOut = p +.+ squashNormalizeV (sp -.- p)
p = _dmAt dm p = _dmAt dm