diff --git a/demo/Demo01.hs b/demo/Demo01.hs
--- a/demo/Demo01.hs
+++ b/demo/Demo01.hs
@@ -41,30 +41,50 @@
 tree_pic1 = udrawTracing (0::Double) $ do
     --
     draw $ dcTextlabel "Tree 1:"        `at` (P2 0  550)
-    drawl (P2 10 500) $ runTreeLoc props1 (const red_dot) tree1
+    drawl (P2 10 500) $ treeDrawing props1 $ plainTree (const red_dot) tree1
     --
     draw $ dcTextlabel "Tree 2:"       `at` (P2 200 550) 
-    drawl (P2 300 550) $ runTreeLoc props2 dotChar tree2
+    drawl (P2 300 550) $ treeDrawing props2 $ plainTree dotChar tree2
 
     draw $ dcTextlabel "Tree 3:"       `at` (P2 0  410) 
     localize (set_font_size 12) $ 
-        drawl (P2 280 410) $ runTreeLoc props3 dotChar tree3
+        drawl (P2 280 410) $ treeDrawing props3 $ plainTree dotChar tree3
 
     --
     draw $ dcTextlabel "Tree 4:"       `at` (P2 0  190)
-    drawl (P2 80 190) $ runTreeLoc props4 (const circ_dot) tree4
+    drawl (P2 80 190) $ treeDrawing props4 $ plainTree (const circ_dot) tree4
     --
     draw $ dcTextlabel "Tree 5:"        `at` zeroPt
-    drawl (P2 320 0) $ runTreeLoc props5 (const circ_dot) tree5
+    drawl (P2 320 0) $ treeDrawing props5 $ plainTree (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
+    props1 = TreeProps { tp_level_distance   = 30
+                       , tp_sibling_distance = 30
+                       , tp_direction        = TREE_RIGHT
+                       , tp_otm_connector    = radialOTM }
+
+    props2 = TreeProps { tp_level_distance   = 40
+                       , tp_sibling_distance = 30
+                       , tp_direction        = TREE_DOWN
+                       , tp_otm_connector    = familyOTM }
+
+    props3 = TreeProps { tp_level_distance   = 30
+                       , tp_sibling_distance = 25
+                       , tp_direction        = TREE_DOWN
+                       , tp_otm_connector    = familyOTM  }
+
+    props4 = TreeProps { tp_level_distance   = 30
+                       , tp_sibling_distance = 20
+                       , tp_direction        = TREE_DOWN
+                       , tp_otm_connector    = radialOTM }
+
+    props5 = TreeProps { tp_level_distance   = 36
+                       , tp_sibling_distance = 30
+                       , tp_direction        = TREE_DOWN
+                       , tp_otm_connector    = radialOTM }
 
 
 tree1 :: Tree Char
diff --git a/src/Wumpus/Tree.hs b/src/Wumpus/Tree.hs
--- a/src/Wumpus/Tree.hs
+++ b/src/Wumpus/Tree.hs
@@ -17,14 +17,10 @@
 module Wumpus.Tree
   (
   -- * Re-exports
-    module Wumpus.Tree.OTMConnectors
-
-  , TreeDirection(..) 
-  , tree_direction
-  , runTreeLoc
-
-  -- * Definitions
-  , standardTreeProps
+    module Wumpus.Tree.Base
+  , module Wumpus.Tree.DrawLoc
+  , module Wumpus.Tree.OTMConnectors
+  , module Wumpus.Tree.VersionNumber
 
   )
   where
@@ -32,18 +28,6 @@
 import Wumpus.Tree.Base
 import Wumpus.Tree.DrawLoc
 import Wumpus.Tree.OTMConnectors
-
-
-
-
-
+import Wumpus.Tree.VersionNumber
 
-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
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# OPTIONS -Wall #-}
 
@@ -18,43 +19,111 @@
 module Wumpus.Tree.Base
   (
 
-    OTMAnchorConn
+    TreeMonad
+  , OTMAnchorConn
   , TreeProps(..)
-  , TreePropsF
   , TreeDirection(..)
-  , tree_direction
-  , getTreeConnector
 
-  ) where
+  , runTreeMonad
 
+  , drawConn
 
+  ) where
 
+
 import Wumpus.Basic.Kernel                      -- package: wumpus-basic
 
+import Wumpus.Core                              -- package: wumpus-core
 
-type OTMAnchorConn u a = TreeDirection -> u -> a -> [a] -> Graphic u
+import Control.Applicative
+import Data.Monoid
 
+data TreeMonad node u a = TreeMonad { 
+        getTreeMonad :: TreeProps node u -> LocDrawing u a }
 
