Fix no damage to walls bug

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

src/Dodge/Data/Machine/Sensor.hs

@@ -17,6 +17,7 @@ data Sensor
         , _sensAmount :: Int
         , _sensType :: DamageType
         , _sensDraw :: (PaletteColor, DecorationShape)
+        , _sensThreshold :: Int
         }
     | ProximitySensor
         { _proxStatus :: CloseToggle

src/Dodge/Euse.hs

@@ -84,7 +84,6 @@ shieldWall crid =
         , _wlWalkable = True
         , _wlFireThrough = True
         , _wlReflect = True
-        , _wlUnshadowed = False
         , _wlRotateTo = False
         , _wlStructure = CreaturePart crid -- shieldWallDamage
         }

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 $
+              IntAnno $ PassthroughLockKeyLists keyCardRunPastRand itemRooms
-                PassthroughLockKeyLists
-                    [(sensorRoomRunPast ELECTRICAL, takeOne [CRAFT STATICMODULE, HELD SPARKGUN])]
-                    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)
+                            .++~ [ psPtPl anyUnusedSpot (PutCrit invisibleChaseCrit)
-                                 , spNoID anyUnusedSpot (PutCrit armourChaseCrit)
+                                 , psPtPl anyUnusedSpot (PutCrit armourChaseCrit)
                                  ]
             , IntAnno $ AnTree . fmap (tToBTree "healthTest") . healthTest
             , AnTree (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)

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

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

src/Dodge/LevelGen/Data.hs

@@ -5,8 +5,12 @@ import Data.Maybe
 import Dodge.Data.GenWorld
 import Geometry
 
-spNoID :: PlacementSpot -> PSType -> Placement
+--spNoID
-spNoID ps pst = Placement 10 ps pst Nothing (const . const Nothing)
+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

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

src/Dodge/Machine/Draw.hs

@@ -1,35 +1,40 @@
-module Dodge.Machine.Draw
+module Dodge.Machine.Draw where
-    where
+
-import Dodge.Item.HeldOffset
-import Dodge.Item.Draw.SPic
-import Dodge.Placement.TopDecoration
-import Shape
-import Picture
-import Geometry
 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
+    McTurret tu -> drawBaseMachine 20 mc <> drawTurret tu mc
-    McSensor se -> drawSensor se mc
+    McSensor se -> drawBaseMachine 25 mc <> drawSensor se mc
 
 drawSensor :: Sensor -> Machine -> SPic
 drawSensor sens = case sens of
-    DamageSensor {_sensDraw = pcds} -> sensorSPic pcds
+    DamageSensor{_sensDraw = pcds} -> sensorSPic pcds
-    ProximitySensor {} -> const mempty
+    ProximitySensor{} -> const mempty
 
 terminalSPic :: Machine -> SPic
 terminalSPic = noPic . terminalShape
 
 terminalShape :: Machine -> Shape
