module Data.Sifflet.TreeLayout 
    (VColor(..), white, cream, black, lightBlue, lightBlueGreen
    , lightGray, mediumGray, darkGray
    , yellow, darkBlueGreen, blueGreen
    , Style(..), VFont(..), defaultStyle, style0, style1, style2, style3
    , wstyle
    , styleIncreasePadding
    , FontTextExtents(..), setFont, measureText, styleTextExtents, ftExtents
    , TextBox(..), makeTextBox, tbWidth, tbHeight, tbBottom
    , tbCenter, tbTextCenter, tbBoxCenter, offsetTextBoxCenters
    , tbSetWidth
    , treeSizes
    , GNode(..), treeGNodes, gnodeText, gnodeTextBB
    , Iolet(..), ioletCenter, makeIolets, makeIoletsRow
    , pointInIolet
    , IoletCounter, zeroIoletCounter
    , makeGNode
    , TreeLayout, LayoutNode(..)
    , layoutNodeSource, layoutRootBB, layoutTreeBB
    , treeLayout
    , treeLayoutPaddedSize, treeLayoutSize, treeLayoutWidth
    , layoutTreeMoveCenterTo
    , pointInLayoutNode, pointInGNode, findRect
    , treeLayoutWiden
    )

where

import System.IO.Unsafe

-- All this VVV is needed just to measure a piece of text;
-- maybe font and text should be split out to a new module?

import Graphics.Rendering.Cairo (FontExtents(..),
                                 FontSlant(..), FontWeight(..),
                                 Format(..), Render,
                                 TextExtents(..),
                                 fontExtents,
                                 renderWith,
                                 textExtents,
                                 selectFontFace, setFontSize,
                                 withImageSurface)

import Graphics.UI.Gtk (Rectangle)
import Data.Traversable () -- imports only instance declarations

import Data.Sifflet.Geometry
import Data.Sifflet.Tree as T hiding (tree)
import Text.Sifflet.Repr ()
import Language.Sifflet.Util

-- Do colors really belong here???

data VColor = ColorRGB Double Double Double |
              ColorRGBA Double Double Double Double

black, white, cream, lightBlue, lightBlueGreen :: VColor

black = ColorRGB 0 0 0
white = ColorRGB 1 1 1
cream = ColorRGB 0.94902 0.94902 0.82745
lightBlue = ColorRGB 0.43529 0.43922 0.95686
lightBlueGreen = ColorRGB 0 1 1

lightGray, mediumGray, darkGray :: VColor
lightGray = ColorRGBA 0.75 0.75 0.75 0.5
mediumGray = ColorRGB 0.5 0.5 0.5
darkGray = ColorRGB 0.25 0.25 0.25

yellow, darkBlueGreen, blueGreen :: VColor

yellow = ColorRGB 0.9 0.9 0
darkBlueGreen = ColorRGB 0 0.3 0.3
blueGreen = ColorRGB 0 0.4 0.4

-- darkRed = ColorRGB 0.5 0 0, -- dark red

data VFont = VFont {vfontFace :: String, vfontSlant :: FontSlant,
                    vfontWeight :: FontWeight,
                    vfontSize :: Double}

data Style = 
    Style {styleFont :: VFont,
           lineWidth :: Double,
           textMargin :: Double, -- in box on all four sides
           hpad, vpad :: Double, -- internode (interbox) spacing
           exomargin :: Double,  -- margin of the tree within the window
           vtinypad :: (Double, Double), -- node-edge spacing (above, below)
           styleFramePad :: Double,      -- pad between frames
           styleNormalTextColor, styleNormalFillColor, 
           styleNormalEdgeColor,
           styleActiveTextColor, styleActiveFillColor,
           styleActiveEdgeColor,
           styleSelectedTextColor, styleSelectedFillColor, 
           styleSelectedEdgeColor,
           styleTetherColor :: VColor,
           -- auxiliary text style, e.g., the value of an ExprNode
           styleAuxOffset :: Position, -- center-to-center offset dx dy
           styleAuxColor :: VColor,
           styleAuxFont :: VFont,
           styleIoletRadius :: Double, -- could extend to other shapes ***
           styleShowNodeBoxes :: Bool, -- draw a box around expr nodes
           styleShowNodePorts :: Bool  -- draw the I/O ports of expr nodes
          }

