Commit before unifying placements in rooms (in/out)

src/Dodge/Floor.hs

@@ -39,7 +39,7 @@ initialAnoTree :: Tree [Annotation]
 initialAnoTree = padSucWithDoors $ treeFromPost 
     [[AnoApplyInt 110 startRoom]
     , [PassthroughLockKeyLists 2 keyCardRunPastRand itemRooms]
-    , [SpecificRoom $ warningRooms 7]
+    , [SpecificRoom $ warningRooms 777777]
     , [SpecificRoom $ return ( toOnward "chaseCrit+armourChaseCrit rectRoom"
             , return . useAll $ roomRectAutoLinks 400 400
                 & rmPmnts .++~ [spNoID anyUnusedSpot (PutCrit invisibleChaseCrit)

src/Dodge/Placement/Instance/Terminal.hs

@@ -88,7 +88,6 @@ termButton = Button
     , _btName = ""
     }
 
-
 terminalColor :: Color
 terminalColor = dark magenta
 

src/Dodge/Room/Door.hs

@@ -31,7 +31,7 @@ door = defaultRoom
 triggerDoorRoom :: Int -> Room
 triggerDoorRoom inplid = defaultRoom
     { _rmPolys  = [rectNSWE 40 0 0 40]
-    , _rmLinks  = init lnks++ [last lnks]
+    , _rmLinks  = [uncurry outLink (V2 20 35,0) ,uncurry inLink(V2 20  5,pi) ]
     , _rmPath   = [(V2 20 35,V2 20 5)]
     , _rmInPmnt = [InPlacement f inplid]
     , _rmName   = "triggerDoorRoom"
@@ -39,10 +39,6 @@ triggerDoorRoom inplid = defaultRoom
 -- note no bounds
     }
   where 
-    lnks = [uncurry outLink (V2 20 35,0)
-        ,uncurry inLink(V2 20  5,pi)
-        ]
     f (pmnt:_) = putDoubleDoor False red (cond pmnt) (V2 0 20) (V2 40 20) 2
     f _ = error "tried to put a door using an empty placement list"
     cond pmnt w = w & _triggers w IM.! fromJust (_plMID pmnt)
-

src/Dodge/Room/RunPast.hs

@@ -39,29 +39,28 @@ roomCritLS = do
     rad <- takeOne [300]
     return $ lsPosColRad (V3 0 0 h) col rad
 
-critRoom :: Room
+smallRoom :: Room
-critRoom = corridorWallN & rmRandPSs .~ [psRandRanges (15,25) (30,45) (pi,2*pi)]
+smallRoom = 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)
     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) ]
+    let linkcor = smallRoom & rmPmnts .~ [ spanLS thels (V2 0 65) (V2 40 65) ]
         critroom = linkcor & rmPmnts .:~ plRRpt 0 randC1
-        aswitchroom = corridorWallN
+        switchdoor = triggerDoorRoom i
+        n = length $ filter (elem theedge . _rlType) (_rmLinks cenroom)
+        doorrooms = map (treePost . (switchdoor:)) $ [critroom]
+            : [ linkcor,corridor,corridor,useAll door]
+            : replicate (n-2) [linkcor]
+    return $ Node cenroom $
+        map (over root $ rmConnectsTo .~ S.member theedge) doorrooms
+        ++ [return corridorWallN
                 {_rmOutPmnt = [OutPlacement (putLitButOnPosExtTrig red useUnusedLnk) i]
                 ,_rmPmnts = []
                 }
-        switchdoor = triggerDoorRoom i
+            ]
-        n = length $ filter (elem theedge . _rlType) $ _rmLinks cenroom
-        controom = treeFromPost [ switchdoor, linkcor,corridor,corridor] (useAll door)
-        doorrooms = treeFromPost [ switchdoor] critroom 
-            : replicate (n-2) (treeFromPost [ switchdoor] linkcor)
-    return $ Node cenroom $
-        map (over root $ rmConnectsTo .~ S.member theedge) (controom : doorrooms) 
-            ++ [return aswitchroom]

src/Dodge/Terminal.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
 module Dodge.Terminal where
 import Dodge.Data
 import Dodge.Default
@@ -245,4 +246,5 @@ connectionBlurb1 =
     ,TerminalLineDisplay 0 (const ("CONNECTING",termTextColor))
     ,TerminalLineDisplay 10 (const ("...",termTextColor))
     ,TerminalLineDisplay 10 (const ("CONNECTED",termTextColor))
-    ,TerminalLineTerminalEffect 0 (tmStatus .~ TerminalReady)]
+    ] ++ map (TerminalLineDisplay 10 . const . (,white) . show) [(1::Int)..50] ++
+    [TerminalLineTerminalEffect 0 (tmStatus .~ TerminalReady)]

src/TreeHelp.hs

@@ -13,6 +13,7 @@ module TreeHelp
     , applyToSubtree
     , applyToSubforest
     , treeFromPost
+    , treePost
     , treeFromTrunk
     , splitTrunk
     , applyToRandomNode
@@ -36,6 +37,11 @@ Safe.  -}
 treeFromPost :: [a] -> a -> Tree a
 treeFromPost xs = treeFromTrunk xs . pure
 
+{- | Creates a linear tree from a list.
+Unsafe.  -}
+treePost :: [a] -> Tree a
+treePost xs = treeFromPost (init xs) (last xs)
+
 {- | Creates a tree with one trunk branch, 
 input as a list, that ends in another tree.  -}
 treeFromTrunk