diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index 9b53aeaca..2c92d3a49 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -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) : ) diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index cc05870cf..27b8042a1 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -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 diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 85c134fde..1365be188 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -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 diff --git a/src/Dodge/Creature/State/Data.hs b/src/Dodge/Creature/State/Data.hs index a32258a5b..77f25238d 100644 --- a/src/Dodge/Creature/State/Data.hs +++ b/src/Dodge/Creature/State/Data.hs @@ -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 } diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 6acab3bc3..40f4365a2 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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' diff --git a/src/Dodge/Data/DamageType.hs b/src/Dodge/Data/DamageType.hs index 3770d04d6..f0d0b1438 100644 --- a/src/Dodge/Data/DamageType.hs +++ b/src/Dodge/Data/DamageType.hs @@ -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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index c11e62657..85a8c2df8 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -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 diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 6c12c54c1..8cbf63829 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -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] diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index f9b63906f..f5788185e 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 06fed9426..dbbbca136 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/SprayGuns.hs b/src/Dodge/Item/Weapon/SprayGuns.hs index c4fc75517..d7766bda0 100644 --- a/src/Dodge/Item/Weapon/SprayGuns.hs +++ b/src/Dodge/Item/Weapon/SprayGuns.hs @@ -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) diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index a7047faae..1a483098e 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -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 diff --git a/src/Dodge/Particle/Spark.hs b/src/Dodge/Particle/Spark.hs index 74788edd4..24d348d63 100644 --- a/src/Dodge/Particle/Spark.hs +++ b/src/Dodge/Particle/Spark.hs @@ -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 diff --git a/src/Dodge/Particle/TeslaArc.hs b/src/Dodge/Particle/TeslaArc.hs index 19caeb373..6c18fc033 100644 --- a/src/Dodge/Particle/TeslaArc.hs +++ b/src/Dodge/Particle/TeslaArc.hs @@ -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' diff --git a/src/Dodge/Placement/Instance/LightSource.hs b/src/Dodge/Placement/Instance/LightSource.hs index 2e896daf1..b3ccf51fc 100644 --- a/src/Dodge/Placement/Instance/LightSource.hs +++ b/src/Dodge/Placement/Instance/LightSource.hs @@ -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) diff --git a/src/Dodge/Placement/Instance/Sensor.hs b/src/Dodge/Placement/Instance/Sensor.hs index 0dfe3c3a1..0ad80389c 100644 --- a/src/Dodge/Placement/Instance/Sensor.hs +++ b/src/Dodge/Placement/Instance/Sensor.hs @@ -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 ) diff --git a/src/Dodge/Placement/Instance/Turret.hs b/src/Dodge/Placement/Instance/Turret.hs index 2880d76cd..cde0e8fe5 100644 --- a/src/Dodge/Placement/Instance/Turret.hs +++ b/src/Dodge/Placement/Instance/Turret.hs @@ -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 diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs index 8b7b239d4..e944121a7 100644 --- a/src/Dodge/PlacementSpot.hs +++ b/src/Dodge/PlacementSpot.hs @@ -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 ( ( 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) diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 9d160ac8b..6e0a35c7c 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -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 diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index 35b6cb26f..c3e7e0117 100644 --- a/src/Dodge/Room/Door.hs +++ b/src/Dodge/Room/Door.hs @@ -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 } diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index e9bbf165a..f99dfec7b 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -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) diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index cf764ded9..fb6d32302 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -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. -} diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index 43d7b1e00..22e1ea685 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -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) diff --git a/src/Dodge/Room/RunPast.hs b/src/Dodge/Room/RunPast.hs index 165dbaeb9..e4ec8aadd 100644 --- a/src/Dodge/Room/RunPast.hs +++ b/src/Dodge/Room/RunPast.hs @@ -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] diff --git a/src/Dodge/Room/SensorDoor.hs b/src/Dodge/Room/SensorDoor.hs new file mode 100644 index 000000000..4c1259f35 --- /dev/null +++ b/src/Dodge/Room/SensorDoor.hs @@ -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] diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index b931dfb88..5c0e38ea0 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -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 diff --git a/src/Dodge/WorldEvent/Damage.hs b/src/Dodge/WorldEvent/Damage.hs index 33079403f..8c995b10d 100644 --- a/src/Dodge/WorldEvent/Damage.hs +++ b/src/Dodge/WorldEvent/Damage.hs @@ -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 diff --git a/src/Dodge/WorldEvent/HitEffect.hs b/src/Dodge/WorldEvent/HitEffect.hs index 020365773..a34f3bd25 100644 --- a/src/Dodge/WorldEvent/HitEffect.hs +++ b/src/Dodge/WorldEvent/HitEffect.hs @@ -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 diff --git a/src/Dodge/WorldEvent/Shockwave.hs b/src/Dodge/WorldEvent/Shockwave.hs index 00958e319..9d78ec620 100644 --- a/src/Dodge/WorldEvent/Shockwave.hs +++ b/src/Dodge/WorldEvent/Shockwave.hs @@ -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 diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index f41e6c817..e404079c7 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -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