DIAG: make the current node in the tree red

This commit is contained in:
2014-11-15 15:26:43 +01:00
parent 50fc0c3d01
commit 60d7dca2c8
2 changed files with 33 additions and 17 deletions

View File

@@ -203,18 +203,23 @@ lookupByNeighbors = flip (foldlM (flip findNeighbor))
quadTreeToRoseTree :: Zipper PT -> Tree String
quadTreeToRoseTree z = case z of
(TNil, _) -> Node printOrigin []
(TLeaf a, _) -> Node (printOrigin ++ "\n" ++ (show . unp2 $ a)) []
_ -> Node printOrigin
[quadTreeToRoseTree (fromJust . goNW $ z)
, quadTreeToRoseTree (fromJust . goNE $ z)
, quadTreeToRoseTree (fromJust . goSW $ z)
, quadTreeToRoseTree (fromJust . goSE $ z)]
quadTreeToRoseTree z' = go (rootNode z')
where
printOrigin
| isNWchild z = "NW"
| isNEchild z = "NE"
| isSWchild z = "SW"
| isSEchild z = "SE"
| otherwise = "root"
go z = case z of
(TNil, _) -> Node markAndPrintOrigin []
(TLeaf a, _) -> Node (markAndPrintOrigin ++ "\n" ++ (show . unp2 $ a)) []
_ -> Node markAndPrintOrigin
[go (fromJust . goNW $ z)
, go (fromJust . goNE $ z)
, go (fromJust . goSW $ z)
, go (fromJust . goSE $ z)]
where
markAndPrintOrigin
| z' == z = "* " ++ printOrigin
| otherwise = printOrigin
printOrigin
| isNWchild z = "NW"
| isNEchild z = "NE"
| isSWchild z = "SW"
| isSEchild z = "SE"
| otherwise = "root"