Allow for more complex placement positioning

src/Dodge/Tree/Compose.hs

@@ -8,11 +8,13 @@ module Dodge.Tree.Compose
     , useAllAtEnd
     , changeToPassDown
     , overwriteLabel
+    , applyToCompRoot
     ) where
 import Dodge.Tree.Compose.Data
 import Dodge.Tree.Polymorphic
 import Dodge.Base
 import Data.Tree
+import Control.Lens
 
 expandTree :: CompTree a -> Tree a
 expandTree (Node root extChildren) = case root of
@@ -24,6 +26,9 @@ expandTree (Node root extChildren) = case root of
     Node (SplitDown x)  xs  -> Node x $ map expandTree $ zipWith Node xs 
             $ map (:[]) extChildren ++ repeat []
 
+applyToCompRoot :: (a -> a) -> SubCompTree a -> SubCompTree a
+applyToCompRoot f = applyToRoot (unCompose %~ f)
+
 overwriteLabel :: Int -> (a -> ComposingNode a) -> SubCompTree a -> [SubCompTree a] -> SubCompTree a
 overwriteLabel i f t ts = errorHead ("tried to overwriteLabel " ++ show i)
     $ updateSingleNode islabel update t

src/Dodge/Tree/Shift.hs

@@ -12,6 +12,7 @@ import Geometry.ConvexPoly
 import Geometry.Data
 import Padding
 
+import qualified Data.Set as S
 import Data.Tree
 import Data.Sequence hiding (zipWith)
 import Data.List (delete)
@@ -34,8 +35,12 @@ posRms bounds (parent,_) [] st = case st of
     Node childi ts :<| tseq -> fmap (parent:) <$> posRms bounds childi (zipCount ts) tseq
 posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
     printInfoCheckNum parenti numChild childi
-    tryParentLinks $ zipCount $ rmOutLinks parent
+    tryParentLinks outlinks
   where
+    child = fst childi
+    outlinks = zipCount 
+        . Prelude.filter (not . S.null . S.intersection (_rmConnectsTo child) . _rlType) 
+        $ _rmLinks parent 
     tryParentLinks [] = putStrLn "no viable link pairs, backtrack" >> return Nothing
     tryParentLinks ((j,outlnk):ls) = tryChildLinks $ zipCount (rmInLinks $ fst childi)
       where