Add lenses for SPic and MountedObject positions

src/Dodge/Data/MountedObject.hs

@@ -1,8 +1,10 @@
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE LambdaCase #-}
 
 module Dodge.Data.MountedObject where
 
+import Control.Lens
 import ShapePicture.Data
 import Geometry.Data
 import Data.Aeson
@@ -13,4 +15,9 @@ data MountedObject
     | MountedSPic SPic
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
+moPos :: ASetter' MountedObject Point3
+moPos f = \case
+    MountedLight p r c -> Identity $ MountedLight (runIdentity $ f p) r c
+    MountedSPic sp -> Identity . MountedSPic $ sp & spPos %~ (runIdentity . f)
+
 deriveJSON defaultOptions ''MountedObject

src/Dodge/Room/LongDoor.hs

@@ -190,6 +190,11 @@ pushCaverns :: RandomGen g => State g Room
 pushCaverns = do
     rm <- shuffleLinks =<< removeLights <$> roomRectAutoLights 250 100
     crs <- takeOne [[] ]
+    l <- takeOne 
+--            [ [MountedLight (V3 55 0 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 0,V2 60 0])]
+--            , [MountedLight (V3 20 0 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 0,V2 22 0])]
+            [ [MountedLight (V3 30 45 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 45,V2 32 45])]
+            ]
     return $ rm
         & rmBound <>~ [
             ]
@@ -199,24 +204,21 @@ pushCaverns = do
          [ps0 (PutTrigger False) $ \i -> Just $
             pContID (spos (slinks West)) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
             pContID (spos (slinks East)) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
-        sps0 (PutDoor (dr & drTrigger .~ WdTrig i) defaultDoorWall) & plIDCont . mapped . mapped ?~
+        sps0 (PutDoor (dr & drTrigger .~ WdTrig i
-        sps0 (PutDoor (dr1 & drTrigger .~ WdTrig i) defaultDoorWall)
+                        & drMounts .~ l) defaultDoorWall) & plIDCont . mapped . mapped ?~
+        sps0 (PutDoor (dr1 & drTrigger .~ WdTrig i
+                    & drMounts .~ (l & each . moPos . _xy %~ rotateV pi)) defaultDoorWall)
         ] <> crs
   where
     slinks x s = (FromEdge x 0 `S.member` s)
     dr = defaultDoor
         & drUpdate .~ DoorLerp 0.005
         & drZeroPos .~ (V2 (-5) 50, 0)
-        & drOnePos .~ (V2 150 50, 0)
+        & drOnePos .~ (V2 145 50, 0)
-        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 10 49))
+        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 10 47))
-        & drMounts .~ [MountedLight (V3 30 0 50) 200 0.5
-            , MountedSPic (noPic $ aBar 55 [V2 10 0,V2 32 0])]
     dr1 = dr
         & drOnePos .~ (V2 255 50, 0)
-        & drZeroPos .~ (V2 100 50, 0)
+        & drZeroPos .~ (V2 105 50, 0)
-        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 10 49))
-        & drMounts .~ [MountedLight (V3 (-30) 0 50) 200 0.5
-            , MountedSPic (noPic $ aBar 55 [V2 (-10) 0,V2 (-32) 0])]
     f ps = case ps of
         PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 (-5))
         _ -> ps

src/Dodge/Room/Tutorial.hs

@@ -55,9 +55,6 @@ tutAnoTree = do
     foldMTRS
         [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
         , corDoor
-        , lasRunYinYang
-        , corDoor
-        , corDoor
         , tToBTree "slowCrush" . return . cleatOnward <$> pushCaverns
         , corDoor
         , chasmSpitTerminal

src/ShapePicture/Data.hs

@@ -1,7 +1,16 @@
 module ShapePicture.Data where
 
+import Control.Lens
 import Data.Strict.Tuple
+import Geometry.Data
 import Picture.Data
 import Shape.Data
 
 type SPic = Pair Shape Picture
+
+spPos :: ASetter' SPic Point3
+spPos f x =
+    Identity $
+        x
+            & _1 . each . sfVs . each %~ (runIdentity . f)
+            & _2 . each . vxPos %~ (runIdentity . f)