-terminalShape mc = colorSH col (prismPoly
+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
+        <> 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]
@@ -38,21 +43,19 @@ terminalShape mc = colorSH col (prismPoly
   where
     col = _mcColor mc
 
-drawTurret :: Turret -> Machine -> SPic
+drawBaseMachine :: Float -> Machine -> SPic
-drawTurret tu mc =
+drawBaseMachine h mc =
-    ( colorSH (_mcColor mc) $ upperPrismPoly 20 (square w)
+    ( 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 $
+    noPic $ decorationToShape ds w w 25 col col
-        colorSH (_mcColor mc) (upperPrismPoly 25 (square w))
-            <> decorationToShape ds w w 25 col col
   where
     col = paletteToColor pc
     w = _mcWidth mc

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,23 +19,17 @@ updateMachine mc
     | otherwise =
         mcApplyDamage (_mcDamage mc) mc
             . mcPlaySound mc
-            . mcSensorTriggerUpdate mc
+            . mcTypeUpdate mc
-            . mcTurretUpdate mc
-            . mcSensorUpdate mc
 
-mcTurretUpdate :: Machine -> World -> World
+mcTypeUpdate :: Machine -> World -> World
-mcTurretUpdate mc = case mc ^? mcType . _McTurret of
+mcTypeUpdate mc = case mc ^. mcType of
-    Just tu -> updateTurret (_tuTurnSpeed tu) mc
+    McStatic -> id
-    _ -> 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
+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
@@ -77,17 +66,16 @@ mcUseItem mc = fromMaybe id $ do
     guard (_tuFireTime tu > 0)
     return $ mcUseHeld hit it mc
 
-mcSensorTriggerUpdate :: Machine -> World -> World
+mcSensorTriggerUpdate :: Sensor -> Machine -> World -> World
-mcSensorTriggerUpdate mc = fromMaybe id $ do
+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 :: Sensor -> Maybe Bool
-mcTriggerVal mc = case mc ^? mcType . _McSensor of
+mcTriggerVal se = case se of
-    Nothing -> Nothing
+    ProximitySensor{} -> se ^? sensToggle
-    Just s@ProximitySensor{} -> s ^? sensToggle
+    DamageSensor{} -> Just $ _sensAmount se > _sensThreshold se
-    Just s@DamageSensor{} -> Just $ _sensAmount s > 900
 
 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 ->
+    Nothing -> mcpointer
-        cWorld . machines . ix (_mcID mc)
             %~ ((mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)))
-    _ -> id
+    _ -> mcpointer
+            %~ (mcDamage .~ [])
+  where
+    mcpointer = cWorld . machines . ix (_mcID mc)
 
-mcSensorUpdate :: Machine -> World -> World
+mcSensorUpdate :: Sensor -> Machine -> World -> World
-mcSensorUpdate mc w = case mc ^? mcType . _McSensor of
+mcSensorUpdate se mc w = case se of
-    Nothing -> w
+    s@DamageSensor{} -> senseDamage (_sensThreshold se) (_sensType s) mc w
-    Just s@DamageSensor{} -> senseDamage (_sensType s) mc w
+    ProximitySensor{} -> mcProximitySensorUpdate mc w
-    Just 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 :: Int -> DamageType -> Machine -> World -> World
-senseDamage dt mc =
+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)
+    newsense
-    ni = fromIntegral (mc ^?! mcType . _McSensor . sensAmount) / 1000
+        | 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

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

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 $
+    \lsid -> psPtJpl ps $
-        spNoID ps $
         PutUsingGenParams $
             \gw ->
-                    (,) gw $
+                ( gw
-                        PutMachine
+                , 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)
+                        & 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
-

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 =

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)
+    foldMap (drawZoneCol orange 50) ps
-        <> runIdentity (S.foldMap_ (drawZoneCol green 50) ps')
+--    runIdentity (S.foldMap_ (drawZoneCol orange 50) ps)
-        <> runIdentity (S.foldMap_ drawCross qs)
+--        <> runIdentity (S.foldMap_ (drawZoneCol green 50) ps')
-        <> color blue (runIdentity (S.foldMap_ drawCross qs'))
+--        <> 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 = ddaStreamX 50 cvf mwp
-    ps' = ddaStreamY 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
+    ps = zoneOfSeg' 50 cvf mwp
-    qs = xIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
+    --ps' = ddaStreamY 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
-    qs' = yIntercepts 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

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

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)
+        .++~ [ psPtPl (PSRoomRand 0 (uncurry PS)) (PutCrit miniGunCrit)
-             , spNoID (PSRoomRand 1 (uncurry PS)) randC1
+             , 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

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

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 ->
+    MachinePart mcid -> w' & cWorld . machines . ix mcid . mcDamage .:~ dt
-        fst . defaultWallDamage dt wl $
+    BlockPart blid -> w' & cWorld . blocks . ix blid . blHP -~ x & maybeDestroyBlock blid
-            w
+    DoorPart drid -> w' & cWorld . doors . ix drid . drHP -~ x & maybeDestroyDoor drid
-                & cWorld . machines . ix mcid . mcDamage .:~ dt
+    _ -> w'
-    BlockPart blid ->
+  where
-        let (w', x) = defaultWallDamage dt wl w
+    x = dt' ^. dmAmount
-         in w' & cWorld . blocks . ix blid . blHP -~ x & maybeDestroyBlock blid
+    (w', dt') = damageWallEffect dt wl w
-    DoorPart drid ->
-        let (w', x) = defaultWallDamage dt wl w
-         in w' & cWorld . doors . ix drid . drHP -~ x & maybeDestroyDoor drid
-    _ -> fst $ defaultWallDamage dt wl w
 
 -- block destruction is convoluted...
 maybeDestroyBlock :: Int -> World -> World

src/Dodge/Wall/DamageEffect.hs

@@ -8,10 +8,10 @@ import Dodge.Wall.Dust
 import Geometry
 import LensHelp
 
-defaultWallDamage :: Damage -> Wall -> World -> (World, Int)
+damageWallEffect :: Damage -> Wall -> World -> (World, Damage)
-defaultWallDamage dm wl = case _wlMaterial wl of
+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)
+glassWallDamage :: Damage -> Wall -> World -> (World, Damage)
-windowWallDamage dm wl w =
+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 :: Int -> (World -> World) -> World -> (World, Damage)
-    a x f w' = (f w', x)
+    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