Cleanup, improve auto wall rotate

src/Dodge/Placement/Instance/Button.hs

@@ -10,6 +10,7 @@ import Dodge.LightSource
 import Dodge.Placement.Instance.LightSource
 import Dodge.PlacementSpot
 import Geometry
+import Shape
 
 triggerSwitchSPic :: Color -> Color -> PlacementSpot -> Placement
 triggerSwitchSPic c1 c2 ps = psPtCont ps (PutTrigger False) $
@@ -19,7 +20,8 @@ triggerSwitchSPic c1 c2 ps = psPtCont ps (PutTrigger False) $
                 ps
                 ( PutButton
                     ( makeSwitch
-                        c1 c2
+                        c1
+                        c2
                         (SetTrigger True $ trigid tp)
                         (SetTrigger False $ trigid tp)
                     )
@@ -50,14 +52,7 @@ triggerSwitch col ps = psPtCont ps (PutTrigger False) $
         Just $
             pContID
                 ps
-                ( PutButton
-                    ( makeSwitch
-                        col
-                        col
-                        (SetTrigger True $ trigid tp)
-                        (SetTrigger False $ trigid tp)
-                    )
-                )
+                (PutButton (makeSwitch col col (SetTrigger True $ trigid tp) (SetTrigger False $ trigid tp)))
                 (const Nothing)
   where
     trigid tp = fromJust $ _plMID tp
@@ -65,14 +60,14 @@ triggerSwitch col ps = psPtCont ps (PutTrigger False) $
 putLitButOnPos :: Color -> PlacementSpot -> (Placement -> Maybe Placement) -> Placement
 putLitButOnPos col theps subpl =
     plSpot .~ theps $
-        mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40) $
-            \plmnt ->
+        mntLSOn shp ls 0 (V3 0 (-40) 40) $
+            \pmnt ->
                 jps0'
-                    (PutButton (makeButton col (changeLight . fromJust $ _plMID plmnt)){_btPos = V2 0 (-1), _btRot = pi})
+                    (PutButton (makeButton col (changeLight $ pmnt ^?! plMID . _Just) & btPos .~ V2 0 (-1) & btRot .~ pi))
                     subpl
-                    <&> plSpot
-                    .~ _plSpot plmnt
+                    <&> plSpot .~ _plSpot pmnt
   where
+    shp = fmap (fmap $ colorSH col) aShape
     changeLight = SetLSCol (V3 0 0.5 0)
     ls = lsColPosRad (V3 0.5 0 0) (V3 0 0 50) 50
 
@@ -107,7 +102,7 @@ putLitButOnPosExtTrig' col thePS cnt =
     psPtCont thePS (PutTrigger False) $
         \tp -> Just $
             plSpot .~ _plSpot tp $
-                mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40) $
+                mntLSOn shp ls 0 (V3 0 (-40) 40) $
                     \plmnt ->
                         jps0'
                             ( PutButton
@@ -118,8 +113,9 @@ putLitButOnPosExtTrig' col thePS cnt =
                             )
                             (cnt tp plmnt)
                             <&> plSpot
-                            .~ _plSpot plmnt
+                                .~ _plSpot plmnt
   where
+    shp = fmap (fmap $ colorSH col) aShape
     trigid tp = fromJust $ _plMID tp
     oneff = SetTrigger True
     changeLight = SetLSCol (V3 0 0.5 0)

src/Dodge/Placement/Instance/Door.hs

@@ -74,6 +74,6 @@ putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing Nothing $ \_ apl ->
                         a
                         b
                         ( defaultDoor
-                            & drTrigger .~ (WdBlCrFilterNearPoint 40 (0.5 *^ (x + y)) CrOpenAutoDoor)
+                            & drTrigger .~ WdBlCrFilterNearPoint 40 (0.5 *^ (x + y)) CrOpenAutoDoor
                             & drUpdate .~ DoorLerpWithTimer 0 3
                         )

src/Dodge/Placement/Instance/LightSource.hs

@@ -36,15 +36,14 @@ mntLSOn ::
     -- | function describing the mount shape
     (Point2 -> Point3 -> Shape) ->
     -- | describing a possible color override for the shape
-    Maybe Color ->
     LightSource ->
     Point2 ->
     Point3 ->
     (Placement -> Maybe Placement) ->
     Placement
-mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _) =
+mntLSOn shapeF ls wallp lsp@(V3 lx ly _) =
     ps0jPushPS (PutLabel "light") .
-    ps0jPushPS (putShape . setCol $ shapeF wallp lsp)
+    ps0jPushPS (putShape $ shapeF wallp lsp)
     --ps0j (PutLabel "light") .
     --ps0j (putShape . setCol $ shapeF wallp lsp)
         . pt0 (PutLS $ ls & lsParam . lsPos .~ lsp')
@@ -52,7 +51,7 @@ mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _) =
     lsp' = lsp -.-.- V3 x y 1
     -- hack! perturb the light position
     V2 x y = rotateV 1 . (0.1 *.*) . normalizeV $ wallp -.- V2 lx ly
-    setCol = maybe id colorSH mcol
+--    setCol = maybe id colorSH mcol
 
 iShape :: Point2 -> Point3 -> Shape
 iShape wp (V3 x y z) = thinHighBar z wp (V2 x y)
@@ -107,7 +106,7 @@ vShape wallpos (V3 x y z) =
     wallposDown = wallpos -.- n
 
 mntLS :: (Point2 -> Point3 -> Shape) -> Point2 -> Point3 -> Placement
-mntLS shp wallp lampp = mntLSOn shp Nothing defaultLS wallp lampp (const Nothing)
+mntLS shp wallp lampp = mntLSOn shp defaultLS wallp lampp (const Nothing)
   where
     defaultLS = LS 0 $ LSParam 0 300 0.6
 
@@ -152,7 +151,7 @@ mntLightLnkCond ps = do
     return $ mntLSCond (fmap (fmap $ colorSH black) shp) ps
 
 mntLightLnkShape :: (Point2 -> Point3 -> Shape) -> PlacementSpot -> Placement
-mntLightLnkShape shp ps = mntLSCond (fmap (fmap $ colorSH black) shp) ps
+mntLightLnkShape shp = mntLSCond (fmap (fmap $ colorSH black) shp)
 
 mntLightLnkCond' :: PlacementSpot -> Placement
 mntLightLnkCond' = mntLSCond (fmap (fmap $ colorSH black) vShape)