From 00999f5921ea237fd12ab6fe10d65eedb5c0b046 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 29 Mar 2026 16:38:48 +0100 Subject: [PATCH] Add lenses for SPic and MountedObject positions --- src/Dodge/Data/MountedObject.hs | 7 +++++++ src/Dodge/Room/LongDoor.hs | 22 ++++++++++++---------- src/Dodge/Room/Tutorial.hs | 3 --- src/ShapePicture/Data.hs | 9 +++++++++ 4 files changed, 28 insertions(+), 13 deletions(-) diff --git a/src/Dodge/Data/MountedObject.hs b/src/Dodge/Data/MountedObject.hs index d77491e79..65aa60352 100644 --- a/src/Dodge/Data/MountedObject.hs +++ b/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 diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index a06eaa5e1..7695744c5 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/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 (dr1 & drTrigger .~ WdTrig i) defaultDoorWall) + sps0 (PutDoor (dr & drTrigger .~ WdTrig i + & 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) - & 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])] + & drOnePos .~ (V2 145 50, 0) + & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 10 47)) dr1 = dr & drOnePos .~ (V2 255 50, 0) - & drZeroPos .~ (V2 100 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])] + & drZeroPos .~ (V2 105 50, 0) f ps = case ps of PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 (-5)) _ -> ps diff --git a/src/Dodge/Room/Tutorial.hs b/src/Dodge/Room/Tutorial.hs index 588c4a415..dbceac674 100644 --- a/src/Dodge/Room/Tutorial.hs +++ b/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 diff --git a/src/ShapePicture/Data.hs b/src/ShapePicture/Data.hs index eaa0381d9..670186d2c 100644 --- a/src/ShapePicture/Data.hs +++ b/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)