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

Cleanup, redo damage direction

Browse Source
This commit is contained in:
justin
2025-06-08 20:40:58 +01:00
parent 5b1e4fba4e
commit 70c78824f3
12 changed files with 105 additions and 147 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Barreloid.hs
+1 -1
View File
@@ -27,7 +27,7 @@ updateExpBarrel cr w
pierceSparks :: [World -> World]
pierceSparks =
zipWith
(\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p))
(\p a -> sparkRandDir 0.1 (_crPos cr +.+ p) (a + argV p))
poss
as
as = randomRs (-0.7, 0.7) g
src/Dodge/Bullet.hs
+1 -1
View File
@@ -114,7 +114,7 @@ useBulletPayload bu = case _buPayload bu of
BulFlak -> makeFlak bu
BulFrag -> makeFragBullets
BulGas -> (`makeGasCloud` V2 0 0)
BulBall FlamingBall -> incBallAt
-- BulBall FlamingBall -> incBallAt
BulBall ExplosiveBall -> \p -> cWorld . lWorld . shockwaves .:~ concBall p
BulBall ElectricalBall -> makeStaticBall
BulBall FlashBall -> makeFlashBall
src/Dodge/Creature.hs
+1 -2
View File
@@ -281,8 +281,7 @@ inventoryX c = case c of
, megaTinMag 10200
] <>
-- [bulletTargetingModule btt | btt <- [minBound .. maxBound]]
[bulletModule (BulletModPayload (BulBall x)) | x <- [ FlamingBall
, FlameletBall 5 0
[bulletModule (BulletModPayload (BulBall x)) | x <- [ FlameletBall 5 0
, ElectricalBall
, ExplosiveBall
, FlashBall ]]
src/Dodge/Creature/Damage.hs
+2 -6
View File
@@ -45,18 +45,14 @@ defaultApplyDamage ds cr w =
--p = _dmAt dm
applyIndividualDamage :: Creature -> World -> Damage -> World
--applyIndividualDamage cr w dm = applyDamageEffect dm (_dmEffect dm) cr $ applyIndividualDamage' cr w dm
applyIndividualDamage cr w dm = applyIndividualDamage' cr w dm
applyIndividualDamage' :: Creature -> World -> Damage -> World
applyIndividualDamage' cr w dm = case dm of
applyIndividualDamage cr w dm = case dm of
Piercing{} -> applyPiercingDamage cr dm w
_ -> w & damageHP cr (_dmAmount dm)
applyPiercingDamage :: Creature -> Damage -> World -> World
applyPiercingDamage cr dm
| crIsArmouredFrom p cr = f . makeSpark NormalSpark p1 (argV (p1 -.- p))
| otherwise = f . (damageHP cr $ _dmAmount dm)
| otherwise = f . damageHP cr (_dmAmount dm)
where
f = cWorld . lWorld . creatures . ix (_crID cr) . crPos -~ _dmVector dm
/ V2 x x
src/Dodge/Damage.hs
+13 -14
View File
@@ -1,18 +1,18 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Damage
( damageCrWl
, damageDirection
, damageCrWlID
, maxDamageType
) where
--import qualified Data.Map.Strict as M
module Dodge.Damage (
damageCrWl,
damageDirection,
damageCrWlID,
maxDamageType,
) where
import Geometry.Vector
import ListHelp
import Dodge.Data.CrWlID
import Dodge.Data.World
--import FoldableHelp
--import Geometry.Vector
import LensHelp
import qualified IntMapHelp as IM
import LensHelp
damageCrWlID :: Damage -> CrWlID -> World -> World
damageCrWlID dam = \case
@@ -24,11 +24,9 @@ damageCrWl :: Damage -> Either Creature Wall -> World -> World
damageCrWl dt (Left cr) = cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .:~ dt
damageCrWl dt (Right wl) = cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) [dt]
-- could sort for damage amount as well
damageDirection :: [Damage] -> Maybe Float
damageDirection _ = Nothing
--damageDirection ds = do
-- dm <- safeMinimumOn (negate . _dmAmount) ds
-- safeArgV (_dmTo dm -.- _dmFrom dm)
damageDirection ds = safeArgV =<< safeHead (ds ^.. each . dmVector)
--collectDamageTypes :: [Damage] -> M.Map DamageType Int
--collectDamageTypes = foldl' (flip f) M.empty
@@ -37,4 +35,5 @@ damageDirection _ = Nothing
--
maxDamageType :: [Damage] -> Maybe (Damage, Int)
maxDamageType _ = Nothing
--maxDamageType = safeMinimumOn (negate . snd) . M.assocs . collectDamageTypes
src/Dodge/Data/AimStance.hs
-1
View File
@@ -1,5 +1,4 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.AimStance where
src/Dodge/Data/EnergyBall/Type.hs
+1 -2
View File
@@ -10,8 +10,7 @@ import Data.Aeson
import Data.Aeson.TH
data EnergyBallType
= FlamingBall
| FlameletBall {_fbSize :: Float, _fbRot :: Float}
= FlameletBall {_fbSize :: Float, _fbRot :: Float}
| ElectricalBall
| ExplosiveBall
| FlashBall
src/Dodge/EnergyBall.hs
+19 -39
View File
@@ -18,17 +18,7 @@ import LensHelp
import Picture
import RandomHelp
makeFlamelet ::
-- | Position
Point2 ->
-- | Velocity
Point2 ->
-- | Size
Float ->
-- | Timer
Int ->
World ->
World
makeFlamelet :: Point2 -> Point2 -> Float -> Int -> World -> World
makeFlamelet p v s t w =
w
& randGen .~ g
@@ -53,35 +43,31 @@ updateEnergyBall w eb
p = eb ^. ebPos + eb ^. ebVel
(bp, bv) = fromMaybe (p, eb ^. ebVel) $ bouncePoint (const True) 0 (eb ^. ebPos) p w
incBallAt :: Point2 -> World -> World
incBallAt p = cWorld . lWorld . energyBalls
.:~ EnergyBall
{ _ebVel = 0
, _ebPos = p
, _ebTimer = 20
, _ebEff = FlamingBall
}
makeFlashBall :: Point2 -> World -> World
makeFlashBall p =
energyBallAt :: EnergyBallType -> Point2 -> World -> World
energyBallAt ebt p =
cWorld . lWorld . energyBalls
.:~ EnergyBall
{ _ebVel = 0
, _ebPos = p
, _ebTimer = 20
, _ebEff = FlashBall
, _ebEff = ebt
}
incBallAt :: Point2 -> World -> World
incBallAt = energyBallAt (FlameletBall 5 0)
makeFlashBall :: Point2 -> World -> World
makeFlashBall = energyBallAt FlashBall
ebFlicker :: EnergyBall -> World -> World
ebFlicker pt
| _ebTimer pt `mod` 7 == 0 =
cWorld . lWorld . lights
.:~ LSParam (addZ 20 $ _ebPos pt) 70 (0.5 *.*.* xyzV4 (ebColor pt))
.:~ LSParam (addZ 20 $ _ebPos pt) 70 (0.5 * xyzV4 (ebColor pt))
| otherwise = id
ebColor :: EnergyBall -> Color
ebColor eb = case eb ^. ebEff of
FlamingBall -> red
FlameletBall{} -> red
ElectricalBall -> cyan
ExplosiveBall -> yellow
@@ -93,28 +79,22 @@ damageCircle sp dt w =
& cWorld . lWorld . wallDamages %~ addwalldamages
& cWorld . lWorld . creatures %~ addcreaturedamages
where
r = 5
addwalldamages wlds = foldl' (damageWlCircle wldam) wlds wlstodam
addwalldamages wlds = foldl' (damageWlCircle dam) wlds wlstodam
addcreaturedamages crs = foldl' (damageCrCircle dam) crs crstodam
wlstodam = wlsHitRadial sp r w
wldam p = ebtToDamage p dt
addcreaturedamages crs = foldl' (damageCrCircle crdam) crs crstodam
crdam = ebtToDamage sp dt
crstodam = crsHitRadial sp r w
r = fromMaybe 5 $ dt ^? fbSize
dam = ebtToDamage sp dt
ebtToDamage :: Point2 -> EnergyBallType -> Damage
ebtToDamage p = \case
FlamingBall -> Flaming 10
FlameletBall {} -> Flaming 1
FlameletBall{} -> Flaming 1
ElectricalBall -> Electrical 10
ExplosiveBall -> Explosive 10 p
FlashBall -> Flashing 10 p
damageWlCircle ::
(Point2 -> Damage) ->
IM.IntMap [Damage] ->
(Point2, Wall) ->
IM.IntMap [Damage]
damageWlCircle f wldams (p, wl) = IM.insertWith (++) (_wlID wl) [f p] wldams
damageWlCircle :: Damage -> IM.IntMap [Damage] -> (Point2, Wall) -> IM.IntMap [Damage]
damageWlCircle dam wls (_, wl) = wls & at (_wlID wl) . non mempty .:~ dam
damageCrCircle :: Damage -> IM.IntMap Creature -> (Point2, Creature) -> IM.IntMap Creature
damageCrCircle crdam crs (_, cr) = crs & ix (_crID cr) . crState . csDamage .:~ crdam
damageCrCircle dam crs (_, cr) = crs & ix (_crID cr) . crState . csDamage .:~ dam
src/Dodge/EnergyBall/Draw.hs
+3 -8
View File
@@ -8,7 +8,6 @@ import Picture
drawEnergyBall :: EnergyBall -> Picture
drawEnergyBall eb = case _ebEff eb of
FlamingBall -> drawFlamelet 5 0 eb
FlameletBall x a -> drawFlamelet x a eb
ElectricalBall -> drawStaticBall eb
ExplosiveBall -> mempty
@@ -33,16 +32,12 @@ drawFlamelet size rot pt =
]
where
z = 20
-- z = _ebZ pt
sp = _ebPos pt
vel = _ebVel pt
ep = sp +.+ vel
--size = _ebWidth pt
siz2 = size + 0.2
time = _ebTimer pt
piu =
setDepth (z + 25)
. uncurryV translate ep
. uncurryV translate sp
. color
( mixColors
(fromIntegral (max 0 (time -2)))
@@ -58,7 +53,7 @@ drawFlamelet size rot pt =
$ reverse (rectNSWE siz2 (- siz2) (- siz2) siz2)
pi2 =
setDepth (z + 25)
. uncurryV translate ep
. uncurryV translate sp
. color
( mixColors
(fromIntegral (max 0 (time -2)))
@@ -75,7 +70,7 @@ drawFlamelet size rot pt =
$ rectNSWE siz2 (- siz2) (- siz2) siz2
pic =
setDepth (z + 20)
. uncurryV translate ep
. uncurryV translate sp
. color
( mixColors
(fromIntegral (max 0 (time -2)))
src/Dodge/Spark.hs
+17 -34
View File
@@ -1,21 +1,19 @@
module Dodge.Spark (
updateSpark,
sparkRandDir,
createBarrelSpark,
randDirSpark,
randSpark,
makeSpark,
) where
import Dodge.Damage
import Control.Monad.State
import Dodge.Damage
import Dodge.Data.World
import Dodge.WorldEvent.ThingsHit
import Geometry
import LensHelp
import System.Random
updateSpark :: World -> Spark -> (World, Maybe Spark)
updateSpark w sk
| magV (_skVel sk) < 1 = (w, Nothing)
@@ -29,36 +27,26 @@ updateSpark w sk
sp = _skPos sk
ep = sp + _skVel sk
sparkDam ::
Spark ->
Either Creature Wall ->
World ->
World
sparkDam sk x = damageCrWl (sparkToDamage sk) x
sparkDam :: Spark -> Either Creature Wall -> World -> World
sparkDam sk = damageCrWl (sparkToDamage sk)
sparkToDamage :: Spark -> Damage
sparkToDamage sp = case _skType sp of
ElectricSpark -> Electrical 10
FireSpark -> Flaming 1
NormalSpark -> Sparking 10
createBarrelSpark :: Point2 -> Float -> World -> World
createBarrelSpark pos dir = sparkRandDir 0.1 pos dir
ElectricSpark -> Electrical 10
FireSpark -> Flaming 1
NormalSpark -> Sparking 10
makeSpark :: SparkType -> Point2 -> Float -> World -> World
makeSpark st p d = cWorld . lWorld . sparks
.:~ Spark
{ _skVel = rotateV d (V2 5 0)
, _skPos = p
, _skOldPos = p
, _skType = st
}
makeSpark st p d =
cWorld . lWorld . sparks
.:~ Spark
{ _skVel = rotateV d (V2 5 0)
, _skPos = p
, _skOldPos = p
, _skType = st
}
randDirSpark ::
State StdGen Float ->
Point2 ->
World ->
World
randDirSpark :: State StdGen Float -> Point2 -> World -> World
randDirSpark randdir pos w =
w
& randGen .~ g
@@ -70,9 +58,7 @@ randDirSpark randdir pos w =
, _skType = NormalSpark
}
where
(dir, g) = (`runState` _randGen w) $ do
d <- randdir
return d
(dir, g) = randdir `runState` _randGen w
randSpark ::
SparkType ->
@@ -98,7 +84,4 @@ randSpark dt randspeed randdir pos w =
return (d, x)
sparkRandDir :: Float -> Point2 -> Float -> World -> World
sparkRandDir a pos dir =
randDirSpark
(state $ randomR (dir - a, dir + a))
pos
sparkRandDir a pos dir = randDirSpark (state $ randomR (dir - a, dir + a)) pos
src/Dodge/Zoning/Base.hs
+6
View File
@@ -11,6 +11,7 @@ module Dodge.Zoning.Base
, zonesAroundPoint
, xIntercepts
, yIntercepts'
, updateInt2Map
) where
import Control.Lens
@@ -78,6 +79,7 @@ yIntercepts' s sp ep = map f $ xIntercepts s (f sp) (f ep)
where
f (V2 x y) = V2 y x
-- consider using: at x . non mempty . at y . non mempty <>~ a
zoneMonoid :: Semigroup m => Int2 -> m -> IM.IntMap (IM.IntMap m) -> IM.IntMap (IM.IntMap m)
{-# INLINE zoneMonoid #-}
zoneMonoid (V2 !x !y) a = IM.insertWith f x $! IM.singleton y a
@@ -87,6 +89,10 @@ zoneMonoid (V2 !x !y) a = IM.insertWith f x $! IM.singleton y a
deZoneIX :: Int -> IM.IntMap (IM.IntMap IS.IntSet) -> Int2 -> IM.IntMap (IM.IntMap IS.IntSet)
deZoneIX i im (V2 x y) = im & ix x . ix y %~ IS.delete i
updateInt2Map :: (Eq a,Monoid a) =>
(a -> a) -> Int2 -> IM.IntMap (IM.IntMap a) -> IM.IntMap (IM.IntMap a)
updateInt2Map f (V2 x y) = at x . non mempty . at y . non mempty %~ f
zonesAroundPoint :: Float -> Point2 -> [Int2]
zonesAroundPoint s p = [V2 a b | a <- [x -1 .. x + 1], b <- [y -1 .. y + 1]]
where