styleIncreasePadding :: Style -> Double -> Style
-- increase hpad, vpad of style by multiplication
styleIncreasePadding style factor =
  style {hpad = factor * hpad style,
         vpad = factor * vpad style}

style0, style1, style2, style3, defaultStyle :: Style

style0 = 
    let green = ColorRGB 0.1 0.9 0.1
        veryDarkGray = ColorRGB 0.1 0.1 0.1
        brighterGreen = ColorRGB 0.5 0.95 0.5
    in Style {styleFont = VFont "serif" FontSlantNormal FontWeightNormal 18, 
              lineWidth = 2, 
              textMargin = 18.0, -- text within its box
              hpad = 27, vpad = 36, -- inter-node separation
              exomargin = 0,
              vtinypad = (4.5, 4.5),  -- node-edge separation
              styleFramePad = 35,          -- padding between frames
              -- Foreground and background colors
              styleNormalTextColor = green,
              styleNormalEdgeColor = green,
              styleNormalFillColor = veryDarkGray,
              styleActiveTextColor = brighterGreen,
              styleActiveEdgeColor = brighterGreen,
              styleActiveFillColor = mediumGray,
              styleSelectedTextColor = blueGreen,
              styleSelectedEdgeColor = blueGreen,
              styleSelectedFillColor = darkGray,
              styleTetherColor = white,
              styleAuxOffset = Position 0.0 (-20.0),
              styleAuxColor = lightGray,
              styleAuxFont = 
                  VFont "serif" FontSlantItalic FontWeightNormal 12,
              styleIoletRadius = 5,
              styleShowNodeBoxes = True, -- draw a box around expr nodes
              styleShowNodePorts = True  -- draw the I/O ports of expr nodes
             }

style1 = 
    let veryDarkBlue = ColorRGB 0 0 0.1
        pinkIHope = ColorRGB 1 0.9 0.9
    in style0 {styleNormalTextColor = veryDarkBlue,
               styleNormalEdgeColor = veryDarkBlue,
               styleNormalFillColor = lightGray,
               styleActiveTextColor = pinkIHope,
               styleActiveEdgeColor = pinkIHope
              }

style2 = 
    let darkPink = ColorRGB 1 0.5 0.5
    in style1 {styleNormalFillColor = white,
               styleActiveTextColor = darkPink,
               styleActiveEdgeColor = darkPink}

style3 = 
    let semiTranspBlue = ColorRGBA 0 0.2 0.9 0.5
    in style0 {exomargin = 10,
               styleNormalTextColor = yellow,
               styleNormalEdgeColor = yellow,
               styleNormalFillColor = darkBlueGreen,
               styleActiveTextColor = yellow,
               styleActiveEdgeColor = yellow,
               styleActiveFillColor = blueGreen,
               styleAuxColor = semiTranspBlue
              } 

defaultStyle = style3

wstyle :: Style
wstyle = 
    style3 { 
           -- smaller to allow multiple frames on one canvas
           styleFont = VFont "serif" FontSlantNormal FontWeightNormal 14,
           textMargin = 8.0,
           hpad = 10.0, vpad = 24.0, 
           vtinypad = (0.0, 0.0),
           exomargin = 10.0,    -- between tree and window edges
           styleFramePad = 15,

           -- colors
           styleNormalTextColor = yellow,
           styleNormalEdgeColor = mediumGray,
           styleNormalFillColor = darkBlueGreen,

           styleActiveTextColor = yellow,
           styleActiveEdgeColor = mediumGray,
           styleActiveFillColor = blueGreen,

           styleSelectedTextColor = black,
           styleSelectedEdgeColor = lightBlueGreen,
           styleSelectedFillColor = lightBlueGreen,

           styleTetherColor =
               ColorRGBA 0.7 0.7 0.7 0.3, -- light gray
           
           -- node values
           styleAuxOffset = Position 0 (-16),
           styleAuxFont = VFont "serif" FontSlantItalic FontWeightNormal 12,
           styleAuxColor = ColorRGBA 0.9 0.5 0.5 1.0,
               -- ColorRGBA 1 0.9 0.9 0.75 
           styleIoletRadius = 5
         }
 

