Fix no damage to walls bug

2022-07-28 18:57:53 +01:00
parent ec4ff84c46
commit c8ad3e1294
19 changed files with 177 additions and 158 deletions
@@ -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
@@ -17,6 +17,7 @@ data Sensor
        , _sensAmount :: Int
        , _sensType :: DamageType
        , _sensDraw :: (PaletteColor, DecorationShape)
+        , _sensThreshold :: Int
        }
    | ProximitySensor
        { _proxStatus :: CloseToggle
@@ -84,7 +84,6 @@ shieldWall crid =
        , _wlWalkable = True
        , _wlFireThrough = True
        , _wlReflect = True
-        , _wlUnshadowed = False
        , _wlRotateTo = False
        , _wlStructure = CreaturePart crid -- shieldWallDamage
        }
@@ -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)
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
-
@@ -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 =
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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