Fix incorrect creation of unused links pos

src/Dodge/Tree/Shift.hs

@@ -24,7 +24,8 @@ type RoomInt = (Room,Int)
 
 positionRoomsFromTree :: Tree RoomInt -> IO (Maybe [RoomInt])
 positionRoomsFromTree (Node (r,i) ts) = printHeader 
-    >> posRms (map pointsToPoly $ _rmBound r') (r',i) (zipCount ts) Empty
+    >> (fmap (fmap (map $ first createUnusedLinkPos))) 
+        (posRms (map pointsToPoly $ _rmBound r') (r',i) (zipCount ts) Empty)
   where
     r' = r & rmMID ?~ 0
 
@@ -41,7 +42,7 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
     tryParentLinks outlinks
   where
     child = fst childi
-    outlinks = zipCount 
+    outlinks = zipCount
         . Prelude.filter (not . S.null . S.intersection (_rmConnectsTo child) . _rlType) 
         $ _rmLinks parent
     tryParentLinks [] = putStrLn "no viable link pairs, backtrack" >> return Nothing
@@ -62,19 +63,23 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
             newBounds = map pointsToPoly . _rmBound . doRoomShift . fst $ rootLabel shiftedt
             clipping = or (convexPolysOverlap <$> newBounds <*> bounds)
             updateparent rm = doLnkEff (lnkPosDir outlnk) $ rm 
-                & rmLinks %~ delete outlnk 
-                & rmPos .:~ uncurry (UsedOutLink numChild (snd childi)) (lnkPosDir outlnk)
+                & rmLinks    %~ delete outlnk 
+                & rmPos      .:~ uncurry (UsedOutLink numChild (snd childi)) (lnkPosDir outlnk)
                 & rmChildren .:~ snd childi
             shiftedoutlink = shiftLinkBy (_rmShift parent) outlnk
             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)) ++) )
+                & rmLinks   %~ delete il 
+                & rmPos     %~ ( (uncurry (UsedInLink 0) (lnkPosDir il):)
+--                    . (map (uncurry UnusedLink . lnkPosDir) (delete il (_rmLinks rm)) ++) 
+                    )
             shiftedt = applyToRoot 
                 (first $ updatechild . shiftRoomShiftToLink (lnkPosDir shiftedoutlink) (lnkPosDir il)) t
 
+createUnusedLinkPos :: Room -> Room
+createUnusedLinkPos rm = rm & rmPos .++~ map (uncurry UnusedLink . lnkPosDir) (_rmLinks rm)
+
 zipCount :: [a] -> [(Int,a)]
 zipCount = Prelude.zip [0..]