Remove separate wall color, should be handled by material type

src/Dodge/Placement/Instance/Block.hs

@@ -18,7 +18,7 @@ decoratedBlock decf mat col h ps = PutBlock bl wl $ reverse ps
             & blMaterial .~ mat
     wl =
         defaultWall
-            & wlColor .~ col
+--            & wlColor .~ col
             & wlRotateTo .~ False
             & wlOpacity .~ SeeAbove
             & wlMaterial .~ mat

src/Dodge/Placement/Instance/Door.hs

@@ -111,7 +111,8 @@ switchDoor btpos btrot dra drb col = pContID
         jsps0J (doorbetween btid dra drc) $
             sps0 (doorbetween btid drb drc)
   where
-    doorbetween btid a b = PutSlideDr thedoor (switchWallCol col) 
+    --doorbetween btid a b = PutSlideDr thedoor (switchWallCol col) 
+    doorbetween btid a b = PutSlideDr thedoor defaultSwitchWall 
         (S.fromList (WallObstacle <$> [WallNotAutoOpen,WallBlockVisibility])) 1 a b
       where
         thedoor =

src/Dodge/Placement/Instance/Wall.hs

@@ -1,6 +1,6 @@
 module Dodge.Placement.Instance.Wall where
 
-import Color
+import Dodge.Material.Color
 import Control.Lens
 import Data.List
 import Dodge.Data.GenWorld
@@ -11,7 +11,7 @@ import Dodge.Placement.Instance.Block
 import Geometry
 
 heightWallPS :: PlacementSpot -> Float -> [Point2] -> Placement
-heightWallPS spot h ps = psPtPl spot $ lowBlock Stone (_wlColor defaultWall) h ps
+heightWallPS spot h ps = psPtPl spot $ lowBlock Stone (materialColor Stone) h ps
 
 invisibleWall :: [Point2] -> Placement
 invisibleWall ps =
@@ -89,12 +89,10 @@ baseBlockPane =
         { _wlLine = (V2 0 0, V2 50 0)
         , _wlID = 0
         --, _wlColor = greyN 0.5
-        , _wlColor = dark $ dark orange
+--        , _wlColor = dark $ dark orange
         --, _wlOpacity = Opaque 10
         , _wlOpacity = Opaque 17
         , _wlUnshadowed = True
-        , _wlFireThrough = False
-        , _wlPenetrable = True
         }
 
 -- TODO find home for this

src/Dodge/Placement/PlaceSpot.hs

@@ -7,7 +7,6 @@
 module Dodge.Placement.PlaceSpot (placeSpot) where
 
 import qualified Data.Set as S
-import Color
 import Control.Monad.State
 import Data.Bifunctor
 import Data.Foldable
@@ -135,7 +134,7 @@ placeSpotID rid ps pt w = case pt of
     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
-    PutDoor col eo f l p1 p2 -> plDoor col eo f l (pashift p1) (pashift p2)  w
+    PutDoor eo f l p1 p2 -> plDoor eo f l (pashift p1) (pashift p2)  w
     PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
     PutSlideDr wl dr eo off a b ->
         plSlideDoor wl dr eo off (doShift a) (doShift b) w
@@ -229,7 +228,7 @@ plTurret ::
 plTurret wallpoly mc wl itm p rot gw =
     ( mcid
     , gw & gwWorld . cWorld . lWorld . machines %~ addMc
-        & gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
+        & gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wl wallpoly mcid wlid
         & gwWorld . cWorld . lWorld . items . at itid ?~ itm'
     )
   where
@@ -237,7 +236,6 @@ plTurret wallpoly mc wl itm p rot gw =
         itm & itID .~ NInt itid
             & itLocation .~ OnTurret mcid
     itid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . items
-    col = _mcColor mc
     mcid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . machines
     wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
     wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
@@ -252,10 +250,9 @@ plMachine' :: [Point2] -> Machine -> Wall -> Point2 -> Float -> GenWorld -> (Int
 plMachine' wallpoly mc wl p rot gw =
     ( mcid
     , gw & gwWorld . cWorld . lWorld . machines %~ addMc
-        & gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
+        & gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wl wallpoly mcid wlid
     )
   where
-    col = _mcColor mc
     mcid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . machines
     wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
     wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
@@ -263,13 +260,13 @@ plMachine' wallpoly mc wl p rot gw =
 
 -- TODO correctly remove/shift pathfinding lines (removePathsCrossing)
 placeMachineWalls ::
-    Wall -> Color -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
-placeMachineWalls wl col poly mcid wlid = flip (foldr f) $ zip [wlid ..] $ loopPairs poly
+    Wall -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
+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
-            & wlColor .~ col
+--            & wlColor .~ col
             & wlStructure . wsMachine .~ mcid
             & wlTouchThrough .~ True
 

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -15,10 +15,8 @@ import Dodge.Path
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
-import Picture
 
 plDoor ::
-    Color ->
     S.Set EdgeObstacle ->
     -- | Opening condition
     WdBl ->
@@ -29,7 +27,7 @@ plDoor ::
     Point2A ->
     GenWorld ->
     (Int, GenWorld)
-plDoor col eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
+plDoor eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
   where
     drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
     addDoor =
@@ -45,7 +43,8 @@ plDoor col eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cW
                 }
     wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld $ _gwWorld gw)) ..]
     wlps' = rectanglePairs 9 0 (V2 l 0)
-    addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids
+    --addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids
+    addWalls w' = foldl' (addDoorWall eo drid $ defaultSwitchWall) w' $ zip wlids
         $ wlps' & each . each %~ shiftPointBy p1
 
 addDoorWall :: S.Set EdgeObstacle