Make machines have footprint like doors

src/Dodge/Placement/PlaceSpot.hs

@@ -10,7 +10,6 @@ module Dodge.Placement.PlaceSpot (placeSpot) where
 import Control.Monad.Trans.State.Lazy
 import Data.Bifunctor
 import Data.Foldable
-import qualified Data.IntSet as IS
 import Data.Maybe
 import qualified Data.Set as S
 import Dodge.Base.NewID
@@ -127,7 +126,7 @@ placeSpotID rid ps pt w = case pt of
     PutCrit cr -> plNewUpID (gwWorld . cWorld . lWorld . creatures) crID (mvCr p rot cr) w
     PutForeground fs ->
         (0, w & gwWorld . cWorld . lWorld . foreShapes .:~ mvFS p rot fs)
-    PutMachine pps mc mitm -> plMachine (map doShift pps) mc mitm p rot w
+    PutMachine mc mitm -> plMachine mc mitm p rot w
     PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p rot ls) w
     RandPS _ -> error "RandPS should not be reachable here" -- evaluateRandPS rid rgn ps w
     PutDoor dr wl -> plDoor (dr & drZeroPos %~ pashift & drOnePos %~ pashift) wl w
@@ -189,31 +188,42 @@ mvFS :: Point2 -> Float -> ForegroundShape -> ForegroundShape
 mvFS p a = (fsDir +~ a) . (fsPos %~ ((p +) . rotateV a))
 
 plMachine ::
-    [Point2] ->
+--    [Point2] ->
     Machine ->
     Maybe Item ->
     Point2 ->
     Float ->
     GenWorld ->
     (Int, GenWorld)
-plMachine wallpoly mc mitm p rot gw =
+plMachine mc mitm p rot gw =
     ( mcid
     , gw
-        & tolw
-        . machines
-        . at mcid
-        ?~ themc
-        & gwWorld
-        %~ placeMachineWalls (_mcSkin mc) wallpoly mcid wlid
-        & tolw
-        %~ maybe id placeturretitm mitm
+        & tolw . machines . at mcid ?~ themc
+        & tolw %~ maybe id placeturretitm mitm
+        & gwWorld %~ addwalls
+        -- & gwWorld %~ placeMachineWalls (_mcSkin mc) wallpoly mcid wlid
     )
   where
+    addwalls =
+        insertStructureWalls
+            MachinePart
+            wl
+            (map fst pps & each %~ shiftPointBy (p,rot))
+            mcid
+            wlid
+    pps = IM.elems $ mc ^. mcFootPrint
+    wl = 
+        defaultMachineWall
+            & wlStructure . wsMachine .~ mcid
+            & wlMaterial .~ (mc ^. mcSkin)
     tolw = gwWorld . cWorld . lWorld
     mcid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . machines
     wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
-    wlids = IS.fromList $ take (length wallpoly) [wlid ..]
-    themc = mc{_mcPos = p, _mcDir = rot, _mcID = mcid, _mcWallIDs = wlids}
+    themc = mc
+        & mcPos .~ p
+        & mcDir .~ rot  
+        & mcID .~ mcid
+        & mcFootPrint .~ IM.fromDistinctAscList (zip [wlid..] pps)
     placeturretitm itm =
         (items . at itid ?~ itm')
             . (machines . ix mcid . mcType . mctTurret . tuWeapon .~ itid)
@@ -221,16 +231,5 @@ plMachine wallpoly mc mitm p rot gw =
         itid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . items
         itm' = itm & itID .~ NInt itid & itLocation .~ OnTurret mcid
 
-placeMachineWalls :: Material -> [Point2] -> Int -> Int -> World -> World
-placeMachineWalls mat poly mcid = insertStructureWalls MachinePart baseWall poly mcid
-  where
-    baseWall =
-        defaultMachineWall
-            & wlStructure
-            . wsMachine
-            .~ mcid
-            & wlMaterial
-            .~ mat
-
 mvLS :: Point2 -> Float -> LightSource -> LightSource
 mvLS x rot = lsParam . lsPos . _xy %~ ((+ x) . rotateV rot)