Allow for random choice between placements in different rooms

src/Dodge/Tree/Shift.hs

@@ -21,7 +21,7 @@ import Control.Lens hiding (Empty, (<|) , (|>))
 
 type RoomInt = (Room,Int)
 
-positionRoomsFromTree :: Tree RoomInt -> IO (Maybe [Room])
+positionRoomsFromTree :: Tree RoomInt -> IO (Maybe [RoomInt])
 positionRoomsFromTree (Node (r,i) ts) = printHeader 
     >> posRms (map pointsToPoly $ _rmBound r) (r,i) (zipCount ts) Empty
 
@@ -29,10 +29,10 @@ posRms :: [ConvexPoly]
     -> RoomInt
     -> [(Int,Tree RoomInt)]     -- the list of children, with indices
     -> Seq (Tree RoomInt)
-    -> IO (Maybe [Room])
-posRms bounds (parent,_) [] st = case st of
-    Empty                   -> return $ Just [parent]
-    Node childi ts :<| tseq -> fmap (parent:) <$> posRms bounds childi (zipCount ts) tseq
+    -> IO (Maybe [RoomInt])
+posRms bounds (parent,i) [] st = case st of
+    Empty                   -> return $ Just [(parent,i)]
+    Node childi ts :<| tseq -> fmap ((parent,i):) <$> posRms bounds childi (zipCount ts) tseq
 posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
     printInfoCheckNum parenti numChild childi
     tryParentLinks outlinks
@@ -61,9 +61,12 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
             updateparent rm = doLnkEff (lnkPosDir outlnk) $ rm 
                 & rmLinks %~ delete outlnk 
                 & rmPos %~ (uncurry (UsedOutLink numChild (snd childi)) (lnkPosDir outlnk) :)
+                & rmChildren %~ (snd childi :)
             shiftedoutlink = shiftLinkBy (_rmShift parent) outlnk
             r' = doRoomShift . fst $ rootLabel shiftedt
             updatechild rm = rm 
+                & rmMParent ?~ snd parenti
+                & rmMID     ?~ snd childi
                 & rmLinks %~ delete il 
                 & rmPos %~ ( (uncurry (UsedInLink 0) (lnkPosDir il):)
                     . (map (uncurry UnusedLink . lnkPosDir) (delete il (_rmLinks rm)) ++) )