-data TreeProps u a = TreeProps
-      { tp_sibling_distance :: u
-      , tp_level_distance   :: u
-      , tp_multiconn        :: OTMAnchorConn u a
-      , tp_direction        :: TreeDirection
+type instance DUnit (TreeMonad node u a) = u
+
+
+type OTMAnchorConn node u = TreeDirection -> u -> node -> [node] -> Graphic u
+
+
+
+-- Design note - as the TreeMonad will be used internally there
+-- doesn\'t seem to be a need for user state.
+
+data TreeProps node u = TreeProps
+      { tp_sibling_distance     :: u
+      , tp_level_distance       :: u
+      , tp_direction            :: TreeDirection
+      , tp_otm_connector        :: OTMAnchorConn node u
       }  
 
-type TreePropsF u a = TreeProps u a -> TreeProps u a
+type instance DUnit (TreeProps node u) = u
 
+
 data TreeDirection = TREE_UP | TREE_DOWN | TREE_LEFT | TREE_RIGHT
   deriving (Eq,Ord,Show)
 
-tree_direction :: TreeDirection -> TreePropsF u a
-tree_direction dir props = props { tp_direction = dir }
 
 
-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)
+
+-- Note - not entirely sure TreeDrawing is a LocTrace, it will
+-- certainly need branching if it is.
+
+-- Functor
+
+instance Functor (TreeMonad node u) where
+  fmap f ma = TreeMonad $ \env -> fmap f $ getTreeMonad ma env 
+
+-- Applicative
+ 
+instance Applicative (TreeMonad node u) where
+  pure a    = TreeMonad $ \_   -> pure a
+  mf <*> ma = TreeMonad $ \env -> 
+                getTreeMonad mf env <*> getTreeMonad ma env
+
+
+-- Monad
+
+instance Monad (TreeMonad node u) where
+  return a  = TreeMonad $ \_   -> return a
+  ma >>= k  = TreeMonad $ \env -> 
+                getTreeMonad ma env >>= \ans -> getTreeMonad (k ans) env
+
+-- Monoid 
+
+instance Monoid a => Monoid (TreeMonad node u a) where
+  mempty          = TreeMonad $ \_   -> mempty
+  ma `mappend` mb = TreeMonad $ \env -> 
+                      getTreeMonad ma env `mappend` getTreeMonad mb env
+
+
+-- DrawingCtxM
+
+instance DrawingCtxM (TreeMonad node u) where
+  askDC           = TreeMonad $ \_   -> askDC
+  asksDC fn       = TreeMonad $ \_   -> asksDC fn
+  localize upd ma = TreeMonad $ \env -> localize upd (getTreeMonad ma env)
+
+
+
+instance InterpretUnit u => LocDrawM (TreeMonad node u) where
+  inserti  gf       = TreeMonad $ \_ -> inserti gf
+  insertli p1 gf    = TreeMonad $ \_ -> insertli p1 gf
+  insertci p1 p2 gf = TreeMonad $ \_ -> insertci p1 p2 gf
+
+
+runTreeMonad :: (Translate a, InterpretUnit u, u ~ DUnit a)
+             => TreeMonad node u a -> TreeProps node u -> LocImage u a
+runTreeMonad ma props = runLocDrawing $ getTreeMonad ma props
+
+
+
+drawConn :: InterpretUnit u 
+         => node -> [node] -> TreeMonad node u ()
+drawConn start kids = TreeMonad $ \(TreeProps { tp_level_distance = h  
+                                              , tp_otm_connector  = conn
+                                              , tp_direction      = tdir
+                                              }) ->
+    let gf = conn tdir h start kids in inserti_ gf
 
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
@@ -21,6 +21,9 @@
 -- original.
 --
 -- Any mistakes are mine of course.
+--
+-- Note - although this module is exposed, it is not expected to 
+-- be indenpendently useful for client code.
 -- 
 --------------------------------------------------------------------------------
 
@@ -303,7 +306,7 @@
           => 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
+    let fn = mkFun sz in return $ fmap (\(a,b) -> (fn a, b)) tree
   where
     mkFun sz = \(P2 x y) -> let ux = sib_dist * (dinterp sz $ realToFrac x)
                                 uy = lvl_dist * (dinterp sz $ realToFrac y)
