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

Partial (not working) refactor of damages, energyballs

Browse Source
This commit is contained in:
justin
2025-06-07 12:22:06 +01:00
parent 2b39152060
commit e914555728
10 changed files with 265 additions and 290 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Bullet.hs
+4 -9
View File
@@ -24,14 +24,6 @@ updateBullet w bu
-- have to be slightly carefull not to accelerate bullets using magnets
| otherwise = second (Just . updateBulVel) . hitEffFromBul w $ applyMagnetsToBul bu w
buDamages :: Bullet -> [Damage]
buDamages bu = case _buPayload bu of
BulBall {} -> []
BulPlain x -> [Damage PIERCING x 0 0 0]
BulFlak -> []
BulFrag -> []
BulGas -> []
-- do we want this to drain energy from the deflection source?
applyMagnetsToBul :: Bullet -> World -> Bullet
applyMagnetsToBul bu = foldl' doMagnetBuBu bu . _oldMagnets . _lWorld . _cWorld
@@ -172,8 +164,11 @@ hitEffFromBul w bu = case _buEffect bu of
hitstream = thingsHit sp (sp + _buVel bu) w
setFromToDams :: Bullet -> Point2 -> [Damage]
setFromToDams bu p = map f (buDamages bu)
setFromToDams bu p = case _bu of
BullPlain x -> [Piercing x p v]
_ -> []
where
v = _buVel bu
f = (dmFrom .~ _buPos bu) . (dmAt .~ p) . (dmTo .~ _buPos bu +.+ _buVel bu)
damageThingHit :: Bullet -> (Point2, Either Creature Wall) -> World -> World
src/Dodge/Creature/Action/Blink.hs
+1 -1
View File
@@ -68,7 +68,7 @@ unsafeBlinkAction cr w
w
& blinkActionFail cr
& cWorld . lWorld . creatures . ix cid . crState . csDamage
.:~ Damage ENTERREMENT 10000 mwp mwp mwp
.:~ Enterrement 100000000
where
success = fromMaybe True $ do
wl <- snd $ collidePointWallsFilter (const True) mwp cpos w
src/Dodge/Creature/Damage.hs
+8 -4
View File
@@ -1,7 +1,8 @@
module Dodge.Creature.Damage (applyCreatureDamage) where
import Dodge.Creature.Material
import Data.List
import Dodge.Creature.Mass
import Dodge.Creature.Material
import Dodge.Creature.Test
import Dodge.Data.World
import Dodge.Spark
@@ -49,14 +50,17 @@ applyIndividualDamage cr w dm = applyIndividualDamage' cr w dm
applyIndividualDamage' :: Creature -> World -> Damage -> World
applyIndividualDamage' cr w dm = case _dmType dm of
PIERCING -> applyPiercingDamage cr dm w
Piercing{} -> applyPiercingDamage cr dm w
_ -> w & damageHP cr (_dmAmount dm)
applyPiercingDamage :: Creature -> Damage -> World -> World
applyPiercingDamage cr dm
| crIsArmouredFrom p cr = makeSpark NormalSpark p1 (argV (p1 -.- p))
| otherwise = damageHP cr $ _dmAmount dm
| crIsArmouredFrom p cr = f . makeSpark NormalSpark p1 (argV (p1 -.- p))
| otherwise = f . (damageHP cr $ _dmAmount dm)
where
f = cWorld . lWorld . creatures . ix (_crID cr) . crPos -~ _dmVector dm
/ V2 x x
x = crMass (_crType cr)
p = _dmAt dm
p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)
src/Dodge/DamageCircle.hs
-38
View File
@@ -1,38 +0,0 @@
module Dodge.DamageCircle (
damageCircle,
) where
import Data.Foldable
import Dodge.Data.World
import Dodge.WorldEvent.ThingsHit
import Geometry
import qualified IntMapHelp as IM
import LensHelp
damageCircle :: Float -> Point2 -> DamageType -> Int -> World -> World
damageCircle r sp dt da w =
w
& cWorld . lWorld . wallDamages %~ addwalldamages
& cWorld . lWorld . creatures %~ addcreaturedamages
where
--addwalldamages wlds = runIdentity $ S.fold_ (damageWlCircle wldam) wlds id wlstodam
addwalldamages wlds = foldl' (damageWlCircle wldam) wlds wlstodam
wlstodam = wlsHitRadial sp r w
wldam p = Damage dt da sp p (sp +.+ r *.* normalizeV (p -.- sp))
addcreaturedamages crs = foldl' (damageCrCircle crdam) crs crstodam
crdam p cr = Damage dt da sp p (_crPos cr)
crstodam = crsHitRadial sp r w
damageWlCircle ::
(Point2 -> Damage) ->
IM.IntMap [Damage] ->
(Point2, Wall) ->
IM.IntMap [Damage]
damageWlCircle f wldams (p, wl) = IM.insertWith (++) (_wlID wl) [f p] wldams
damageCrCircle ::
(Point2 -> Creature -> Damage) ->
IM.IntMap Creature ->
(Point2, Creature) ->
IM.IntMap Creature
damageCrCircle crdam crs (p, cr) = crs & ix (_crID cr) . crState . csDamage .:~ crdam p cr
src/Dodge/Data/Bullet.hs
+1 -8
View File
@@ -8,6 +8,7 @@ module Dodge.Data.Bullet (
module Dodge.Data.Damage,
) where
import Dodge.Data.EnergyBall.Type
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
@@ -27,13 +28,6 @@ data Bullet = Bullet
}
deriving (Show, Eq, Ord, Read) --Generic, Flat)
data EnergyBallType
= IncBall
| TeslaBall
| ConcBall
| FlashBall
deriving (Show, Eq, Ord, Enum, Bounded, Read) --Generic, Flat)
data BulletEffect
= DestroyBullet
| BounceBullet
@@ -64,7 +58,6 @@ data BulletTrajectoryType
makeLenses ''Bullet
makeLenses ''BulletPayload
deriveJSON defaultOptions ''EnergyBallType
deriveJSON defaultOptions ''BulletEffect
deriveJSON defaultOptions ''BulletPayload
deriveJSON defaultOptions ''BulletTrajectory
src/Dodge/Data/Damage.hs
+13 -9
View File
@@ -9,22 +9,26 @@ creatures.
-}
module Dodge.Data.Damage (
module Dodge.Data.Damage,
module Dodge.Data.Damage.Type,
) where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Damage.Type
import Geometry.Data
data Damage = Damage
{ _dmType :: DamageType
, _dmAmount :: Int
, _dmFrom :: Point2
, _dmAt :: Point2
, _dmTo :: Point2
}
data Damage
= Piercing {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
| Blunt {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
| Sparking {_dmAmount :: Int}
| Crushing {_dmAmount :: Int}
| Shattering {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
| Flaming {_dmAmount :: Int}
| Lasering {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
| Flashing {_dmAmount :: Int, _dmPos :: Point2}
| Electrical {_dmAmount :: Int}
| Explosive {_dmAmount :: Int, _dmCenter :: Point2}
| Poison {_dmAmount :: Int}
| Enterrement {_dmAmount :: Int}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''Damage
src/Dodge/Data/Damage/Type.hs
-31
View File
@@ -1,31 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Damage.Type where
import Data.Aeson
import Data.Aeson.TH
data DamageType
= PIERCING
| BLUNT
| CUTTING
| SPARKING
| CRUSHING
| SHATTERING
| FLAMING
| LASERING
| ELECTRICAL
| EXPLOSIVE
| CONCUSSIVE
| POISONDAM
| ENTERREMENT
deriving (Eq, Ord, Show, Enum, Bounded, Read) --Generic, Flat)
deriveJSON defaultOptions ''DamageType
instance ToJSONKey DamageType
instance FromJSONKey DamageType
src/Dodge/Data/EnergyBall.hs
+11 -8
View File
@@ -1,24 +1,27 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.EnergyBall where
module Dodge.Data.EnergyBall (
module Dodge.Data.EnergyBall,
module Dodge.Data.EnergyBall.Type,
) where
import Color
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Damage.Type
import Dodge.Data.EnergyBall.Type
import Geometry.Data
data EnergyBall = EnergyBall
{ _ebVel :: Point2
, _ebColor :: Color
, _ebPos :: Point2
, _ebWidth :: Float
, _ebTimer :: Int
, _ebEff :: (DamageType, Int)
, -- , _ebColor :: Color
_ebPos :: Point2
, -- , _ebWidth :: Float
_ebTimer :: Int
, _ebEff :: EnergyBallType
, _ebRot :: Float
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
src/Dodge/EnergyBall.hs
+54 -19
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.EnergyBall
( updateEnergyBall
, incBallAt
@@ -5,9 +6,11 @@ module Dodge.EnergyBall
, makeFlamelet
) where
import Data.List (foldl')
import Dodge.WorldEvent.ThingsHit
import qualified Data.IntMap.Strict as IM
import Dodge.Base.Collide
import Data.Maybe
import Dodge.DamageCircle
import Dodge.Data.World
import Geometry
import LensHelp
@@ -19,24 +22,19 @@ makeFlamelet ::
Point2 ->
-- | Velocity
Point2 ->
-- | Size
Float ->
-- | Timer
Int ->
World ->
World
makeFlamelet (V2 x y) vel size time w =
makeFlamelet (V2 x y) vel time w =
w
& randGen .~ g
& cWorld . lWorld . energyBalls
.:~ EnergyBall
{ _ebVel = vel
, _ebColor = red
, _ebPos = V2 x y
, _ebWidth = size
, _ebTimer = time
, _ebEff = (FLAMING, 1)
-- , _ebZ = z
, _ebEff = FlameletBall
, _ebRot = rot
}
where
@@ -46,8 +44,7 @@ updateEnergyBall :: World -> EnergyBall -> (World, Maybe EnergyBall)
updateEnergyBall w eb
| _ebTimer eb <= 0 = (w, Nothing)
| otherwise =
( ebFlicker eb $ uncurry (damageCircle 5 (_ebPos eb)) (_ebEff eb) w
-- , Just $ eb & ebTimer -~ 1 & ebPos .+.+~ _ebVel eb & ebVel .*.*~ 0.9
( ebFlicker eb $ damageCircle (_ebPos eb) (_ebEff eb) w
, Just $ eb & ebTimer -~ 1 & ebPos .~ bp & ebVel .~ 0.85 * bv
)
where
@@ -66,12 +63,9 @@ incBallAt p w =
return
EnergyBall
{ _ebVel = 0
, _ebColor = red
, _ebPos = p
, _ebWidth = 3
, _ebTimer = 20
, _ebEff = (FLAMING, 1)
-- , _ebZ = 20
, _ebEff = FlamingBall
, _ebRot = rot
}
@@ -86,12 +80,9 @@ makeFlashBall p w =
return
EnergyBall
{ _ebVel = 0
, _ebColor = yellow
, _ebPos = p
, _ebWidth = 3
, _ebTimer = 20
, _ebEff = (LASERING, 1)
-- , _ebZ = 20
, _ebEff = FlashBall
, _ebRot = rot
}
@@ -99,5 +90,49 @@ 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
FlashBall -> white
damageCircle :: Point2 -> EnergyBallType -> World -> World
damageCircle sp dt w =
w
& cWorld . lWorld . wallDamages %~ addwalldamages
& cWorld . lWorld . creatures %~ addcreaturedamages
where
r = 5
addwalldamages wlds = foldl' (damageWlCircle wldam) wlds wlstodam
wlstodam = wlsHitRadial sp r w
wldam p = ebtToDamage p dt
addcreaturedamages crs = foldl' (damageCrCircle crdam) crs crstodam
crdam p cr = ebtToDamage sp dt
crstodam = crsHitRadial sp r w
ebtToDamage :: Point2 -> EnergyBallType -> Damage
ebtToDamage p = \case
FlamingBall -> Flaming 10
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
damageCrCircle ::
(Point2 -> Creature -> Damage) ->
IM.IntMap Creature ->
(Point2, Creature) ->
IM.IntMap Creature
damageCrCircle crdam crs (p, cr) = crs & ix (_crID cr) . crState . csDamage .:~ crdam p cr