module Tree(node, nodeL, box, boxSz) where

import SlideWare

node :: Pict -> [Pict] -> Pict
node = nodeL line

nodeL :: ((PPoint, PPoint) -> Pict) -> Pict -> [Pict] -> Pict
nodeL ln r cs =
    let (r':cs') = zipWith addLabel [0..] (r:cs)
	p = vcAppend [spacing gapSize, r', htAppend (spacing (gapSize/2) : cs')]
	rb = findCB (mkLabel 0) p
	mkArrow n = ln (rb, findCT (mkLabel n) p)
	as = map mkArrow [1..length cs]
    in  ltSuperimpose (launderPrefix "_" p : as)

addLabel n p = label (mkLabel n) p

mkLabel n = "_" ++ show n

box :: Pict -> Pict
box = boxSz (blank (4 * gapSize) (2 * gapSize))

boxSz :: Pict -> Pict -> Pict
boxSz sz p =
    let p' = ccSuperimpose [p, ghost sz]
    in  ltSuperimpose [colorize "lightgrey" (fill p'), frame p']