hasufell/cga
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

DIAG: make the current node in the tree red

Browse Source
This commit is contained in:
hasufell
2014-11-15 15:26:43 +01:00
parent 50fc0c3d01
commit 60d7dca2c8
2 changed files with 33 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
Graphics/Diagram/Plotter.hs
View File

@@ -238,13 +238,24 @@ treePretty :: Diag
treePretty = Diag f
where
f p (Object []) = mempty
f p (Object vt) = prettyRoseTree (quadTreeToRoseTree (qt, []))
f p (Object vt) =
prettyRoseTree (quadTreeToRoseTree . flip getCurQT (qt, []) . stringToQuads . pQt $ p)
where
qt = quadTree (filterValidPT p vt) (dX p, dY p)
getCurQT :: [Either Quad Orient] -> Zipper PT -> Zipper PT
getCurQT [] z = z
getCurQT (q:qs) z = case q of
Right x -> getCurQT qs (fromMaybe z (findNeighbor x z))
Left x -> getCurQT qs (fromMaybe z (goQuad x z))
prettyRoseTree :: Tree String -> Diagram Cairo R2
prettyRoseTree t =
renderTree (\n -> (text n # fontSizeL 5.0)
<> rect 50.0 20.0 # fc white)
renderTree (\n -> case head n of
'*' ->
(text n # fontSizeL 5.0)
<> rect 50.0 20.0 # fc red
_ ->
(text n # fontSizeL 5.0)
<> rect 50.0 20.0 # fc white)
(~~)
(symmLayout' (with & slHSep .~ 60 & slVSep .~ 40) t)
# scale 2 # alignT # bg white