-- | Binary trees

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
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

--------------------------------------------------------------------------------

{-
padX :: (Backend b R2, Monoid' m) => Double -> QDiagram b R2 m -> QDiagram b R2 m
padX s d = withEnvelope (d # scaleX s) d

frame :: ( Backend b v, InnerSpace v, OrderedField (Scalar v), Monoid' m)
        => Scalar v -> QDiagram b v m -> QDiagram b v m
frame s d = setEnvelope (onEnvelope t (d^.envelope)) d
  where
    t f = \x -> f x + s
-}