pointInLayoutNode :: Position -> LayoutNode e -> Bool
pointInLayoutNode point = pointInGNode point . nodeGNode

pointInGNode :: Position -> GNode e -> Bool
pointInGNode point = pointInBB point . gnodeNodeBB

-- UNUSED: findNode (except in findRect)
-- find the node, if any, containing a point 
-- might need to adjust this to take iolets into account ******
findNode :: Position -> TreeLayout e -> Maybe (LayoutNode e)
findNode point (T.Node node@(LayoutNode _rootGNode treeBB) sublayouts) =
    if pointInBB point treeBB
    then if pointInLayoutNode point node
         then Just node
         else findInSubs point sublayouts
    else Nothing

    where findInSubs :: Position -> [TreeLayout e] -> Maybe (LayoutNode e)
          findInSubs _p [] = Nothing
          findInSubs p (l:ls) = 
              let found = findNode p l in
              case found of
                (Just _) -> found
                Nothing -> findInSubs p ls

-- UNUSED: findRect
findRect :: Position -> TreeLayout e -> Maybe Rectangle
findRect point tlo = 
    case findNode point tlo of
      Nothing -> Nothing
      Just node -> Just (bbToRect (gnodeNodeBB (nodeGNode node)))

setFont :: VFont -> Render ()
setFont (VFont face slant weight size) = do
  selectFontFace face slant weight
  setFontSize size

data FontTextExtents = FontTextExtents {
      fontAscent::Double, fontDescent::Double, fontHeight::Double,
      fontMaxXadvance::Double, fontMaxYadvance::Double,
      textXbearing::Double, textYbearing::Double,
      extTextWidth::Double, extTextHeight::Double,
      textXadvance::Double, textYadvance::Double}
                       deriving (Eq, Read, Show)

measureText :: Style -> String -> Size
measureText style str =
    let extents = styleTextExtents style str
        in Size (textXadvance extents)
                (fontHeight extents + fontDescent extents)

-- Rationale for unsafePerformIO:
-- font extents of a string will not change unless the font itself
-- changes, which is extremely unlikely

styleTextExtents :: Style -> String -> FontTextExtents
styleTextExtents style str = 
    unsafePerformIO $ 
    withImageSurface FormatARGB32 0 0 $ \ surface ->
        renderWith surface $ 
          setFont (styleFont style) >>
          ftExtents str

-- | ftExtents: used for what?
ftExtents :: String -> Render FontTextExtents
ftExtents text = do
  FontExtents asc desc fheight maxxadv maxyadv <- fontExtents
  TextExtents xbear ybear twidth theight xadv yadv <- textExtents text
  return (FontTextExtents asc desc fheight maxxadv maxyadv
                          xbear ybear twidth theight xadv yadv)

data TextBox = TextBox {tbText :: String,
                        tbTextBB :: BBox, -- BBox of text without margins
                        tbBoxBB :: BBox -- of text with margins
                       }
             deriving (Eq, Read, Show)

