diff --git a/CHANGES b/CHANGES
--- a/CHANGES
+++ b/CHANGES
@@ -1,3 +1,46 @@
+0.14.0 to 0.15.0:
+
+  * Updated to work with latest Wumpus libraries. 
+    @ScalingContext@ has been temporarily added from Wumpus-Basic 
+    (it was considered obsolete there). At some point the 
+    functionality needs re-implementing so it can be removed from 
+    Tree.
+  
+0.13.0 to 0.14.0:
+
+  * Updated to work with latest Wumpus libraries. 
+
+0.12.0 to 0.13.0:
+
+  * Changed the specification of trees so that they are built in a
+    monad. The bind operation of the monad allows /anchors/ to be 
+    extracted from tree nodes so they can be annotated with 
+    supplementary graphics. At the moment this is rather limited 
+    as Wumpus-Basic and Wumpus-Drawing do not offer much support 
+    for anchors other than the basic type classes.
+
+  * Changed the type of the rendering functions so they produce a 
+    TreeDrawing. This type is more suitable for building composite
+    pictures than the previous type TreePicture. 
+
+  * Also the rendering functions now take a start point for the 
+    root node, again this should be more convenient for drawing 
+    composite pictures - see the demo which now draws all the 
+    example trees on one page.
+
+  * Internally the tree design is now more flexible - trees can be 
+    designed upwards or leftwards rightwards, rather than just 
+    downwards; and edge drawing style is lifted out of the 
+    rendering to use a supplied combinator. Currently these 
+    features are not exposed by the API, the API needs more 
+    thought (possibly warranting changes to Wumpus-Basic and 
+    Wumpus-Drawing).
+
+
+0.11.1 to 0.12.0:
+
+  * Internal changes to track updates to Wumpus-Basic.
+ 
 
 0.11.0 to 0.11.1:
 
diff --git a/demo/Demo01.hs b/demo/Demo01.hs
--- a/demo/Demo01.hs
+++ b/demo/Demo01.hs
@@ -1,23 +1,13 @@
 {-# OPTIONS -Wall #-}
 
--- Note - @main@ is more convoluted than would normally be 
--- expected as it supports both sources of glyph metrics - the 
--- GhostScript distribution or the Core 14 metrics from Adobe.
--- 
--- \"Real\" applications would be expected to choose one source. 
---
--- I-am-not-a-lawyer, but it does look as though the Adobe font
--- metrics are redistributable, the GhostScript metrics are 
--- seemingly redistributable under the same terms as the larger
--- GhostScript distribution.
--- 
 
 module Demo01 where
 
 import Wumpus.Tree
-import Wumpus.Tree.TreeBuildMonad
+-- import Wumpus.Tree.TreeBuildMonad
 
 import Wumpus.Drawing.Colour.SVGColours         -- package: wumpus-drawing
+import Wumpus.Drawing.Dots.AnchorDots
 import Wumpus.Drawing.Text.StandardFontDefs
 
 import Wumpus.Basic.Kernel                      -- package: wumpus-basic
@@ -35,7 +25,7 @@
 main1 :: FontLoader -> IO ()
 main1 loader = do
     createDirectoryIfMissing True "./out/" 
-    base_metrics <- loader [ Right helvetica_family ]
+    base_metrics <- loader [ Right times_roman_family ]
     printLoadErrors base_metrics
     let pic1 = runCtxPictureU (makeCtx 18 base_metrics) tree_pic1
     writeEPS "./out/regular_tree01.eps"  pic1
@@ -50,39 +40,44 @@
 tree_pic1 :: CtxPicture
 tree_pic1 = udrawTracing (0::Double) $ do
     --
-    draw $ plainTextLine "Tree 1:"        `at` (P2 0  530)
-    drawScaledTree (uniformSF 30)         (P2 80 530) $ 
-       runTreeBuild charNode tree1
+    draw $ dcTextlabel "Tree 1:"        `at` (P2 0  550)
+    drawl (P2 10 500) $ runTreeLoc props1 (const red_dot) tree1
     --
-    draw $ plainTextLine "Tree 2:"       `at` (P2 160 530) 
-    drawScaledTree (uniformSF 30)        (P2 240 530) $ 
-        runTreeBuild (diskNode red) tree2
+    draw $ dcTextlabel "Tree 2:"       `at` (P2 200 550) 
+    drawl (P2 300 550) $ runTreeLoc props2 dotChar tree2
 
-    draw $ plainTextLine "Tree 3:"       `at` (P2 0  410) 
+    draw $ dcTextlabel "Tree 3:"       `at` (P2 0  410) 
     localize (set_font_size 12) $ 
-        drawScaledFamilyTree (uniformSF 25) (P2 280 410) $ 
-          runTreeBuild charNode tree3
+        drawl (P2 280 410) $ runTreeLoc props3 dotChar tree3
 
     --
-    draw $ plainTextLine "Tree 4:"       `at` (P2 0  200)
-    drawScaledTree (scaleFactors 20 30)  (P2 80 200) $ 
-        runTreeBuild (circleNode black) tree4
+    draw $ dcTextlabel "Tree 4:"       `at` (P2 0  190)
+    drawl (P2 80 190) $ runTreeLoc props4 (const circ_dot) tree4
     --
-    draw $ plainTextLine "Tree 5:"        `at` zeroPt
-    drawScaledTree (scaleFactors 20 30)  (P2 240 0) $
-        runTreeBuild (circleNode black)  tree5
+    draw $ dcTextlabel "Tree 5:"        `at` zeroPt
+    drawl (P2 320 0) $ runTreeLoc props5 (const circ_dot) tree5
+  where
+    red_dot  = localize (fill_colour red) dotDisk
+    circ_dot = localize (stroke_colour black) dotCircle
 
+    props1 = tree_direction TREE_RIGHT $ standardTreeProps 30 30 radialOTMC
+    props2 = standardTreeProps 30 40 familyOTMC
+    props3 = tree_direction TREE_DOWN $ standardTreeProps 25 30 familyOTMC
+    props4 = standardTreeProps 20 30 radialOTMC
+    props5 = standardTreeProps 30 36 radialOTMC
 
 
-tree1 :: TreeBuild u (TreeSpec Char)
-tree1 = regularBuild $ Node 'A' [Node 'B' bs, Node 'F' fs]
+tree1 :: Tree Char
+tree1 = Node 'A' [Node 'B' bs, Node 'F' fs]
   where
     bs = [Node 'C' [], Node 'D' [], Node 'E' []]
     fs = [Node 'G' [Node 'H' [], Node 'I' [], Node 'J' []]]
 
 
-tree2 :: TreeBuild u (TreeSpec Char)
-tree2 = regularBuild $ Node 'A' [Node 'B' bs, Node 'F' [], Node 'G' gs]
+
+
+tree2 :: Tree Char
+tree2 = Node 'A' [Node 'B' bs, Node 'F' [], Node 'G' gs]
   where
     bs = [Node 'C' [], Node 'D' [], Node 'E' []]
     gs = [Node 'H' [], Node 'I' [], Node 'J' []]
@@ -91,8 +86,10 @@
 -- This is the tree from Andrew Kennedy's 
 -- /Functional Pearl Drawing Trees/
 --
-tree3 :: TreeBuild u (TreeSpec Char)
-tree3 = regularBuild $ Node 'A' [a1, a2, a3]
+-- Draw with dotChar.
+--
+tree3 :: Tree Char
+tree3 = Node 'A' [a1, a2, a3]
   where
     a1 = Node 'B' [b1, b2]
     a2 = Node 'S' [b3,b4]
@@ -123,8 +120,8 @@
 -- This is the tree (a) T3 from Buchheim, Junger and Leipert
 -- /Improving Walker\'s Algorithm to Run in Linear Time/.
 -- 
-tree4 :: TreeBuild u (TreeSpec Int)
-tree4 = regularBuild $ Node 1 [a1, a2]
+tree4 :: Tree Int
+tree4 = Node 1 [a1, a2]
   where
     a1 = Node  2 [b1]
     a2 = Node  3 [b2, b3]
@@ -137,6 +134,7 @@
     d1 = Node 11 [tleaf 14]
     d2 = Node 13 [tleaf 15]
 
+
 -- This is the tree (b) T3 from Buchheim, Junger and Leipert
 -- /Improving Walker\'s Algorithm to Run in Linear Time/.
 -- 
@@ -144,8 +142,8 @@
 -- spaces the leaves, it looks like the trees in that paper are 
 -- evenly spaced at the interior nodes too.
 -- 
-tree5 :: TreeBuild u (TreeSpec Int)
-tree5 = regularBuild $
+tree5 :: Tree Int
+tree5 = 
     Node 1 [a1, tleaf 3, tleaf 4, tleaf 5, a2, tleaf 7, tleaf 8, tleaf 9, a3]
   where
     a1 = Node  2 [ tleaf 11, tleaf 12, tleaf 13, tleaf 14, tleaf 15, tleaf 16
diff --git a/src/Wumpus/Tree.hs b/src/Wumpus/Tree.hs
--- a/src/Wumpus/Tree.hs
+++ b/src/Wumpus/Tree.hs
@@ -1,170 +1,49 @@
-{-# LANGUAGE TypeFamilies               #-}
-{-# LANGUAGE FlexibleContexts           #-}
 {-# OPTIONS -Wall #-}
 
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Wumpus.Tree
--- Copyright   :  (c) Stephen Tetley 2010
+-- Copyright   :  (c) Stephen Tetley 2010-2011
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
 -- Stability   :  highly unstable
 -- Portability :  GHC
 --
+-- Note - this module is a kludge whilst I work out a usable API.
+-- 
 --------------------------------------------------------------------------------
 
 module Wumpus.Tree
   (
-  -- * The type of rendered trees
-
-    ScaleFactors
-  , uniformSF
-  , scaleFactors
-
-  , drawScaledTree
-  , TreeDirection(..)
-  , drawScaledTreeD
-
-  , drawScaledFamilyTree
+  -- * Re-exports
+    module Wumpus.Tree.OTMConnectors
 
+  , TreeDirection(..) 
+  , tree_direction
+  , runTreeLoc
 
-  -- * Drawing nodes
-  , charNode
-  , textNode
-  , circleNode
-  , diskNode
+  -- * Definitions
+  , standardTreeProps
 
   )
   where
 
 import Wumpus.Tree.Base
-import Wumpus.Tree.Design
-import Wumpus.Tree.Draw
-import Wumpus.Tree.ScalingContext
-import Wumpus.Tree.TreeBuildMonad
+import Wumpus.Tree.DrawLoc
+import Wumpus.Tree.OTMConnectors
 
-import Wumpus.Basic.Kernel                      -- package: wumpus-basic
-import Wumpus.Drawing.Dots.AnchorDots
 
-import Wumpus.Core                              -- package: wumpus-core
 
-import Data.VectorSpace                         -- package: vector-space
 
 
 
-
--- | Customize the size of the printed tree.
---
--- A tree is /designed/ with a height of 1 unit between 
--- parent and child nodes.
---
--- The y-scaling factor multiplies the unit height, a scaling 
--- factor of 30 represents 30 /points/.
---
--- In the horizontal, 1 unit is the smallest possible distance 
--- between child nodes.
---
-type ScaleFactors u = ScalingContext u Int u
-
-
-
-
--- | Build uniform x- and y-scaling factors, i.e. @ x == y @.
---
-uniformSF :: Num u => u -> ScaleFactors u
-uniformSF u = ScalingContext (\x -> u * x)
-                             (\y -> u * fromIntegral y) 
-
-
-scaleFactors :: Num u => u -> u -> ScaleFactors u
-scaleFactors sx sy = ScalingContext (\x -> sx * x)
-                                    (\y -> sy * fromIntegral y)	
-
-
-
--- 
-
-drawScaledTree :: (Real u, Floating u, InterpretUnit u, InnerSpace (Vec2 u)) 
-               => ScaleFactors u -> Point2 u -> TreeBuildAns u 
-               -> TreeDrawing u
-drawScaledTree scale_f ogin (tree,annos) = 
-    drawTree annos $ design ogin scale_f tree
-
-
-
-data TreeDirection = TREE_UP | TREE_DOWN | TREE_LEFT | TREE_RIGHT
-  deriving (Eq,Ord,Show)
-
-drawScaledTreeD :: (Real u, Floating u, InterpretUnit u, InnerSpace (Vec2 u)) 
-                => ScaleFactors u -> Point2 u 
-                -> TreeDirection -> TreeBuildAns u 
-                -> TreeDrawing u
-drawScaledTreeD scale_f ogin tdir (tree,annos) = 
-    drawTree annos $ rotTree tdir $ design ogin scale_f tree
-
-
-
-
-rotTree :: (Real u, Floating u) 
-        => TreeDirection -> CoordTree u a -> CoordTree u a
-rotTree TREE_UP     = rotateAboutRoot pi
-rotTree TREE_DOWN   = id
-rotTree TREE_LEFT   = rotateAboutRoot (1.5*pi)
-rotTree TREE_RIGHT  = rotateAboutRoot (0.5*pi)
-
-
-
-
-drawScaledFamilyTree :: (Real u, Floating u, InterpretUnit u, InnerSpace (Vec2 u)) 
-               => ScaleFactors u -> Point2 u -> TreeBuildAns u 
-               -> TreeDrawing u
-drawScaledFamilyTree scale_f ogin (tree,annos) = 
-    drawFamilyTree annos $ design ogin scale_f tree
-
---------------------------------------------------------------------------------
--- Drawing functions
-
--- | Render tree nodes with a single character.
---
---  Useful for rendering @ Data.Tree Char @.
---
-charNode :: (Real u, Floating u, InterpretUnit u) 
-         => Char -> TreeNode u
-charNode = dotChar
-
-
--- | Tree nodes with a text label.
---
--- Useful for rendering @ Data.Tree String @.
---
--- Note the width of the label is not accounted for in the 
--- /design/ of the tree. Labels with long texts may overlap.
--- Also, only a single line of text is printed - any text after 
--- the first newline character will be dropped.
---
-textNode :: (Real u, Floating u, InterpretUnit u) 
-         => String -> TreeNode u
-textNode = dotText . uptoNewline
-  where
-    uptoNewline = takeWhile (/='\n')
-
--- | Tree nodes with a stroked circle.
---
--- Suitable for printing the shape of a tree, ignoring the data.
---
-circleNode :: (Floating u, InterpretUnit u) 
-           => RGBi -> (a -> TreeNode u)
-circleNode rgb = \_ -> localize (stroke_colour rgb) dotCircle
-
-
--- | Tree nodes with a filled circle.
---
--- Suitable for printing the shape of a tree, ignoring the data.
---
-diskNode :: (Floating u, InterpretUnit u) 
-         => RGBi -> (a -> TreeNode u)
-diskNode rgb = \_ -> localize (fill_colour rgb) dotDisk
-
-
+standardTreeProps :: Fractional u 
+                  => u -> u -> OTMAnchorConn u a -> TreeProps u a
+standardTreeProps sx sy otm_conn = 
+    TreeProps { tp_sibling_distance = sx 
+              , tp_level_distance   = sy
+              , tp_multiconn        = otm_conn         
+              , tp_direction        = TREE_DOWN
+              }  
 
diff --git a/src/Wumpus/Tree/Base.hs b/src/Wumpus/Tree/Base.hs
--- a/src/Wumpus/Tree/Base.hs
+++ b/src/Wumpus/Tree/Base.hs
@@ -4,7 +4,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Wumpus.Tree.Base
--- Copyright   :  (c) Stephen Tetley 2010
+-- Copyright   :  (c) Stephen Tetley 2010-2011
 -- License     :  BSD3
 --
 -- Maintainer  :  stephen.tetley@gmail.com
@@ -18,52 +18,43 @@
 module Wumpus.Tree.Base
   (
 
-    TreeDrawing
-  , DTreeDrawing
-  , CoordTree
-  
-  , TreeNode
-
-  , Design(..)
+    OTMAnchorConn
+  , TreeProps(..)
+  , TreePropsF
+  , TreeDirection(..)
+  , tree_direction
+  , getTreeConnector
 
   ) where
 
-import Wumpus.Basic.Kernel                      -- package: wumpus-basic
-import Wumpus.Drawing.Dots.AnchorDots
 
-import Wumpus.Core                              -- package: wumpus-core
 
-import Data.Tree
-
-
--- | A rendered tree - alias for for @Picture Double@ in 
--- Wumpus-Core.
---
-type TreeDrawing u      = TraceDrawing u ()
-
-type DTreeDrawing       = TreeDrawing Double
-
+import Wumpus.Basic.Kernel                      -- package: wumpus-basic
 
 
+type OTMAnchorConn u a = TreeDirection -> u -> a -> [a] -> Graphic u
 
 
--- | Tree annotated with positions.
---
-type CoordTree u a = Tree (Point2 u, a)
+data TreeProps u a = TreeProps
+      { tp_sibling_distance :: u
+      , tp_level_distance   :: u
+      , tp_multiconn        :: OTMAnchorConn u a
+      , tp_direction        :: TreeDirection
+      }  
 
+type TreePropsF u a = TreeProps u a -> TreeProps u a
 
+data TreeDirection = TREE_UP | TREE_DOWN | TREE_LEFT | TREE_RIGHT
+  deriving (Eq,Ord,Show)
 
--- | Tree nodes are currently a /Dot/ from Wumpus-Drawing.
---
--- At some point this should change to allow any object that 
--- supports anchors.
---
-type TreeNode u = DotLocImage u
+tree_direction :: TreeDirection -> TreePropsF u a
+tree_direction dir props = props { tp_direction = dir }
 
 
-data Design u a = Design 
-      { tree_design     :: CoordTree u a
-      , tree_bbox       :: BoundingBox u
-      }
-
+getTreeConnector :: (DrawingCtxM m, InterpretUnit u)
+                 => TreeProps u a -> m (a -> [a] -> Graphic u)
+getTreeConnector (TreeProps { tp_level_distance   = lvl
+                            , tp_multiconn        = conn
+                            , tp_direction        = dir  }) = 
+    uconvertCtx1 lvl >>= \ulvl -> return (conn dir ulvl)
 
diff --git a/src/Wumpus/Tree/Design.hs b/src/Wumpus/Tree/Design.hs
--- a/src/Wumpus/Tree/Design.hs
+++ b/src/Wumpus/Tree/Design.hs
@@ -1,10 +1,11 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# OPTIONS -Wall #-}
 
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Wumpus.Tree.Design
--- Copyright   :  (c) Stephen Tetley 2010
+-- Copyright   :  (c) Stephen Tetley 2010-2011
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -25,14 +26,22 @@
 
 module Wumpus.Tree.Design
   (
-    design
-  , rotateAboutRoot
+
+  -- * Design a tree
+    UW
+  , CoordTree
+  , design
+
+  -- * Post transform a tree design
+  , scaleTree
+  , orientateTree
+
   )
   where
 
 import Wumpus.Tree.Base
-import Wumpus.Tree.ScalingContext
 
+import Wumpus.Basic.Kernel              -- package: wumpus-basic
 
 import Wumpus.Core                      -- package: wumpus-core
 
@@ -41,53 +50,77 @@
 import Data.Tree
 
 
+-- | Tree unit width.
+-- 
+-- Trees are designed with 1.0 as the ideal width between nodes.
+-- This is represented as a specific newtype so it can be 
+-- contextually scaled after the design, before the tree is drawn.
+--
+newtype UW = UW { getUW :: Double }
+  deriving (Eq,Ord,Num,Floating,Fractional,Real,RealFrac,RealFloat)
 
+instance Show UW where
+  showsPrec p d = showsPrec p (getUW d)
 
+instance InterpretUnit UW where
+  normalize _ = realToFrac
+  dinterp   _ = realToFrac
+
+
+
+
+-- | Tree annotated with positions.
+-- 
+-- This is the result of 'design'.
+--
+type CoordTree a = Tree (Point2 UW, a)
+
+
 -- | XPos is an absolute position
 --
-type XPos u = u     
+type XPos = UW
 
-type XTree u a = Tree (XPos u, a)
+type XTree a = Tree (XPos, a)
 
 
 -- | Delta - difference in X-positions.
 --
-type Delta u = u
+type Delta = UW
 
 -- A horizontal span.
 --
-data HSpan u = HSpan !u !u
+data HSpan = HSpan !UW !UW
   deriving (Eq,Ord,Show)
 
 
 
-outsideMerge :: HSpan u -> HSpan u -> HSpan u
+outsideMerge :: HSpan -> HSpan -> HSpan
 outsideMerge (HSpan p _) (HSpan _ q) = HSpan p q
 
 
 
 
-moveSpan :: Num u => Delta u -> HSpan u -> HSpan u
+moveSpan :: Delta -> HSpan -> HSpan
 moveSpan d (HSpan p q) = HSpan (p+d) (q+d)
 
 
-newtype Extent u = Extent { span_list :: [HSpan u] }
+newtype Extent = Extent { span_list :: [HSpan] }
   deriving (Eq,Show)
 
 
-extlink :: u -> Extent u -> Extent u
+extlink :: UW -> Extent -> Extent
 extlink a (Extent as) = Extent $ (HSpan a a) :as 
 
 -- note is this just for left ... ?
 --
-midtop :: Fractional u => u -> Extent u -> XPos u
+midtop :: UW -> Extent -> XPos
 midtop r (Extent [])        = r
 midtop _ (Extent (HSpan p q:_)) = p + (0.5*(q-p))
 
 
 -- merge \"moving right\"...
 --
-mergeMR :: Num u => Delta u -> Extent u -> Extent u -> Extent u
+mergeMR :: Delta -> Extent -> Extent -> Extent
 mergeMR dx (Extent xs) (Extent ys) = Extent $ step xs ys
   where
     step ps     []     = ps
@@ -96,7 +129,7 @@
 
 -- dx is negative...
 --
-mergeML :: Num u => Delta u -> Extent u -> Extent u -> Extent u
+mergeML :: Delta-> Extent -> Extent -> Extent
 mergeML dx (Extent xs) (Extent ys) = Extent $ step xs ys
   where
     step ps     []     = map (moveSpan dx) ps
@@ -105,24 +138,23 @@
 
 
 
-extentZero :: Extent u
+extentZero :: Extent
 extentZero = Extent []
 
-extentOne :: XPos u -> Extent u
+extentOne :: XPos -> Extent
 extentOne x = Extent [HSpan x x]
 
 
 -- 'moveTree' is now recursive...
 --
-moveTree :: Num u => Delta u -> XTree u a -> XTree u a
+moveTree :: Delta -> XTree a -> XTree a
 moveTree dx (Node (x,a) subtrees) = Node ((x+dx),a) subtrees'
   where
     subtrees' = map (moveTree dx) subtrees
 
 
 
-fit :: (Fractional u, Ord u) 
-    => Extent u -> Extent u -> u
+fit :: Extent -> Extent -> UW
 fit a b = go (span_list a) (span_list b) 0.0 
   where
     go (HSpan _ p:ps) (HSpan q _:qs) acc = go ps qs (max acc (p - q + 1.0))
@@ -132,8 +164,7 @@
 -- Fitting the children of a node...
 
 
-fitleft :: (Fractional u, Ord u) 
-        => [(XTree u a,Extent u)] -> ([XTree u a], Extent u)
+fitleft :: [(XTree a,Extent)] -> ([XTree a], Extent)
 fitleft []           = ([],extentZero)
 fitleft ((l,ext):xs) = (l:ts,ext') -- left-most child unchanged
    where 
@@ -142,8 +173,7 @@
      step aex (t,ex)  = let dx = fit aex ex 
                         in (mergeMR dx aex ex, moveTree dx t)
 
-fitright :: (Fractional u, Ord u) 
-         => [(XTree u a, Extent u)] -> ([XTree u a], Extent u)
+fitright :: [(XTree a, Extent)] -> ([XTree a], Extent)
 fitright = post . foldr fn Nothing
   where
     post                        = fromMaybe ([],extentZero)
@@ -156,35 +186,38 @@
 
 
 
--- Note - this will tell how wide the tree is...
--- though the last exten is not necessarily the widest.
 
-designl :: forall a u. (Fractional u, Ord u) 
-        => Tree a -> (XTree u a, Extent u)
+-- | Design the tree from the left.
+-- 
+-- Left and right tree designs are merged.
+--
+designl :: forall a. Tree a -> (XTree a, Extent)
 designl (Node a [])   = (Node (0.0,a)  [],    extentOne 0.0)
 designl (Node a kids) = (Node (xpos,a) kids', ext1)
   where
-    xs              :: [(XTree u a, Extent u)]
+    xs              :: [(XTree a, Extent)]
     xs              = map designl kids
 
-    kids'           :: [XTree u a]
-    ext0, ext1      :: Extent u
+    kids'           :: [XTree a]
+    ext0, ext1      :: Extent
     (kids',ext0)    = fitleft xs
 
     xpos            = midtop 0.0 ext0
     ext1            = xpos `extlink` ext0
 
-
-designr :: forall u a. (Fractional u, Ord u) 
-        => XPos u -> Tree a -> (XTree u a, Extent u)
+-- | Design the tree from the right.
+-- 
+-- Right and left tree designs are merged.
+--
+designr :: forall a. XPos -> Tree a -> (XTree a, Extent)
 designr r (Node a [])   = (Node (r,a)  [],    extentOne r)
 designr r (Node a kids) = (Node (xpos,a) kids', ext1)
   where
-    xs              :: [(XTree u a, Extent u)]
+    xs              :: [(XTree a, Extent)]
     xs              = map (designr r) kids
 
-    kids'           :: [XTree u a]
-    ext0, ext1      :: Extent u
+    kids'           :: [XTree a]
+    ext0, ext1      :: Extent
     (kids',ext0)    = fitright xs
 
     xpos            = midtop r ext0
@@ -199,9 +232,8 @@
 -- 1.0 separating nodes it is rescaled as a post-processing step
 -- into drawable coordinates. 
 --
-design :: (Fractional u, Ord u)
-       => Point2 u -> ScalingContext u Int u -> Tree a -> CoordTree u a
-design ro sctx t = rootOrientate ro $ scaleDesign sctx 0 t3
+design :: Tree a -> CoordTree a
+design t = rootOrientate zeroPt $ decorateYPosns 0 t3
   where
     (t1,ext)                    = designl t
     (_, HSpan xmin xmax)        = stats ext
@@ -213,41 +245,28 @@
     zfn (x0,a) (x1,_)           = (mean x0 x1,a)
 
 
--- Scale the tree. Originally the tree has no y-positions (but by 
--- recursion they can be counted) and x-positions are respective 
--- to the unit width 1.0.
+-- Originally the tree has no y-positions, recurse through the 
+-- tree adding them...
 --
-scaleDesign :: Num uy 
-            => ScalingContext ux uy u -> uy -> Tree (XPos ux, a) -> CoordTree u a
-scaleDesign ctx lvl (Node (xpos,a) kids) = Node (pt,a) kids'
+decorateYPosns :: UW -> Tree (XPos, a) -> CoordTree a
+decorateYPosns lvl (Node (xpos,a) kids) = Node (pt,a) kids'
   where
-    pt    = scalePt ctx xpos lvl
-    kids' = map (scaleDesign ctx (lvl-1)) kids
+    pt    = P2 xpos lvl
+    kids' = map (decorateYPosns (lvl-1)) kids
      
     
 
-rootOrientate :: Num u => Point2 u -> CoordTree u a -> CoordTree u a
+rootOrientate :: Point2 UW -> CoordTree a -> CoordTree a
 rootOrientate (P2 ox oy) (Node (P2 x0 y0, val) kids) = 
     Node (P2 ox oy, val) $ map (mv (ox-x0) (oy-y0)) kids
   where
     mv dx dy (Node (P2 x y, a) ks) = let ks' = map (mv dx dy) ks 
                                      in Node (P2 (x+dx) (y+dy), a) ks'
 
--- Updating this to the latest Wumpus-Basic would make the 
--- function a query...
---
-rotateAboutRoot :: (Real u, Floating u) 
-                => Radian -> CoordTree u a -> CoordTree u a
-rotateAboutRoot ang (Node (ogin,val) kids) =
-    Node (ogin, val) $ map step kids
-  where
-    step (Node (p0, a) ks) = Node (rotA p0, a) $ map step ks
 
-    rotA                   = rotateAbout ang ogin
-
 -- find height and width
 --
-stats :: (Num u, Ord u) => Extent u -> (Int, HSpan u)
+stats :: Extent -> (Int, HSpan)
 stats (Extent [])     = (0,HSpan 0 0)
 stats (Extent (e:es)) = foldr fn (1,e) es
   where
@@ -257,7 +276,7 @@
 mean x y = (x+y) / 2.0
 
 
-minmaxMerge :: Ord u => HSpan u -> HSpan u -> HSpan u
+minmaxMerge :: HSpan -> HSpan -> HSpan
 minmaxMerge (HSpan p q) (HSpan p' q') = HSpan (min p p') (max q q')
 
 
@@ -266,6 +285,53 @@
   where
     step (p:ps) (q:qs) = treeZipWith f p q : step ps qs
     step _      _      = [] 
+
+
+
+
+
+--------------------------------------------------------------------------------
+-- Post design transformations...
+
+
+-- | 'scaleTree' : @ sibling_distance * level_distance * CoordTree -> Tree @
+--
+-- Scale a CoordTree - this forms a tree where the node label
+-- is a pair of @Point2 u@ and an @a@ (usually a LocImage).
+-- 
+scaleTree :: (DrawingCtxM m, InterpretUnit u)
+          => u -> u -> CoordTree a -> m (Tree (Point2 u, a))
+scaleTree sib_dist lvl_dist tree = 
+    getFontSize >>= \sz -> 
+    let fn = mkFun sz in return $ fmap (bimapL fn) tree
+  where
+    mkFun sz = \(P2 x y) -> let ux = sib_dist * (dinterp sz $ realToFrac x)
+                                uy = lvl_dist * (dinterp sz $ realToFrac y)
+                            in P2 ux uy
+
+
+
+
+-- | Orientate the Tree according to it\'s drawing direction.
+-- 
+-- This is a rotation about the root node.
+--
+orientateTree :: (Real u, Floating u)
+              => TreeDirection -> Tree (Point2 u, a) -> Tree (Point2 u, a)
+orientateTree TREE_DOWN  tree = tree
+orientateTree TREE_UP    tree = rotateAboutRoot pi tree
+orientateTree TREE_LEFT  tree = rotateAboutRoot (1.5*pi) tree
+orientateTree TREE_RIGHT tree = rotateAboutRoot (0.5*pi) tree
+
+
+rotateAboutRoot :: (Real u, Floating u)
+                => Radian -> Tree (Point2 u, a) -> Tree (Point2 u, a)
+rotateAboutRoot ang (Node (ogin,val) kids) =
+    Node (ogin, val) $ map step kids
+  where
+    step (Node (v0, a) ks) = Node (rotA v0, a) $ map step ks
+
+    rotA                   = rotateAbout ang ogin
 
 
 
diff --git a/src/Wumpus/Tree/Draw.hs b/src/Wumpus/Tree/Draw.hs
deleted file mode 100644
--- a/src/Wumpus/Tree/Draw.hs
+++ /dev/null
@@ -1,152 +0,0 @@
-{-# LANGUAGE TypeFamilies               #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# OPTIONS -Wall #-}
-
---------------------------------------------------------------------------------
--- |
--- Module      :  Wumpus.Tree.Draw
--- Copyright   :  (c) Stephen Tetley 2010
--- License     :  BSD3
---
--- Maintainer  :  stephen.tetley@gmail.com
--- Stability   :  unstable
--- Portability :  GHC
---
--- Drawing the tree using Wumpus-Basic.
---
---------------------------------------------------------------------------------
-
-module Wumpus.Tree.Draw 
-  (
-    drawTree
-  , drawFamilyTree
-
-  ) where
-
-import Wumpus.Tree.Base
-import Wumpus.Tree.TreeBuildMonad
-
-import Wumpus.Basic.Kernel                      -- package: wumpus-basic
-import Wumpus.Drawing.Dots.AnchorDots
-
-import Wumpus.Core                              -- package: wumpus-core
-
-
-import Control.Monad
-import qualified Data.IntMap as IntMap
-import Data.Tree hiding ( drawTree )
-
-
-
-
-drawTree :: (Real u, Floating u, InterpretUnit u) 
-          => NodeAnnoRefs u -> CoordTree u (TreeNodeAns u) -> TreeDrawing u
-drawTree annos tree = drawStep annos radialConns tree >> return ()
-
-
-
-drawFamilyTree :: (Real u, Floating u, InterpretUnit u) 
-          => NodeAnnoRefs u -> CoordTree u (TreeNodeAns u) -> TreeDrawing u
-drawFamilyTree annos tree = drawStep annos familyConn tree >> return ()
-
-
-drawStep :: (Real u, Floating u) 
-         => NodeAnnoRefs u 
-         -> (DotAnchor u -> [DotAnchor u] -> Graphic u)
-         -> CoordTree u (TreeNodeAns u) -> TraceDrawing u (DotAnchor u)
-drawStep annos connF (Node (pt,(fn, mb_ix)) ns) = do 
-    ancr <- drawi $ fn `at` pt
-    xs   <- mapM (drawStep annos connF) ns   
-    when (not $ null xs) $ draw $ connF ancr xs
-    drawAnno annos ancr mb_ix
-    return ancr
-
-drawAnno :: NodeAnnoRefs u -> DotAnchor u -> Maybe Int -> TraceDrawing u ()
-drawAnno _    _    Nothing   = return ()
-drawAnno refs ancr (Just ix) = maybe (return ()) sk $ IntMap.lookup ix refs
-  where
-    sk fn = draw $ fn ancr
-
-
-
-radialConns :: ( Real u, Floating u, InterpretUnit u
-               , CenterAnchor a, RadialAnchor a 
-               , u ~ DUnit a) 
-            => a -> [a] -> Graphic u
-radialConns a []     = emptyLocGraphic `at` (center a)
-radialConns a (x:xs) = oconcat (connector a x) (map (connector a) xs)
-
-
-
-connector :: ( Real u, Floating u, InterpretUnit u
-             , CenterAnchor a, RadialAnchor a
-             , u ~ DUnit a )  
-          => a -> a -> Graphic u
-connector a0 a1 = vertexPP [pt0,pt1] >>= openStroke
-  where
-    (ang0,ang1) = anchorAngles (center a0) (center a1)
-    pt0         = radialAnchor ang0 a0
-    pt1         = radialAnchor ang1 a1
-    
-
-
-
-
-anchorAngles :: (Real u, Floating u) 
-             => Point2 u -> Point2 u -> (Radian,Radian)
-anchorAngles f t = (theta0, theta1)
-  where
-    conn_v  = pvec f t
-    theta0  = vdirection conn_v
-    theta1  = if theta0 < pi then theta0 + pi else theta0 - pi
-    
-
-
-
-
-
---------------------------------------------------------------------------------
--- 
-
-familyConn :: ( Real u, Fractional u, InterpretUnit u
-              , CenterAnchor a, CardinalAnchor a 
-              , u ~ DUnit a ) 
-           => a -> [a] -> Graphic u
-familyConn a [] = emptyLocGraphic `at` (center a)
-familyConn a xs = famconn (south a) (map north xs)
-
-famconn :: (Fractional u, Ord u, InterpretUnit u) 
-        => Point2 u -> [Point2 u] -> Graphic u
-famconn _       []         = error "famconn - empty list"
-famconn pt_from [p1]       = famconn1 pt_from p1
-famconn pt_from xs@(p1:_)  = oconcat downtick (horizontal : upticks)
-   where
-     hh         = halfHeight pt_from p1
-     downtick   = locStraightLine (vvec (-hh)) `at` pt_from
-     horizontal = midline (displaceV (-hh) pt_from) xs 
-     upticks    = map (locStraightLine (vvec hh) `at`) xs
-
-midline :: (Fractional u, Ord u, InterpretUnit u) 
-        => Point2 u -> [Point2 u] -> Graphic u
-midline _        []           = error "midline - empty list" 
-midline (P2 _ y) (P2 x0 _:zs) = 
-    let (a,b) = foldr fn (x0,x0) zs in straightLine (P2 a y) (P2 b y)
-  where   
-    fn (P2 x _) (lo,hi) | x < lo    = (x,hi)
-                        | x > hi    = (lo,x)
-                        | otherwise = (lo,hi)
-
-halfHeight :: Fractional u => Point2 u -> Point2 u -> u
-halfHeight (P2 _ ya) (P2 _ yb) = 0.5 * (abs $ ya - yb)
- 
--- special case - should always be a vertical, but...
---
-famconn1 :: (Fractional u, InterpretUnit u)
-         => Point2 u -> Point2 u -> Graphic u
-famconn1 a@(P2 xa _) b@(P2 xb _) 
-    | xa == xb  = straightLine a b
-    | otherwise = vertexPP [a,m1,m2,b] >>= openStroke
-  where
-    hh = halfHeight a b
-    m1 = displaceV (-hh)     a  
-    m2 = displaceH (xb - xa) m1
diff --git a/src/Wumpus/Tree/DrawLoc.hs b/src/Wumpus/Tree/DrawLoc.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Tree/DrawLoc.hs
@@ -0,0 +1,112 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Tree.DrawLoc
+-- Copyright   :  (c) Stephen Tetley 2011
+-- License     :  BSD3
+--
+-- Maintainer  :  stephen.tetley@gmail.com
+-- Stability   :  unstable
+-- Portability :  GHC
+--
+-- Drawing a Tree as a LocGraphic.
+--
+--------------------------------------------------------------------------------
+
+module Wumpus.Tree.DrawLoc
+  (
+    
+    runTreeLoc
+
+  ) where
+
+import Wumpus.Tree.Base
+import Wumpus.Tree.Design
+
+
+import Wumpus.Basic.Kernel                      -- package: wumpus-basic
+
+import Wumpus.Core                              -- package: wumpus-core
+
+import Data.Tree hiding ( drawTree )
+
+
+--
+-- DESIGN NOTE 
+--
+-- Only simplistic trees can be drawn as LocGraphics.
+--
+-- Technically, this is because LocImages only support 
+-- /production/ of /answers/ and not their /introspection/, so
+-- we cannot query anchors directly[*] during construction. Thus 
+-- we can\'t have /graph-links/ which need /located/ anchors.
+--
+-- [*] Though we can use @dblelaborate@ for a special case.
+--
+
+
+-- | Build a LocGraphic from a @Data.Tree@.
+--
+-- Nodes support custom drawing as the value of the /label/ at 
+-- each node is interpreted (naturally, all node drawings must 
+-- be of the same type). 
+--
+runTreeLoc :: (Real u, Floating u, InterpretUnit u) 
+           => TreeProps u a -> (elt -> LocImage u a) -> Tree elt 
+           -> LocGraphic u
+runTreeLoc props drawF tree = promoteLoc $ \pt ->
+    let tree1 = fmap drawF tree
+    in zapQuery (runDesign props tree1) >>= \ans -> 
+       ignoreAns (drawStep props ans `at` pt)
+
+
+
+drawStep :: (Real u, Floating u, InterpretUnit u) 
+         => TreeProps u a -> Tree (LocImage u a) -> LocImage u a
+drawStep props (Node gf ns) =
+    getTreeConnector props >>= \conn ->
+    let imgs = sequence $ map (drawStep props) ns
+    in dblelaborate gf imgs conn
+      
+
+-- | This is not really a generally function - the types are not
+-- complementary and it returns only the first answer but consumes 
+-- the second, so it doesn\'t belong in Wumpus-Basic. 
+-- 
+-- However, it is a problematic that it needs to 
+-- deconstruct the Ans directly - this suggests there is a need 
+-- for a more general version of this combinator in Wumpus-Basic.
+-- 
+dblelaborate :: LocImage u a -> LocImage u b 
+             -> (a -> b -> Graphic u) 
+             -> LocImage u a
+dblelaborate ma mb fn = promoteLoc $ \pt -> 
+    both (ma `at` pt) (mb `at` pt) >>= \(a,b) -> fn a b >> return a
+
+designOrientateScale :: (Real u, Floating u, InterpretUnit u)
+                     => TreeProps u a  -> Tree (LocImage u a) 
+                     -> Query u (Tree (Point2 u, LocImage u a))
+designOrientateScale props tree =  
+    scaleTree sx sy (design tree) >>= \ans -> return $ orientateTree dir ans
+  where
+    dir = tp_direction props
+    sx  = tp_sibling_distance props
+    sy  = tp_level_distance props
+
+
+
+-- | Transform a tree where each node is a LocImage into a tree
+-- where each LocImage is displaced by the necessary coordinate
+-- so it can be drawn.
+--
+runDesign :: (Real u, Floating u, InterpretUnit u)
+          => TreeProps u a  -> Tree (LocImage u a) 
+          -> Query u (Tree (LocImage u a))
+runDesign props tree =  
+    designOrientateScale props tree >>= \tree2 -> 
+    return $ fmap fn tree2
+  where
+    fn ((P2 x y), gf) = moveStart (vec x y) gf
+
+
diff --git a/src/Wumpus/Tree/OTMConnectors.hs b/src/Wumpus/Tree/OTMConnectors.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Tree/OTMConnectors.hs
@@ -0,0 +1,173 @@
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Tree.Draw
+-- Copyright   :  (c) Stephen Tetley 2011
+-- License     :  BSD3
+--
+-- Maintainer  :  stephen.tetley@gmail.com
+-- Stability   :  unstable
+-- Portability :  GHC
+--
+-- One-to-many connectors.
+--
+--------------------------------------------------------------------------------
+
+module Wumpus.Tree.OTMConnectors
+  (
+
+    radialOTMC
+  , blankOTMC
+  , familyOTMC
+  , splayOTMC
+
+  ) where
+
+import Wumpus.Tree.Base
+
+import Wumpus.Drawing.Paths.Absolute            -- package: wumpus-drawing
+
+import Wumpus.Basic.Kernel                      -- package: wumpus-basic
+
+import Wumpus.Core                              -- package: wumpus-core
+
+import Data.AffineSpace                         -- package: vector-space
+
+import Data.Monoid
+
+
+
+
+
+-- Pulling out the points (nodes) from parent plus list of 
+-- children.
+
+
+radialNodes :: ( Real u, Floating u, InterpretUnit u
+               , CenterAnchor a, RadialAnchor a
+               , u ~ DUnit a )  
+            => a -> [a] -> [(Point2 u, Point2 u)]
+radialNodes a as = map fn as
+  where
+    actr = center a
+    fn x = (radialAnchor ang0 a , radialAnchor ang1 x) 
+             where (ang0, ang1) = anchorAngles actr (center x)
+        
+
+anchorAngles :: (Real u, Floating u) 
+             => Point2 u -> Point2 u -> (Radian,Radian)
+anchorAngles f t = (theta0, theta1)
+  where
+    conn_v  = pvec f t
+    theta0  = vdirection conn_v
+    theta1  = if theta0 < pi then theta0 + pi else theta0 - pi
+
+
+-- 
+-- @radialConn@ cannot be represented as a connector from
+-- one-point-to-many-points as the initial points all start from
+-- slightly different places. 
+--
+
+
+-- | 'radialOTMC' has no need for the TreeDirection or height step.
+-- 
+radialOTMC :: ( Real u, Floating u, InterpretUnit u
+              , CenterAnchor a, RadialAnchor a 
+              , u ~ DUnit a) 
+           => OTMAnchorConn u a
+radialOTMC _ _ a xs = mconcat $ map fn $ radialNodes a xs
+  where
+    fn (p0,p1) = zapQuery (vertexPP [p0,p1]) >>= dcOpenPath
+
+-- | Blank connector - nothing is drawn.
+--
+blankOTMC :: ( Real u, Floating u, InterpretUnit u
+            , CenterAnchor a
+            , u ~ DUnit a) 
+         => OTMAnchorConn u a
+blankOTMC _ _ a _ = emptyLocImage `at` center a
+
+
+--------------------------------------------------------------------------------
+-- 
+
+-- Note - can the \"crossbar\" of a famillyConn cannot be 
+-- calcuated parent-to-arbitrary-child?
+-- 
+-- Probably we need to know half the height step, rather than 
+-- calculate it from anchors.
+--
+
+-- Drawing a fmaily connector is quite horrible...
+
+
+
+familyOTMC :: ( Real u, Floating u, Ord u, Tolerance u, InterpretUnit u
+              , CenterAnchor a, CardinalAnchor a 
+              , u ~ DUnit a ) 
+           => OTMAnchorConn u a
+familyOTMC _   _ _ [] = mempty
+familyOTMC dir h a xs = 
+    let hh        = 0.5 * h
+        (paF,caF) = famAnchors dir
+        ptick     = outtick hh (center a) (paF a)
+        cticks    = map (\o -> outtick hh (center o) (caF o)) xs
+        kids      = sequence cticks
+    in ignoreAns ptick `mappend` (ignoreAns $ elaborate kids fn)
+  where
+    fn ps = case linkAll ps of
+              Nothing -> emptyLocImage `at` (center a)
+              Just path -> zapQuery (toPrimPath path) >>= dcOpenPath
+
+
+
+famAnchors :: (CardinalAnchor a, u ~ DUnit a ) 
+             => TreeDirection -> (a -> Anchor u, a -> Anchor u)
+famAnchors TREE_UP    = (north, south)
+famAnchors TREE_DOWN  = (south, north)
+famAnchors TREE_LEFT  = (west,  east)
+famAnchors TREE_RIGHT = (east,  west)
+
+
+
+outtick :: (Real u, Floating u, InterpretUnit u) 
+        => u -> Point2 u -> Point2 u -> Image u (Point2 u)
+outtick ll p0 p1 = 
+    let v0  = pvec p0 p1
+        ang = vdirection v0
+        v1  = avec ang ll
+        p2  = p0 .+^ v1
+    in replaceAns p2 (straightLine p1 p2)
+
+-- | The input list is expected to be ordered...
+--
+linkAll :: (Real u, Floating u, Ord u, Tolerance u) 
+        => [Point2 u] -> Maybe (AbsPath u)
+linkAll [] = Nothing
+linkAll xs = Just $ optimizeLines $ vertexPath xs
+
+
+
+
+
+splayOTMC :: ( Real u, Floating u, Ord u, Tolerance u, InterpretUnit u
+              , CenterAnchor a, CardinalAnchor a 
+              , u ~ DUnit a ) 
+           => OTMAnchorConn u a
+splayOTMC _   _ _ [] = mempty
+splayOTMC dir _ a xs = 
+    let (paF,caF) = famAnchors dir
+        p0        = paF a
+    in mconcat $ map (\x -> fn p0 (caF x)) xs
+  where
+    fn p0 p1 = zapQuery (vertexPP [p0,p1]) >>= dcOpenPath
+
+
+
+--------------------------------------------------------------------------------
+
+
diff --git a/src/Wumpus/Tree/ScalingContext.hs b/src/Wumpus/Tree/ScalingContext.hs
deleted file mode 100644
--- a/src/Wumpus/Tree/ScalingContext.hs
+++ /dev/null
@@ -1,103 +0,0 @@
-{-# OPTIONS -Wall #-}
-
---------------------------------------------------------------------------------
--- |
--- Module      :  Wumpus.Tree.ScalingContext
--- Copyright   :  (c) Stephen Tetley 2010-2011
--- License     :  BSD3
---
--- Maintainer  :  stephen.tetley@gmail.com
--- Stability   :  unstable
--- Portability :  GHC
---
--- Scaling in X and Y
---
--- \*\* WARNING \*\* - to be removed at some point.
--- 
---------------------------------------------------------------------------------
-
-module Wumpus.Tree.ScalingContext
-  (
-
-    ScalingContext(..)
-
-  , scaleX
-  , scaleY
-  , scalePt
-  , scaleVec
-
-  , unitX
-  , unitY
-
-  , uniformScaling
-  , coordinateScaling
-
-  ) where
-
-
-import Wumpus.Core				-- package: wumpus-core
-
-
-
--- | ScalingContext is a dictionary of two functions for scaling 
--- in X and Y.
---
-data ScalingContext ux uy u = ScalingContext
-      { scale_in_x  :: ux -> u
-      , scale_in_y  :: uy -> u
-      }
-
-
-scaleX              :: ScalingContext ux uy u -> ux -> u
-scaleX ctx ux       = (scale_in_x ctx) ux
-
-scaleY              :: ScalingContext ux uy u -> uy -> u
-scaleY ctx uy       = (scale_in_y ctx) uy
-
-
-scalePt             :: ScalingContext ux uy u -> ux -> uy -> Point2 u
-scalePt ctx ux uy   = P2 (scale_in_x ctx ux) (scale_in_y ctx uy)
-
-scaleVec            :: ScalingContext ux uy u -> ux -> uy -> Vec2 u
-scaleVec ctx ux uy  = V2 (scale_in_x ctx ux) (scale_in_y ctx uy)
-
-
-unitX               :: Num ux => ScalingContext ux uy u -> u
-unitX ctx           = scaleX ctx 1
- 
-unitY               :: Num uy => ScalingContext ux uy u -> u
-unitY ctx           = scaleY ctx 1
-
-
-
-
---------------------------------------------------------------------------------
--- constructors for scaling context
-
-
--- | Build a ScalingContext where both X and Y are scaled by the 
--- same uniform step.
---
--- The dimensions (types) of the ScalingContext are unified - the 
--- output type and the input types are all the same.
---
-uniformScaling :: Num u => u -> ScalingContext u u u
-uniformScaling u = ScalingContext
-      { scale_in_x  = (\x -> u*x)
-      , scale_in_y  = (\y -> u*y)
-      }
-
-
-
--- | Build a ScalingContext for scaling Int coordinates.
---
--- The scaling factors in X and Y can be different sizes.
----
-coordinateScaling :: Num u => u -> u -> ScalingContext Int Int u
-coordinateScaling sx sy = ScalingContext
-      { scale_in_x  = (\x -> sx * fromIntegral x)
-      , scale_in_y  = (\y -> sy * fromIntegral y)
-      }
-
-
-
diff --git a/src/Wumpus/Tree/TreeBuildMonad.hs b/src/Wumpus/Tree/TreeBuildMonad.hs
deleted file mode 100644
--- a/src/Wumpus/Tree/TreeBuildMonad.hs
+++ /dev/null
@@ -1,213 +0,0 @@
-{-# LANGUAGE TypeFamilies               #-}
-{-# OPTIONS -Wall #-}
-
---------------------------------------------------------------------------------
--- |
--- Module      :  Wumpus.Tree.TreeBuildMonad
--- Copyright   :  (c) Stephen Tetley 2010-2011
--- License     :  BSD3
---
--- Maintainer  :  stephen.tetley@gmail.com
--- Stability   :  unstable
--- Portability :  GHC
---
--- Build a tree within a monad - the monad allows anchor references.
---
---------------------------------------------------------------------------------
-
-module Wumpus.Tree.TreeBuildMonad
-  (
-    NodeId
-  , ZNodeId
-  , NodeAnno
-  , NodeAnnoRefs
-  
-  , TreeBuild
-  , TreeSpec
-  , ZTreeSpec
-
-  , TreeNodeAns
-  , TreeBuildAns
-  , runTreeBuild
-
-  , regularBuild
-
-  , nodeId
-  , label
-
-  , branch
-  , zbranch
-  , leaf
-  , zleaf
-
-  ) where
-
-import Wumpus.Tree.Base
-
-import Wumpus.Basic.Kernel                      -- package: wumpus-basic
-import Wumpus.Drawing.Dots.AnchorDots
-
-
-import Control.Applicative
-import qualified Data.IntMap as IntMap
-import Data.Monoid
-import Data.Tree
-
-
-
-
-
--- | Nodes can be bound with @(>>=)@ or in the do-notation before 
--- they are drawn. This is similar to the concept of /embedded/ 
--- nodes in TikZ. Bound nodes can be referenced by their anchors 
--- e.g. to give them an extra annotation.
---
--- This opaque type represents bound nodes and regular nodes that 
--- are just drawn and cannot be annotated.
--- 
-data NodeId a = NodeId Int
-              | RegularNode a
-  deriving (Eq)
-
--- The default node type. With this type, regular nodes have no
--- payload so can only be drawn as some common graphic e.g. a 
--- filled or stroked disk.
---
-type ZNodeId u = NodeId (UNil u)
-
-type NodeDrawRefs u = IntMap.IntMap (TreeNode u)
-
-type NodeAnno u     = DotAnchor u -> Graphic u
-
-type NodeAnnoRefs u = IntMap.IntMap (NodeAnno u)
-
-data St u = St
-      { uid_counter     :: Int
-      , node_refs       :: NodeDrawRefs u
-      , anno_refs       :: NodeAnnoRefs u
-      }
-
-
-zeroSt :: St u
-zeroSt = St { uid_counter = 0, node_refs = mempty, anno_refs = mempty }
-
-
-newtype TreeBuild u a = TreeBuild { getTreeBuild :: St u -> (a, St u) }
-
-instance Functor (TreeBuild u) where
-  fmap f ma = TreeBuild $ \s -> let (a,s1) = getTreeBuild ma s in (f a, s1)
-
-instance Applicative (TreeBuild u) where
-  pure a    = TreeBuild $ \s -> (a,s)
-  mf <*> ma = TreeBuild $ \s -> let (f,s1) = getTreeBuild mf s
-                                    (a,s2) = getTreeBuild ma s1
-                                in (f a,s2)
-
-instance Monad (TreeBuild u) where
-  return a  = TreeBuild $ \s -> (a,s)
-  ma >>= k  = TreeBuild $ \s -> let (a,s1) = getTreeBuild ma s 
-                                in getTreeBuild (k a) s1 
-
-
-type TreeSpec a   = Tree (NodeId a)
-type ZTreeSpec u  = TreeSpec (UNil u)
-
-
-type TreeNodeAns  u = (TreeNode u, Maybe Int)
-type TreeBuildAns u = (Tree (TreeNodeAns u), NodeAnnoRefs u)
-
--- | This is the @run@ function for the TreeBuild monad.
---
--- Note the monadic /command/ is type specialized to 
--- @(TreeSpec a)@, this is because evaluation in the TreeBuild
--- monad is only significant for producing a @Tree (TreeNode u)@.
---
-
-runTreeBuild :: (Real u, Floating u, InterpretUnit u)
-             => (a -> TreeNode u) -> TreeBuild u (TreeSpec a) -> TreeBuildAns u
-runTreeBuild regDrawF ma = 
-    let (a,s) = getTreeBuild ma zeroSt
-        t1    = postRun regDrawF (a, node_refs s)
-    in (t1, anno_refs s)
-
-
--- As the constructor to build NodeIds is not exposed a 
--- TreeBuild should not be able to refer to uninstantiated
--- nodes, however while the failure continuation should be 
--- unreachable we still need it in the code to make the 
--- IntMap.lookup total.
---
-postRun :: (Real u, Floating u, InterpretUnit u)
-        => (a -> TreeNode u) -> (TreeSpec a,NodeDrawRefs u) 
-        -> Tree (TreeNode u, Maybe Int)
-postRun regDrawF (tree1,table) = fmap changeNode tree1
-  where
-    changeNode (RegularNode a)  = (regDrawF a, Nothing)
-    changeNode (NodeId ix)      = maybe fk (sk ix) $ IntMap.lookup ix table 
-    
-    sk ix                       = \a -> (a, Just ix)
-    fk                          = (dotText "Error missing node", Nothing)
- 
-
-
--- | Turn an ordinary @Data.Tree@ into a /regular/ 'TreeSpec'.
---
--- All nodes become /regular/ nodes, no nodes are /bound/. Thus
--- nodes cannot be annotated etc.
---  
-regularBuild :: Tree a -> TreeBuild u (TreeSpec a)
-regularBuild (Node a kids) =  
-    Node (RegularNode a) <$> mapM regularBuild kids
-
-
-nodeId :: TreeNode u -> TreeBuild u (NodeId a)
-nodeId drawF = 
-    TreeBuild $ \(St ix nodes annos) -> 
-      let nodes' = IntMap.insert ix drawF nodes
-      in (NodeId ix, St (ix+1) nodes' annos)
-
--- | Note - this is not /in/ the TreeBuild monad.
---
-label :: a -> NodeId a 
-label a = RegularNode a
-
-
-{-
--- | Annotate a /node/ with a 'NodeAnno'.
--- 
--- Note - /regular/ nodes cannot be annotated, a node must be 
--- bound to a variable first with 'nodeId'.
---
--- Also this function is not so useful now Wumpus-Basic has
--- the @decorate@, @sdecorate@, and @adecorate@ functions.
--- 
-annotate :: u ~ DUnit a => NodeId a -> NodeAnno u -> TreeBuild u ()
-annotate (RegularNode _) _     = return ()
-annotate (NodeId nid)    annoF = 
-    TreeBuild $ \(St ix nodes annos) -> 
-      let annos' = IntMap.insert nid annoF annos
-      in ((), St ix nodes annos')
--}
-
-
-branch :: NodeId a -> [TreeSpec a] -> TreeSpec a
-branch uid kids = Node uid kids
-
-
--- | Default /branch/ - has children.
---
-zbranch :: [ZTreeSpec u] -> ZTreeSpec u
-zbranch kids = Node (RegularNode UNil) kids 
-
-leaf :: NodeId a -> TreeSpec a
-leaf uid = Node uid []
-
--- | Default /leaf/ - tree node with no children.
---
-zleaf :: ZTreeSpec u
-zleaf = Node (RegularNode UNil) []
-
-
-            
-
-
diff --git a/src/Wumpus/Tree/TreeBuilder.hs b/src/Wumpus/Tree/TreeBuilder.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Tree/TreeBuilder.hs
@@ -0,0 +1,316 @@
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Tree.TreeBuilder
+-- Copyright   :  (c) Stephen Tetley 2011
+-- License     :  BSD3
+--
+-- Maintainer  :  stephen.tetley@gmail.com
+-- Stability   :  unstable
+-- Portability :  GHC
+--
+-- Monadic building - trees with references for indirect 
+-- node-to-node connections and decoration
+--
+--------------------------------------------------------------------------------
+
+module Wumpus.Tree.TreeBuilder
+  (
+    AbsTreeSpec
+  , TreeSpec
+  , TbNode
+
+  , ref 
+  , leaf
+  , root
+  , mkleaf
+  , linkref    
+
+  , drawTreeSpec
+
+  ) where
+
+import Wumpus.Tree.Base
+import Wumpus.Tree.Design
+
+import Wumpus.Drawing.Basis.TraceGraphic        -- package: wumpus-drawing
+
+import Wumpus.Basic.Kernel                      -- package: wumpus-basic
+import Wumpus.Basic.Utils.HList
+
+import Wumpus.Core                              -- package: wumpus-core
+
+import Control.Applicative
+import qualified Data.IntMap as IM
+import Data.Monoid
+import Data.Tree
+
+-- TODO - are you sure this needs to build a Graphic rather than 
+-- a LocGraphic?
+
+
+data TbNode u a = RefNode Int (LocImage u a)
+                | PlainNode (LocImage u a)
+
+type instance DUnit (TbNode u a) = u
+
+
+
+type RefTree u a = Tree (TbNode u a)
+
+type CoordRefTree u a = Tree (Point2 u, TbNode u a)
+
+
+
+type LinkDraw u node  = (node -> node -> Graphic u)
+
+
+-- | This allows special connectors or edge labels.
+--
+type LinkRef u node = (Int,Int, LinkDraw u node)
+
+
+newtype TreeSpec node u a = TreeSpec { 
+          getTreeSpec :: Int -> (a, Int, H (LinkRef u node)) }
+
+type instance MonUnit (TreeSpec node u a) = u
+
+
+type AbsTreeSpec u node = TreeSpec node u (RefTree u node)
+
+
+-- Functor
+
+instance Functor (TreeSpec node u) where
+  fmap f ma = TreeSpec $ \s0 -> let (a,s1,w1) = getTreeSpec ma s0 
+                                in (f a, s1, w1)
+
+
+-- Applicative
+
+instance Applicative (TreeSpec node u) where
+  pure a    = TreeSpec $ \s0  -> (a, s0, mempty)
+  mf <*> ma = TreeSpec $ \s0 -> 
+                let (f,s1,w1) = getTreeSpec mf s0
+                    (a,s2,w2) = getTreeSpec ma s1
+                in (f a, s2, w1 `mappend` w2)
+
+
+-- Monad
+
+instance Monad (TreeSpec node u) where
+  return a = TreeSpec $ \s0 -> (a, s0, mempty)
+  ma >>= k = TreeSpec $ \s0 -> let (a,s1,w1) = getTreeSpec ma s0
+                                   (b,s2,w2) = (getTreeSpec . k) a s1
+                               in (b,s2, w1 `mappend` w2)
+
+
+runTreeSpec :: AbsTreeSpec u node -> (RefTree u node, [LinkRef u node])
+runTreeSpec ma = let (a,_,w1) = getTreeSpec ma 0 
+                 in (a, toListH w1)
+
+
+ref :: LocImage u node -> TreeSpec node u (TbNode u node)
+ref img = TreeSpec $ \s0 -> (RefNode s0 img, s0+1, mempty)
+
+leaf :: TbNode u node -> RefTree u node 
+leaf nod = Node nod []
+
+root :: TbNode u node -> [RefTree u node ] -> RefTree u node 
+root n1 xs = Node n1 xs
+
+mkleaf :: LocImage u node -> RefTree u node
+mkleaf img = Node (PlainNode img) []
+
+
+linkref :: TbNode u node -> TbNode u node -> LinkDraw u node -> TreeSpec node u ()
+linkref (RefNode ix _) (RefNode jx _) fn = TreeSpec $ \s0 -> 
+   ((), s0, wrapH $ (ix,jx, fn))
+
+linkref _              _              _  = TreeSpec $ \s0 -> ((), s0, mempty)
+
+
+
+-------------------------------------------------------------
+-- 
+
+
+
+
+-- | Map for indexed objects that support taking anchors.
+--
+type ObjectMap node = IM.IntMap node
+
+
+
+drawTreeSpec :: ( Real u, Floating u, InterpretUnit u
+                , DrawingCtxM m, TraceM m, u ~ MonUnit (m ())
+                )
+             => TreeProps u node -> Point2 u 
+             -> AbsTreeSpec u node
+             -> m ()
+drawTreeSpec props rootpt ma = 
+    let (rtree,links) = runTreeSpec ma
+    in  makeCoordRefTree props rootpt rtree >>= \ctree -> 
+        askDC >>= \ctx ->
+        let prim = rawBuildPrim ctx props ctree links
+        in trace prim 
+
+makeCoordRefTree :: ( Real u, Floating u, InterpretUnit u
+                    , DrawingCtxM m, u ~ MonUnit (m ())
+                    )
+                 => TreeProps u a -> Point2 u -> RefTree u a 
+                 -> m (CoordRefTree u a)
+makeCoordRefTree props (P2 x y) tree = 
+    scaleTree sx sy (design tree) >>= \ans -> return $ moveTree $ orient ans
+  where
+    orient   = orientateTree (tp_direction props)
+    moveTree = fmap (bimapL (displace $ V2 x y))
+    sx       = tp_sibling_distance props
+    sy       = tp_level_distance props
+
+
+-- Whoa - have to be very careful about producing something that 
+-- is consistent with the DrawingContext.
+-- 
+-- If we fork the DrawingContext we don\'t want to produce a 
+-- Graphic as a Graphic should be able to be (re-)drawn various 
+-- times in updated Contexts and reflect the changes each time.
+--
+-- Need a custom draw function... 
+
+
+
+rawBuildPrim :: InterpretUnit u 
+             => DrawingContext -> TreeProps u node 
+             -> CoordRefTree u node
+             -> [LinkRef u node]
+             -> HPrim u
+rawBuildPrim ctx props tree links = 
+    let (_,w1,o) = runBuilder ctx props (node1 tree) 
+        w2       = foldr (fn o) mempty links
+    in w1 `mappend` w2
+  where
+    fn imap (i,j,drawF) acc = case (IM.lookup i imap, IM.lookup j imap) of
+        (Just a, Just b) -> let (PrimW o _) = runImage ctx (drawF a b)
+                            in singleH o `mappend` acc
+        _                -> acc
+
+
+node1 :: InterpretUnit u
+      => CoordRefTree u node -> Builder node u node
+node1 (Node (pt, RefNode ix gf) kids) = 
+    let img = applyLoc gf pt
+    in do { a <- tellImage img
+          ; addNodeRef ix a
+          ; as <- mapM node1 kids
+          ; conn <- currentConnector
+          ; tellImage_ (conn a as)
+          ; return a
+          }
+
+node1 (Node (pt, PlainNode gf) kids) = 
+    let img = applyLoc gf pt
+    in do { a <- tellImage img
+          ; as <- mapM node1 kids
+          ; conn <- currentConnector
+          ; tellImage_ (conn a as)
+          ; return a
+          }
+
+
+--------------------------------------------------------------------------------
+-- Here a dependency on MTL would be useful...
+
+newtype MonBase node u a = MonBase { 
+    getMonBase :: TreeProps u node -> ObjectMap node -> (a, ObjectMap node) }
+
+newtype Builder node u a = Builder { 
+    getBuilder :: TraceGraphicT u (MonBase node u) a } 
+
+type instance MonUnit (MonBase node u a) = u
+type instance MonUnit (Builder node u a) = u
+
+
+-- Functor
+
+instance Functor (MonBase node u) where
+  fmap f ma = MonBase $ \env s0 -> let (a,s1) = getMonBase ma env s0 
+                                   in (f a, s1)
+
+instance Functor (Builder node u) where
+  fmap f = Builder . fmap f . getBuilder 
+
+
+-- Applicative
+
+instance Applicative (MonBase node u) where
+  pure a    = MonBase $ \_   s0  -> (a, s0)
+  mf <*> ma = MonBase $ \env s0 -> 
+                let (f,s1) = getMonBase mf env s0
+                    (a,s2) = getMonBase ma env s1
+                in (f a, s2)
+
+instance Applicative (Builder node u) where
+  pure a    = Builder $ pure a
+  mf <*> ma = Builder $ getBuilder mf <*> getBuilder ma 
+
+
+-- Monad
+
+instance Monad (MonBase node u) where
+  return a = MonBase $ \_   s0 -> (a, s0)
+  ma >>= k = MonBase $ \env s0 -> let (a,s1) = getMonBase ma env s0
+                                   in (getMonBase . k) a env s1
+
+
+instance Monad (Builder node u) where
+  return a = Builder $ return a
+  ma >>= f = Builder $ getBuilder ma >>= getBuilder . f
+
+
+-- TraceGraphicM
+
+instance TraceGraphicM (Builder node u) where
+  tellImage img = Builder $ tellImage img
+
+
+-- DrawingCtxM
+
+instance DrawingCtxM (Builder node u) where
+  askDC           = Builder $ askDC
+  asksDC f        = Builder $ asksDC f
+  localize upd ma = Builder $ localize upd (getBuilder ma)
+
+
+
+liftBSt :: MonBase node u a -> Builder node u a
+liftBSt ma = Builder $ liftTraceGraphicT ma
+
+addNodeRef :: Int -> node -> Builder node u ()
+addNodeRef i a = liftBSt inside
+  where
+    inside = MonBase $ \_ s0 -> ((), IM.insert i a s0)
+
+
+currentConnector :: InterpretUnit u 
+                 => Builder node u (node -> [node] -> Graphic u)
+currentConnector = liftBSt inside >>= getTreeConnector
+  where
+    inside = MonBase $ \env s0 -> (env,s0)
+
+
+runMonBase :: TreeProps u node -> MonBase node u a -> (a, ObjectMap node)
+runMonBase props ma = getMonBase ma props mempty
+
+
+runBuilder :: DrawingContext 
+           -> TreeProps u node 
+           -> (Builder node u a) 
+           -> (a, HPrim u, ObjectMap node)
+runBuilder ctx props ma = 
+    let ((a,wp),s) = runMonBase props (runTraceGraphicT ctx (getBuilder ma)) in (a,wp,s)
+
diff --git a/src/Wumpus/Tree/VersionNumber.hs b/src/Wumpus/Tree/VersionNumber.hs
--- a/src/Wumpus/Tree/VersionNumber.hs
+++ b/src/Wumpus/Tree/VersionNumber.hs
@@ -22,7 +22,7 @@
 
 -- | Version number
 --
--- > (0,15,0)
+-- > (0,16,0)
 --
 wumpus_tree_version :: (Int,Int,Int)
-wumpus_tree_version = (0,15,0)
+wumpus_tree_version = (0,16,0)
diff --git a/wumpus-tree.cabal b/wumpus-tree.cabal
--- a/wumpus-tree.cabal
+++ b/wumpus-tree.cabal
@@ -1,5 +1,5 @@
 name:             wumpus-tree
-version:          0.15.0
+version:          0.16.0
 license:          BSD3
 license-file:     LICENSE
 copyright:        Stephen Tetley <stephen.tetley@gmail.com>
@@ -32,48 +32,15 @@
   .
   Changelog:
   .
-  v0.14.0 to v0.15.0
-  .
-  * Updated to work with latest Wumpus libraries. 
-    @ScalingContext@ has been temporarily added from Wumpus-Basic 
-    (it was considered obsolete there). At some point the 
-    functionality needs re-implementing so it can be removed from 
-    Tree.
-  .  
-  v0.13.0 to v0.14.0:
-  .
-  * Updated to work with latest Wumpus libraries. 
-  .
-  v0.12.0 to v0.13.0:
-  .
-  * Changed the specification of trees so that they are built in a
-    monad. The bind operation of the monad allows /anchors/ to be 
-    extracted from tree nodes so they can be annotated with 
-    supplementary graphics. At the moment this is rather limited 
-    as Wumpus-Basic and Wumpus-Drawing do not offer much support 
-    for anchors other than the basic type classes.
-  .
-  * Changed the type of the rendering functions so they produce a 
-    TreeDrawing. This type is more suitable for building composite
-    pictures than the previous type TreePicture. 
-  .
-  * Also the rendering functions now take a start point for the 
-    root node, again this should be more convenient for drawing 
-    composite pictures - see the demo which now draws all the 
-    example trees on one page.
-  .
-  * Internally the tree design is now more flexible - trees can be 
-    designed upwards or leftwards rightwards, rather than just 
-    downwards; and edge drawing style is lifted out of the 
-    rendering to use a supplied combinator. Currently these 
-    features are not exposed by the API, the API needs more 
-    thought (possibly warranting changes to Wumpus-Basic and 
-    Wumpus-Drawing).
+  v0.15.0 to v0.16.0:
   .
+  * Re-worked so tree drawings form a @LocGraphic@ rather than a 
+    @TraceDrawing@, this makes more in line with other graphic 
+    objects in Wumpus like shapes.
   .
-  v0.11.1 to v0.12.0:
+  * Changed node type to be any @LocImage@ where the answer 
+    supports anchors.
   .
-  * Internal changes to track updates to Wumpus-Basic.
   . 
   .
 build-type:         Simple
@@ -90,18 +57,18 @@
   build-depends:      base              <  5, 
                       containers        >= 0.3.0     && <= 0.6.0,
                       vector-space      >= 0.6       && <  1.0,
-                      wumpus-core       >= 0.50.0    && <  0.51.0,
-                      wumpus-basic      == 0.17.0,
-                      wumpus-drawing    == 0.3.0
+                      wumpus-core       >= 0.51.0    && <  0.52.0,
+                      wumpus-basic      == 0.18.0,
+                      wumpus-drawing    == 0.4.0
 
   
   exposed-modules:
     Wumpus.Tree,
     Wumpus.Tree.Base,
     Wumpus.Tree.Design,
-    Wumpus.Tree.Draw,
-    Wumpus.Tree.ScalingContext,
-    Wumpus.Tree.TreeBuildMonad,
+    Wumpus.Tree.DrawLoc,
+    Wumpus.Tree.OTMConnectors,
+    Wumpus.Tree.TreeBuilder,
     Wumpus.Tree.VersionNumber
 
   other-modules: