diff --git a/src/Dodge/Damage.hs b/src/Dodge/Damage.hs index 63368801d..7120a7455 100644 --- a/src/Dodge/Damage.hs +++ b/src/Dodge/Damage.hs @@ -7,12 +7,13 @@ import Dodge.Wall.Damage import FoldableHelp import Geometry.Vector import LensHelp +import qualified IntMapHelp as IM damageCrWlID :: Damage -> CrWlID -> World -> World damageCrWlID dam crwl = case crwl of NothingID -> id CrID cid -> cWorld . creatures . ix cid . crState . csDamage .:~ dam - WlID wlid -> cWorld . wallDamages . ix wlid .:~ dam + WlID wlid -> cWorld . wallDamages %~ IM.insertWith (++) wlid [dam] damageCrWall :: Damage -> Either Creature Wall -> World -> World damageCrWall dt (Left cr) = cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ dt diff --git a/src/Dodge/Data/Machine/Sensor.hs b/src/Dodge/Data/Machine/Sensor.hs index f7aee5ea9..1c22937d0 100644 --- a/src/Dodge/Data/Machine/Sensor.hs +++ b/src/Dodge/Data/Machine/Sensor.hs @@ -17,6 +17,7 @@ data Sensor , _sensAmount :: Int , _sensType :: DamageType , _sensDraw :: (PaletteColor, DecorationShape) + , _sensThreshold :: Int } | ProximitySensor { _proxStatus :: CloseToggle diff --git a/src/Dodge/Euse.hs b/src/Dodge/Euse.hs index 21f2ea631..e316222fd 100644 --- a/src/Dodge/Euse.hs +++ b/src/Dodge/Euse.hs @@ -84,7 +84,6 @@ shieldWall crid = , _wlWalkable = True , _wlFireThrough = True , _wlReflect = True - , _wlUnshadowed = False , _wlRotateTo = False , _wlStructure = CreaturePart crid -- shieldWallDamage } diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index e8d7cde9d..5e27e5a0d 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -21,6 +21,10 @@ initialAnoTree = intersperse (AnTree corDoor) [ IntAnno $ AnTree . startRoom + , IntAnno $ + PassthroughLockKeyLists + [(sensorRoomRunPast ELECTRICAL, takeOne [CRAFT STATICMODULE, HELD SPARKGUN])] + itemRooms , IntAnno $ AnTree . lasSensorTurretTest , -- , AnRoom $ tanksRoom [] [] <&> rmPmnts .~ [] -- , AnRoom $ tanksRoom [] [] @@ -40,18 +44,14 @@ initialAnoTree = -- , AnTree $ tToBTree "spawners" <$> spawnerRoom -- , AnRoom pistolerRoom -- , AnRoom doubleCorridorBarrels - IntAnno $ - PassthroughLockKeyLists - [(sensorRoomRunPast ELECTRICAL, takeOne [CRAFT STATICMODULE, HELD SPARKGUN])] - itemRooms - , IntAnno $ PassthroughLockKeyLists keyCardRunPastRand itemRooms + IntAnno $ PassthroughLockKeyLists keyCardRunPastRand itemRooms , IntAnno $ AnTree . warningRooms "INVISIBLE CREATURE AHEAD" , AnTree $ rToOnward "chaseCrit+armourChaseCrit rectRoom" $ return . cleatOnward $ roomRectAutoLinks 400 400 & rmPmnts - .++~ [ spNoID anyUnusedSpot (PutCrit invisibleChaseCrit) - , spNoID anyUnusedSpot (PutCrit armourChaseCrit) + .++~ [ psPtPl anyUnusedSpot (PutCrit invisibleChaseCrit) + , psPtPl anyUnusedSpot (PutCrit armourChaseCrit) ] , IntAnno $ AnTree . fmap (tToBTree "healthTest") . healthTest , AnTree (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward) diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index 2b4293701..0d0ad02a1 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -1,5 +1,7 @@ module Dodge.HeldUse where +import Dodge.Creature.HandPos +import Dodge.Tesla.Arc import Color import Data.Maybe import Data.Traversable @@ -494,3 +496,13 @@ mcShootLaser it mc = cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam dir = mc ^?! mcType . _McTurret . tuDir phasev = _phaseV . _itParams $ it dam = _lasDamage $ _itParams it + +-- | assumes that the item is held +shootTeslaArc :: Item -> Creature -> World -> World +shootTeslaArc it cr w = + w' + & cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itParams .~ ip + where + (w', ip) = shootTeslaArc' (_itParams it) pos dir w + pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir + dir = _crDir cr diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 533126225..af20c83cd 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -1,10 +1,9 @@ module Dodge.Item.Weapon.BatteryGuns ( - teslaParams, lasRayAt, flameBeamCombine, teslaBeamCombine, splitBeamCombine, - shootTeslaArc, +-- shootTeslaArc, shootLaser, circleLaser, shootDualLaser, @@ -17,7 +16,6 @@ import Dodge.Creature.HandPos import Dodge.Data.World import Dodge.Item.Location import Dodge.Item.Weapon.LaserPath -import Dodge.Tesla import Geometry import qualified IntMapHelp as IM import LensHelp @@ -132,15 +130,6 @@ import Picture -- y = 15 * sin (pi * fromIntegral x' * 0.01) -- x' = _lasCycle $ _itParams it --- | assumes that the item is held -shootTeslaArc :: Item -> Creature -> World -> World -shootTeslaArc it cr w = - w' - & cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itParams .~ ip - where - (w', ip) = shootTeslaArc' (_itParams it) pos dir w - pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir - dir = _crDir cr shootLaser :: Item -> Creature -> World -> World diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index c2783f8d6..2a34fb861 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -5,8 +5,12 @@ import Data.Maybe import Dodge.Data.GenWorld import Geometry -spNoID :: PlacementSpot -> PSType -> Placement -spNoID ps pst = Placement 10 ps pst Nothing (const . const Nothing) +--spNoID +psPtPl :: PlacementSpot -> PSType -> Placement +psPtPl ps pst = Placement 10 ps pst Nothing (const . const Nothing) + +psPtJpl :: PlacementSpot -> PSType -> Maybe Placement +psPtJpl ps = Just . psPtPl ps pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement pContID ps pt = Placement 10 ps pt Nothing . contToIDCont diff --git a/src/Dodge/Machine/Destroy.hs b/src/Dodge/Machine/Destroy.hs index 504cc5420..4b96d6632 100644 --- a/src/Dodge/Machine/Destroy.hs +++ b/src/Dodge/Machine/Destroy.hs @@ -1,5 +1,6 @@ module Dodge.Machine.Destroy where +import Dodge.FloorItem import Data.Maybe import Dodge.Data.World import Dodge.Wall.Delete @@ -15,6 +16,12 @@ destroyMachine mc = . makeExplosionAt (_mcPos mc) . mcKillTerm mc . mcKillBut mc + . destroyMcType (mc ^. mcType) mc + +destroyMcType :: MachineType -> Machine -> World -> World +destroyMcType mt mc = case mt of + McTurret tu -> copyItemToFloor (_mcPos mc) (_tuWeapon tu) + _ -> id mcKillTerm :: Machine -> World -> World mcKillTerm mc w = fromMaybe w $ do diff --git a/src/Dodge/Machine/Draw.hs b/src/Dodge/Machine/Draw.hs index 471dcd438..ec2ad9d9c 100644 --- a/src/Dodge/Machine/Draw.hs +++ b/src/Dodge/Machine/Draw.hs @@ -1,58 +1,61 @@ -module Dodge.Machine.Draw - where -import Dodge.Item.HeldOffset -import Dodge.Item.Draw.SPic -import Dodge.Placement.TopDecoration -import Shape -import Picture -import Geometry +module Dodge.Machine.Draw where + import Dodge.Data.Machine +import Dodge.Item.Draw.SPic +import Dodge.Item.HeldOffset +import Dodge.Placement.TopDecoration +import Geometry +import Picture +import Shape import ShapePicture drawMachine :: Machine -> SPic drawMachine mc = case _mcType mc of McStatic -> mempty McTerminal -> terminalSPic mc - McTurret tu -> drawTurret tu mc - McSensor se -> drawSensor se mc + McTurret tu -> drawBaseMachine 20 mc <> drawTurret tu mc + McSensor se -> drawBaseMachine 25 mc <> drawSensor se mc drawSensor :: Sensor -> Machine -> SPic drawSensor sens = case sens of - DamageSensor {_sensDraw = pcds} -> sensorSPic pcds - ProximitySensor {} -> const mempty + DamageSensor{_sensDraw = pcds} -> sensorSPic pcds + ProximitySensor{} -> const mempty terminalSPic :: Machine -> SPic terminalSPic = noPic . terminalShape terminalShape :: Machine -> Shape -terminalShape mc = colorSH col (prismPoly - [V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10] - [V3 10 10 0, V3 (-10) 10 0, V3 (-10) (-10) 0, V3 10 (-10) 0] - ) - <> colorSH black (prismPoly - [V3 8 8 20, V3 (-8) 8 20, V3 0 (-8) 10] - [V3 8 8 19, V3 (-8) 8 19, V3 0 (-8) 9] - --[V3 8 8 20, V3 (-8) 8 20, V3 (-8) (-8) 10, V3 8 (-8) 10] - --[V3 8 8 19, V3 (-8) 8 19, V3 (-8) (-8) 9, V3 8 (-8) 9] - ) +terminalShape mc = + colorSH + col + ( prismPoly + [V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10] + [V3 10 10 0, V3 (-10) 10 0, V3 (-10) (-10) 0, V3 10 (-10) 0] + ) + <> colorSH + black + ( prismPoly + [V3 8 8 20, V3 (-8) 8 20, V3 0 (-8) 10] + [V3 8 8 19, V3 (-8) 8 19, V3 0 (-8) 9] + --[V3 8 8 20, V3 (-8) 8 20, V3 (-8) (-8) 10, V3 8 (-8) 10] + --[V3 8 8 19, V3 (-8) 8 19, V3 (-8) (-8) 9, V3 8 (-8) 9] + ) where col = _mcColor mc -drawTurret :: Turret -> Machine -> SPic -drawTurret tu mc = - ( colorSH (_mcColor mc) $ upperPrismPoly 20 (square w) +drawBaseMachine :: Float -> Machine -> SPic +drawBaseMachine h mc = + ( colorSH (_mcColor mc) $ upperPrismPoly h (reverse $ square (_mcWidth mc)) , mempty ) - <> overPosSP (turretItemOffset it tu mc) (itemSPic it) +drawTurret :: Turret -> Machine -> SPic +drawTurret tu mc = overPosSP (turretItemOffset it tu mc) (itemSPic it) where it = _tuWeapon tu - w = _mcWidth mc sensorSPic :: (PaletteColor, DecorationShape) -> Machine -> SPic sensorSPic (pc, ds) mc = - noPic $ - colorSH (_mcColor mc) (upperPrismPoly 25 (square w)) - <> decorationToShape ds w w 25 col col + noPic $ decorationToShape ds w w 25 col col where col = paletteToColor pc w = _mcWidth mc diff --git a/src/Dodge/Machine/Update.hs b/src/Dodge/Machine/Update.hs index c81a6466e..dd6293072 100644 --- a/src/Dodge/Machine/Update.hs +++ b/src/Dodge/Machine/Update.hs @@ -1,22 +1,17 @@ module Dodge.Machine.Update where +import Control.Monad import Data.List (partition) import Data.Maybe import Dodge.Base.Collide import Dodge.Base.You import Dodge.Data.World -import Dodge.FloorItem import Dodge.HeldUse -import Dodge.Item.Held.BatteryGuns import Dodge.Machine.Destroy import Dodge.Movement.Turn import Dodge.SoundLogic -import Dodge.Wall.Delete -import Dodge.WorldEvent.Explosion import Geometry -import qualified IntMapHelp as IM import LensHelp -import Control.Monad updateMachine :: Machine -> World -> World updateMachine mc @@ -24,27 +19,21 @@ updateMachine mc | otherwise = mcApplyDamage (_mcDamage mc) mc . mcPlaySound mc - . mcSensorTriggerUpdate mc - . mcTurretUpdate mc - . mcSensorUpdate mc + . mcTypeUpdate mc -mcTurretUpdate :: Machine -> World -> World -mcTurretUpdate mc = case mc ^? mcType . _McTurret of - Just tu -> updateTurret (_tuTurnSpeed tu) mc - _ -> id +mcTypeUpdate :: Machine -> World -> World +mcTypeUpdate mc = case mc ^. mcType of + McStatic -> id + McTerminal -> id + McTurret tu -> updateTurret (_tuTurnSpeed tu) mc + McSensor se -> mcSensorTriggerUpdate se mc . mcSensorUpdate se mc updateTurret :: Float -> Machine -> World -> World -updateTurret rotSpeed mc w - | _mcHP mc < 1 = - w & cWorld . machines %~ IM.delete mcid - & deleteWallIDs (_mcWallIDs mc) - & makeExplosionAt mcpos - & copyItemToFloor mcpos lasGun - | otherwise = - w - & dodamage - & mcUseItem mc - & elecDamBranch +updateTurret rotSpeed mc w = + w + & dodamage + & mcUseItem mc + & elecDamBranch where dodamage = cWorld . machines . ix mcid @@ -77,17 +66,16 @@ mcUseItem mc = fromMaybe id $ do guard (_tuFireTime tu > 0) return $ mcUseHeld hit it mc -mcSensorTriggerUpdate :: Machine -> World -> World -mcSensorTriggerUpdate mc = fromMaybe id $ do +mcSensorTriggerUpdate :: Sensor -> Machine -> World -> World +mcSensorTriggerUpdate se mc = fromMaybe id $ do trid <- mc ^? mcMounts . ix ObTrigger - bval <- mcTriggerVal mc + bval <- mcTriggerVal se return $ cWorld . triggers . ix trid .~ bval -mcTriggerVal :: Machine -> Maybe Bool -mcTriggerVal mc = case mc ^? mcType . _McSensor of - Nothing -> Nothing - Just s@ProximitySensor{} -> s ^? sensToggle - Just s@DamageSensor{} -> Just $ _sensAmount s > 900 +mcTriggerVal :: Sensor -> Maybe Bool +mcTriggerVal se = case se of + ProximitySensor{} -> se ^? sensToggle + DamageSensor{} -> Just $ _sensAmount se > _sensThreshold se mcPlaySound :: Machine -> World -> World mcPlaySound mc w = case _mcCloseSound mc of @@ -101,16 +89,17 @@ mcPlaySound mc w = case _mcCloseSound mc of mcApplyDamage :: [Damage] -> Machine -> World -> World mcApplyDamage ds mc = case mc ^? mcType . _McSensor of - Nothing -> - cWorld . machines . ix (_mcID mc) + Nothing -> mcpointer %~ ((mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds))) - _ -> id + _ -> mcpointer + %~ (mcDamage .~ []) + where + mcpointer = cWorld . machines . ix (_mcID mc) -mcSensorUpdate :: Machine -> World -> World -mcSensorUpdate mc w = case mc ^? mcType . _McSensor of - Nothing -> w - Just s@DamageSensor{} -> senseDamage (_sensType s) mc w - Just ProximitySensor{} -> mcProximitySensorUpdate mc w +mcSensorUpdate :: Sensor -> Machine -> World -> World +mcSensorUpdate se mc w = case se of + s@DamageSensor{} -> senseDamage (_sensThreshold se) (_sensType s) mc w + ProximitySensor{} -> mcProximitySensorUpdate mc w mcProximitySensorUpdate :: Machine -> World -> World mcProximitySensorUpdate mc w = case ( _proxStatus sens @@ -142,15 +131,19 @@ mcProxTest mc w = case mc ^? mcType . _McSensor . proxRequirement of where cr = you w -senseDamage :: DamageType -> Machine -> World -> World -senseDamage dt mc = +senseDamage :: Int -> DamageType -> Machine -> World -> World +senseDamage threshold dt mc = (cWorld . machines . ix mcid %~ upmc) . updatels where - upmc = mcType . _McSensor . sensAmount %~ min 1000 . max 0 . (+ (newsense - 5)) + upmc = mcType . _McSensor . sensAmount %~ min (100 * threshold) . max 0 . (+ newsense) mcid = _mcID mc - newsense = sum . map _dmAmount $ filter ((== dt) . _dmType) (_mcDamage mc) - ni = fromIntegral (mc ^?! mcType . _McSensor . sensAmount) / 1000 + newsense + | x > 0 = x + | otherwise = -5 + where + x = sum . map _dmAmount $ filter ((== dt) . _dmType) (_mcDamage mc) + ni = fromIntegral (mc ^?! mcType . _McSensor . sensAmount) / fromIntegral threshold updatels = fromMaybe id $ do lsid <- mc ^? mcMounts . ix ObLightSource return $ cWorld . lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index 8f44c304e..10c6bc098 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -29,7 +29,7 @@ analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp -> -- & mcUpdate .~ mcProximitySensorUpdate & mcType .~ McTerminal & mcHP .~ 100 - & mcType . _McSensor .~ defaultProximitySensor{_proxRequirement = proxreq} + & mcType .~ McSensor (defaultProximitySensor{_proxRequirement = proxreq}) --this can probably be deleted --mcProximitySensorUpdate :: Machine -> World -> World diff --git a/src/Dodge/Placement/Instance/Sensor.hs b/src/Dodge/Placement/Instance/Sensor.hs index 75f0f8a95..0e45671f3 100644 --- a/src/Dodge/Placement/Instance/Sensor.hs +++ b/src/Dodge/Placement/Instance/Sensor.hs @@ -19,20 +19,27 @@ damageSensor :: PlacementSpot -> Placement damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $ - \lsid -> Just $ - spNoID ps $ - PutUsingGenParams $ - \gw -> - (,) gw $ - PutMachine - (reverse $ square wdth) - ( defaultMachine - & mcColor .~ yellow - & mcMounts . at ObTrigger .~ mtrid - & mcMounts . at ObLightSource ?~ lsid - & mcType . _McSensor .~ DamageSensor False 0 dt (_sensorCoding (_genParams (_cWorld gw)) M.! dt) - ) - defaultSensorWall + \lsid -> psPtJpl ps $ + PutUsingGenParams $ + \gw -> + ( gw + , PutMachine + (reverse $ square wdth) + ( defaultMachine + & mcColor .~ yellow + & mcMounts . at ObTrigger .~ mtrid + & mcMounts . at ObLightSource ?~ lsid + & mcType .~ McSensor (DamageSensor False 0 dt (_sensorCoding (_genParams (_cWorld gw)) M.! dt) (damageTypeThreshold dt)) + ) + defaultSensorWall + ) + +damageTypeThreshold :: DamageType -> Int +damageTypeThreshold dt = case dt of + FLAMING -> 1000 + LASERING -> 1000 + ELECTRICAL -> 5 + _ -> undefined lightSensor :: Float -> @@ -40,4 +47,3 @@ lightSensor :: PlacementSpot -> Placement lightSensor = damageSensor LASERING - diff --git a/src/Dodge/Placement/Instance/Wall.hs b/src/Dodge/Placement/Instance/Wall.hs index bac3e6353..dff588ddd 100644 --- a/src/Dodge/Placement/Instance/Wall.hs +++ b/src/Dodge/Placement/Instance/Wall.hs @@ -11,7 +11,7 @@ import Dodge.Placement.Instance.Block import Geometry heightWallPS :: PlacementSpot -> Float -> [Point2] -> Placement -heightWallPS spot h ps = spNoID spot $ lowBlock Stone (_wlColor defaultWall) h ps +heightWallPS spot h ps = psPtPl spot $ lowBlock Stone (_wlColor defaultWall) h ps invisibleWall :: [Point2] -> Placement invisibleWall ps = diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 7194f0c7c..e3273542e 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -2,6 +2,7 @@ module Dodge.Render.ShapePicture ( worldSPic, ) where +import Dodge.Zoning.Base import Control.Lens import Data.Foldable import qualified Data.Graph.Inductive as FGL @@ -49,7 +50,7 @@ import Dodge.Zone import Dodge.Zoning import Geometry import Geometry.ConvexPoly -import Geometry.Zone +--import Geometry.Zone import qualified IntMapHelp as IM import Padding import Picture @@ -285,18 +286,20 @@ drawFarWallDetect w = drawDDATest :: World -> Picture drawDDATest w = - runIdentity (S.foldMap_ (drawZoneCol orange 50) ps) - <> runIdentity (S.foldMap_ (drawZoneCol green 50) ps') - <> runIdentity (S.foldMap_ drawCross qs) - <> color blue (runIdentity (S.foldMap_ drawCross qs')) + foldMap (drawZoneCol orange 50) ps +-- runIdentity (S.foldMap_ (drawZoneCol orange 50) ps) +-- <> runIdentity (S.foldMap_ (drawZoneCol green 50) ps') +-- <> runIdentity (S.foldMap_ drawCross qs) +-- <> color blue (runIdentity (S.foldMap_ drawCross qs')) <> setLayer DebugLayer (color yellow (line [cvf, mwp])) where cvf = _cameraViewFrom (_cWorld w) mwp = mouseWorldPos w - ps = ddaStreamX 50 cvf mwp - ps' = ddaStreamY 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w) - qs = xIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w) - qs' = yIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w) + --ps = ddaStreamX 50 cvf mwp + ps = zoneOfSeg' 50 cvf mwp + --ps' = ddaStreamY 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w) + --qs = xIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w) + --qs' = yIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w) drawCross :: Point2 -> Picture drawCross p = setLayer DebugLayer . color red . uncurryV translate p $ crossPic 5 diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index c64c04e83..43b373c8a 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -96,7 +96,7 @@ healthTest n = do return $ treePost [ door - , corridor & rmPmnts .:~ spNoID (PS 20 0) (PutFlIt (medkit 100)) + , corridor & rmPmnts .:~ psPtPl (PS 20 0) (PutFlIt (medkit 100)) , cenroom , triggerDoorRoom n , cleatOnward door diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index 4f5d7265d..affdb1616 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -101,8 +101,8 @@ glassSwitchBack = do glassSwitchBackCrits :: RandomGen g => State g Room glassSwitchBackCrits = glassSwitchBack <&> rmPmnts - .++~ [ spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit miniGunCrit) - , spNoID (PSRoomRand 1 (uncurry PS)) randC1 + .++~ [ psPtPl (PSRoomRand 0 (uncurry PS)) (PutCrit miniGunCrit) + , psPtPl (PSRoomRand 1 (uncurry PS)) randC1 ] miniTree2 :: RandomGen g => State g (Tree Room) @@ -262,7 +262,7 @@ weaponRoom i = roomCCrits :: RandomGen g => Int -> State g Room roomCCrits i = roomC 200 200 - <&> rmPmnts .++~ replicate i (spNoID (PSRoomRand 0 (uncurry PS)) randC1) + <&> rmPmnts .++~ replicate i (psPtPl (PSRoomRand 0 (uncurry PS)) randC1) doubleCorridorBarrels :: RandomGen g => State g Room doubleCorridorBarrels = do @@ -310,14 +310,14 @@ shootersRoom1 = .:~ RandomPlacement ( takeOne $ map - (\i -> spNoID (PSRoomRand i (uncurry PS)) (PutCrit autoCrit)) + (\i -> psPtPl (PSRoomRand i (uncurry PS)) (PutCrit autoCrit)) [0, 1, 2] ) shootersRoom :: RandomGen g => State g Room shootersRoom = shootersRoom' <&> rmPmnts - .++~ map (\i -> spNoID (PSRoomRand i (uncurry PS)) (PutCrit autoCrit)) [0, 1, 2] + .++~ map (\i -> psPtPl (PSRoomRand i (uncurry PS)) (PutCrit autoCrit)) [0, 1, 2] -- TODO stop from spawning on inlinks fromedge pistolerRoom :: RandomGen g => State g Room @@ -326,7 +326,7 @@ pistolerRoom = do roomPillars 10 w 200 wn 3 <&> rmPmnts .++~ replicate 3 - ( spNoID + ( psPtPl (rprBool $ \rp _ -> _rpPlacementUse rp == 0 && rpIsOnPath rp) (PutCrit pistolCrit) ) @@ -365,7 +365,7 @@ spawnerRoom = do y <- state $ randomR (300, 400) roomWithSpawner <- roomC x y <&> rmPmnts - .:~ spNoID + .:~ psPtPl ( rprBool $ \rp _ -> _rpPlacementUse rp == 0 && rpIsOnPath rp && xV2 (_rpPos rp) < x / 2 diff --git a/src/Dodge/Tesla/Arc.hs b/src/Dodge/Tesla/Arc.hs index 3eba3d3a7..5fbfaedd2 100644 --- a/src/Dodge/Tesla/Arc.hs +++ b/src/Dodge/Tesla/Arc.hs @@ -1,4 +1,7 @@ -module Dodge.Tesla.Arc where +module Dodge.Tesla.Arc + ( shootTeslaArc' + , moveTeslaArc + ) where import Dodge.Data.CrWlID import Dodge.Data.ArcStep @@ -45,7 +48,6 @@ moveTeslaArc w pt ArcStep lp' ld' (WlID wlid) -> case w ^? cWorld . walls . ix wlid of Nothing -> (lp', ld') Just _ -> (lp' -.- 2 *.* unitVectorAtAngle ld', ld' + pi) - --damthings (ArcStep _ _ NothingID) = id damthings (ArcStep p dir crwl) = damageCrWlID (thedamage p dir) crwl thedamage p dir = Damage ELECTRICAL 50 (p -.- q) p (p +.+ q) NoDamageEffect where diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index 7162a095e..738391db3 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -11,19 +11,16 @@ import Dodge.Data.World import Dodge.Wall.DamageEffect import LensHelp +-- maybeDestroyDoor should rather happen during the door mechanism update damageWall :: Damage -> Wall -> World -> World damageWall dt wl w = case _wlStructure wl of - MachinePart mcid -> - fst . defaultWallDamage dt wl $ - w - & cWorld . machines . ix mcid . mcDamage .:~ dt - BlockPart blid -> - let (w', x) = defaultWallDamage dt wl w - in w' & cWorld . blocks . ix blid . blHP -~ x & maybeDestroyBlock blid - DoorPart drid -> - let (w', x) = defaultWallDamage dt wl w - in w' & cWorld . doors . ix drid . drHP -~ x & maybeDestroyDoor drid - _ -> fst $ defaultWallDamage dt wl w + MachinePart mcid -> w' & cWorld . machines . ix mcid . mcDamage .:~ dt + BlockPart blid -> w' & cWorld . blocks . ix blid . blHP -~ x & maybeDestroyBlock blid + DoorPart drid -> w' & cWorld . doors . ix drid . drHP -~ x & maybeDestroyDoor drid + _ -> w' + where + x = dt' ^. dmAmount + (w', dt') = damageWallEffect dt wl w -- block destruction is convoluted... maybeDestroyBlock :: Int -> World -> World diff --git a/src/Dodge/Wall/DamageEffect.hs b/src/Dodge/Wall/DamageEffect.hs index 789184e06..04ced2be4 100644 --- a/src/Dodge/Wall/DamageEffect.hs +++ b/src/Dodge/Wall/DamageEffect.hs @@ -8,10 +8,10 @@ import Dodge.Wall.Dust import Geometry import LensHelp -defaultWallDamage :: Damage -> Wall -> World -> (World, Int) -defaultWallDamage dm wl = case _wlMaterial wl of +damageWallEffect :: Damage -> Wall -> World -> (World, Damage) +damageWallEffect dm wl = case _wlMaterial wl of Stone -> stoneWallDamage dm wl - Glass -> windowWallDamage dm wl + Glass -> glassWallDamage dm wl Dirt -> dirtWallDamage dm wl Crystal -> crystalWallDamage dm wl Metal -> stoneWallDamage dm wl @@ -19,7 +19,9 @@ defaultWallDamage dm wl = case _wlMaterial wl of Electronics -> stoneWallDamage dm wl Flesh -> stoneWallDamage dm wl -stoneWallDamage :: Damage -> Wall -> World -> (World, Int) +-- there is quite a lot of duplication here, should be sorted out + +stoneWallDamage :: Damage -> Wall -> World -> (World, Damage) stoneWallDamage dm wl = case _dmType dm of LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl) PIERCING -> a d $ colSparkRandDir 0.2 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo @@ -37,7 +39,7 @@ stoneWallDamage dm wl = case _dmType dm of POISONDAM -> a 0 id ENTERREMENT -> a 0 id where - a x f w = (f w, x) + a x f w = (f w, dm & dmAmount .~ x) d = _dmAmount dm sp = _dmFrom dm p = _dmAt dm @@ -45,8 +47,8 @@ stoneWallDamage dm wl = case _dmType dm of pSparkCol = V4 5 1 0.5 2 lSparkCol = V4 20 (-5) 0 1 -windowWallDamage :: Damage -> Wall -> World -> (World, Int) -windowWallDamage dm wl w = +glassWallDamage :: Damage -> Wall -> World -> (World, Damage) +glassWallDamage dm wl w = w & case _dmType dm of LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl) PIERCING -> a d $ dosplint . colSparkRandDir 0.2 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo @@ -69,8 +71,8 @@ windowWallDamage dm wl w = w ^? cWorld . blocks . ix blid d :: Int d = max 1 $ maybe 1 (subtract 1 . _blHP) mbl - a :: Int -> (World -> World) -> World -> (World, Int) - a x f w' = (f w', x) + a :: Int -> (World -> World) -> World -> (World, Damage) + a x f w' = (f w', dm & dmAmount .~ x) dosplint = maybe id splinterBlock mbl sp = _dmFrom dm p = _dmAt dm @@ -78,7 +80,7 @@ windowWallDamage dm wl w = pSparkCol = V4 5 1 0.5 2 lSparkCol = V4 20 (-5) 0 1 -crystalWallDamage :: Damage -> Wall -> World -> (World, Int) +crystalWallDamage :: Damage -> Wall -> World -> (World, Damage) crystalWallDamage dm wl = case _dmType dm of LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl) PIERCING -> a 0 $ colSparkRandDir 0.2 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo @@ -96,7 +98,7 @@ crystalWallDamage dm wl = case _dmType dm of POISONDAM -> a 0 id ENTERREMENT -> a 0 id where - a x f w = (f w, x) + a x f w = (f w, dm & dmAmount .~ x) d = _dmAmount dm sp = _dmFrom dm p = _dmAt dm @@ -104,7 +106,7 @@ crystalWallDamage dm wl = case _dmType dm of pSparkCol = V4 5 1 0.5 2 lSparkCol = V4 20 (-5) 0 1 -dirtWallDamage :: Damage -> Wall -> World -> (World, Int) +dirtWallDamage :: Damage -> Wall -> World -> (World, Damage) dirtWallDamage dm wl = case _dmType dm of LASERING -> a d $ wlDustAt wl outTo PIERCING -> a d $ wlDustAt wl outTo @@ -122,7 +124,7 @@ dirtWallDamage dm wl = case _dmType dm of POISONDAM -> a 0 id ENTERREMENT -> a 0 id where - a x f w = (f w, x) + a x f w = (f w, dm & dmAmount .~ x) d = _dmAmount dm sp = _dmFrom dm p = _dmAt dm