diff --git a/src/Wumpus/Tree/DrawLoc.hs b/src/Wumpus/Tree/DrawLoc.hs
--- a/src/Wumpus/Tree/DrawLoc.hs
+++ b/src/Wumpus/Tree/DrawLoc.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeFamilies               #-}
 {-# OPTIONS -Wall #-}
 
 --------------------------------------------------------------------------------
@@ -17,8 +18,16 @@
 module Wumpus.Tree.DrawLoc
   (
     
-    runTreeLoc
+    AnnoNode
+  , TreeSpec    
+  , plainTree
+  , treeDrawing
 
+  , leaf
+  , xleaf
+  , tree
+  , xtree
+
   ) where
 
 import Wumpus.Tree.Base
@@ -29,84 +38,87 @@
 
 import Wumpus.Core                              -- package: wumpus-core
 
+import Control.Applicative
 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.
---
+data AnnoNode ix u a = PlainNode (LocImage u a)
+                   | RefNode ix (LocImage u a)
 
 
--- | 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). 
+type TreeSpec ix u a = Tree (AnnoNode ix u a)
+
+
+plainTree :: (elt -> LocImage u a) -> Tree elt -> TreeSpec ix u a
+plainTree gf = fmap (PlainNode . gf)
+
+
+treeDrawing :: (Real u, Floating u, Translate node, InterpretUnit u, u ~ DUnit node)
+            => TreeProps node u -> TreeSpec ix u node -> LocGraphic u
+treeDrawing props t1 = promoteLoc $ \pt ->
+    liftQuery (runDesign props t1) >>= \t2 -> applyLoc (phase1 props t2) pt
+
+
+
+-- leaf should build a Data.Tree node with no kids...
 --
-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)
+leaf :: LocImage u a -> TreeSpec ix u a
+leaf a = Node (PlainNode a) []
 
+xleaf :: ix -> LocImage u a -> TreeSpec ix u a
+xleaf ix a = Node (RefNode ix a) []
 
 
-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
-      
+tree :: LocImage u a -> [TreeSpec ix u a] -> TreeSpec ix u a
+tree a kids = Node (PlainNode a) kids
 
--- | 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
+xtree :: ix -> LocImage u a -> [TreeSpec ix u a] -> TreeSpec ix u a
+xtree ix a kids = Node (RefNode ix a) kids
 
-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
+
+
+phase1 :: (Translate node, InterpretUnit u, u ~ DUnit node)
+       => TreeProps node u -> TreeSpec ix u node -> LocGraphic u
+phase1 props t1 = ignoreAns $ runTreeMonad (step1 t1) props
   where
-    dir = tp_direction props
-    sx  = tp_sibling_distance props
-    sy  = tp_level_distance props
+    step1 (Node nd []) = insert1 nd
 
+    step1 (Node nd xs) = insert1 nd    >>= \r1 -> 
+                         mapM step1 xs >>= \rs ->
+                         drawConn r1 rs >>
+                         return r1
 
+    -- TODO ix
+    insert1 (PlainNode gf)         = insertli zeroPt gf
+    insert1 (RefNode _ gf)         = insertli zeroPt gf
 
+
+
+
+
 -- | 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
+          => TreeProps node u -> TreeSpec ix u a -> Query u (TreeSpec ix u a)
+runDesign props t1 =  
+     fmap post <$> designOrientateScale props t1
   where
-    fn ((P2 x y), gf) = moveStart (vec x y) gf
+    post ((P2 x y), PlainNode gf)   = PlainNode $ moveStart (vec x y) gf
+    post ((P2 x y), RefNode ix gf)  = RefNode ix $ moveStart (vec x y) gf
+
+
+
+
+designOrientateScale :: (Real u, Floating u, InterpretUnit u)
+                     => TreeProps node u -> TreeSpec ix u a 
+                     -> Query u (Tree (Point2 u, AnnoNode ix u a))
+designOrientateScale props t1 =  
+    scaleTree sx sy (design t1) >>= \ans -> return $ orientateTree dir ans
+  where
+    dir = tp_direction props
+    sx  = tp_sibling_distance props
+    sy  = tp_level_distance props
 
 
diff --git a/src/Wumpus/Tree/OTMConnectors.hs b/src/Wumpus/Tree/OTMConnectors.hs
--- a/src/Wumpus/Tree/OTMConnectors.hs
+++ b/src/Wumpus/Tree/OTMConnectors.hs
@@ -19,16 +19,16 @@
 module Wumpus.Tree.OTMConnectors
   (
 
-    radialOTMC
-  , blankOTMC
-  , familyOTMC
-  , splayOTMC
+    radialOTM
+  , blankOTM
+  , familyOTM
+  , splayOTM
 
   ) where
 
 import Wumpus.Tree.Base
 
-import Wumpus.Drawing.Paths.Absolute            -- package: wumpus-drawing
+import Wumpus.Drawing.Paths.Absolute
 
 import Wumpus.Basic.Kernel                      -- package: wumpus-basic
 