makeTextBox :: Style -> String -> TextBox
makeTextBox style text =
  let extents = styleTextExtents style text
      Size textW textH = measureText style text
      -- textW = textXadvance extents
      -- textH = fontHeight extents + fontDescent extents
      margin = textMargin style

      boxW = textW + 2.0 * margin -- max (textW + 2.0 * margin) minWidth
      boxH = textH + 2.0 * margin

      boxX = 0
      boxY = 0

      textX = (boxW - textW) / 2.0
      -- raise text slightly, by a fraction of its font descent
      -- (why? because it just looks better!)
      -- Maybe this should be made an aspect of style?
      raise = 0.5 * fontDescent extents
      textY = fontHeight extents + (boxH - textH) / 2.0 - raise

      textBB = BBox textX textY textW textH
      boxBB = BBox boxX boxY boxW boxH

  in TextBox text textBB boxBB

instance Widen TextBox where
    widen tb@(TextBox _text textBB boxBB) minWidth =
        let w = bbWidth boxBB
        in if w >= minWidth
           then tb
           else let dw = minWidth - w 
                in tb {tbTextBB = translate (dw / 2) 0 textBB,
                       tbBoxBB = widen boxBB minWidth}

instance Translate TextBox where
    translate dx dy (TextBox text textBB boxBB) = 
        TextBox text (translate dx dy textBB) (translate dx dy boxBB)


tbWidth :: TextBox -> Double
tbWidth = bbWidth .tbBoxBB

