Make machines have footprint like doors

src/Dodge/Placement/Instance/Sensor.hs

@@ -9,14 +9,15 @@ import Dodge.Default
 import Dodge.LevelGen.PlacementHelper
 import Dodge.LightSource
 import Geometry
+import qualified Data.IntMap.Strict as IM
 
 damageSensor :: SensorType -> Float -> Maybe Int -> PlacementSpot -> Placement
 damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
     \lsid ->
         psPtJpl ps $
             PutMachine
-                (reverse $ square wdth)
                 ( defaultMachine
+                    & mcFootPrint .~ IM.fromDistinctAscList (zip [0..] . loopPairs . reverse $ square wdth)
                     & mcSkin .~ mattype
                     & mcMounts . at OTTrigger .~ mtrid
                     & mcMounts . at OTLightSource ?~ lsid

src/Dodge/Placement/Instance/Terminal.hs

@@ -4,6 +4,7 @@ module Dodge.Placement.Instance.Terminal (
     putTerminal,
 ) where
 
+import qualified Data.IntMap.Strict as IM
 import Data.Maybe
 import Dodge.Data.GenWorld
 import Dodge.Default
@@ -29,9 +30,9 @@ putTerminalFull f mc tm =
                 \btpl -> Just $
                     pt0
                         ( PutMachine
-                            (reverse $ square 10)
                             ( mc & mcMounts . at OTButton ?~ fromJust (_plMID btpl)
                                 & mcMounts . at OTTerminal .~ _plMID tmpl
+                                & mcFootPrint .~ IM.fromDistinctAscList (zip [0..] . loopPairs . reverse $ square 10)
                             )
                             Nothing
                         )

src/Dodge/Placement/Instance/Turret.hs

@@ -1,5 +1,4 @@
-module Dodge.Placement.Instance.Turret 
-    (putLasTurret) where
+module Dodge.Placement.Instance.Turret (putLasTurret) where
 
 import Dodge.Item.Held.BatteryGuns
 import Dodge.Data.GenWorld
@@ -7,6 +6,7 @@ import Dodge.Default
 import Dodge.LevelGen.PlacementHelper
 import Geometry
 import LensHelp
+import qualified Data.IntMap.Strict as IM
 
 --putTurret :: Item -> Float -> Placement
 --putTurret itm rotSpeed =
@@ -24,8 +24,8 @@ putLasTurret :: Float -> Placement
 putLasTurret rotSpeed =
     sps0 $
         PutMachine
-            (reverse $ square 10)
             ( defaultMachine
+                    & mcFootPrint .~ IM.fromDistinctAscList (zip [0..] . loopPairs . reverse $ square 10)
 --                & mcColor .~ blue
                 & mcType .~ (lasTurret & mctTurret . tuTurnSpeed .~ rotSpeed)
                 & mcHP .~ 1500

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)

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -9,11 +9,7 @@ import Dodge.ShiftPoint
 import qualified IntMapHelp as IM
 import LensHelp
 
-plDoor ::
-    Door ->
-    Wall ->
-    GenWorld ->
-    (Int, GenWorld)
+plDoor :: Door -> Wall -> GenWorld -> (Int, GenWorld)
 plDoor dr wl gw = 
     ( drid
     , over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors . at drid ?~ newdr