@@ -36,12 +36,21 @@
 
 import Data.AffineSpace                         -- package: vector-space
 
+import Data.Maybe
 import Data.Monoid
+import Prelude hiding ( lookup )
 
 
 
+radialOTM :: ( Real u, Floating u, InterpretUnit u
+             , RadialAnchor node, CenterAnchor node, u ~ DUnit node) 
+          => OTMAnchorConn node u 
+radialOTM _ _ a as = mconcat $ map fn $ radialNodes a as
+  where
+    fn (s,t)      = connect s t straightConnector
 
 
+
 -- Pulling out the points (nodes) from parent plus list of 
 -- children.
 
@@ -66,67 +75,58 @@
     theta1  = if theta0 < pi then theta0 + pi else theta0 - pi
 
 
+
+
+blankOTM :: OTMAnchorConn node u
+blankOTM _ _ _ _ = mempty
+
+
+
 -- 
 -- @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?
+-- calculated parent-to-arbitrary-child?
 -- 
--- Probably we need to know half the height step, rather than 
--- calculate it from anchors.
+-- Probably we need to know half the height step 
+-- (vcenter-to-vcenter), 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 = 
+-- Drawing a family connector is quite horrible, we need to know
+-- both the tree direction and the vertical height between layers.
+
+
+
+familyOTM :: ( Real u, Floating u, Ord u, Tolerance u, InterpretUnit u
+             , CenterAnchor node, CardinalAnchor node
+             , u ~ DUnit node ) 
+          => OTMAnchorConn node u
+familyOTM _   _ _ [] = mempty
+familyOTM 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)
+    in ignoreAns ptick `mappend` (ignoreAns $ selaborate kids fn)
   where
     fn ps = case linkAll ps of
               Nothing -> emptyLocImage `at` (center a)
-              Just path -> zapQuery (toPrimPath path) >>= dcOpenPath
+              Just path -> drawOpenPath_ path
 
 
 
 famAnchors :: (CardinalAnchor a, u ~ DUnit a ) 
-             => TreeDirection -> (a -> Anchor u, a -> Anchor u)
+           => TreeDirection -> (a -> Anchor u, a -> Anchor u)
 famAnchors TREE_UP    = (north, south)
 famAnchors TREE_DOWN  = (south, north)
 famAnchors TREE_LEFT  = (west,  east)
@@ -154,17 +154,17 @@
 
 
 
-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
+splayOTM :: ( Real u, Floating u, Ord u, Tolerance u, InterpretUnit u
+            , CenterAnchor node, CardinalAnchor node 
+            , u ~ DUnit node) 
+          => OTMAnchorConn node u
+splayOTM _   _ _ [] = mempty
+splayOTM 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
+    fn p0 p1 = straightLine p0 p1
+
 
 
 
diff --git a/src/Wumpus/Tree/TreeBuilder.hs b/src/Wumpus/Tree/TreeBuilder.hs
deleted file mode 100644
--- a/src/Wumpus/Tree/TreeBuilder.hs
+++ /dev/null
@@ -1,316 +0,0 @@
-{-# 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,16,0)
+-- > (0,17,0)
 --
 wumpus_tree_version :: (Int,Int,Int)
-wumpus_tree_version = (0,16,0)
+wumpus_tree_version = (0,17,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.16.0
+version:          0.17.0
 license:          BSD3
 license-file:     LICENSE
 copyright:        Stephen Tetley <stephen.tetley@gmail.com>
@@ -32,6 +32,11 @@
   .
   Changelog:
   .
+  v0.16.0 to v0.17.0:
+  .
+  * Reworked internals to use the @LocDrawing@ monad from 
+    Wumpus-Basic.
+  .
   v0.15.0 to v0.16.0:
   .
   * Re-worked so tree drawings form a @LocGraphic@ rather than a 
@@ -58,8 +63,8 @@
                       containers        >= 0.3.0     && <= 0.6.0,
                       vector-space      >= 0.6       && <  1.0,
                       wumpus-core       >= 0.51.0    && <  0.52.0,
-                      wumpus-basic      == 0.18.0,
-                      wumpus-drawing    == 0.4.0
+                      wumpus-basic      == 0.21.0,
+                      wumpus-drawing    == 0.6.0
 
   
   exposed-modules:
@@ -68,7 +73,6 @@
     Wumpus.Tree.Design,
     Wumpus.Tree.DrawLoc,
     Wumpus.Tree.OTMConnectors,
-    Wumpus.Tree.TreeBuilder,
     Wumpus.Tree.VersionNumber
 
   other-modules: