module Math.Combinat.Diagrams.Trees.Binary where
import Math.Combinat.Trees.Binary
import Data.VectorSpace
import Data.Colour hiding ( atop )
import Diagrams.Core
import Diagrams.Prelude
drawBinTree_ :: forall a b. (Backend b R2, Renderable (Path R2) b ) => BinTree a -> Diagram b R2
drawBinTree_ = go "." where
radius = 0.25
radius1 = 0.15
fx = 0.5
fy = 1
linewidth = 0.04
go :: String -> BinTree a -> Diagram b R2
go name t = (centerXY stuff # lwL linewidth) where
stuff = case t of
Leaf _ -> square radius # named name # fc blue
Branch l r -> cherry where
cherry = subdiags # attach name lname # attach name rname
node = circle radius1 # extrudeBottom fy # fc red # named name
subdiags = (centerX node) === (centerX (ldiag ||| rdiag))
ldiag = alignT (go lname l # extrudeRight fx)
rdiag = alignT (go rname r # extrudeLeft fx)
lname = 'L' : name
rname = 'R' : name
attach n1 n2 =
withName n1 $ \b1 -> withName n2 $ \b2 ->
(flip atop) ((location b1 ~~ location b2) # lwL linewidth)
frameX t = extrudeLeft t . extrudeRight t
frameY t = extrudeTop t