tbSetWidth :: TextBox -> Double -> TextBox
tbSetWidth tbox w = 
    let TextBox text textBB boxBB = tbox
        boxBB' = bbSetWidth boxBB w
        (dx, dy) = positionDelta (bbCenter boxBB) (bbCenter boxBB')
    in TextBox text (translate dx dy textBB) boxBB'

tbHeight :: TextBox -> Double
tbHeight = bbHeight . tbBoxBB

tbBottom :: TextBox -> Double
tbBottom = bbBottom . tbBoxBB

-- The geometric "center" of a TextBox is the center of its "BoxBB"
tbCenter :: TextBox -> Position
tbCenter = tbBoxCenter
 
tbBoxCenter :: TextBox -> Position
tbBoxCenter = bbCenter . tbBoxBB

-- and the center of its text should have the same x coordinate,
-- but due to the way text is positioned, maybe not the same y.
-- But do we ever need this?
tbTextCenter :: TextBox -> Position
tbTextCenter = bbCenter . tbTextBB

offsetTextBoxCenters :: Position -> TextBox -> TextBox -> TextBox
offsetTextBoxCenters offset anchor floater =
  -- Position the floater text box so that its center differs
  -- from the anchor text box by the given offset.
  -- (The offset argument comes first, like dx dy in translate.)
  let Position ax ay = tbBoxCenter anchor
      Position fx fy = tbBoxCenter floater
      Position ox oy = offset
      -- translate floater by (dx, dy), where fx + dx = ax + ox, 
      -- so dx = ax + ox - fx; and dy similarly
      dx = ax + ox - fx
      dy = ay + oy - fy
  in translate dx dy floater


-- GNode = graphical node, suitable for drawing
data GNode e = GNode {gnodeValue :: e, 
                      gnodeTextBoxes :: [TextBox], -- one or two only
                      gnodeNodeBB :: BBox,    -- encloses all textboxes
                      gnodeInlets :: [Iolet], -- input connectors
                      gnodeOutlets :: [Iolet] -- output connectors
                     }
               deriving (Eq)

gnodeText :: GNode e -> String
gnodeText = tbText . head . gnodeTextBoxes

gnodeTextBB :: GNode e -> BBox
gnodeTextBB = tbTextBB . head . gnodeTextBoxes

instance (Show e) => Show (GNode e) where
    show (GNode v tbs nodeBB inlets outlets) = 
        par "GNode" [show v, show tbs, show nodeBB, show inlets, show outlets]

instance (Repr e) => Repr (GNode e) where
    repr (GNode v tbs nodeBB inlets outlets) = 
        par "GNode" [repr v, show tbs, show nodeBB, show inlets, show outlets]
  
instance Translate (GNode e) where
    translate dx dy (GNode value textboxes nodeBB inlets outlets) = 
          GNode value 
                (map (translate dx dy) textboxes)
                (translate dx dy nodeBB)
                (translate dx dy inlets)
                (translate dx dy outlets)


-- An IoletCounter returns (no. of inlets, no. of outlets)
type IoletCounter e = e -> (Int, Int)

-- A sort of "default" IoletCounter returning zeroes
zeroIoletCounter :: IoletCounter e
zeroIoletCounter _node = (0, 0)

-- An IoletsMaker ???
-- type IoletsMaker e = Style -> e -> ([Position], [Position])

makeGNode :: (Repr e) => Style -> IoletCounter e -> e -> GNode e
makeGNode style countIolets value =
  -- The function countIolets creates a tuple (# of inlets, # of outlets)
  -- for the node, of course being (0, 0) if we don't want any.
  let textboxes1 = map (makeTextBox style) (reprl value)
      textboxes2 = case textboxes1 of
                     [_tb] -> textboxes1
                     [tb1, tb2] -> 
                         [tb1, 
                          offsetTextBoxCenters (styleAuxOffset style) tb1 tb2]
                     _ -> wrong textboxes1
      nodeBB = case textboxes2 of
                 [tb] -> tbBoxBB tb
                 [tb1, tb2] -> bbMerge (tbBoxBB tb1) (tbBoxBB tb2)
                 _ -> wrong textboxes2
      wrong tbs = 
          errcats ["makeGNode: wrong no. of text boxes;",
                   "expected 1 or 2, but got", show (length tbs)]
      (inlets, outlets) = makeIolets style nodeBB (countIolets value)
  in GNode value textboxes2 nodeBB inlets outlets

makeIolets :: Style -> BBox -> (Int, Int) -> ([Iolet], [Iolet])
makeIolets style bbox (nin, nout) =
    -- make the (inlets, outlets)
    (makeIoletsRow style (bbXCenter bbox) (bbBottom bbox) nin,
     makeIoletsRow style (bbXCenter bbox) (bbTop bbox) nout)

makeIoletsRow :: Style -> Double -> Double -> Int -> [Iolet]
makeIoletsRow style cx cy n =
    -- make a row of n Iolets, centered at (cx, cy)
    let radius = styleIoletRadius style
        diam = 2 * radius -- diameter
        w = fromIntegral n * diam
        x1 = cx - w / 2 + radius     -- the center of the first iolet
        x i = x1 + fromIntegral (i - 1) * diam
        make i = Iolet (Circle (Position (x i) cy) radius)
    in map make [1..n]

-- | An Iolet is a circular port.
-- Other shapes could be added.
newtype Iolet = Iolet Circle
             deriving (Eq, Read, Show)

instance Translate Iolet where
    translate dx dy (Iolet circle) = Iolet (translate dx dy circle)

ioletCenter :: Iolet -> Position
ioletCenter (Iolet circle) = circleCenter circle

pointInIolet :: Position -> Iolet -> Bool
pointInIolet point (Iolet circle) = pointInCircle point circle

-- Build a Tree of node Sizes parallel to the Repr tree,
-- each node in the Size tree is the size of 
-- the corresponding node in the repr tree.

-- treeSizes: given a tree of *node* sizes, for the root nodes of the tree
-- and its subtrees, returns a tree of *tree* sizes

treeSizes :: Style -> Tree (GNode e) -> Tree Size
treeSizes style gTree = 
    let subtreeSizes = map (treeSizes style) (subForest gTree)
        (BBox _ _ rootWidth rootHeight) = gnodeNodeBB (rootLabel gTree)
        treeWidth = max rootWidth (paddedWidth style subtreeSizes)
        treeHeight = rootHeight + paddedHeight style subtreeSizes
    in T.Node (Size treeWidth treeHeight) subtreeSizes

-- (paddedWidth style subtrees) and (paddedHeight style subtrees)
-- compute the total size of all subtrees
-- of of a Size tree, including padding.
paddedWidth :: Style -> [Tree Size] -> Double
paddedWidth _style [] = 0
paddedWidth style subtrees =
    sum [w | (T.Node (Size w _h) _) <- subtrees] +
    hpad style * fromIntegral (length subtrees - 1)

-- UNUSED:
-- -- | pairSum is unused; should it be?
-- pairSum :: (Double, Double) -> Double
-- pairSum (a, b) = a + b

paddedHeight :: Style -> [Tree Size] -> Double
paddedHeight _style [] = 0
paddedHeight style subtrees = 
    vpad style + maximum [h | (T.Node (Size _w h) _) <- subtrees]

-- A TreeLayout is a Tree of LayoutNodes.
-- The root node in a TreeLayout identifies the root of the source Tree 
-- (nodeSource) and the node's bounding box (nodeNodeBB).
-- It also tells the bounding box of the whole tree (nodeTreeBB).
-- The subtrees of the TreeLayout are the TreeLayouts 
-- of the subtrees of the source Tree.

type TreeLayout e = Tree (LayoutNode e)

data LayoutNode e = LayoutNode {nodeGNode :: GNode e,
                                nodeTreeBB :: BBox}
                  deriving (Eq)

layoutNodeSource :: LayoutNode e -> e
layoutNodeSource = gnodeValue . nodeGNode

instance (Show e) => Show (LayoutNode e) where
  show (LayoutNode gnode treebb) = par "LayoutNode" [show gnode, show treebb]

instance (Repr e) => Repr (LayoutNode e) where
  repr (LayoutNode gnode treebb) = par "LayoutNode" [repr gnode, show treebb]
  
instance Translate (LayoutNode e) where
    translate dx dy (LayoutNode gnode treeBB) = 
        LayoutNode (translate dx dy gnode)
                   (translate dx dy treeBB)

instance Widen (LayoutNode e) where
  widen node@(LayoutNode gNode treeBB) minWidth =
    let dw = bbWidth treeBB - minWidth
    in if dw <= 0
       then node
       else LayoutNode (translate (dw / 2) 0 gNode)
                       (widen treeBB minWidth)

-- Try this, it's tough!
--     instance (Draw n, Widen n) = Widen (Tree n) where ...
-- But why not just
--     instance (Widen n) = Widen (Tree n) where ...


-- UNUSED
-- -- | layoutRootSource: unused
-- layoutRootSource :: TreeLayout e -> e
-- layoutRootSource tree = layoutNodeSource (rootLabel tree)

layoutRootBB :: TreeLayout e -> BBox
layoutRootBB = gnodeNodeBB . nodeGNode . rootLabel

layoutTreeBB :: TreeLayout e -> BBox
layoutTreeBB = nodeTreeBB . rootLabel

treeLayout :: (Repr e) => Style -> IoletCounter e -> Tree e -> TreeLayout e
treeLayout style counter tree = 
  let t1 = treeGNodes style counter tree
      t2 = treeSizes style t1
      start = Position (hpad style) (vpad style)
      t3 = treeLayout2 style start tree t1 t2
  in treeLayoutAddMargin t3 (exomargin style)


-- treeGNodes produces a tree of (GNode e),
-- based on a top left corner at (0, 0) which, of course, will need
-- to be translated in the final tlo.

treeGNodes :: Repr e => 
  Style -> IoletCounter e -> Tree e -> Tree (GNode e)
treeGNodes style counter tree = fmap (makeGNode style counter) tree

treeLayout2 :: (Repr e) =>
               Style -- ^ tree style
            -> Position  -- ^ top left after padding
            -> Tree e  -- ^ the tree being laid out 
                       -- (actually we don't need the tree as an argument;
                       -- it's implied by the GNode tree)
            -> Tree (GNode e) -- ^ "node sizes"
            -> Tree Size -- ^ tree Sizes
            -> TreeLayout e

treeLayout2 style
            (Position startX startY)
            (T.Node _root subtrees)
            (T.Node gnode subGNodes)                          
            (T.Node (Size treeWidth treeHeight) subTreeSizes) 
    = 
      let 
        nodeHeight = bbHeight (gnodeNodeBB gnode)
        -- center the root in its level
        -- UNUSED:
        -- nodeCenterX = startX + treeWidth / 2
        -- nodeCenterY = startY + nodeHeight

        -- center the subtrees (may be wider or narrower than the root)
        subtreesTotalWidth =  paddedWidth style subTreeSizes
        subX = startX + (treeWidth - subtreesTotalWidth) / 2 -- first subtree
        subY = startY + nodeHeight + vpad style

        sublayouts :: (Repr e) =>
                      Double -> [Tree e] -> [Tree (GNode e)] -> [Tree Size] -> 
                      [TreeLayout e]
        sublayouts _ [] [] [] = []
        sublayouts x (t:ts) (g:gs) (s:ss) = 
            treeLayout2 style (Position x subY) t g s :
            sublayouts (x + sizeW (rootLabel s) + hpad style) ts gs ss
        sublayouts _ _ _ _ = error "treeLayout2: mismatched list lengths"

    in T.Node (LayoutNode -- root node
               (centerGNode gnode startX startY treeWidth nodeHeight) -- node
               (BBox startX startY treeWidth treeHeight)) -- whole tree
           (sublayouts subX subtrees subGNodes subTreeSizes)

-- | Center a GNode in a rectangular area
centerGNode :: GNode e -> Double -> Double -> Double -> Double -> GNode e
centerGNode gnode startx starty awidth aheight =
    let cx = startx + awidth / 2 -- desired center
        cy = starty + aheight / 2
        Position cgx cgy = bbCenter (gnodeNodeBB gnode)
    in translate (cx - cgx) (cy - cgy) gnode
    
treeLayoutPaddedSize :: Style -> TreeLayout e -> Size
treeLayoutPaddedSize style tlo =
  let Size w h = treeLayoutSize tlo
  in Size (w + 2.0 * hpad style) (h + 2.0 * vpad style)

treeLayoutSize :: TreeLayout e -> Size
treeLayoutSize tlo = 
    let BBox _x _y w h = layoutTreeBB tlo in Size w h

layoutTreeMoveCenterTo :: 
    Double -> Double -> TreeLayout e -> TreeLayout e
layoutTreeMoveCenterTo newX newY layoutTree =
    let Position oldX oldY = bbCenter (nodeTreeBB (rootLabel layoutTree))
    in translate (newX - oldX) (newY - oldY) layoutTree

treeLayoutAddMargin :: TreeLayout e -> Double -> TreeLayout e
treeLayoutAddMargin tree margin =
    let LayoutNode {nodeGNode = rootGNode, nodeTreeBB = treeBB} =
            rootLabel tree
        subtrees = subForest tree
        BBox x y w h = treeBB
        treeBB' = BBox (x - margin) (y - margin) 
                  (w + 2 * margin) (h + 2 * margin)
        root' = translate margin margin (LayoutNode rootGNode treeBB')
        subtrees' = translate margin margin subtrees
    in T.Node root' subtrees'

        

treeLayoutWidth :: TreeLayout e -> Double
treeLayoutWidth = bbWidth . layoutTreeBB

treeLayoutWiden :: TreeLayout e -> Double -> TreeLayout e
treeLayoutWiden tlo minWidth =
    let w = treeLayoutWidth tlo
    in
      if w >= minWidth
      then tlo
      else let dw = minWidth - w
               T.Node root subs = translate (dw / 2) 0 tlo
               LayoutNode rootGNode treeBB = root
               root' = LayoutNode rootGNode 
                                  (translate (-dw / 2) 
                                             0 
                                             (widen treeBB minWidth))
           in T.Node root' subs