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

Rethink damage data type, work on damage sensors

Browse Source
This commit is contained in:
justin
2022-03-13 09:27:35 +00:00
parent d340fd73c3
commit 06a501ff88
30 changed files with 356 additions and 240 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Impulse.hs
+3 -2
View File
@@ -73,6 +73,7 @@ followImpulse cr w imp = case imp of
cid = _crID cr
posFromID cid' = _crPos $ _creatures w IM.! cid'
rr a = fst $ randomR (-a,a) $ _randGen w
hitCr i = (creatures . ix i . crState . crDamage %~ addDam i)
hitCr i = (creatures . ix i . crState . crDamage
.:~ Damage Blunt 100 cpos (posFromID i) (posFromID i) NoDamageEffect
)
. soundStart (CrSound cid) cpos hitS Nothing
addDam i = ( Blunt 100 cpos (posFromID i) (posFromID i) : )
src/Dodge/Creature/Inanimate.hs
+12 -9
View File
@@ -85,18 +85,21 @@ updateExpBarrel cr w
| otherwise = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] (_crPos cr) foamSprayLoopS (Just 1)
stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1)
damToExpBarrel :: [DamageType] -> Creature -> Creature
damToExpBarrel :: [Damage] -> Creature -> Creature
damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
where
(pierceDam,otherDam) = partition isPierce ds
isPierce Piercing{} = True
isPierce (Damage {_dmType = Piercing{}}) = True
isPierce _ = False
damToExpBarrel' :: DamageType -> Creature -> Creature
damToExpBarrel' (Piercing amount _ int _) cr
= over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr)
damToExpBarrel' :: Damage -> Creature -> Creature
damToExpBarrel' dm cr = case _dmType dm of
Piercing -> over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr)
$ over crHP (\hp -> hp - div amount 200) cr
damToExpBarrel' PoisonDam {} cr = cr
damToExpBarrel' SparkDam {} cr = cr
damToExpBarrel' PushDam{_dmPushBack = v} cr = cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* v)
damToExpBarrel' dt cr = cr Control.Lens.& crHP -~ _dmAmount dt
PoisonDam -> cr
SparkDam -> cr
PushDam -> cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* (_dePushBack $ _dmEffect dm))
dt -> cr Control.Lens.& crHP -~ amount
where
amount = _dmAmount dm
int = _dmAt dm
src/Dodge/Creature/State.hs
+1 -1
View File
@@ -88,7 +88,7 @@ doDamage cr = set (crState . crDamage) []
where
dams = _crDamage $ _crState cr
advancePastDamages :: [DamageType] -> V.Vector [DamageType] -> V.Vector [DamageType]
advancePastDamages :: [Damage] -> V.Vector [Damage] -> V.Vector [Damage]
advancePastDamages newDs v = f $ V.backpermute v bpVector
where
f = V.modify $ \v' -> MV.write v' 0 newDs
src/Dodge/Creature/State/Data.hs
+2 -2
View File
@@ -11,8 +11,8 @@ import Control.Lens
import qualified Data.IntSet as IS
import qualified Data.Vector as V
data CreatureState = CrSt
{ _crDamage :: [DamageType]
, _crPastDamage :: V.Vector [DamageType]
{ _crDamage :: [Damage]
, _crPastDamage :: V.Vector [Damage]
, _crSpState :: CrSpState
, _crDropsOnDeath :: CreatureDropType
}
src/Dodge/Data.hs
+5 -4
View File
@@ -259,7 +259,7 @@ data Creature = Creature
, _crLeftInvSel :: Maybe Int
, _crState :: CreatureState
, _crCorpse :: Picture
, _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
, _crApplyDamage :: [Damage] -> Creature -> (World -> World,Creature)
, _crStance :: Stance
, _crActionPlan :: ActionPlan
, _crMeleeCooldown :: Int
@@ -720,8 +720,9 @@ data Machine = Machine
, _mcPos :: Point2
, _mcDir :: Float
, _mcHP :: Int
, _mcSensor :: Int
, _mcDamage :: [DamageType]
, _mcSensorAmount :: Int
, _mcSensorToggle :: Bool
, _mcDamage :: [Damage]
, _mcLSs :: [Int]
, _mcType :: MachineType
}
@@ -772,7 +773,7 @@ data WallStructure
| BlockPart { _wlStBlock :: Int }
| CreaturePart
{ _wlStCreature :: Int
, _wlStDamCreature :: DamageType -> Wall -> Int -> World -> World
, _wlStDamCreature :: Damage -> Wall -> Int -> World -> World
}
-- | Strict maybe
data Maybe' a = Just' {__Just' :: a} | Nothing'
src/Dodge/Data/DamageType.hs
+41 -27
View File
@@ -11,34 +11,48 @@ import Geometry.Data
import Control.Lens
data DamageType
= Piercing {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Blunt {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Cutting {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| SparkDam {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Flaming {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Lasering {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Electrical {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Explosive {_dmAmount :: Int , _dmFrom :: Point2 }
| Concussive
{ _dmAmount :: Int
, _dmFrom :: Point2
, _dmPush :: Float
, _dmPushExp :: Float
, _dmPushRadius :: Float
}
| TorqueDam {_dmAmount :: Int , _dmTorque :: Float }
| PushDam {_dmAmount :: Int , _dmPushBack :: Point2 }
| PoisonDam {_dmAmount :: Int}
data DamageType = Piercing
| Blunt
| Cutting
| SparkDam
| Flaming
| Lasering
| Electrical
| Explosive
| Concussive
| TorqueDam
| PushDam
| PoisonDam
deriving (Eq,Ord,Show)
isElectrical :: DamageType -> Bool
isElectrical Electrical {} = True
isElectrical _ = False
data DamageEffect
= PushDamage
{ _dePush :: Float
, _dePushExp :: Float
, _dePushRadius :: Float
}
| TorqueDamage { _deTorque :: Float }
| PushBackDamage {_dePushBack :: Point2 }
| NoDamageEffect
deriving (Eq,Ord,Show)
isMovementDam :: DamageType -> Bool
isMovementDam TorqueDam{} = True
isMovementDam PushDam{} = True
isMovementDam _ = False
data Damage = Damage
{ _dmType :: DamageType
, _dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2
, _dmEffect :: DamageEffect
}
deriving (Eq,Ord,Show)
makeLenses ''DamageType
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/Default.hs
+26 -23
View File
@@ -183,35 +183,37 @@ defaultConsumable = Item
, _itScope = NoScope
, _itTargeting = NoTargeting
}
defaultApplyDamage :: [DamageType] -> Creature -> (World -> World, Creature)
defaultApplyDamage :: [Damage] -> Creature -> (World -> World, Creature)
defaultApplyDamage ds cr = (id, doPoisonDam $ foldl' (flip $ \d c -> snd $ applyIndividualDamage d c) cr ds')
where
(ps,ds') = partition isPoison ds
isPoison PoisonDam{} = True
isPoison Damage{_dmType=PoisonDam} = True
isPoison _ = False
poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
doPoisonDam = over crHP (\hp -> hp - poisonDam)
applyIndividualDamage :: DamageType -> Creature -> (World -> World, Creature)
applyIndividualDamage (Concussive amount fromDir push pushexp pushRad) cr
= ( id
, over crHP (\hp -> hp - amount)
$ over crPos (+.+ (pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir)))
cr
)
where
pushAmount
| dist (_crPos cr) fromDir == 0 = 0
| otherwise = min 5 $ (push*5*pushRad / (dist (_crPos cr) fromDir * _crMass cr))**pushexp
applyIndividualDamage (TorqueDam amount rot) cr
= ( id
, over crHP (\hp -> hp - amount) $ over crDir (+ rot) cr)
applyIndividualDamage (PushDam amount pback) cr
= ( id
, over crHP (\hp -> hp - amount) $ over crPos (+.+ ((1/_crMass cr) *.* pback )) cr
)
applyIndividualDamage dt cr
= ( id , over crHP (\hp -> hp - _dmAmount dt) cr )
applyDamageEffect :: Damage -> DamageEffect -> Creature -> Creature
applyDamageEffect dm de cr = case de of
NoDamageEffect -> cr
PushDamage push pushexp pushRad -> cr
& crPos %~ (+.+ (pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir)))
where
pushAmount
| dist (_crPos cr) fromDir == 0 = 0
| otherwise = min 5 $ (push*5*pushRad / (dist (_crPos cr) fromDir * _crMass cr))**pushexp
PushBackDamage pback -> cr
& crPos %~ (+.+ ((1/_crMass cr) *.* pback ))
TorqueDamage rot -> cr & crDir +~ rot
where
fromDir = _dmFrom dm
applyIndividualDamage :: Damage -> Creature -> (World -> World, Creature)
applyIndividualDamage dm cr = ( id
, cr
& crHP -~ _dmAmount dm
& applyDamageEffect dm (_dmEffect dm)
)
defaultFlIt :: FloorItem
defaultFlIt = FlIt {_flItRot=0,_flIt = defaultConsumable, _flItPos = V2 0 0, _flItID = 0}
defaultMachine :: Machine
@@ -223,7 +225,8 @@ defaultMachine = Machine
, _mcPos = V2 0 0
, _mcDir = 0
, _mcHP = 1000
, _mcSensor = 0
, _mcSensorAmount = 0
, _mcSensorToggle = False
, _mcDamage = []
, _mcLSs = []
, _mcType = StaticMachine
src/Dodge/Floor.hs
+3 -1
View File
@@ -8,9 +8,11 @@ module Dodge.Floor
import Dodge.LockAndKey
--import Dodge.Creature.State.Data
import Dodge.Room
import Dodge.Data.DamageType
--import Dodge.Placement.Instance.Button
import Dodge.Tree
import Dodge.Annotation
import Dodge.Placement.Instance.Sensor
--import Dodge.Creature
--import Dodge.LevelGen.Data
--import Dodge.LevelGen.Switch
@@ -34,7 +36,7 @@ import System.Random
initialAnoTree :: RandomGen g => Tree [Annotation g]
initialAnoTree = padSucWithCorridors $ treeFromTrunk
[[AnoApplyInt 0 startRoom]
-- , [SpecificRoom $ fmap (return . UseAll) lasTunnelRunnable]
, [SpecificRoom $ sensorRoom Flaming 50]
, [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms]
, [SpecificRoom randomChallenges]
, [AnoApplyInt 1 lasSensorTurretTest]
src/Dodge/Item/Equipment.hs
+7 -4
View File
@@ -118,12 +118,15 @@ shieldWall crid = defaultWall
,_wlStructure = CreaturePart crid shieldWallDamage
}
shieldWallDamage :: DamageType -> Wall -> Int -> World -> World
shieldWallDamage dt wl crid w = case dt of
Lasering {_dmFrom=df,_dmAt=da} ->
shieldWallDamage :: Damage -> Wall -> Int -> World -> World
shieldWallDamage dm wl crid w = case _dmType dm of
Lasering ->
w & instantParticles .:~ lasRayAt 5 (da +.+ normalizeV (df -.- da)) (reflDirWall df da wl)
d | isMovementDam d -> w & creatures . ix crid . crState . crDamage .:~ d
d | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
_ -> w
where
df = _dmFrom dm
da = _dmAt dm
createShieldWall :: Creature -> Int -> World -> World
createShieldWall cr invid w = case _itEffectID $ _itEffect it of
src/Dodge/Item/Weapon/BatteryGuns.hs
+1 -2
View File
@@ -179,7 +179,7 @@ mvLaser :: Float -- ^ Phase velocity, controls deflection through windows
-> Particle
-> (World, Maybe Particle)
mvLaser phasev pos dir w pt
= ( damThingHitWith (Lasering 19) pos xp thHit w
= ( damThingHitWith (\p1 p2 p3 -> Damage Lasering 19 p1 p2 p3 NoDamageEffect) pos xp thHit w
, Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 }
)
where
@@ -190,7 +190,6 @@ mvLaser phasev pos dir w pt
, setDepth 19.5 . color (brightX 10 1 yellow) $ thickLine 3 (pos:ps)
]
aTractorBeam :: Item -> Creature -> World -> World
aTractorBeam _ cr w = w & props . at i ?~ tractorBeamAt i spos outpos dir
where
src/Dodge/Item/Weapon/SprayGuns.hs
+3 -1
View File
@@ -171,7 +171,9 @@ overNozzles' eff it cr w = neww & creatures . ix cid . crInv . ix i . itParams .
overNozzle :: (Nozzle -> Item -> Creature -> World -> World)
-> Item -> Creature -> World -> Nozzle -> (World, Nozzle)
overNozzle eff it cr w nz = (eff nz it (cr & crDir +~ wa + na) w & randGen .~ g,nz & nzCurrentWalkAngle .~ wa)
overNozzle eff it cr w nz =
( eff nz it (cr & crDir +~ wa + na) w & randGen .~ g
, nz & nzCurrentWalkAngle .~ wa)
where
na = _nzDir nz
(walkamount, g) = randomR (-aspeed,aspeed) (_randGen w)
src/Dodge/Particle/Bullet/HitEffect.hs
+36 -22
View File
@@ -26,8 +26,9 @@ bulHitCr bt p cr w
sp = head $ _ptTrail bt
bulVel = _ptVel bt
ep = sp +.+ bulVel
mvDams = [ PushDam 1 $ 2 *.* bulVel ]
addDamage = creatures . ix cid . crState . crDamage .++~ (Piercing 100 sp p ep : mvDams)
mvDams = [ Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel ]
addDamage = creatures . ix cid . crState . crDamage .++~
(Damage Piercing 100 sp p ep NoDamageEffect : mvDams)
addDamageArmoured = creatures . ix cid . crState . crDamage .++~ mvDams
cid = _crID cr
p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)
@@ -43,8 +44,9 @@ bulBounceArmCr' bt p cr w
sp = head $ _ptTrail bt
bulVel = _ptVel bt
ep = sp +.+ bulVel
mvDams = [ PushDam 1 $ 2 *.* bulVel ]
addDamage = creatures . ix cid . crState . crDamage .++~ (Piercing 100 sp p ep : mvDams)
mvDams = [ Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel ]
addDamage = creatures . ix cid . crState . crDamage .++~
(Damage Piercing 100 sp p ep NoDamageEffect : mvDams)
addDamageArmoured = creatures . ix cid . crState . crDamage .++~ mvDams
cid = _crID cr
newDir = squashNormalizeV (p -.- _crPos cr)
@@ -60,11 +62,12 @@ bulPenCr' bt p cr w = w
& instantParticles .:~ piercer
& bulletHitSound ep
& creatures . ix cid . crState . crDamage .++~
[Piercing 50 sp p ep
,Blunt 50 sp p ep
,TorqueDam 1 d1
,PushDam 1 $ 3 *.* (ep -.- sp)
]
damageGamut 50 50 d1 sp p ep
-- [Damage Piercing 50 sp p ep NoDamageEffect
-- ,Damage Blunt 50 sp p ep NoDamageEffect
-- ,Damage TorqueDam 1 sp p ep $ TorqueDamage d1
-- ,Damage PushDam 1 sp p ep . PushBackDamage $ 3 *.* (ep -.- sp)
-- ]
where
(d1,_) = randomR (-0.7,0.7) $ _randGen w
cid = _crID cr
@@ -78,23 +81,33 @@ piercing, blunt, twisting and pushback damage all applied. -}
hvBulHitCr :: Particle -> Point2 -> Creature -> World -> World
hvBulHitCr bt p cr w = w
& creatures . ix cid . crState . crDamage .++~
[Piercing 200 sp p ep
,Blunt 100 sp p ep
,TorqueDam 1 d1
,PushDam 1 $ 3 *.* (ep -.- sp)
]
damageGamut 200 100 d1 sp p ep
-- [Piercing 200 sp p ep
-- ,Blunt 100 sp p ep
-- ,TorqueDam 1 d1
-- ,PushDam 1 $ 3 *.* (ep -.- sp)
-- ]
& bulletHitSound ep
where
(d1,_) = randomR (-0.7,0.7) $ _randGen w
cid = _crID cr
sp = head $ _ptTrail bt
ep = sp +.+ _ptVel bt
damageGamut :: Int -> Int -> Float -> Point2 -> Point2 -> Point2
-> [Damage]
damageGamut pdam bdam tor sp p ep =
[Damage Piercing pdam sp p ep NoDamageEffect
,Damage Blunt bdam sp p ep NoDamageEffect
,Damage TorqueDam 1 sp p ep $ TorqueDamage tor
,Damage PushDam 1 sp p ep . PushBackDamage $ 3 *.* (ep -.- sp)
]
{- | Create a flamelet when hitting a creature. -}
bulIncCr :: Particle -> Point2 -> Creature -> World -> World
bulIncCr bt p cr w = w
& makeFlamelet p 20 v Nothing 3 20
& bulletHitSound p
& creatures . ix cid . crState . crDamage .:~ Piercing 60 sp p ep
& creatures . ix cid . crState . crDamage .:~ Damage Piercing 60 sp p ep NoDamageEffect
where
cid = _crID cr
sp = head $ _ptTrail bt
@@ -102,7 +115,8 @@ bulIncCr bt p cr w = w
v = evalState (randInCirc 1) $ _randGen w
{- | Creates a shockwave when hitting a creature. -}
bulConCr :: Particle -> Point2 -> Creature -> World -> World
bulConCr bt p cr = over (creatures . ix cid . crState . crDamage) (Blunt 10 sp p ep :)
bulConCr bt p cr
= over (creatures . ix cid . crState . crDamage) (Damage Blunt 10 sp p ep NoDamageEffect :)
. makeShockwaveAt [] p 15 4 1 white
. bulletHitSound p
where
@@ -111,13 +125,13 @@ bulConCr bt p cr = over (creatures . ix cid . crState . crDamage) (Blunt 10 sp p
ep = sp +.+ _ptVel bt
{- | Hitting wall effects: create a spark, damage blocks. -}
bulHitWall :: Particle -> Point2 -> Wall -> World -> World
bulHitWall bt p = damageWall (Piercing 100 sp p ep)
bulHitWall bt p = damageWall (Damage Piercing 100 sp p ep NoDamageEffect)
where
ep = sp +.+ _ptVel bt
sp = head $ _ptTrail bt
{- | Bounce off walls, do damage to blocks. -}
bulBounceWall :: Particle -> Point2 -> Wall -> World -> World
bulBounceWall bt p wl = damageWall (Blunt 50 sp p ep) wl
bulBounceWall bt p wl = damageWall (Damage Blunt 50 sp p ep NoDamageEffect) wl
. over instantParticles (bouncer :)
where
ep = sp +.+ _ptVel bt
@@ -137,7 +151,7 @@ bulIncWall
-> Wall
-> World
-> World
bulIncWall bt p wl = damageWall (Blunt 50 sp p ep) wl
bulIncWall bt p wl = damageWall (Damage Blunt 50 sp p ep NoDamageEffect) wl
. makeFlamelet pOut 20 reflectVel Nothing 3 20
where
ep = sp +.+ _ptVel bt
@@ -152,7 +166,7 @@ bulConWall
-> Wall
-> World
-> World
bulConWall bt p wl = damageWall (Blunt 10 sp p ep) wl .
bulConWall bt p wl = damageWall (Damage Blunt 10 sp p ep NoDamageEffect) wl .
makeShockwaveAt [] p 15 4 1 white
where
ep = sp +.+ _ptVel bt
@@ -164,8 +178,8 @@ hvBulHitWall
-> Wall
-> World
-> World
hvBulHitWall bt p wl w = damageWall (Piercing 200 sp p ep) wl
. damageWall (Blunt 100 sp p ep) wl
hvBulHitWall bt p wl w = damageWall (Damage Piercing 200 sp p ep NoDamageEffect) wl
. damageWall (Damage Blunt 100 sp p ep NoDamageEffect) wl
$ set randGen g $ foldr ($) w (sparks pOut sv)
where
ep = sp +.+ _ptVel bt
src/Dodge/Particle/Spark.hs
+4 -2
View File
@@ -29,7 +29,8 @@ createBarrelSpark pos dir maycid time colid = instantParticles .:~ BulletPt
, _ptHitEff = destroyOnImpact sparkEff noEff
}
where
sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage .:~ SparkDam 1 sp p ep
sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage
.:~ Damage SparkDam 1 sp p ep NoDamageEffect
where
sp = head (_ptTrail bt)
ep = sp +.+ _ptVel bt
@@ -54,7 +55,8 @@ colSparkRandDir randDir time col pos baseDir w = w
, _ptTimer = time
, _ptHitEff = destroyOnImpact sparkEff noEff
}
sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage .:~ SparkDam 1 sp p ep
sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage
.:~ Damage SparkDam 1 sp p ep NoDamageEffect
where
sp = head (_ptTrail bt)
ep = sp +.+ _ptVel bt
src/Dodge/Particle/TeslaArc.hs
+5 -3
View File
@@ -12,8 +12,8 @@ import Dodge.RandomHelp
import Picture
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Control.Lens
import System.Random
import Control.Monad.State
import Data.Function (on)
@@ -44,7 +44,8 @@ moveTeslaArc
moveTeslaArc p d w pt
| t == 2 =
(foldr damCrs w hitCrs & randGen .~ g & colSpark 8 nc q2 (argV sv)
& damThingHitWith (Electrical 50) q1 ((2 *.* q2) -.- q1) thHit
& damThingHitWith (\p1 p2 p3 -> Damage Electrical 50 p1 p2 p3 NoDamageEffect)
q1 ((2 *.* q2) -.- q1) thHit
, Just $ pt & ptTimer -~ 1 & ptPoints .~ ps'
)
| t < 1 = (w , Nothing)
@@ -62,7 +63,8 @@ moveTeslaArc p d w pt
f1 (E3x1 cr) = Just $ _crID cr
f1 _ = Nothing
hitCrs = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w
damCrs cid = over (creatures . ix cid . crState . crDamage) (Electrical 5 cpos cpos cpos :)
damCrs cid = creatures . ix cid . crState . crDamage
.:~ Damage Electrical 5 cpos cpos cpos NoDamageEffect
where
cpos = _crPos (_creatures w IM.! cid)
q1 = last $ init ps'
src/Dodge/Placement/Instance/LightSource.hs
+7 -7
View File
@@ -124,11 +124,12 @@ mntLSLampCol shp (V4 x y z _) wallp lampp = mntLSOn shp Nothing (defaultLS & lsP
col = V3 x y z
mntLSCond :: (Point2 -> Point3 -> Shape)
-> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
-- -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
-> PlacementSpot
-> Placement
mntLSCond shp shift = -- updatePSToLevel 1 (const $ PSLnk shift (const id) Nothing) $
mntLSCond shp ps = -- updatePSToLevel 1 (const $ PSLnk shift (const id) Nothing) $
mntLS shp 0 (V3 0 (-40) 90)
& plSpot .~ PSPos shift (const id) Nothing
& plSpot .~ ps
-- note that this perhaps pushes the vshape light out too far
mntLight :: Point2 -> Point2 -> Placement
@@ -136,11 +137,10 @@ mntLight a b = RandomPlacement $ do
shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
return $ mntLS shp a (addZ 90 b)
mntLightLnkCond :: (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
-> Placement
mntLightLnkCond f = RandomPlacement $ do
mntLightLnkCond :: PlacementSpot -> Placement
mntLightLnkCond ps = RandomPlacement $ do
shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
return $ mntLSCond shp f
return $ mntLSCond shp ps
spanLSLightI :: LightSource -> Float -> Point2 -> Point2 -> Placement
spanLSLightI ls h a b = ps0j (PutLS $ ls & lsParam . lsPos .~ V3 x y h)
src/Dodge/Placement/Instance/Sensor.hs
+14 -12
View File
@@ -1,5 +1,6 @@
module Dodge.Placement.Instance.Sensor
( lightSensor
, damageSensor
) where
import Color
import Dodge.LightSource
@@ -14,41 +15,42 @@ import Control.Lens
import Data.Either
damageSensor
:: (DamageType -> Either Int Int) -- Left gets sensed, Right does damage
:: DamageType -- Left gets sensed, Right does damage
-> Float
-> (Machine -> World -> World)
-> PlacementSpot -> Placement
damageSensor damF wdth upf ps = pContID ps ( PutLS theLS)
damageSensor damF wdth upf ps = pContID ps (PutLS theLS)
$ \lsid -> Just $ spNoID ps $ PutMachine yellow (reverse $ square wdth) defaultMachine
{ _mcDraw = sensorSPic wdth
, _mcUpdate = \mc w -> upf mc $ sensorUpdate damF mc w
, _mcUpdate = \mc -> upf mc . sensorUpdate damF mc
, _mcLSs = [lsid]
}
where
theLS = lsPosCol (V3 0 0 30) 0.1
lightSensor :: Float -> (Machine -> World -> World) -> PlacementSpot -> Placement
lightSensor = damageSensor senseLasering
lightSensor = damageSensor Lasering
senseLasering :: DamageType -> Either Int Int
senseLasering Lasering {_dmAmount = x} = Left x
senseLasering _ = Right 0
sensorUpdate :: (DamageType -> Either Int Int) -> Machine -> World -> World
sensorUpdate :: DamageType -> Machine -> World -> World
sensorUpdate damF mc w = w & machines . ix mcid %~ upmc
& lightSources . ix lsid %~ upls
where
upmc = ( mcSensor %~ \x' -> min 1000 (max 0 (x' - 5 + newSense)) )
upmc = ( mcSensorAmount %~ \x' -> min 1000 (max 0 (x' - 5 + newSense)) )
. ( mcHP -~ sum dam )
. (mcDamage .~ [])
x = _mcSensor mc
x = _mcSensorAmount mc
mcid = _mcID mc
lsid = head (_mcLSs mc)
(senseData,dam) = partitionEithers $ map damF $ _mcDamage mc
(senseData,dam) = partitionEithers $ map (damageUsing damF) $ _mcDamage mc
newSense = sum senseData
ni = fromIntegral x / 1000
upls = lsParam . lsCol .~ V3 ni ni ni
damageUsing :: DamageType -> Damage -> Either Int Int
damageUsing dt dm
| _dmType dm == dt = Left $ _dmAmount dm
| otherwise = Right 0
sensorSPic :: Float -> Machine -> SPic
sensorSPic wdth _ = ( colorSH yellow $ upperPrismPoly 25 (square wdth)
, mempty )
src/Dodge/Placement/Instance/Turret.hs
+1 -1
View File
@@ -82,7 +82,7 @@ updateTurret rotSpeed mc w
& creatures . ix cid . crPos .~ mcpos
& creatures . ix cid . crDir .~ mcdir
dodamage = machines . ix mcid %~
( (mcDamage .~ [Electrical (min 2500 $ max 0 (elecDam - 10)) 0 0 0])
( (mcDamage .~ [Damage Electrical (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect])
. (mcHP -~ dam)
)
elecDamBranch
src/Dodge/PlacementSpot.hs
+41 -43
View File
@@ -9,7 +9,6 @@ module Dodge.PlacementSpot
, unusedSpotAwayFromLink
, isUnusedLnk
, isInLnk
, unusedLnkToPS
, unusedSpotNearInLink
, randDirPS
, unusedSpotAwayFromInLink
@@ -21,8 +20,10 @@ module Dodge.PlacementSpot
, setFallback
, twoRoomPoss
, isUnusedLinkType
, roomPosRoomBoolShift
, rprBoolShift
, rpBool
, shiftInBy
, resetPLUse
) where
import Dodge.LevelGen.Data
import Geometry
@@ -46,19 +47,25 @@ randDirPS ps = do
a <- state $ randomR (0,pi*2)
return $ setDirPS a ps
roomPosBool :: (RoomPos -> Bool) -> PlacementSpot
roomPosBool t = PSPos (useRoomPosCond t) (const id) Nothing
rpBool :: (RoomPos -> Bool) -> PlacementSpot
rpBool t = PSPos (useRoomPosCond t) (const id) Nothing
anyUnusedSpot :: PlacementSpot
anyUnusedSpot = roomPosBool $ \rp -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0
anyUnusedSpot = rpBool $ \rp -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0
roomPosRoomBool :: (RoomPos -> Room -> Bool) -> PlacementSpot
roomPosRoomBool t = PSPos (useRoomPosRoomCond t) (const id) Nothing
rprBool :: (RoomPos -> Room -> Bool) -> PlacementSpot
rprBool t = PSPos (useRoomPosRoomCond t) (const id) Nothing
roomPosRoomBoolShift :: (RoomPos -> Room -> Bool)
resetPLUse :: PlacementSpot -> PlacementSpot
resetPLUse (PSPos f g fallback) = PSPos f' g fallback
where
f' rp = fmap (second (rpPlacementUse .~ 0)) . f rp
resetPLUse _ = error "Tried to reset _rpPlacementUse of non PSPos placement"
rprBoolShift :: (RoomPos -> Room -> Bool)
-> ((Point2,Float) -> (Point2,Float))
-> PlacementSpot
roomPosRoomBoolShift t shift = PSPos f (const id) Nothing
rprBoolShift t shift = PSPos f (const id) Nothing
where
f rp r
| t rp r = Just (PS p a, rp & rpPlacementUse +~ 1)
@@ -67,22 +74,24 @@ roomPosRoomBoolShift t shift = PSPos f (const id) Nothing
(p,a) = shift (_rpPos rp, _rpDir rp)
unusedSpotAwayFromLink :: Float -> PlacementSpot
unusedSpotAwayFromLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink
unusedSpotAwayFromLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink
&& _rpPlacementUse rp == 0
&& all ( (>x) . dist (_rpPos rp) ) (usedRoomLinkPoss r)
setFallback :: Placement -> Placement -> Placement
setFallback fallback = (plSpot . psFallback %~ maybe (Just fallback) Just)
. (plIDCont %~ fmap (fmap $ setFallback fallback))
setFallback fallback
= (plSpot . psFallback %~ maybe (Just fallback) Just)
. (plIDCont %~ fmap (fmap $ setFallback fallback)
)
unusedOffPathAwayFromLink :: Float -> PlacementSpot
unusedOffPathAwayFromLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink
unusedOffPathAwayFromLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink
&& _rpPlacementUse rp == 0
&& all ( (>x) . dist (_rpPos rp) ) (usedRoomLinkPoss r)
&& RoomPosOffPath `S.member` _rpType rp
unusedSpotAwayFromInLink :: Float -> PlacementSpot
unusedSpotAwayFromInLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink
unusedSpotAwayFromInLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink
&& _rpPlacementUse rp == 0
&& all ( (>x) . dist (_rpPos rp) ) (usedRoomInLinkPoss r)
@@ -93,8 +102,8 @@ twoRoomPoss :: (RoomPos -> Bool)
-> (RoomPos -> Bool)
-> (PlacementSpot -> PlacementSpot -> Placement)
-> Placement
twoRoomPoss cond1 cond2 f = Placement (roomPosBool cond1) PutNothing Nothing
$ \pl1 -> Just $ Placement (roomPosBool cond2) PutNothing Nothing
twoRoomPoss cond1 cond2 f = Placement (rpBool cond1) PutNothing Nothing
$ \pl1 -> Just $ Placement (rpBool cond2) PutNothing Nothing
$ \pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2)
isUnusedLnk :: RoomPos -> Bool
@@ -108,7 +117,7 @@ isInLnk rp = case _rpLinkStatus rp of
_ -> False
useUnusedLnk :: PlacementSpot
useUnusedLnk = roomPosBool isUnusedLnk
useUnusedLnk = rpBool isUnusedLnk
isUsedLnkUnplaced :: RoomPos -> Bool
isUsedLnkUnplaced rp = case _rpLinkStatus rp of
@@ -117,32 +126,20 @@ isUsedLnkUnplaced rp = case _rpLinkStatus rp of
_ -> False
useRoomPosCond :: (RoomPos -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
useRoomPosCond t rp _
| t rp = Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
| otherwise = Nothing
useRoomPosCond f = useRoomPosRoomCond $ \rp _ -> f rp
useRoomPosRoomCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
useRoomPosRoomCond t rp r
| t rp r = Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
| otherwise = Nothing
unusedLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
unusedLnkToPS = useRoomPosCond $ \rp -> case _rpLinkStatus rp of
UnusedLink {} -> True
_ -> False
--usedInLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
--usedInLnkToPS = useRoomPosCond $ \rp -> case _rpLinkStatus rp of
-- UsedInLink {} -> True
-- _ -> False
isUnusedLinkType :: RoomLinkType -> RoomPos -> Bool
isUnusedLinkType rlt rp = case _rpLinkStatus rp of
UnusedLink{_rplsType = rlts} -> rlt `S.member` rlts
_ -> False
unusedSpotNearInLink :: Float -> PlacementSpot
unusedSpotNearInLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink
unusedSpotNearInLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink
&& _rpPlacementUse rp == 0
&& any ( (<x) . dist (_rpPos rp) ) (usedRoomInLinkPoss r)
@@ -162,17 +159,19 @@ usedRoomLinkPoss r = mapMaybe f $ _rmPos r
_ -> Nothing
atFstLnkOut :: PlacementSpot
atFstLnkOut = roomPosBool $ \rp -> rp ^? rpLinkStatus . rplsChildNum == Just 0
atFstLnkOut = rpBool $ \rp -> rp ^? rpLinkStatus . rplsChildNum == Just 0
atNthLnkOutShiftBy :: Int -> ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
atNthLnkOutShiftBy n theshift = PSPos f (const id) Nothing
where
f rp _ = case _rpLinkStatus rp of
UsedOutLink {_rplsChildNum = i} | i == n
-> Just (PS p a, rp & rpPlacementUse +~ 1)
_ -> Nothing
where
(p,a) = theshift (_rpPos rp,_rpDir rp)
atNthLnkOutShiftBy n = rprBoolShift
$ \ rp _ -> rp ^? rpLinkStatus . rplsChildNum == Just n
--atNthLnkOutShiftBy n theshift = PSPos f (const id) Nothing
-- where
-- f rp _ = case _rpLinkStatus rp of
-- UsedOutLink {_rplsChildNum = i} | i == n
-- -> Just (PS p a, rp & rpPlacementUse +~ 1)
-- _ -> Nothing
-- where
-- (p,a) = theshift (_rpPos rp,_rpDir rp)
atFstLnkOutShiftBy :: ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
atFstLnkOutShiftBy = atNthLnkOutShiftBy 0
@@ -181,9 +180,8 @@ atFstLnkOutShiftInward :: Float -> PlacementSpot
atFstLnkOutShiftInward = atNthLnkOutShiftInward 0
atNthLnkOutShiftInward :: Int -> Float -> PlacementSpot
atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n f
where
f (p,a) = (p +.+ rotateV a (V2 0 (negate x)),a)
atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n
$ \ (p,a) -> (p +.+ rotateV a (V2 0 (negate x)),a)
shiftInBy :: Float -> (Point2,Float) -> (Point2,Float)
shiftInBy x (p,a) = (p +.+ rotateV a (V2 0 (negate x)),a)
src/Dodge/Room.hs
+2
View File
@@ -20,6 +20,7 @@ module Dodge.Room
, module Dodge.Room.GlassLesson
, module Dodge.Room.Tanks
, module Dodge.Room.Containing
, module Dodge.Room.SensorDoor
) where
import Dodge.Room.Room
import Dodge.Room.RoadBlock
@@ -41,3 +42,4 @@ import Dodge.Room.LongRoom
import Dodge.Room.GlassLesson
import Dodge.Room.Tanks
import Dodge.Room.Containing
import Dodge.Room.SensorDoor
src/Dodge/Room/Door.hs
+6 -6
View File
@@ -28,12 +28,12 @@ door = defaultRoom
,uncurry inLink (V2 20 5,pi)
]
switchDoorRoom :: Int -> Room
switchDoorRoom inplid = defaultRoom
{ _rmPolys = [rectNSWE 40 0 0 40]
, _rmLinks = init lnks++ [last lnks]
, _rmPath = [(V2 20 35,V2 20 5)]
, _rmInPmnt = [InPlacement f inplid]
triggerDoorRoom :: Int -> Room
triggerDoorRoom inplid = defaultRoom
{ _rmPolys = [rectNSWE 40 0 0 40]
, _rmLinks = init lnks++ [last lnks]
, _rmPath = [(V2 20 35,V2 20 5)]
, _rmInPmnt = [InPlacement f inplid]
-- door extends into side walls (for shadows as rendered 12/03/21)
-- note no bounds
}
src/Dodge/Room/LasTurret.hs
+5 -5
View File
@@ -33,8 +33,8 @@ import System.Random
cenLasTur :: Room
cenLasTur = roomNgon 8 200 & rmPmnts .~
[ putLasTurret 0.02
, heightWallPS (roomPosRoomBoolShift (\rp _ -> isInLnk rp) (shiftInBy 100)) 30 covershape
, mntLightLnkCond unusedLnkToPS
, heightWallPS (resetPLUse $ rprBoolShift (const . isInLnk) (shiftInBy 100)) 30 covershape
, mntLightLnkCond $ rpBool isInLnk
]
where
covershape = rectNSEW 10 (-10) 20 (-20)
@@ -53,7 +53,7 @@ lasSensLightAboveDoor wth ps = extTrigLitPos
(atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
( \tp -> Just $ lightSensor wth (upf $ fromJust $ _plMID tp) ps )
where
upf trid mc w | _mcSensor mc > 900 = w & triggers . ix trid .~ const True
upf trid mc w | _mcSensorAmount mc > 900 = w & triggers . ix trid .~ const True
| otherwise = w
lightSensByDoor :: Int -> Room -> Room
@@ -72,13 +72,13 @@ lightSensByDoor outplid rm = rm
lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room)
lasSensorTurretTest n = do
cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur
let doorroom = switchDoorRoom n
let doorroom = triggerDoorRoom n
return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
lasCenSensEdge :: RandomGen g => Int -> State g (SubCompTree Room)
lasCenSensEdge n = do
cenroom <- shuffleLinks $ lightSensByDoor n cenLasTur
let doorroom = switchDoorRoom n
let doorroom = triggerDoorRoom n
return $ treeFromTrunk [PassDown door] $ Node (PassDown cenroom)
[ treeFromPost [PassDown doorroom] (UseAll door)
, treeFromPost [PassDown door] (UseLabel 0 corridor)
src/Dodge/Room/Procedural.hs
+1 -1
View File
@@ -101,7 +101,7 @@ roomRectAutoLinks :: Float -> Float -> Room
roomRectAutoLinks x y = (roomRect x y (f x) (f y)) {_rmPmnts = plmnts}
where
f z = max 1 $ (ceiling z - 40) `div` 60
plmnts = replicate 3 . mntLightLnkCond $ useRoomPosCond isUsedLnkUnplaced
plmnts = [mntLightLnkCond $ resetPLUse $ rpBool isInLnk]
{- Combines two rooms into one room.
- will have to work out exactly what to do with combining links
Mostly involves concatenation. -}
src/Dodge/Room/Room.hs
+5 -5
View File
@@ -156,8 +156,8 @@ roomCenterPillar = randomiseAllLinks . restrictInLinks ((\p -> dist p (V2 120 0)
, blockLine (V2 125 115) (V2 125 125)
--, sPS (V2 40 120) 0 putLamp
--, sPS (V2 200 120) 0 putLamp
, mntLightLnkCond unusedLnkToPS
, mntLightLnkCond unusedLnkToPS
, mntLightLnkCond useUnusedLnk
, mntLightLnkCond useUnusedLnk
]
roomOctogon :: Room
@@ -187,7 +187,7 @@ roomNgon n x = defaultRoom
{ _rmPolys = [poly]
, _rmLinks = muout (init lnks) ++ muin[last lnks]
, _rmPath = [] -- TODO
, _rmPmnts = []
, _rmPmnts = [mntLightLnkCond $ resetPLUse $ rpBool isInLnk]
, _rmBound = [poly]
, _rmFloor = Tiled [makeTileFromPoly poly 9]
, _rmName = show n ++ "gon"
@@ -225,7 +225,7 @@ weaponEmptyRoom = do
,sPS (V2 20 20) (pi/2) randC1
,sPS (V2 (w-20) 20) (pi/2) randC1
--,sPS (V2 (w/2) (h/2)) 0 putLamp
,mntLightLnkCond unusedLnkToPS
,mntLightLnkCond useUnusedLnk
]
f (V2 x y,a) = (a == pi && x > 25 && x < w - 25) || (a /= 0 && y > w - 30)
rm <- shuffleLinks $ restrictRMInLinksPD f (roomRect w h 2 2 & rmPmnts .~ plmnts)
@@ -396,7 +396,7 @@ pillarGrid = do
-- cornerRestrict (V2 x y,_)
-- = (x > 40 && x < h - 40)
-- || (y > 40 && y < h - 40)
let plmnts = replicate 8 (mntLightLnkCond unusedLnkToPS)
let plmnts = replicate 8 (mntLightLnkCond useUnusedLnk)
++
concat [f x y | x<-xs,y<-ys]
return $ roomRect w h (max i 2) (max i 2)
src/Dodge/Room/RunPast.hs
+1 -1
View File
@@ -60,7 +60,7 @@ runPastRoom i = do
{_rmOutPmnt = [OutPlacement (putLitButOnPosExtTrig red useUnusedLnk) i]
,_rmPmnts = []
}
switchdoor = switchDoorRoom i
switchdoor = triggerDoorRoom i
n = length $ filter theedgetest $ map lnkPosDir $ _rmLinks cenroom
controom = treeFromPost [PassDown switchdoor,PassDown linkcor] (UseAll door)
critrooms :: [SubCompTree Room]
src/Dodge/Room/SensorDoor.hs
+57
View File
@@ -0,0 +1,57 @@
module Dodge.Room.SensorDoor where
import Dodge.LevelGen.Data
import Dodge.PlacementSpot
import Dodge.Data
import Dodge.Tree
--import Dodge.RoomLink
import Dodge.Room.Door
import Dodge.Room.Procedural
import Dodge.Room.Room
--import Dodge.Room.Corridor
import Dodge.Room.Link
--import Dodge.Room.Procedural
import Dodge.Room.Foreground
--import Dodge.Room.RoadBlock
import Dodge.Placement.Instance
--import Dodge.Default.Room
--import Dodge.Item.Weapon.BulletGuns
--import Dodge.Item.Weapon.Utility
--import Dodge.LevelGen.Data
--import Geometry.Data
import Geometry
--import Padding
import Color
import Shape
import LensHelp
import Dodge.RandomHelp
--import qualified Data.Set as S
import Data.Maybe
--import Data.Tree
import Control.Monad.State
import System.Random
sensorRoom :: RandomGen g => DamageType -> Int -> State g (SubCompTree Room)
sensorRoom senseType n = do
rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
cenroom <- shuffleLinks $ sensInsideDoor senseType n rm
let doorroom = triggerDoorRoom n
return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
sensAboveDoor :: DamageType -> Float -> PlacementSpot -> Placement
sensAboveDoor sensetype wth ps = extTrigLitPos
(atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
( \tp -> Just $ damageSensor sensetype wth (upf $ fromJust $ _plMID tp) ps )
where
upf trid mc w | _mcSensorAmount mc > 900 = w & triggers . ix trid .~ const True
| otherwise = w
sensInsideDoor :: DamageType -> Int -> Room -> Room
sensInsideDoor senseType outplid rm = rm
& rmPmnts .:~ psPt atFstLnkOut
(PutShape $ colorSH yellow $
thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
<> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
<> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
& rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid]
src/Dodge/Wall/Damage.hs
+28 -24
View File
@@ -13,7 +13,7 @@ import Geometry
import Color
import LensHelp
damageWall :: DamageType -> Wall -> World -> World
damageWall :: Damage -> Wall -> World -> World
damageWall dt wl = case _wlStructure wl of
MachinePart mcid -> wallEff dt wl . (machines . ix mcid . mcDamage .:~ dt)
BlockPart blid -> wallEff dt wl . (blocks . ix blid %~ damageBlockWith dt)
@@ -21,33 +21,35 @@ damageWall dt wl = case _wlStructure wl of
_ -> wallEff dt wl
{- | Damage effects on indestructible walls -}
-- TODO take into account damage amount for amount of dust/sparks?
wallEff :: DamageType -> Wall -> World -> World
wallEff dt wl = case dt of
Lasering _ sp p _ -> colSpark 8 lSparkCol (outTo sp p) (reflDirWall sp p wl)
Piercing _ sp p _ -> colSparkRandDir 0.2 8 pSparkCol (outTo sp p) (reflDirWall sp p wl)
. wlDustAt wl (outTo sp p)
Blunt _ sp p _ -> wlDustAt wl (outTo sp p)
Explosive _ _ -> id
Cutting {} -> id
SparkDam {} -> id
Flaming {} -> id
Electrical {} -> id
Concussive {} -> id
TorqueDam {} -> id
PushDam {} -> id
PoisonDam {} -> id
wallEff :: Damage -> Wall -> World -> World
wallEff dm wl = case _dmType dm of
Lasering -> colSpark 8 lSparkCol outTo (reflDirWall sp p wl)
Piercing -> colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl)
. wlDustAt wl outTo
Blunt -> wlDustAt wl outTo
Explosive-> id
Cutting -> id
SparkDam -> id
Flaming -> id
Electrical -> id
Concussive -> id
TorqueDam -> id
PushDam -> id
PoisonDam -> id
where
outTo sp p = p +.+ squashNormalizeV (sp -.- p)
sp = _dmFrom dm
p = _dmTo dm
outTo = p +.+ squashNormalizeV (sp -.- p)
pSparkCol = brightX 100 1.5 white
lSparkCol = V4 20 (-5) 0 1
damageBlockWith :: DamageType -> Block -> Block
damageBlockWith dt = case dt of
Piercing dam _ _ _ -> blHPs %~ reduceHead dam
Blunt dam _ _ _ -> blHPs %~ reduceHead dam
Cutting dam _ _ _ -> blHPs %~ reduceHead dam
Explosive dam _ -> blHPs %~ reduceHead dam
Concussive dam _ _ _ _ -> blHPs %~ reduceHead dam
damageBlockWith :: Damage -> Block -> Block
damageBlockWith dm = case _dmType dm of
Piercing -> blHPs %~ reduceHead dam
Blunt -> blHPs %~ reduceHead dam
Cutting -> blHPs %~ reduceHead dam
Explosive -> blHPs %~ reduceHead dam
Concussive -> blHPs %~ reduceHead dam
Lasering {} -> id
SparkDam {} -> id
Flaming {} -> id
@@ -55,6 +57,8 @@ damageBlockWith dt = case dt of
TorqueDam {} -> id
PushDam {} -> id
PoisonDam {} -> id
where
dam = _dmAmount dm
reduceHead :: Int -> [Int] -> [Int]
reduceHead y (x:xs) = x-y:xs
src/Dodge/WorldEvent/Damage.hs
+3 -4
View File
@@ -4,17 +4,16 @@ module Dodge.WorldEvent.Damage
import Dodge.Data
import Geometry
import Dodge.Wall.Damage
import Control.Lens
import LensHelp
damThingHitWith
:: (Point2 -> Point2 -> Point2 -> DamageType)
:: (Point2 -> Point2 -> Point2 -> Damage)
-> Point2
-> Point2
-> Maybe (Point2, Either Creature Wall)
-> World
-> World
damThingHitWith partDT sp ep mayEiCrWl = case mayEiCrWl of
Just (hitp,Left cr ) -> creatures . ix (_crID cr) . crState . crDamage %~ (partDT sp hitp ep :)
Just (hitp,Left cr) -> creatures . ix (_crID cr) . crState . crDamage .:~ partDT sp hitp ep
Just (hitp,Right wl) -> damageWall (partDT sp hitp ep) wl
Nothing -> id
src/Dodge/WorldEvent/HitEffect.hs
+1 -1
View File
@@ -63,7 +63,7 @@ penWalls crEff wlEff pt hitThings w = case hitThings of
doFlameDam :: Int -> Particle -> Point2 -> Creature -> World -> World
doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage .:~
Flaming amount sp p ep
Damage Flaming amount sp p ep NoDamageEffect
where
sp = _ptPos pt
ep = sp +.+ _ptVel pt
src/Dodge/WorldEvent/Shockwave.hs
+9 -3
View File
@@ -60,13 +60,17 @@ mvShockwave is w pt
t = _ptTimer pt
tFraction = fromIntegral t / fromIntegral (_ptMaxTime pt)
rad = r - (3/4) * r * tFraction
doDams = over creatures (IM.map damCr) . flip (IM.foldl' (flip $ damageWall (Explosive 10000 p)))
doDams = over creatures (IM.map damCr)
. flip (IM.foldl' (flip $ damageWall (Damage Explosive 10000 p p p NoDamageEffect)))
hitBlocks
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
damCr cr
| _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . crDamage .:~
PushDam dam (25 * push *.* squashNormalizeV (_crPos cr -.- p))
Damage PushDam dam cpos cpos cpos
(PushBackDamage (25 * push *.* squashNormalizeV (_crPos cr -.- p)))
where
cpos = _crPos cr
{- Create a shockwave going from an outside circle into a center point. -}
inverseShockwaveAt
:: Point2 -- Center position
@@ -103,7 +107,9 @@ moveInverseShockwave w pt
damCr cr
| dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . crDamage .:~
PushDam 1 (25 *.* squashNormalizeV (p -.- _crPos cr))
Damage PushDam 1 cpos cpos cpos (PushBackDamage $ 25 *.* squashNormalizeV (p -.- cpos))
where
cpos = _crPos cr
drawInverseShockwave :: Particle -> Picture
drawInverseShockwave pt
src/Dodge/WorldEvent/SpawnParticle.hs
+26 -24
View File
@@ -12,6 +12,7 @@ import Dodge.WorldEvent.Cloud
import Dodge.WorldEvent.Flash
import Dodge.SoundLogic
import Dodge.RandomHelp
import Dodge.Wall.Damage
import Picture
import Geometry
import qualified IntMapHelp as IM
@@ -27,26 +28,27 @@ aFlameParticle
-> Maybe Int -- ^ Creature id
-> Particle
aFlameParticle t pos vel maycid = PtZ
{ _ptDraw = drawFlame vel
, _ptUpdate = moveFlame vel
, _ptVel = vel
, _ptColor = red
, _ptPos = pos
, _ptCrIgnore = maycid
, _ptWidth = 4
, _ptTimer = t
, _ptHitEff = destroyOnImpact (doFlameDam 1) noEff
, _ptZ = 20
{ _ptDraw = drawFlame vel
, _ptUpdate = moveFlame vel
, _ptVel = vel
, _ptColor = red
, _ptPos = pos
, _ptCrIgnore = maycid
, _ptWidth = 4
, _ptTimer = t
, _ptHitEff = destroyOnImpact (doFlameDam 1)
(\_ p -> damageWall (Damage Flaming 19 p p p NoDamageEffect))
, _ptZ = 20
}
drawFlame
drawFlame
:: Point2 -- ^ Rotate direction
-> Particle
-> Picture
drawFlame rotd pt = pictures
drawFlame rotd pt = pictures
[ glow
, aPic 3 prot2 25 (V2 (scaleChange + 1) 2 ) $ V4 2 (-1) (-1) 0.5
, aPic 3 prot 22 (V2 (scaleChange + 0.5) 1) $ V4 1 0.5 0 2
, aPic 1 prot3 20 (V2 scaleChange 0.5 ) $ V4 1 1 1 1
, aPic 3 prot2 25 (V2 (scaleChange + 1) 2 ) $ V4 2 (-1) (-1) 0.5
, aPic 3 prot 22 (V2 (scaleChange + 0.5) 1 ) $ V4 1 0.5 0 2
, aPic 1 prot3 20 (V2 scaleChange 0.5) $ V4 1 1 1 1
]
where
ep = _ptPos pt
@@ -69,17 +71,16 @@ drawFlame rotd pt = pictures
prot2 p' = p' +.+ rotateV (negate $ fromIntegral time) (V2 0 1)
prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (V2 0 2)
{- TODO: add generalised area damage particles/hiteffects. -}
moveFlame
:: Point2 -- ^ Rotation direction
moveFlame :: Point2 -- ^ Rotation direction
-> World
-> Particle
-> (World, Maybe Particle)
moveFlame rotd w pt
| time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing)
| otherwise = case thingsHitExceptCr (_ptCrIgnore pt) sp ep w of
((_,Left _):_) -> (doSound damcrs , mvPt 0.7)
(thing@(p,Right wl):_) -> (doSound . fst $ hiteff [thing] damcrs , rfl wl p)
_ -> (flameFlicker pt $ doSound damcrs , mvPt 0.98)
((_,Left _):_) -> (doSound damcrs , mvPt 0.7)
(th@(p,Right wl):_) -> (doSound . fst $ hiteff [th] damcrs , rfl wl p)
_ -> (flameFlicker pt $ doSound damcrs , mvPt 0.98)
where
time = _ptTimer pt
doSound = soundContinue Flame (V2 x y) fireLoudS (Just 2)
@@ -98,7 +99,7 @@ moveFlame rotd w pt
angleCoeff x' = abs $ 1 - abs ( (x' * 2 - pi) / pi )
hiteff = _ptHitEff pt pt
rfl wl p = Just $ pt
{ _ptTimer = time -1
{ _ptTimer = time - 1
, _ptPos = pOut p
, _ptVel = reflV wl
}
@@ -195,7 +196,7 @@ moveFlamelet w pt
damcrs = w & creatures %~ IM.map damifclose
isClose cr = dist ep (_crPos cr) < _crRad cr + size
damifclose cr
| isClose cr = cr & crState . crDamage .:~ Flaming 3 sp ep ep
| isClose cr = cr & crState . crDamage .:~ Damage Flaming 3 sp ep ep NoDamageEffect
| otherwise = cr
-- | At writing the radius is half the size of the effect area
makeGasCloud
@@ -223,6 +224,7 @@ makeGasCloud pos vel w = w
cloudPoisonDamage :: Cloud -> World -> World
cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs
where
damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (stripZ $ _clPos c) w
damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint clpos w
f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
doDam cr = cr & crState . crDamage .:~ PoisonDam 1
doDam cr = cr & crState . crDamage .:~ Damage PoisonDam 1 clpos clpos clpos NoDamageEffect
clpos = stripZ $ _clPos c