Cleanup

src/Dodge/Floor.hs

@@ -37,7 +37,7 @@ import RandomHelp
 
 initialAnoTree :: Tree [Annotation]
 initialAnoTree = padSucWithDoors $ treeFromPost 
-    [[AnoApplyInt 0 startRoom]
+    [[AnoApplyInt 110 startRoom]
     , [PassthroughLockKeyLists 2 keyCardRunPastRand itemRooms]
     , [SpecificRoom $ warningRooms 7]
     , [SpecificRoom $ return ( toOnward "chaseCrit+armourChaseCrit rectRoom"

src/Dodge/LockAndKey.hs

@@ -15,9 +15,7 @@ import Dodge.Item
 
 
 bossKeyItems :: RandomGen g => [ (State g (Tree Room), State g ItemBaseType) ]
-bossKeyItems = 
-    [(return . useAll <$> bossRoom autoCrit, takeOne [PISTOL])
-    ]
+bossKeyItems = [(return . useAll <$> bossRoom autoCrit, takeOne [PISTOL]) ]
 
 lockRoomMultiItems :: RandomGen g => [ ( State g (LabTree Room) , State g [ItemBaseType] ) ]
 lockRoomMultiItems = 
@@ -40,9 +38,7 @@ lockRoomKeyItems =
     ,(keyCardRoomRunPast 0, return (KEYCARD 0))
     ]
 keyCardRunPastRand :: RandomGen g => [ (Int -> State g (LabTree Room) , State g ItemBaseType ) ]
-keyCardRunPastRand = 
-    [(keyCardRoomRunPast 0, return (KEYCARD 0))
-    ]
+keyCardRunPastRand = [(keyCardRoomRunPast 0, return (KEYCARD 0)) ]
 
 itemRooms :: RandomGen g => [(ItemBaseType, State g (LabTree Room))]
 itemRooms = 

src/Dodge/Placement/Instance/Button.hs

@@ -75,9 +75,7 @@ extTrigLitPos ps f = psPtCont ps (PutTrigger (const False))
         }
     thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75
 
-putLitButOnPosExtTrig :: Color 
-   -> PlacementSpot 
-   -> Placement
+putLitButOnPosExtTrig :: Color -> PlacementSpot -> Placement
 putLitButOnPosExtTrig col thePS = putLitButOnPosExtTrig' col thePS (const . const . const Nothing)
 
 putLitButOnPosExtTrig' :: Color 

src/Dodge/Room/Link.hs

@@ -62,9 +62,7 @@ randomiseAllLinks r = do
 {- Shuffle the order of all links of a room randomly. 
  - Note this does not change their types. -}
 shuffleLinks :: RandomGen g => Room -> State g Room
-shuffleLinks r = do
-    newLinks <- shuffle $ _rmLinks r
-    return $ r {_rmLinks = newLinks }
+shuffleLinks = rmLinks %%~ shuffle
 
 filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
 filterLinks cond r = do

src/Dodge/Room/RunPast.hs

@@ -2,7 +2,7 @@ module Dodge.Room.RunPast where
 import Dodge.UseAll
 import Dodge.LevelGen.Data
 import Dodge.LightSource
-import Dodge.RoomLink
+--import Dodge.RoomLink
 import Dodge.Data
 --import Dodge.Default
 --import Dodge.Layout.Tree.Either
@@ -44,26 +44,24 @@ critRoom = corridorWallN & rmRandPSs .~ [psRandRanges (15,25) (30,45) (pi,2*pi)]
 
 runPastRoom :: RandomGen g => Int -> State g (Tree Room)
 runPastRoom i = do
-    h <- state $ randomR (200,400::Float)
-    theedgetest <- takeOne [horEdgeTest (<1), horEdgeTest  (>39)]
-    thels <- roomCritLS
-    theweapon <- randBlockBreakWeapon
-    cenroom <- shuffleLinks $ restrictRMInLinksPD (\(V2 _ y,_) -> y < 1)
-                $ roomRectAutoLinks 40 h & rmPmnts .~ [plRRpt 0 (PutFlIt theweapon)]
-    theedge <- takeOne [West,East]
-    --let cenroom = filterSortOutLinksOn theedgetest ((\(V2 a b) -> (a,b)) . fst)
+    h           <- state $ randomR (200,400::Float)
+    thels       <- roomCritLS
+    theweapon   <- randBlockBreakWeapon
+    --cenroom     <- shuffleLinks $ restrictRMInLinksPD (\(V2 _ y,_) -> y < 1)
+    cenroom     <- shuffleLinks
+        $ roomRectAutoLinks 40 h & rmPmnts .~ [plRRpt 0 (PutFlIt theweapon)]
+    theedge     <- takeOne $ map OnEdge [West,East]
     let linkcor = critRoom & rmPmnts .~ [ spanLS thels (V2 0 65) (V2 40 65) ]
         critroom = linkcor & rmPmnts .:~ plRRpt 0 randC1
         aswitchroom = corridorWallN
             {_rmOutPmnt = [OutPlacement (putLitButOnPosExtTrig red useUnusedLnk) i]
             ,_rmPmnts = []
             }
-        switchdoor = triggerDoorRoom i 
-        n = length $ filter theedgetest $ map lnkPosDir $ _rmLinks cenroom
+        switchdoor = triggerDoorRoom i
+        n = length $ filter (elem theedge . _rlType) $ _rmLinks cenroom
         controom = treeFromPost [ switchdoor, linkcor,corridor,corridor] (useAll door)
-        critrooms :: [Tree Room]
-        critrooms = treeFromPost [ switchdoor] critroom 
+        doorrooms = treeFromPost [ switchdoor] critroom 
             : replicate (n-2) (treeFromPost [ switchdoor] linkcor)
-    return $ Node cenroom $ 
-        map (over root $ rmConnectsTo .~ S.member (OnEdge theedge)) (controom : critrooms) 
+    return $ Node cenroom $
+        map (over root $ rmConnectsTo .~ S.member theedge) (controom : doorrooms) 
             ++ [return aswitchroom]

src/Dodge/Room/Start.hs

@@ -1,4 +1,4 @@
---{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TupleSections #-}
 module Dodge.Room.Start where
 import Dodge.UseAll
 import Dodge.Data
@@ -53,12 +53,12 @@ startRoom i = join (takeOne
     [-- (,) (0.5::Float) ((chainUses <$> sequence [powerFakeout,fmap fst $weaponRoom i]) 
      --       <&> (,TreeSubLabelling "chainUses <$> sequence [powerFakeout,weaponRoom i]" Nothing))
      --     wat
-      rezBoxesWp                >>= rToOnward "rezBoxesWp"
-    , rezBoxThenWeaponRoom i
-    , rezBoxesWpCrit            >>= rToOnward "rezBoxesWpCrit"
-    , runPastStart i            >>= rToOnward ("runPastStart " ++ show i)
-    , startCrafts >>= roomsContaining' [] >>= rezBoxThenRooms
-        >>= rToOnward "startCrafts >>= roomsContaining [] >>= rezBoxThenRooms"
+--      rezBoxesWp                >>= rToOnward "rezBoxesWp"
+--    , rezBoxThenWeaponRoom i
+--    , rezBoxesWpCrit            >>= rToOnward "rezBoxesWpCrit"
+     runPastStart i            >>= rToOnward ("runPastStart " ++ show i)
+--    , startCrafts >>= roomsContaining' [] >>= rezBoxThenRooms
+--        >>= rToOnward "startCrafts >>= roomsContaining [] >>= rezBoxThenRooms"
     ])
 randomChallenges :: RandomGen g => State g (LabTree Room)
 randomChallenges = shootingRange
@@ -72,7 +72,10 @@ runPastStart :: RandomGen g => Int -> State g (Tree Room)
 runPastStart i = do
     s <- rezBoxStart
     rp <- runPastRoom i
-    return $ s `passUntiluseAll` [rp]
+    --return $ s `passUntiluseAll` [rp]
+    return . shiftChildren $ attachTree toOnward' rp $ fmap ([],) s
+--    return . shiftChildren $ attachTree toOnward' (pure $ useAll corridor) $ fmap ([],) s
+    
 
 rezBoxStart :: RandomGen g => State g (Tree Room)
 rezBoxStart = do

src/Dodge/Tree/Compose.hs

@@ -12,6 +12,8 @@ module Dodge.Tree.Compose
     , overwriteLabel
     , composeTree
     , composeTree'
+    , shiftChildren
+    , attachTree
     , composeTreeRand
 --    , compTree
     ) where
@@ -124,6 +126,11 @@ newf t = safeUpdateSingleNode (isJust . upf . snd) ( (root . _2 %~ g) . (root .
     upf = t ^?! root . _1
     g x = fromMaybe x (upf x)
 
+attachTree :: (a -> Maybe a) -> Tree a -> Tree ([Tree a],a) -> Tree ([Tree a],a)
+attachTree upf t = safeUpdateSingleNode (isJust . upf . snd) ( (root . _2 %~ g) . (root . _1 .:~ t ) )
+  where
+    g x = fromMaybe x (upf x)
+
 shiftChildren :: Tree ([Tree a],a) -> Tree a
 shiftChildren (Node (ts,x) ts') = Node x (ts ++ map shiftChildren ts')
 

src/Dodge/UseAll.hs

@@ -8,9 +8,13 @@ import qualified Data.Set as S
 
 toOnward :: String -> Room -> Maybe ([String],Room)
 toOnward s rm
-    | OnwardCluster `elem` rm ^?! rmClusterStatus . csLinks = Just ([s],rm)
+    | OnwardCluster `elem` rm ^?! rmClusterStatus . csLinks 
+        = Just ([s],rm & rmClusterStatus . csLinks . at OnwardCluster .~ Nothing)
     | otherwise = Nothing
 
+toOnward' :: Room -> Maybe Room
+toOnward' = fmap snd . toOnward ""
+
 rToOnward :: Monad m => String -> Tree Room -> m (Room -> Maybe ([String],Room), Tree Room)
 rToOnward s = return . (toOnward s ,)