Simplify machine placement

src/Dodge/Data/GenWorld.hs

@@ -33,7 +33,7 @@ data PSType
     | PutMachine
         { _putMachinePoly :: [Point2]
         , _putMachineMachine :: Machine
-        , _putMachineWall :: Wall
+--        , _putMachineWall :: Wall
         , _putMachineMaybeItem :: Maybe Item
         }
     | PutLS LightSource

src/Dodge/Data/Wall.hs

@@ -32,7 +32,7 @@ data Wall = Wall
 
 data Opacity
     = SeeThrough
-    | SeeAbove
+    | SeeAbove  -- these are not drawn themselves, but the "owning" machine or block should draw them
     | DrawnWall {_opDraw :: WallDraw} -- Wall -> SPic
     | Opaque {_opTexture :: Int}
     deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/Default/Wall.hs

@@ -19,7 +19,6 @@ defaultWall =
     Wall
         { _wlLine = (V2 0 0, V2 50 0)
         , _wlID = 0
---        , _wlColor = greyN 0.6
         , _wlPathFlag =
             S.fromList
                 [ WallBlockVisibility
@@ -55,6 +54,7 @@ defaultMachineWall =
         , _wlRotateTo = False
         , _wlStructure = MachinePart 0
         , _wlMaterial = Metal
+        , _wlTouchThrough = True
         }
 
 defaultSensorWall :: Wall

src/Dodge/Placement/Instance/Sensor.hs

@@ -29,7 +29,7 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
                                 (damageTypeThreshold dt)
                             )
                 )
-                defaultSensorWall
+--                defaultMachineWall
                 Nothing
 
 damageTypeThreshold :: SensorType -> Int

src/Dodge/Placement/Instance/Terminal.hs

@@ -36,7 +36,7 @@ putTerminalFull f col mc tm =
                             ( mc & mcMounts . at OTButton ?~ fromJust (_plMID btpl)
                                 & mcMounts . at OTTerminal .~ _plMID tmpl
                             )
-                            defaultSensorWall
+--                            defaultMachineWall
                             Nothing
                         )
                         $ \mcpl -> Just $ pt0 (PutWorldUpdate $ const $ const $ over gwWorld  (setids tmpl btpl mcpl)) (\_ -> f tmpl btpl mcpl)

src/Dodge/Placement/Instance/Turret.hs

@@ -18,7 +18,6 @@ putTurret itm rotSpeed =
                 & mcType .~ (turret itm & _McTurret . tuTurnSpeed .~ rotSpeed)
                 & mcHP .~ 50000
             )
-            defaultMachineWall
             (Just itm)
 
 putLasTurret :: Float -> Placement
@@ -31,7 +30,6 @@ putLasTurret rotSpeed =
                 & mcType .~ (lasTurret & _McTurret . tuTurnSpeed .~ rotSpeed)
                 & mcHP .~ 50000
             )
-            defaultMachineWall
             (Just laser)
 
 turret :: Item -> MachineType

src/Dodge/Placement/PlaceSpot.hs

@@ -6,6 +6,7 @@
 -}
 module Dodge.Placement.PlaceSpot (placeSpot) where
 
+import Dodge.Default.Wall
 import qualified Data.Set as S
 import Control.Monad.State
 import Data.Bifunctor
@@ -130,7 +131,8 @@ placeSpotID rid ps pt w = case pt of
             fsID
             (mvFS p rot fs)
             w
-    PutMachine pps mc wl mitm -> plMachine (map doShift pps) mc wl mitm p rot w
+    --PutMachine pps mc wl mitm -> plMachine (map doShift pps) mc wl mitm p rot w
+    PutMachine pps mc mitm -> plMachine (map doShift pps) 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 col eo f pss -> plDoor col eo f (map (bimap doShift doShift) pss) w
@@ -206,29 +208,29 @@ mvFS p a = (fsDir +~ a) . (fsPos %~ ((p +.+) . rotateV a))
 plMachine ::
     [Point2] ->
     Machine ->
-    Wall ->
+--    Wall ->
     Maybe Item ->
     Point2 ->
     Float ->
     GenWorld ->
     (Int, GenWorld)
-plMachine wallpoly mc wl = \case
+plMachine wallpoly mc = \case
-    Nothing -> plMachine' wallpoly mc wl
+    Nothing -> plMachine' wallpoly mc 
-    Just itm -> plTurret wallpoly mc wl itm
+    Just itm -> plTurret wallpoly mc  itm
 
 plTurret ::
     [Point2] ->
     Machine ->
-    Wall ->
+--    Wall ->
     Item ->
     Point2 ->
     Float ->
     GenWorld ->
     (Int, GenWorld)
-plTurret wallpoly mc wl itm p rot gw =
+plTurret wallpoly mc itm p rot gw =
     ( mcid
     , gw & gwWorld . cWorld . lWorld . machines %~ addMc
-        & gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wl wallpoly mcid wlid
+        & gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wallpoly mcid wlid
         & gwWorld . cWorld . lWorld . items . at itid ?~ itm'
     )
   where
@@ -246,11 +248,11 @@ plTurret wallpoly mc wl itm p rot gw =
                 & mcType . mctTurret . tuWeapon .~ itid
             )
 
-plMachine' :: [Point2] -> Machine -> Wall -> Point2 -> Float -> GenWorld -> (Int, GenWorld)
+plMachine' :: [Point2] -> Machine ->  Point2 -> Float -> GenWorld -> (Int, GenWorld)
-plMachine' wallpoly mc wl p rot gw =
+plMachine' wallpoly mc p rot gw =
     ( mcid
     , gw & gwWorld . cWorld . lWorld . machines %~ addMc
-        & gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wl wallpoly mcid wlid
+        & gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wallpoly mcid wlid
     )
   where
     mcid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . machines
@@ -259,14 +261,12 @@ plMachine' wallpoly mc wl p rot gw =
     addMc = IM.insert mcid (mc{_mcPos = p, _mcDir = rot, _mcID = mcid, _mcWallIDs = wlids})
 
 -- TODO correctly remove/shift pathfinding lines (removePathsCrossing)
-placeMachineWalls ::
+placeMachineWalls :: [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
-    Wall -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
+placeMachineWalls poly mcid wlid = flip (foldr f) $ zip [wlid ..] $ loopPairs poly
-placeMachineWalls wl poly mcid wlid = flip (foldr f) $ zip [wlid ..] $ loopPairs poly
   where
     f (wid, l) = IM.insert wid baseWall{_wlID = wid, _wlLine = l}
     baseWall =
-        wl
+        defaultMachineWall
---            & wlColor .~ col
             & wlStructure . wsMachine .~ mcid
             & wlTouchThrough .~ True