diff --git a/CHANGES b/CHANGES
--- a/CHANGES
+++ b/CHANGES
@@ -1,4 +1,19 @@
 
+0.20.0 to 0.21.0:
+
+  * The code from the @Kernel.Base.UserState@ module has been 
+    moved to the module @Kernel.Drawing.Basis@.
+
+  * Moved @Image@ and @Query@ from @Objects.Basis@ to new module
+    @Objects.Image@. Moved @Chain@, @CtxPicture@ and 
+    @TraceDrawing@ into the new @Drawing@ folder.
+
+  * Added @Wumpus.Basic.Kernel.Drawing.LocDrawing@ module.
+ 
+  * Rationalized the combinators exported by the drawing objects 
+    @Image@, @LocImage@, @LocThetaImage@ and @Connector@.
+ 
+
 0.18.0 to 0.20.0 (no release numbered v0.19.0):
 
   * Added text advance-vector calculations to @QueryDC@ - 
diff --git a/demo/AltUnits.hs b/demo/AltUnits.hs
--- a/demo/AltUnits.hs
+++ b/demo/AltUnits.hs
@@ -44,23 +44,23 @@
 dblLocGraphic :: LocGraphic Double
 dblLocGraphic = rect1 `mappend` rect2  
   where
-    rect1 = dcRectangle FILL_STROKE 36 24 
-    rect2 = moveStart (hvec 36) $ dcRectangle FILL_STROKE 60 24 
+    rect1 = dcRectangle DRAW_FILL_STROKE 36 24 
+    rect2 = moveStart (hvec 36) $ dcRectangle DRAW_FILL_STROKE 60 24 
 
 
 
 emLocGraphic :: LocGraphic Em
 emLocGraphic = localize swap_colours $  rect1 `mappend` rect2  
   where
-    rect1 = dcRectangle FILL_STROKE 3 2 
-    rect2 = moveStart (hvec 3) $ dcRectangle FILL_STROKE 5 2 
+    rect1 = dcRectangle DRAW_FILL_STROKE 3 2 
+    rect2 = moveStart (hvec 3) $ dcRectangle DRAW_FILL_STROKE 5 2 
 
 
 enLocGraphic :: LocGraphic En
 enLocGraphic = localize (fill_colour lemon_chiffon) $ rect1 `mappend` rect2  
   where
-    rect1 = dcRectangle FILL_STROKE 6 4
-    rect2 = moveStart (hvec 6) $ dcRectangle FILL_STROKE 10 4
+    rect1 = dcRectangle DRAW_FILL_STROKE 6 4
+    rect2 = moveStart (hvec 6) $ dcRectangle DRAW_FILL_STROKE 10 4
 
 
 haskell_org :: XLink
diff --git a/demo/SimpleAdvGraphic.hs b/demo/SimpleAdvGraphic.hs
--- a/demo/SimpleAdvGraphic.hs
+++ b/demo/SimpleAdvGraphic.hs
@@ -61,7 +61,7 @@
 miniDisk :: AdvGraphic Double
 miniDisk = makeAdvObject (pure $ V2 0 0) disk1 
   where
-    disk1 = localize (fill_colour sienna) $ dcDisk FILL 3
+    disk1 = localize (fill_colour sienna) $ dcDisk DRAW_FILL 3
 
 
 sienna :: RGBi
diff --git a/demo/SimplePosObject.hs b/demo/SimplePosObject.hs
--- a/demo/SimplePosObject.hs
+++ b/demo/SimplePosObject.hs
@@ -58,18 +58,18 @@
     draw $ testDrawBl    BLC    `at` (P2 150  0)
     draw $ testDrawBl    BLR    `at` (P2 225  0)
     
-    drawl (P2 300 0) $ runPosObject msg SW
+    drawl (P2 300 0) $ runPosObject SW msg
   where
     msg = multilinePosText VALIGN_RIGHT "Red dot represents the\nrectangle address."
 
 
 testDrawBl :: RectAddress -> LocGraphic Double
-testDrawBl raddr = dcDisk FILL 2 `mappend` rectBl raddr
+testDrawBl raddr = dcDisk DRAW_FILL 2 `mappend` rectBl raddr
 
 
 rectBl :: RectAddress -> LocGraphic Double
 rectBl raddr = 
-    ignoreAns $ runPosObject (makePosObject (return ortt) (mkRectBl w h)) raddr
+    ignoreAns $ runPosObject raddr $ makePosObject (return ortt) (mkRectBl w h)
   where
     w    = 40 
     h    = 30
@@ -81,18 +81,18 @@
 
 -- start-point - bottom left
 mkRectBl :: InterpretUnit u => u -> u -> LocGraphic u
-mkRectBl w h = dcRectangle STROKE w h
+mkRectBl w h = dcRectangle DRAW_STROKE w h
 
 
 
 testDrawMinor :: RectAddress -> LocGraphic Double
 testDrawMinor raddr = 
-    dcDisk FILL 2 `mappend` (ignoreAns $ rectMinor raddr)
+    dcDisk DRAW_FILL 2 `mappend` (ignoreAns $ rectMinor raddr)
 
 
 rectMinor :: RectAddress -> LocGraphic Double
 rectMinor raddr = 
-    runPosObject (makePosObject (return ortt) (mkRectMinor m w h)) raddr
+    runPosObject raddr $ makePosObject (return ortt) (mkRectMinor m w h)
   where
     m    = 10
     w    = 40 
@@ -110,5 +110,5 @@
         br = displace (hvec w) bl
         tr = displace (vvec h) br
         tl = displace (vvec h) bl
-    in liftQuery (vertexPP [bl, br, tr, tl]) >>= dcClosedPath STROKE
+    in liftQuery (vertexPP [bl, br, tr, tl]) >>= dcClosedPath DRAW_STROKE
 
diff --git a/src/Wumpus/Basic/Geometry.hs b/src/Wumpus/Basic/Geometry.hs
--- a/src/Wumpus/Basic/Geometry.hs
+++ b/src/Wumpus/Basic/Geometry.hs
@@ -20,7 +20,6 @@
     module Wumpus.Basic.Geometry.Base
   , module Wumpus.Basic.Geometry.Illustrate
   , module Wumpus.Basic.Geometry.Intersection
-  , module Wumpus.Basic.Geometry.Paths
   , module Wumpus.Basic.Geometry.Quadrant
   , module Wumpus.Basic.Geometry.Vertices
 
@@ -30,6 +29,5 @@
 import Wumpus.Basic.Geometry.Base
 import Wumpus.Basic.Geometry.Illustrate
 import Wumpus.Basic.Geometry.Intersection
-import Wumpus.Basic.Geometry.Paths
 import Wumpus.Basic.Geometry.Quadrant
 import Wumpus.Basic.Geometry.Vertices
diff --git a/src/Wumpus/Basic/Geometry/Base.hs b/src/Wumpus/Basic/Geometry/Base.hs
--- a/src/Wumpus/Basic/Geometry/Base.hs
+++ b/src/Wumpus/Basic/Geometry/Base.hs
@@ -18,13 +18,9 @@
 module Wumpus.Basic.Geometry.Base
   ( 
 
-  -- * constants
-    quarter_pi
-  , half_pi
-  , two_pi
 
   -- * 2x2 Matrix
-  , Matrix2'2(..)
+    Matrix2'2(..)
   , DMatrix2'2
   , identity2'2
   , det2'2
@@ -81,15 +77,6 @@
 
 
 
-
-quarter_pi      :: Floating u => u
-quarter_pi      = 0.25 * pi
-
-half_pi         :: Floating u => u
-half_pi         = 0.5 * pi
-
-two_pi          :: Floating u => u
-two_pi          = 2.0 * pi
 
 
 --------------------------------------------------------------------------------
diff --git a/src/Wumpus/Basic/Geometry/Illustrate.hs b/src/Wumpus/Basic/Geometry/Illustrate.hs
--- a/src/Wumpus/Basic/Geometry/Illustrate.hs
+++ b/src/Wumpus/Basic/Geometry/Illustrate.hs
@@ -40,7 +40,7 @@
 enDot = uconvF body
   where
     body :: LocGraphic En
-    body = localize (fill_colour white) $ dcDisk FILL_STROKE 0.5
+    body = localize (fill_colour white) $ dcDisk DRAW_FILL_STROKE 0.5
 
 illustrateLine :: (Real u, Floating u, InterpretUnit u) 
                => Line u -> Graphic u
diff --git a/src/Wumpus/Basic/Geometry/Paths.hs b/src/Wumpus/Basic/Geometry/Paths.hs
deleted file mode 100644
--- a/src/Wumpus/Basic/Geometry/Paths.hs
+++ /dev/null
@@ -1,315 +0,0 @@
-{-# LANGUAGE TypeFamilies               #-}
-{-# OPTIONS -Wall #-}
-
---------------------------------------------------------------------------------
--- |
--- Module      :  Wumpus.Drawing.Basic.Paths
--- Copyright   :  (c) Stephen Tetley 2010-2011
--- License     :  BSD3
---
--- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
--- Stability   :  highly unstable
--- Portability :  GHC
---
--- Path /algorithms/ for elementary shapes - rectangle, diamond, 
--- polygon.
--- 
---------------------------------------------------------------------------------
-
-module Wumpus.Basic.Geometry.Paths
-  ( 
-
-    PathAlg
-  , runPathAlgPoint
-  , runPathAlgVec
-  , drawVertexPathAlg
-
-  , pathStartIsStart
-  , pathStartIsLocus
-  , pathIterateLocus
-
-  , rectanglePathAlg
-  , blRectanglePathAlg
-
-  , diamondPathAlg
-  , isoscelesTriPathAlg
-  , polygonPathAlg
-
-  , arcPathAlg
-  , circlePathAlg
-
-  , parallelogramPathAlg
-  , isoscelesTrapeziumPathAlg
-
-  ) 
-  where
-
-import Wumpus.Basic.Geometry.Base
-import Wumpus.Basic.Geometry.Vertices
-import Wumpus.Basic.Kernel
-
-import Wumpus.Core                              -- package: wumpus-core
-
-import Data.AffineSpace                         -- package: vector-space
-import Data.VectorSpace
-
-import Data.List ( unfoldr )
-
-
-data PathAlgScheme = START_IS_START | START_IS_LOCUS 
-  deriving (Enum,Eq,Ord,Show)
-
-
--- | A vector chain building a path.
---
--- The vectors are relative to the predecessor, so the
--- rendering of a 'PathAlg' iterates the start point.
---
--- A polygon PathAlg should have steps for all sides of the 
--- polygon with the end point generated by the last vector 
--- coinciding with thet start point.
--- 
-data PathAlg u = PathAlg { path_alg_scheme  :: PathAlgScheme
-                         , path_alg_steps   :: [Vec2 u]
-                         }
-
-
-type instance DUnit (PathAlg u) = u
-
-
-runPathAlgPoint :: Num u => Point2 u -> PathAlg u -> [Point2 u]
-runPathAlgPoint _  (PathAlg _   [])       = []
-runPathAlgPoint p0 (PathAlg scm (v0:xs)) 
-    | scm == START_IS_START = p0 : step (p0 .+^ v0) xs
-    | otherwise             = step (p0 .+^ v0) xs
-  where
-    step pt []      = [pt]
-    step pt (v:vs)  = pt : step (pt .+^ v) vs
-
-
-runPathAlgVec :: PathAlg u -> (Maybe (Vec2 u), [Vec2 u]) 
-runPathAlgVec (PathAlg START_IS_LOCUS (v:vs)) = (Just v, vs)
-runPathAlgVec (PathAlg _ vs)                  = (Nothing, vs)
-
-
-
-
-drawVertexPathAlg :: InterpretUnit u 
-                  => DrawStyle -> PathAlg u -> LocGraphic u
-drawVertexPathAlg style alg = promoteLoc $ \pt -> 
-    liftQuery (vertexPP $ runPathAlgPoint pt alg) >>= dcClosedPath style
-
-
--- | Create a PathAlg from the vertex list.
---
--- When the PathAlg is run the supplied point will be the start 
--- of the path. 
--- 
-pathStartIsStart :: [Vec2 u] -> PathAlg u
-pathStartIsStart vs = PathAlg { path_alg_scheme = START_IS_START
-                              , path_alg_steps  = vs }
-
-
-
--- | Create a PathAlg from the vector list - the first vector
--- displaces the /start point/ the subsequent vectors displace 
--- the /current tip/. Figuratively, this is rather like Logo 
--- /turtle drawing/.
---
--- When the PathAlg is run, the supplied point is the /locus/ of 
--- the path and it does not form part of the path proper.
--- 
--- This constructor is typically used to make /shape paths/ where
--- the supplied point is the center and the generated path is the 
--- border.
--- 
-pathStartIsLocus :: [Vec2 u] -> PathAlg u
-pathStartIsLocus vs = PathAlg { path_alg_scheme = START_IS_LOCUS
-                              , path_alg_steps  = vs }
-
-
--- | Note this creates a path where the first vector represents a
--- @moveto@, then the subsequence vectors represent @linetos@.
--- 
-
-
--- | Create a PathAlg from the vector list - each vector in the 
--- input list iterates to the start point rather then the 
--- cumulative tip.
---
--- When the PathAlg is run, the supplied point is the /locus/ of 
--- the path and it does not form part of the path proper.
--- 
--- Like 'pathStartIsLocus', this constructor is typically used to 
--- make /shape paths/. Some shapes are easier to express as 
--- iterated displacements of the center rather than 
--- /turtle drawing/. 
--- 
-pathIterateLocus :: Num u => [Vec2 u] -> PathAlg u
-pathIterateLocus []      = pathStartIsLocus []
-pathIterateLocus (v0:xs) = pathStartIsLocus $ v0 : step v0 xs
-  where
-    step v1 []      = [v0 ^-^ v1]
-    step v1 (v2:vs) = (v2 ^-^ v1) : step v2 vs
-
-
-
-
--- | Implicit start point is /center/, the genearated moves are 
--- counter-clockwise so the move-list is
---
--- > [ moveto_bl, moveto_br, moveto_tr, moveto_tl ]
---
-rectanglePathAlg :: Fractional u => u -> u -> PathAlg u
-rectanglePathAlg w h = 
-    pathStartIsLocus [ to_bl, to_br, to_tr, to_tl ]
-  where
-    to_bl = vec (negate $ 0.5*w) (negate $ 0.5*h)
-    to_br = hvec w
-    to_tr = vvec h
-    to_tl = hvec (-w) 
-
-
-
--- | Implicit start point is /bottom-left/, subsequent moves are 
--- counter-clockwise so the move-list is:
---
--- > [ moveto_br, moveto_tr, moveto_tl, moveto_bl ]
---
-blRectanglePathAlg :: Num u => u -> u -> PathAlg u
-blRectanglePathAlg w h = pathStartIsStart [ vbr, vtr, vtl, vbl ]
-  where
-    vbr = hvec w
-    vtr = vvec h
-    vtl = hvec (-w) 
-    vbl = vvec (-h)
-
-
-
-
--- | 'diamondPathAlg' : @ half_width * half_height -> PathAlg @
---
-diamondPathAlg :: Num u => u -> u -> PathAlg u
-diamondPathAlg hw hh = pathIterateLocus [ vs,ve,vn,vw ]
-  where
-    vs = vvec (-hh)
-    ve = hvec hw
-    vn = vvec hh
-    vw = hvec (-hw)
-
-
-
--- | 'isoscelesTriPathAlg' : @ base_width * height -> PathAlg @
---
--- Start point is centtroid not incenter.
---
-isoscelesTriPathAlg :: Floating u => u -> u -> PathAlg u
-isoscelesTriPathAlg bw h = 
-    pathIterateLocus [ to_bl, to_br, to_apex ]
-  where
-    (to_bl, to_br, to_apex) = isoscelesTriangleVertices bw h
-
-    
-
--- | 'polygonPathAlg' : @ num_points * radius -> PathAlg @ 
---
-polygonPathAlg :: Floating u => Int -> u -> PathAlg u
-polygonPathAlg n radius = pathIterateLocus $ unfoldr phi (0,top)
-  where
-    top                     = 0.5*pi
-    theta                   = (2*pi) / fromIntegral n
-    
-    phi (i,ang) | i < n     = Just (avec ang radius, (i+1,ang+theta))
-                | otherwise = Nothing
-
-
--- | 'arcPathAlg' : @ radius * angle1 * angle2 ->  PathAlg @ 
---
-arcPathAlg :: Floating u => u -> Radian -> Radian -> PathAlg u
-arcPathAlg r ang1 ang2 = pathStartIsLocus $ step1 $ arcdiv ang1 ang2
-  where
-    step1 []         = []
-    step1 ((a,b):xs) = let (v0,v1,v2,v3) = minorArcQuadVec r a b
-                       in v0 : v1: v2: v3 : step xs
-
-    step []         = []
-    step ((a,b):xs)  = let (_,v1,v2,v3) = minorArcQuadVec r a b
-                       in v1: v2: v3 : step xs
-
-
-    
--- | Helper - generate four vectors building a minor (<90 deg) 
--- arc.
---
--- The first vec is from center - for cumulative arcs this should 
--- only taken once.
---
-minorArcQuadVec :: Floating u 
-                => u -> Radian -> Radian -> (Vec2 u, Vec2 u, Vec2 u, Vec2 u)
-minorArcQuadVec r ang1 ang2 = (v0, v1, v2, v3)
-  where
-    (p1,p2,p3,p4) = bezierArc r ang1 ang2 zeroPt
-    v0            = pvec zeroPt p1 
-    v1            = pvec p1 p2
-    v2            = pvec p2 p3
-    v3            = pvec p3 p4
-
-
-circlePathAlg :: (Fractional u, Floating u) 
-              => u -> PathAlg u
-circlePathAlg r = pathStartIsLocus vs
-  where
-    vs = hvec r : diff (flip pvec) (bezierCircle r zeroPt)
-
-
-
-
--- | Helper - diff 
--- 
--- Note diff relies on the pointlist cycling the endpoint
--- 
--- > [p0, ..., p0]
---
--- This is how Wumpus-Core generates Bezier circles.
--- 
-diff :: (a -> a -> b) -> [a] -> [b]
-diff _  [] = []
-diff op (x:xs) = step x xs
-  where
-    step _ []     = []
-    step a (b:bs) = b `op` a : step b bs
-
--- | Helper - divide an arc into quadrants plus remainder.
---
-arcdiv :: Radian -> Radian -> [(Radian,Radian)]
-arcdiv ang1 ang2 | ang1 >  ang2 = step ang1 (ang2 + 2 * pi) 
-                 | otherwise    = step ang1 ang2
-  where
-    step a1 a2 | a1 == a2 = []
-    step a1 a2 | a2 - a1 > half_pi = norm (a1,a1+half_pi) : step (a1+half_pi) a2
-               | otherwise         = [(a1,a2)]
-
-    norm (a,b) = (circularModulo a, circularModulo b)
-
-
-
--- | @ width * height * bottom_left_angle @
---
-parallelogramPathAlg :: Floating u => u -> u -> Radian -> PathAlg u
-parallelogramPathAlg w h bl_ang = 
-    pathIterateLocus [ bl, br, tr, tl ]
-  where
-    (bl, br, tr, tl) = parallelogramVertices w h bl_ang
-
-
-
--- | @ base_width * top_width * height @
---
-isoscelesTrapeziumPathAlg :: Floating u => u -> u -> u -> PathAlg u
-isoscelesTrapeziumPathAlg bw tw h = 
-    pathIterateLocus [ bl, br, tr, tl ]
-  where
-    (bl, br, tr, tl) = isoscelesTrapeziumVertices bw tw h
-
-
-
diff --git a/src/Wumpus/Basic/Geometry/Quadrant.hs b/src/Wumpus/Basic/Geometry/Quadrant.hs
--- a/src/Wumpus/Basic/Geometry/Quadrant.hs
+++ b/src/Wumpus/Basic/Geometry/Quadrant.hs
@@ -48,7 +48,7 @@
   ) 
   where
 
-import Wumpus.Basic.Geometry.Base
+import Wumpus.Basic.Kernel
 
 import Wumpus.Core                              -- package: wumpus-core
 
@@ -198,8 +198,8 @@
 hypotenuseQI dx dy ang = avec ang dist
   where
     base_ang = atan (dy / dx)
-    apex     = pi - (base_ang + fromRadian ang)
-    dist     = sin base_ang * (dx / sin apex)
+    apex_c   = pi - (base_ang + fromRadian ang)
+    dist     = sin base_ang * (dx / sin apex_c)
 
 
 
@@ -467,8 +467,8 @@
 triangleQI w h ang = avec ang dist
   where
     base_ang = atan (h / w)
-    apex     = pi - (base_ang + fromRadian ang)
-    dist     = sin base_ang * (w / sin apex)
+    apex_c   = pi - (base_ang + fromRadian ang)
+    dist     = sin base_ang * (w / sin apex_c)
 
 
 
@@ -568,8 +568,8 @@
 triangleLeftSide base_width lang rang =
     (fromRadian $ sin rang) / factor 
   where
-    apex   = pi - (lang + rang)
-    factor = (fromRadian $ sin apex) / base_width
+    apex_c = pi - (lang + rang)
+    factor = (fromRadian $ sin apex_c) / base_width
 
 
 -- | 'rightTrapeziumBaseWidth' : @ top_width * height * top_right_ang -> Length @
diff --git a/src/Wumpus/Basic/Kernel.hs b/src/Wumpus/Basic/Kernel.hs
--- a/src/Wumpus/Basic/Kernel.hs
+++ b/src/Wumpus/Basic/Kernel.hs
@@ -29,6 +29,7 @@
   , module Wumpus.Basic.Kernel.Drawing.CtxPicture
   , module Wumpus.Basic.Kernel.Drawing.LocDrawing
   , module Wumpus.Basic.Kernel.Drawing.LocTrace
+  , module Wumpus.Basic.Kernel.Drawing.PosObject
   , module Wumpus.Basic.Kernel.Drawing.TraceDrawing
   , module Wumpus.Basic.Kernel.Objects.AdvObject
   , module Wumpus.Basic.Kernel.Objects.Anchors
@@ -42,7 +43,7 @@
   , module Wumpus.Basic.Kernel.Objects.LocImage
   , module Wumpus.Basic.Kernel.Objects.LocThetaImage
   , module Wumpus.Basic.Kernel.Objects.Orientation
-  , module Wumpus.Basic.Kernel.Objects.PosObject
+  , module Wumpus.Basic.Kernel.Objects.Trail
 
   ) where
 
@@ -58,6 +59,7 @@
 import Wumpus.Basic.Kernel.Drawing.CtxPicture
 import Wumpus.Basic.Kernel.Drawing.LocDrawing
 import Wumpus.Basic.Kernel.Drawing.LocTrace
+import Wumpus.Basic.Kernel.Drawing.PosObject
 import Wumpus.Basic.Kernel.Drawing.TraceDrawing
 import Wumpus.Basic.Kernel.Objects.AdvObject
 import Wumpus.Basic.Kernel.Objects.Anchors
@@ -71,4 +73,4 @@
 import Wumpus.Basic.Kernel.Objects.LocImage
 import Wumpus.Basic.Kernel.Objects.LocThetaImage
 import Wumpus.Basic.Kernel.Objects.Orientation
-import Wumpus.Basic.Kernel.Objects.PosObject
+import Wumpus.Basic.Kernel.Objects.Trail
diff --git a/src/Wumpus/Basic/Kernel/Base/BaseDefs.hs b/src/Wumpus/Basic/Kernel/Base/BaseDefs.hs
--- a/src/Wumpus/Basic/Kernel/Base/BaseDefs.hs
+++ b/src/Wumpus/Basic/Kernel/Base/BaseDefs.hs
@@ -18,10 +18,23 @@
 
 module Wumpus.Basic.Kernel.Base.BaseDefs
   (
-  
 
+  -- * Constants
+    quarter_pi
+  , half_pi
+  , two_pi
+
+  , ang180
+  , ang150
+  , ang120
+  , ang90
+  , ang60
+  , ang45
+  , ang30
+  , ang15
+
   -- * Unit phantom type
-    UNil(..)
+  , UNil(..)
   , ureturn
   , uvoid
 
@@ -42,10 +55,12 @@
   -- * KernChar
   , KernChar
 
-  -- * Drawing paths
-  , DrawStyle(..)
+  -- * Drawing paths and shapes (closed paths)
+  , PathMode(..)
+  , DrawMode(..)
+  , closedMode
 
-  -- * Drawing /layer/
+  -- * Drawing layers
   , ZDeco(..)  
 
   -- * Alignment
@@ -60,17 +75,17 @@
 
   -- * Direction enumeration
   , Direction(..)
-  
+  , ClockDirection(..)  
 
   -- * Misc
-  , vsum
+
   , both
+  , monPreRepeatPost
 
   ) where
 
 import Wumpus.Core                              -- package: wumpus-core
 
-import Data.VectorSpace                         -- package: vector-space
 
 import Control.Applicative
 import Data.Monoid
@@ -80,7 +95,42 @@
 
 
 
+quarter_pi      :: Radian
+quarter_pi      = 0.25 * pi
 
+half_pi         :: Radian
+half_pi         = 0.5 * pi
+
+two_pi          :: Radian
+two_pi          = 2.0 * pi
+
+
+ang180          :: Radian
+ang180          = pi
+
+ang150          :: Radian
+ang150          = 5 * ang30
+
+ang120          :: Radian 
+ang120          = 3 * ang60
+
+ang90           :: Radian
+ang90           = pi / 2
+
+ang60           :: Radian
+ang60           = pi / 3
+
+ang45           :: Radian 
+ang45           = pi / 4
+
+ang30           :: Radian
+ang30           = pi / 6
+
+ang15           :: Radian
+ang15           = pi / 12
+
+
+
 --------------------------------------------------------------------------------
 -- Simple objects wrapped with unit phatom type 
 
@@ -242,17 +292,42 @@
 
 -- | Draw closed paths. 
 -- 
--- > FILL 
+-- > OSTROKE - open and stroked
+
+-- > CSTROKE - closed and stroke
 --
--- > STROKE
+-- > CFILL - closed and filled
 --
--- > FILL_STROKE - the path is filled and its edge is stroked.
+-- > CFILL_STROKE - closed, the path is filled, its edge is stroked.
 --
-data DrawStyle = FILL | STROKE | FILL_STROKE
+data PathMode = OSTROKE | CSTROKE | CFILL | CFILL_STROKE
   deriving (Bounded,Enum,Eq,Ord,Show)
 
 
 
+-- | Draw closed paths and shapes. 
+-- 
+-- > DRAW_STROKE - closed and stroked
+--
+-- > DRAW_FILL - closed and filled
+--
+-- > CLOSED_FILL_STROKE - the path is filled, its edge is stroked.
+--
+data DrawMode = DRAW_STROKE | DRAW_FILL | DRAW_FILL_STROKE
+  deriving (Bounded,Enum,Eq,Ord,Show)
+
+
+-- | Interpret a 'DrawMode' for a closed path.
+--
+closedMode :: DrawMode -> PathMode
+closedMode DRAW_STROKE      = CSTROKE 
+closedMode DRAW_FILL        = CFILL 
+closedMode DRAW_FILL_STROKE = CFILL_STROKE
+
+
+
+
+
 -- | Decorating with resepct to the Z-order 
 -- 
 -- > SUPERIOR - in front. 
@@ -312,24 +387,17 @@
 
 -- | An enumerated type representing horizontal and vertical 
 -- directions.
+--
 data Direction = UP | DOWN | LEFT | RIGHT
    deriving (Enum,Eq,Ord,Show) 
 
 
+-- | An enumerated type representing /clock/ directions.
+--
+data ClockDirection = CW | CCW
+   deriving (Enum,Eq,Ord,Show) 
 
 
--- | Sum a list of Vectors.
---
--- Note - this function is a candidate to go in Wumpus-Core, but
--- it will be added when there is an intrinsic reason to to update
--- Core (bug fix, or API change).
---
-vsum :: Num u => [Vec2 u] -> Vec2 u
-vsum [] = V2 0 0
-vsum (v:vs) = go v vs
-  where
-    go a []     = a
-    go a (b:bs) = go (a ^+^ b) bs
 
 
 -- | Applicative /both/ - run both computations return the pair
@@ -338,3 +406,12 @@
 both :: Applicative f => f a -> f b -> f (a,b)
 both fa fb = (,) <$> fa <*> fb
 
+
+-- | Monodial scheme - prefix, repeat body n times, suffix.
+--
+monPreRepeatPost :: Monoid a => a -> (Int, a) -> a -> a
+monPreRepeatPost pre (n,body1) post = step pre n
+  where
+    step ac i | i < 1     = ac `mappend` post
+              | otherwise = step (ac `mappend` body1) (i - 1) 
+    
diff --git a/src/Wumpus/Basic/Kernel/Base/DrawingContext.hs b/src/Wumpus/Basic/Kernel/Base/DrawingContext.hs
--- a/src/Wumpus/Basic/Kernel/Base/DrawingContext.hs
+++ b/src/Wumpus/Basic/Kernel/Base/DrawingContext.hs
@@ -29,7 +29,6 @@
 
   , DrawingContextF
   , TextMargin(..)
-  , ConnectorProps(..)
 
   -- * Construction
   , standardContext
@@ -89,7 +88,6 @@
       , dc_text_colour          :: RGBi
       , dc_line_spacing_factor  :: Double
       , dc_text_margin          :: TextMargin
-      , dc_connector_props      :: ConnectorProps
       }
 
 -- TODO - what parts of the Drawing Context should be strict? 
@@ -110,58 +108,7 @@
        }
 
 
--- | ConnectorProps control the drawing of connectors in 
--- Wumpus-Drawing.
---
--- > conn_src_space     :: Em
--- > conn_dst_space     :: Em
---
--- Source and destination spacers - these add spacing between the 
--- respective connector points and the tips of the drawn connector.
--- 
--- > conn_src_offset    :: Em
--- > conn_dst_offset    :: Em
---
--- Source and destination offsets - these offset the drawing of
--- the connector perpendicular to the direction of line formed 
--- between the connector points (a positive offset is drawn above, 
--- a negative offset below). The main use of offsets is to draw
--- parallel line connectors.
---
--- > conn_arc_ang       :: Radian 
---
--- Control the /bend/ of an arc connector.
--- 
--- > conn_src_arm       :: Em
--- > conn_dst_arm       :: Em 
---
--- Control the /arm/ length of a jointed connector - arms are the 
--- initial segments of the connector. 
---
--- > conn_loop_size     :: Em
---
--- Control the /height/ of a loop connector. 
---
--- > conn_box_halfsize  :: Em
--- 
--- Control the size of a connector box. Connector boxes are 
--- drawn with the exterior lines projected out from the connector
--- points a halfsize above and below.
--- 
-data ConnectorProps = ConnectorProps
-      { dc_conn_src_space       :: !Em
-      , dc_conn_dst_space       :: !Em
-      , dc_conn_src_offset      :: !Em
-      , dc_conn_dst_offset      :: !Em
-      , dc_conn_arc_ang         :: !Radian
-      , dc_conn_src_arm         :: !Em
-      , dc_conn_dst_arm         :: !Em
-      , dc_conn_loop_size       :: !Em
-      , dc_conn_box_halfsize    :: !Em
-      }
 
-
-
 -- | 'standardContext' : @ font_size -> DrawingContext @  
 --
 -- Create a 'DrawingContext'.
@@ -193,15 +140,6 @@
 -- > round_corner_factor: 0
 -- > text_margin:         (0.5 em, 0.5 em) 
 --
--- > conn_src_sep:        0
--- > conn_dst_sep:        0
--- > conn_src_offset:     0
--- > conn_dst_offset:     0
--- > conn_arc_ang:        pi / 12
--- > conn_src_arm:        1
--- > conn_dst_arm:        1
--- > conn_loop_size:      2 
--- 
 --
 standardContext :: FontSize -> DrawingContext
 standardContext sz = 
@@ -217,7 +155,6 @@
                    , dc_text_colour          = wumpus_black
                    , dc_line_spacing_factor  = default_line_spacing  
                    , dc_text_margin          = default_text_margin
-                   , dc_connector_props      = default_connector_props
                    }
 
 
@@ -278,7 +215,6 @@
          , dc_text_colour           = wumpus_black
          , dc_line_spacing_factor   = default_line_spacing
          , dc_text_margin           = default_text_margin
-         , dc_connector_props       = default_connector_props
          }
 
 -- Ideally @reset_drawing_properties@ would be in the UpdateDC 
@@ -313,21 +249,6 @@
 default_text_margin :: TextMargin
 default_text_margin = TextMargin { text_margin_x = 0.5, text_margin_y = 0.5 }
 
-
--- Arc angle is 15deg - quite shallow.
---
-default_connector_props :: ConnectorProps
-default_connector_props = 
-    ConnectorProps { dc_conn_src_space    = 0
-                   , dc_conn_dst_space    = 0
-                   , dc_conn_src_offset   = 0
-                   , dc_conn_dst_offset   = 0
-                   , dc_conn_arc_ang      = pi / 12
-                   , dc_conn_src_arm      = 1
-                   , dc_conn_dst_arm      = 1
-                   , dc_conn_loop_size    = 2 
-                   , dc_conn_box_halfsize = 2 
-                   }
 
 
 default_line_spacing :: Double
diff --git a/src/Wumpus/Basic/Kernel/Base/QueryDC.hs b/src/Wumpus/Basic/Kernel/Base/QueryDC.hs
--- a/src/Wumpus/Basic/Kernel/Base/QueryDC.hs
+++ b/src/Wumpus/Basic/Kernel/Base/QueryDC.hs
@@ -65,18 +65,6 @@
 
   , cwLookupTable
 
-
-  -- * Connector props
-  , connectorSrcSpace
-  , connectorDstSpace
-  , connectorSrcOffset
-  , connectorDstOffset
-  , connectorArcAngle
-  , connectorSrcArm
-  , connectorDstArm
-  , connectorLoopSize
-  , connectorBoxHalfSize
-
   ) where
 
 import Wumpus.Basic.Kernel.Base.BaseDefs
@@ -343,55 +331,3 @@
 --
 cwLookupTable :: DrawingCtxM m => m CharWidthLookup
 cwLookupTable = glyphQuery get_cw_table
-
---------------------------------------------------------------------------------
--- Connector props
-
--- helper 
-connectorAsks :: DrawingCtxM m => (ConnectorProps -> a) -> m a
-connectorAsks f = f <$> asksDC dc_connector_props
-
-
-
-connectorSrcSpace :: (DrawingCtxM m, InterpretUnit u) => m u 
-connectorSrcSpace = (\sz u -> uconvert1 sz u) 
-                      <$> pointSize <*> connectorAsks dc_conn_src_space
-
-
-connectorDstSpace :: (DrawingCtxM m, InterpretUnit u) => m u 
-connectorDstSpace = (\sz u -> uconvert1 sz u) 
-                      <$> pointSize <*> connectorAsks dc_conn_dst_space
-
-connectorSrcOffset :: (DrawingCtxM m, InterpretUnit u) => m u 
-connectorSrcOffset = (\sz u -> uconvert1 sz u) 
-                       <$> pointSize <*> connectorAsks dc_conn_src_offset
-
-
-connectorDstOffset :: (DrawingCtxM m, InterpretUnit u) => m u 
-connectorDstOffset = (\sz u -> uconvert1 sz u) 
-                       <$> pointSize <*> connectorAsks dc_conn_dst_offset
-
-
-connectorArcAngle :: DrawingCtxM m => m Radian
-connectorArcAngle = connectorAsks dc_conn_arc_ang
-
-
-connectorSrcArm :: (DrawingCtxM m, InterpretUnit u) => m u 
-connectorSrcArm = (\sz u -> uconvert1 sz u) 
-                    <$> pointSize <*> connectorAsks dc_conn_src_arm
-
-
-connectorDstArm :: (DrawingCtxM m, InterpretUnit u) => m u 
-connectorDstArm = (\sz u -> uconvert1 sz u) 
-                    <$> pointSize <*> connectorAsks dc_conn_dst_arm
-
-
-connectorLoopSize :: (DrawingCtxM m, InterpretUnit u) => m u 
-connectorLoopSize = (\sz u -> uconvert1 sz u) 
-                      <$> pointSize <*> connectorAsks dc_conn_loop_size
-
-
-connectorBoxHalfSize :: (DrawingCtxM m, InterpretUnit u) => m u 
-connectorBoxHalfSize = 
-    (\sz u -> uconvert1 sz u) 
-      <$> pointSize <*> connectorAsks dc_conn_box_halfsize
diff --git a/src/Wumpus/Basic/Kernel/Base/Units.hs b/src/Wumpus/Basic/Kernel/Base/Units.hs
--- a/src/Wumpus/Basic/Kernel/Base/Units.hs
+++ b/src/Wumpus/Basic/Kernel/Base/Units.hs
@@ -75,7 +75,12 @@
   normalize _ = cm 
   dinterp   _ = dcm
 
+instance Tolerance Centimeter where 
+  eq_tolerance     = 0.001
+  length_tolerance = 0.01
 
+
+
 -- | Wrapped Double /Pica/ unit type.
 -- 
 -- Pica is 12 Points.
@@ -102,11 +107,7 @@
 dpica = Pica . (\x -> x / 12.0)
 
 
-instance Tolerance Pica where 
-  eq_tolerance     = 0.001
-  length_tolerance = 0.01
 
-
 instance ScalarUnit Pica where
   fromPsPoint = dpica
   toPsPoint   = pica
@@ -116,7 +117,12 @@
   dinterp   _ = dpica
 
 
+instance Tolerance Pica where 
+  eq_tolerance     = 0.001
+  length_tolerance = 0.01
 
+
+
 --------------------------------------------------------------------------------
 -- Contextual units
 
@@ -134,7 +140,8 @@
   normalize sz a = fromIntegral sz * realToFrac a
   dinterp sz d   = realToFrac d / fromIntegral sz
 
-instance Tolerance Centimeter where 
+
+instance Tolerance Em where 
   eq_tolerance     = 0.001
   length_tolerance = 0.01
 
@@ -153,11 +160,7 @@
   dinterp sz d   = 2 * (realToFrac d) / (fromIntegral sz)
 
 
-
-instance Tolerance Em where 
-  eq_tolerance     = 0.001
-  length_tolerance = 0.01
-
 instance Tolerance En where
   eq_tolerance     = 0.001 
   length_tolerance = 0.01
+
diff --git a/src/Wumpus/Basic/Kernel/Base/UpdateDC.hs b/src/Wumpus/Basic/Kernel/Base/UpdateDC.hs
--- a/src/Wumpus/Basic/Kernel/Base/UpdateDC.hs
+++ b/src/Wumpus/Basic/Kernel/Base/UpdateDC.hs
@@ -96,23 +96,9 @@
   , text_use_stroke_colour
   , text_use_fill_colour
 
-  -- * Connector Props
-  , source_space
-  , dest_space
-  , source_offset
-  , dest_offset
-  , uniform_conn_space
-  , conn_arc_angle
-  , source_arm_len
-  , dest_arm_len
-  , uniform_arm_len
-  , conn_loop_size
-  , conn_box_halfsize
-
   ) where
 
 
-import Wumpus.Basic.Kernel.Base.BaseDefs
 import Wumpus.Basic.Kernel.Base.DrawingContext
 import Wumpus.Basic.Kernel.Base.FontSupport
 import Wumpus.Basic.Kernel.Base.Units
@@ -563,126 +549,3 @@
     (\s a -> s { dc_text_colour = a }) <*> dc_fill_colour
 
 
-
---------------------------------------------------------------------------------
--- Connector props
-
--- helper 
-connectorUpd :: (ConnectorProps -> ConnectorProps) -> DrawingContextF
-connectorUpd f = 
-   (\s a -> s { dc_connector_props = f a }) <*> dc_connector_props
-
--- | Normalize to zero if negative.
---
-normZero :: (Num u, Ord u) => u -> u
-normZero u = if u < 0 then 0 else u
-
--- | Set the connector source spacing.
---
--- The spacing is used as a projection along the line formed 
--- between connector points making the connection /looser/ if 
--- required.
--- 
--- The default value is 0. Negative values are not allowed, they
--- are normalized to 0.
---
-source_space :: (Ord u, InterpretUnit u) => u -> DrawingContextF
-source_space u = withFontSize $ \sz -> 
-    connectorUpd (\s -> s { dc_conn_src_space = uconvert1 sz $ normZero u })
-
-
--- | Set the connector destination spacing.
---
--- The spacing is used as a projection along the line formed 
--- between connector points making the connection /looser/ if 
--- required.
--- 
--- The default value is 0. Negative values are not allowed, they
--- are normalized to 0.
---
-dest_space :: (Ord u, InterpretUnit u) => u -> DrawingContextF
-dest_space u = withFontSize $ \sz -> 
-    connectorUpd (\s -> s { dc_conn_dst_space = uconvert1 sz $ normZero u })
-
-
-
--- | Set the connector source and destination spacings to the 
--- same length.
---
-uniform_conn_space :: (Ord u, InterpretUnit u) => u -> DrawingContextF
-uniform_conn_space u = withFontSize $ \sz -> 
-    connectorUpd (\s -> s { dc_conn_src_space = uconvert1 sz $ normZero u
-                          , dc_conn_dst_space = uconvert1 sz $ normZero u })
-
-
-
--- | Set the connector source offset.
---
--- The offset is used to shift the start point /upwards/ 
--- perpendicular to its true origin (negative values are 
--- downwards). This can be used to draw a connector with two 
--- parallel lines, for example.
---
--- Upwards and downwards in this description are dependent on the
--- direction of the line, of course. Generally the documentations 
--- consider lines are left-to-right unless specifically noted.
---
-source_offset :: (Ord u, InterpretUnit u) => u -> DrawingContextF
-source_offset u = withFontSize $ \sz -> 
-    connectorUpd (\s -> s { dc_conn_src_offset = uconvert1 sz u })
-
-
--- | Set the connector destination offset.
---
--- See 'source_offset' for an explanation.
---
-dest_offset :: (Ord u, InterpretUnit u) => u -> DrawingContextF
-dest_offset u = withFontSize $ \sz -> 
-    connectorUpd (\s -> s { dc_conn_dst_offset = uconvert1 sz u })
-
-
--- | Set the connector arc angle.
---
-conn_arc_angle :: Radian -> DrawingContextF
-conn_arc_angle ang = 
-    connectorUpd (\s -> s { dc_conn_arc_ang = ang })
-
-
--- | Set the connector source arm length.
---
-source_arm_len :: InterpretUnit u => u -> DrawingContextF
-source_arm_len u = withFontSize $ \sz -> 
-    connectorUpd (\s -> s { dc_conn_src_arm = uconvert1 sz u })
-                       
-
-
-
--- | Set the connector destination arm length.
---
-dest_arm_len :: InterpretUnit u => u -> DrawingContextF
-dest_arm_len u = withFontSize $ \sz -> 
-    connectorUpd (\s -> s { dc_conn_dst_arm = uconvert1 sz u })
-
-
-
-
--- | Set the connector source and destination arms to the same 
--- length.
---
-uniform_arm_len :: InterpretUnit u => u -> DrawingContextF
-uniform_arm_len u = withFontSize $ \sz -> 
-    connectorUpd (\s -> s { dc_conn_src_arm = uconvert1 sz u
-                          , dc_conn_dst_arm = uconvert1 sz u })
-
-
--- | Set the connector loop size.
---
-conn_loop_size :: InterpretUnit u => u -> DrawingContextF
-conn_loop_size u = withFontSize $ \sz -> 
-    connectorUpd (\s -> s { dc_conn_loop_size = uconvert1 sz u })
-
--- | Set the connector box halfsize.
---
-conn_box_halfsize :: InterpretUnit u => u -> DrawingContextF
-conn_box_halfsize u = withFontSize $ \sz -> 
-    connectorUpd (\s -> s { dc_conn_box_halfsize = uconvert1 sz u })
diff --git a/src/Wumpus/Basic/Kernel/Drawing/Chain.hs b/src/Wumpus/Basic/Kernel/Drawing/Chain.hs
--- a/src/Wumpus/Basic/Kernel/Drawing/Chain.hs
+++ b/src/Wumpus/Basic/Kernel/Drawing/Chain.hs
@@ -33,17 +33,26 @@
   , runChain
   , runChain_
 
-  , cnext
+  , chain1
+  , sequenceChain
+
   , setChainScheme
 
+  , chainPrefix
 
   , chainIterate
-  , chainH
-  , chainV
 
-  , tableRight  
-  , tableDown
+  , horizontalChainScm
+  , verticalChainScm
+  , runChainH
+  , runChainV
 
+  , tableRowwiseScm
+  , tableColumnwiseScm
+  
+  , runTableRowwise
+  , runTableColumnwise
+
   , radialChain
 
   ) where
@@ -83,8 +92,8 @@
 -- not be possible if start was just a pure @cst@ value. 
 --
 data ChainScheme u = forall cst. ChainScheme 
-      { scheme_start    :: Point2 u -> cst
-      , scheme_step     :: Point2 u -> cst -> (Point2 u,cst)
+      { chain_init      :: Point2 u -> cst
+      , chain_step      :: Point2 u -> cst -> (Point2 u,cst)
       }
 
 type instance DUnit (ChainScheme u) = u
@@ -170,8 +179,8 @@
 -- Run functions
 
 runGenChain :: InterpretUnit u 
-         => GenChain st u a -> ChainScheme u -> st -> LocImage u (a,st)
-runGenChain ma (ChainScheme start step) ust = promoteLoc $ \pt -> 
+            => ChainScheme u -> st -> GenChain st u a -> LocImage u (a,st)
+runGenChain (ChainScheme start step) ust ma = promoteLoc $ \pt -> 
     askDC >>= \ctx ->
     let st_zero     = ChainSt { chain_st         = start pt
                               , chain_next       = step
@@ -185,121 +194,181 @@
 -- | Forget the user state LocImage, just return the /answer/.
 --
 evalGenChain :: InterpretUnit u 
-             => GenChain st u a -> ChainScheme u -> st -> LocImage u a
-evalGenChain ma cscm st = fmap fst $ runGenChain ma cscm st
+             => ChainScheme u -> st -> GenChain st u a -> LocImage u a
+evalGenChain cscm st ma = fmap fst $ runGenChain cscm st ma
 
 
 -- | Forget the /answer/, just return the user state.
 --
 execGenChain :: InterpretUnit u 
-             => GenChain st u a -> ChainScheme u -> st -> LocImage u st 
-execGenChain ma cscm st = fmap snd $ runGenChain ma cscm st
+             => ChainScheme u -> st -> GenChain st u a -> LocImage u st 
+execGenChain cscm st ma = fmap snd $ runGenChain cscm st ma
 
 
 stripGenChain :: InterpretUnit u 
-              => GenChain st u a -> ChainScheme u -> st -> LocQuery u (a,st)
-stripGenChain ma cscm st = stripLocImage $ runGenChain ma cscm st 
+              => ChainScheme u -> st -> GenChain st u a -> LocQuery u (a,st)
+stripGenChain cscm st ma = stripLocImage $ runGenChain cscm st ma
 
 
 
 runChain :: InterpretUnit u 
-         => Chain u a -> ChainScheme u -> LocImage u a
-runChain ma cscm = evalGenChain ma cscm ()
+         => ChainScheme u -> Chain u a -> LocImage u a
+runChain cscm ma = evalGenChain cscm () ma
 
 runChain_ :: InterpretUnit u 
-          => Chain u a -> ChainScheme u -> LocGraphic u
-runChain_ ma cscm = ignoreAns $ runChain ma cscm
+          => ChainScheme u -> Chain u a -> LocGraphic u
+runChain_ cscm ma = ignoreAns $ runChain cscm ma
 
 
 
+
 --------------------------------------------------------------------------------
 -- Operations
 
-cnext :: InterpretUnit u 
-      => LocImage u a -> GenChain st u a
-cnext gf  = GenChain $ \ctx pt (ChainSt s0 sf ust) -> 
-    let dpt       = dinterpF (dc_font_size ctx) pt
-        (pt1,st1) = sf dpt s0
+chain1 :: InterpretUnit u 
+        => LocImage u a -> GenChain st u a
+chain1 gf  = GenChain $ \ctx pt (ChainSt s0 sf ust) -> 
+    let upt       = dinterpF (dc_font_size ctx) pt
+        (a,w1)    = runImage ctx $ applyLoc gf upt
+        (pt1,st1) = sf upt s0
         dpt1      = normalizeF (dc_font_size ctx) pt1
-        (a,w1)    = runImage (applyLoc gf pt1) ctx
-        new_st    = ChainSt { chain_st = st1
-                            , chain_next = sf
+        new_st    = ChainSt { chain_st         = st1
+                            , chain_next       = sf
                             , chain_user_state = ust }
     in (a, dpt1, new_st, w1)
 
+sequenceChain :: InterpretUnit u 
+              => [LocImage u a] -> GenChain st u (UNil u)
+sequenceChain = ignoreAns . mapM_ chain1
 
+--
+-- Note - onChain draws at the initial position, then increments 
+-- the next position.
+--
+
+
 setChainScheme :: InterpretUnit u 
                => ChainScheme u -> GenChain st u ()
 setChainScheme (ChainScheme start step) = 
     GenChain $ \ctx pt (ChainSt _ _ ust) -> 
       let upt     = dinterpF (dc_font_size ctx) pt
-          new_st  = ChainSt { chain_st = start upt
-                            , chain_next = step
+          new_st  = ChainSt { chain_st         = start upt
+                            , chain_next       = step
                             , chain_user_state = ust }
       in ((), pt, new_st, mempty) 
 
 
 
+chainPrefix :: ChainScheme u -> Int -> ChainScheme u -> ChainScheme u
+chainPrefix (ChainScheme astart astep) ntimes chb@(ChainScheme bstart bstep)
+    | ntimes < 1 = chb
+    | otherwise  = ChainScheme { chain_init = start, chain_step = next }
+  where
+    start pt = (astart pt,ntimes, bstart pt)
+
+    next pt (ast,n,bst) 
+        | n > 0     = let (p2,ast1) = astep pt ast in (p2, (ast1,n-1,bst))
+        | n == 0    = let bst1      = bstart pt 
+                          (p2,bst2) = bstep pt bst1 
+                      in (p2, (ast,(-1),bst2))
+        | otherwise = let (p2,bst1) = bstep pt bst in (p2,(ast, (-1), bst1))
+ 
+
+
+
+
 --------------------------------------------------------------------------------
 -- Schemes
 
 chainIterate :: (Point2 u -> Point2 u) -> ChainScheme u
-chainIterate fn = ChainScheme { scheme_start = const ()
-                              , scheme_step  = \pt _ -> (fn pt, ())
+chainIterate fn = ChainScheme { chain_init = const ()
+                              , chain_step = \pt _ -> (fn pt, ())
                               }
 
 
-chainH :: Num u => u -> ChainScheme u
-chainH dx = 
-    ChainScheme { scheme_start = const ()
-                , scheme_step  = \pt _ -> (displace (hvec dx) pt, ())
+horizontalChainScm :: Num u => u -> ChainScheme u
+horizontalChainScm dx = 
+    ChainScheme { chain_init = const ()
+                , chain_step = \pt _ -> (displace (hvec dx) pt, ())
                 }
    
-chainV :: Num u => u -> ChainScheme u
-chainV dy = 
-    ChainScheme { scheme_start = const ()
-                , scheme_step  = \pt _ -> (displace (vvec dy) pt, ())
+verticalChainScm :: Num u => u -> ChainScheme u
+verticalChainScm dy = 
+    ChainScheme { chain_init = const ()
+                , chain_step = \pt _ -> (displace (vvec dy) pt, ())
                 }
 
 
+-- Horizontal and vertical chains are common enough to merit 
+-- dedicated run functions.
 
+runChainH :: InterpretUnit u => u -> Chain u a -> LocImage u a
+runChainH dx ma = runChain (horizontalChainScm dx) ma
 
+
+runChainV :: InterpretUnit u => u -> Chain u a -> LocImage u a
+runChainV dy ma = runChain (verticalChainScm dy) ma
+
+
 -- | Outer and inner steppers.
 --
 scStepper :: PointDisplace u -> Int -> PointDisplace u 
           -> ChainScheme u
 scStepper outF n innF = 
-    ChainScheme { scheme_start = start, scheme_step = step }
+    ChainScheme { chain_init = start, chain_step = step }
   where
-    start pt                      = (pt,0)
-    step  pt (ogin,i) | i < n     = (innF pt, (ogin, i+1))
+    start pt                      = (pt,1)
+    step  pt (ogin,i) | i <  n    = (innF pt, (ogin, i+1))
                       | otherwise = let o1 = outF ogin 
-                                    in (innF o1, (o1,1)) 
+                                    in (o1, (o1,1)) 
 
 
-tableRight :: Num u => Int -> (u,u) -> ChainScheme u
-tableRight num_cols (col_width,row_height) = 
+tableRowwiseScm :: Num u => Int -> (u,u) -> ChainScheme u
+tableRowwiseScm num_cols (col_width,row_height) = 
     scStepper downF num_cols rightF
   where
     downF   = displace $ vvec $ negate row_height
     rightF  = displace $ hvec col_width
 
-tableDown :: Num u => Int -> (u,u) -> ChainScheme u
-tableDown num_rows (col_width,row_height) = 
+tableColumnwiseScm :: Num u => Int -> (u,u) -> ChainScheme u
+tableColumnwiseScm num_rows (col_width,row_height) = 
     scStepper rightF num_rows downF
   where
     downF   = displace $ vvec $ negate row_height
     rightF  = displace $ hvec col_width
 
 
+runTableRowwise :: InterpretUnit u 
+             => Int -> (u,u) -> Chain u a -> LocImage u a
+runTableRowwise num_cols dims ma = 
+    runChain (tableRowwiseScm num_cols dims) ma
 
+
+runTableColumnwise :: InterpretUnit u 
+             => Int -> (u,u) -> Chain u a -> LocImage u a
+runTableColumnwise num_rows dims ma = 
+    runChain (tableColumnwiseScm num_rows dims) ma
+
+
+
 radialChain :: Floating u 
             => u -> Radian -> Radian -> ChainScheme u
 radialChain radius angstart angi = 
-    ChainScheme { scheme_start = start, scheme_step = step }
+    ChainScheme { chain_init = start, chain_step = step }
   where
-    start pt           = (pt,angstart)
-    step  _ (ogin,ang) = (displace (avec ang radius) ogin, (ogin,ang + angi))
+    start pt           = let ogin = displace (avec angstart (-radius)) pt
+                         in (ogin, angstart)
+    step  _ (ogin,ang) = let ang_next = ang + angi 
+                             pt       = displace (avec ang_next radius) ogin
+                         in (pt, (ogin, ang_next))
+
+    
+
+-- radialChain is convoluted because first point is not the 
+-- circle center but a point on the circumference. Also the next
+-- step iterates the (constant) origin rather than the previous 
+-- point.
+
 
 -- Note - radialChains stepper is oblivious to the previous point...
 
diff --git a/src/Wumpus/Basic/Kernel/Drawing/CtxPicture.hs b/src/Wumpus/Basic/Kernel/Drawing/CtxPicture.hs
--- a/src/Wumpus/Basic/Kernel/Drawing/CtxPicture.hs
+++ b/src/Wumpus/Basic/Kernel/Drawing/CtxPicture.hs
@@ -129,8 +129,8 @@
 -- Transform a 'TraceDrawing' into a 'CtxPicture'.
 --
 drawTracing :: TraceDrawing u a -> CtxPicture
-drawTracing mf = 
-    CtxPicture $ \ctx -> liftToPictureMb $ execTraceDrawing mf ctx
+drawTracing ma = 
+    CtxPicture $ \ctx -> liftToPictureMb $ execTraceDrawing ctx ma
 
 -- | 'udrawTracing' : @ scalar_unit_value * trace_drawing  -> CtxPicture @
 --
@@ -140,8 +140,8 @@
 --
 --
 udrawTracing :: u -> TraceDrawing u a -> CtxPicture
-udrawTracing _ mf = 
-    CtxPicture $ \ctx -> liftToPictureMb $ execTraceDrawing mf ctx
+udrawTracing _ ma = 
+    CtxPicture $ \ctx -> liftToPictureMb $ execTraceDrawing ctx ma
 
 
 -- Note need Gen versions with user state...
diff --git a/src/Wumpus/Basic/Kernel/Drawing/LocDrawing.hs b/src/Wumpus/Basic/Kernel/Drawing/LocDrawing.hs
--- a/src/Wumpus/Basic/Kernel/Drawing/LocDrawing.hs
+++ b/src/Wumpus/Basic/Kernel/Drawing/LocDrawing.hs
@@ -163,8 +163,8 @@
 
 
 runGenLocDrawing :: (Translate a, InterpretUnit u, u ~ DUnit a) 
-                 => GenLocDrawing st u a -> st -> LocImage u (a,st)
-runGenLocDrawing ma st = promoteLoc $ \(P2 x y) -> 
+                 => st -> GenLocDrawing st u a -> LocImage u (a,st)
+runGenLocDrawing st ma = promoteLoc $ \(P2 x y) -> 
     askDC >>= \ctx ->
     let (a,s1,w1) = getGenLocDrawing ma ctx st
         ans       = translate x y a 
@@ -177,20 +177,20 @@
 -- | Forget the user state LocImage, just return the /answer/.
 --
 evalGenLocDrawing :: (Translate a, InterpretUnit u, u ~ DUnit a) 
-                  => GenLocDrawing st u a -> st -> LocImage u a
-evalGenLocDrawing ma st = fmap fst $ runGenLocDrawing ma st
+                  => st -> GenLocDrawing st u a -> LocImage u a
+evalGenLocDrawing st ma = fmap fst $ runGenLocDrawing st ma
 
 
 -- | Forget the /answer/, just return the user state.
 --
 execGenLocDrawing :: (Translate a, InterpretUnit u, u ~ DUnit a) 
-                  => GenLocDrawing st u a -> st -> LocImage u st 
-execGenLocDrawing ma st = fmap snd $ runGenLocDrawing ma st
+                  => st -> GenLocDrawing st u a -> LocImage u st 
+execGenLocDrawing st ma = fmap snd $ runGenLocDrawing st ma
 
 
 stripGenLocDrawing :: (Translate a, InterpretUnit u, u ~ DUnit a) 
-                   => GenLocDrawing st u a -> st -> LocQuery u (a,st)
-stripGenLocDrawing ma st = stripLocImage $ runGenLocDrawing ma st 
+                   => st -> GenLocDrawing st u a -> LocQuery u (a,st)
+stripGenLocDrawing st ma = stripLocImage $ runGenLocDrawing st ma
 
 
 -- | Simple version of 'runGenLocDrawing' - run a 'LocDrawing' without
@@ -198,7 +198,7 @@
 --
 runLocDrawing :: (Translate a, InterpretUnit u, u ~ DUnit a) 
               => LocDrawing u a -> LocImage u a
-runLocDrawing ma = evalGenLocDrawing ma ()
+runLocDrawing ma = evalGenLocDrawing () ma
 
 
 runLocDrawing_ :: (Translate a, InterpretUnit u, u ~ DUnit a) 
@@ -212,7 +212,7 @@
 insertiImpl :: InterpretUnit u 
             => Image u a -> GenLocDrawing st u a
 insertiImpl gf = GenLocDrawing $ \ctx s -> 
-    let (a,w1)   = runImage gf ctx in (a,s,w1) 
+    let (a,w1)   = runImage ctx gf in (a,s,w1) 
 
 
 
@@ -221,7 +221,7 @@
 insertliImpl :: InterpretUnit u
              => Anchor u -> LocImage u a -> GenLocDrawing st u a
 insertliImpl p1 gf = GenLocDrawing $ \ctx s -> 
-    let (a,w1) = runLocImage gf ctx p1 in (a,s,w1) 
+    let (a,w1) = runLocImage ctx p1 gf in (a,s,w1) 
 
 
 
@@ -235,4 +235,4 @@
              => Anchor u -> Anchor u -> ConnectorImage u a 
              -> GenLocDrawing st u a
 insertciImpl p1 p2 gf = GenLocDrawing $ \ctx s -> 
-    let (a,w1) = runConnectorImage gf ctx p1 p2 in (a,s,w1) 
+    let (a,w1) = runConnectorImage ctx p1 p2 gf in (a,s,w1) 
diff --git a/src/Wumpus/Basic/Kernel/Drawing/LocTrace.hs b/src/Wumpus/Basic/Kernel/Drawing/LocTrace.hs
--- a/src/Wumpus/Basic/Kernel/Drawing/LocTrace.hs
+++ b/src/Wumpus/Basic/Kernel/Drawing/LocTrace.hs
@@ -146,7 +146,7 @@
 insertlImpl :: InterpretUnit u => LocImage u a -> GenLocTrace st u a
 insertlImpl gf = GenLocTrace $ \ctx pt s ->
     let upt    = dinterpF (dc_font_size ctx) pt 
-        (a,w1) = runLocImage gf ctx upt
+        (a,w1) = runLocImage ctx upt gf
     in (a,pt,s,w1) 
 
 
@@ -171,8 +171,8 @@
 
 
 runGenLocTrace :: InterpretUnit u 
-               => GenLocTrace st u a -> st -> LocImage u (a,st)
-runGenLocTrace ma st = promoteLoc $ \pt -> 
+               => st -> GenLocTrace st u a -> LocImage u (a,st)
+runGenLocTrace st ma = promoteLoc $ \pt -> 
     askDC >>= \ctx ->
     let dpt         = normalizeF (dc_font_size ctx) pt
         (a,_,s1,w1) = getGenLocTrace ma ctx dpt st
@@ -184,20 +184,20 @@
 -- | Forget the user state LocImage, just return the /answer/.
 --
 evalGenLocTrace :: InterpretUnit u 
-                => GenLocTrace st u a -> st -> LocImage u a
-evalGenLocTrace ma st = fmap fst $ runGenLocTrace ma st
+                => st -> GenLocTrace st u a -> LocImage u a
+evalGenLocTrace st ma = fmap fst $ runGenLocTrace st ma
 
 
 -- | Forget the /answer/, just return the user state.
 --
 execGenLocTrace :: InterpretUnit u 
-                => GenLocTrace st u a -> st -> LocImage u st 
-execGenLocTrace ma st = fmap snd $ runGenLocTrace ma st
+                => st -> GenLocTrace st u a -> LocImage u st 
+execGenLocTrace st ma = fmap snd $ runGenLocTrace st ma
 
 
 stripGenLocTrace :: InterpretUnit u 
-                 => GenLocTrace st u a -> st -> LocQuery u (a,st)
-stripGenLocTrace ma st = stripLocImage $ runGenLocTrace ma st 
+                 => st -> GenLocTrace st u a -> LocQuery u (a,st)
+stripGenLocTrace st ma = stripLocImage $ runGenLocTrace st ma
 
 
 -- | Simple version of 'runGenLocTrace' - run a 'LocTrace' without
@@ -205,7 +205,7 @@
 --
 runLocTrace :: InterpretUnit u 
             => LocTrace u a -> LocImage u a
-runLocTrace ma = evalGenLocTrace ma ()
+runLocTrace ma = evalGenLocTrace () ma
 
 
 runLocTrace_ :: InterpretUnit u 
diff --git a/src/Wumpus/Basic/Kernel/Drawing/PosObject.hs b/src/Wumpus/Basic/Kernel/Drawing/PosObject.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Basic/Kernel/Drawing/PosObject.hs
@@ -0,0 +1,661 @@
+{-# LANGUAGE TypeFamilies               #-}
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Basic.Kernel.Drawing.PosObject
+-- Copyright   :  (c) Stephen Tetley 2011
+-- License     :  BSD3
+--
+-- Maintainer  :  stephen.tetley@gmail.com
+-- Stability   :  highly unstable
+-- Portability :  GHC 
+--
+-- Extended Graphic object - a rectangular /positionable/ Image.
+-- 
+-- This graphic object has a more flexible API for positioning 
+-- than other graphic objects. Rather than a LocGraphic which 
+-- supports a single method of positioning at some start-point,
+-- a @PosGraphic@ can be drawn at its center or locations on its 
+-- outer rectangle.
+--
+--------------------------------------------------------------------------------
+
+module Wumpus.Basic.Kernel.Drawing.PosObject
+  (
+
+  -- * Positionable image
+    GenPosObject
+  , GenPosGraphic
+
+  , PosObject
+  , DPosObject
+
+  , PosGraphic
+  , DPosGraphic
+
+  -- * Operations
+  , runGenPosObject
+  , evalGenPosObject
+  , execGenPosObject
+  
+  , runPosObject
+
+  , runPosObjectBBox
+
+  , makePosObject
+  , emptyPosObject
+
+  , elaboratePosObject
+  , decoratePosObject
+
+  , extendPosObject
+  , mapOrientation
+
+  , illustratePosObject
+
+  -- * Primitive text PosObjects
+  , posChar
+  , posEscChar 
+  , posCharUpright
+  , posEscCharUpright
+  
+  , posCharPrim
+
+  , posText
+  , posEscText 
+  , posTextUpright
+  , posEscTextUpright
+
+  , posTextPrim
+
+  , multilinePosText
+  , multilinePosEscText
+
+  , rposText
+  , rposEscText
+  , rposChar
+  , rposEscChar
+  
+
+  , posHKernText
+
+  , monospaceText
+  , monospaceEscText
+
+  ) where
+
+
+import Wumpus.Basic.Kernel.Base.BaseDefs
+import Wumpus.Basic.Kernel.Base.DrawingContext
+import Wumpus.Basic.Kernel.Base.QueryDC
+import Wumpus.Basic.Kernel.Base.UpdateDC
+import Wumpus.Basic.Kernel.Base.WrappedPrimitive
+import Wumpus.Basic.Kernel.Drawing.Basis
+import Wumpus.Basic.Kernel.Objects.Basis
+import Wumpus.Basic.Kernel.Objects.Concat
+import Wumpus.Basic.Kernel.Objects.DrawingPrimitives
+import Wumpus.Basic.Kernel.Objects.Image
+import Wumpus.Basic.Kernel.Objects.LocImage
+import Wumpus.Basic.Kernel.Objects.LocThetaImage
+import Wumpus.Basic.Kernel.Objects.Orientation
+
+import Wumpus.Core                              -- package: wumpus-core
+import Wumpus.Core.Colour ( red, blue )
+
+import Data.AffineSpace                         -- package: vector-space
+import Data.VectorSpace
+
+import Control.Applicative
+import Data.Monoid
+
+type DOrt = Orientation Double
+
+-- | A positionable \"Object\".
+--
+newtype GenPosObject st u a = GenPosObject { 
+    getGenPosObject :: DrawingContext -> DPoint2 -> st -> (a, st, DOrt, CatPrim) }
+
+type instance DUnit   (GenPosObject st u a) = u
+type instance UState  (GenPosObject st u)   = st
+
+type GenPosGraphic st u = GenPosObject st u (UNil u)
+
+
+-- | Type synonym for @GenPosObject () u a@, a PosObject without
+-- user state.
+--
+type PosObject u a = GenPosObject () u a
+    
+-- | Version of PosObject specialized to Double for the unit type.
+--
+type DPosObject a = PosObject Double a
+
+
+-- | Version of PosObject with answer specialized to UNil.
+--
+type PosGraphic u = PosObject u (UNil u)
+
+-- | Version of PosGraphic specialized to Double for the unit type.
+--
+type DPosGraphic = PosGraphic Double
+
+
+
+
+instance Functor (GenPosObject st u) where
+  fmap f mf = GenPosObject $ \ctx pt s -> 
+              let (a,s1,o1,w1) = getGenPosObject mf ctx pt s in (f a,s1,o1,w1)
+
+
+instance Applicative (GenPosObject st u) where
+  pure a    = GenPosObject $ \_   _  s -> (a,s,mempty,mempty)
+  mf <*> ma = GenPosObject $ \ctx pt s -> 
+              let (f,s1,o1,w1) = getGenPosObject mf ctx pt s
+                  (a,s2,o2,w2) = getGenPosObject ma ctx pt s1
+              in (f a, s2, o1 `mappend` o2, w1 `mappend` w2)
+
+
+
+instance Monad (GenPosObject st u) where
+  return a  = GenPosObject $ \_   _  s  -> (a, s, mempty, mempty)
+  mf >>= k  = GenPosObject $ \ctx pt s -> 
+              let (a,s1,o1,w1) = getGenPosObject mf ctx pt s
+                  (b,s2,o2,w2) = getGenPosObject (k a) ctx pt s1
+              in (b, s2, o1 `mappend` o2, w1 `mappend` w2)
+
+
+instance (Monoid a, InterpretUnit u) => Monoid (GenPosObject st u a) where
+  mempty = GenPosObject $ \_ _ s -> (mempty, s, mempty, mempty)
+  ma `mappend` mb = GenPosObject $ \ctx pt s -> 
+                    let (a,s1,o1,w1) = getGenPosObject ma ctx pt s
+                        (b,s2,o2,w2) = getGenPosObject mb ctx pt s1
+                    in (a `mappend` b, s2, o1 `mappend` o2, w1 `mappend` w2)
+
+
+
+-- DrawingCtxM
+
+instance DrawingCtxM (GenPosObject st u) where
+  askDC           = GenPosObject $ \ctx _  s -> (ctx, s, mempty, mempty)
+  asksDC fn       = GenPosObject $ \ctx _  s -> (fn ctx, s, mempty, mempty)
+  localize upd ma = GenPosObject $ \ctx pt s -> 
+                      getGenPosObject ma (upd ctx) pt s
+
+instance UserStateM (GenPosObject st u) where
+  getState        = GenPosObject $ \_ _ s -> (s, s, mempty, mempty)
+  setState s      = GenPosObject $ \_ _ _ -> ((), s, mempty, mempty)
+  updateState upd = GenPosObject $ \_ _ s -> ((), upd s, mempty, mempty)
+
+
+
+-- | Running an PosObject produces a LocImage.
+--
+runGenPosObject :: InterpretUnit u 
+                => RectAddress -> st -> GenPosObject st u a -> LocImage u (a,st)
+runGenPosObject addr st ma = promoteLoc $ \ot -> 
+    askDC >>= \ctx -> 
+    let dot          = normalizeF (dc_font_size ctx) ot
+        (a,s1,o1,ca) = getGenPosObject ma ctx dot st
+        v1           = vtoOrigin addr o1
+    in replaceAns (a,s1) $ primGraphic $ cpmove v1 ca
+
+
+evalGenPosObject :: InterpretUnit u 
+                 => RectAddress -> st -> GenPosObject st u a -> LocImage u a
+evalGenPosObject addr st ma = fmap fst $ runGenPosObject addr st ma
+
+execGenPosObject :: InterpretUnit u 
+                 => RectAddress -> st -> GenPosObject st u a -> LocImage u st
+execGenPosObject addr st ma = fmap snd $ runGenPosObject addr st ma
+
+runPosObject :: InterpretUnit u 
+             => RectAddress -> PosObject u a -> LocImage u a
+runPosObject addr ma = fmap fst $ runGenPosObject addr () ma
+
+
+
+
+-- | Run a PosObject producing a LocImage (BoundingBox u).
+--
+runPosObjectBBox :: InterpretUnit u 
+                    => RectAddress -> PosObject u a -> LocImage u (BoundingBox u)
+runPosObjectBBox addr ma = promoteLoc $ \pt -> 
+    askDC >>= \ctx -> 
+    let sz          = dc_font_size ctx 
+        dpt         = normalizeF sz pt
+        (_,_,o1,w1) = getGenPosObject ma ctx dpt ()
+        v1          = vtoOrigin addr o1
+        bb          = dinterpF sz $ orientationBounds o1 (dpt .+^ v1)
+    in replaceAns bb $ primGraphic $ cpmove v1 w1
+
+
+
+
+--------------------------------------------------------------------------------
+
+
+-- | 'makePosObject' : @ object_pos * loc_image -> PosObject @ 
+--
+-- Create a 'PosObject' from an 'Orientation' describing how it
+-- is orientated within a border rectangle and a 'LocImage' that 
+-- draws it.
+--
+-- This is the /primary/ constructor for PosObjects. Because the
+-- PosObject type is considered as a specialized object it does
+-- not have the range of functions of LocImage or LocThetaImage.
+-- 
+makePosObject :: InterpretUnit u
+              => Query u (Orientation u) -> LocImage u a -> GenPosObject st u a
+makePosObject ma gf = GenPosObject $ \ctx pt s -> 
+    let ort1  = runQuery ctx ma
+        dort1 = normalizeF (dc_font_size ctx) ort1
+        upt   = dinterpF (dc_font_size ctx) pt
+        (a,w) = runLocImage ctx upt gf
+    in (a,s,dort1,w)
+
+
+-- | 'emptyPosObject' : @ PosObject @
+--
+-- Build an empty 'PosGraphicObject'.
+--
+emptyPosObject :: (Monoid a, InterpretUnit u) => GenPosObject st u a
+emptyPosObject = mempty
+
+    
+
+--
+-- decorate  - oblivious to /answer/.
+-- elaborate - derives annotation from the /answer/ and makes a 
+--             cumulative graphic.
+--
+
+
+elaboratePosObject :: (Fractional u, Ord u, InterpretUnit u)
+                   => ZDeco -> RectAddress -> LocGraphic u -> GenPosObject st u a
+                   -> GenPosObject st u a
+elaboratePosObject zdec raddr gf ma = decoratePosObject zdec fn ma
+  where
+    fn ortt = moveStart (vtoRectAddress ortt raddr) gf
+
+
+
+decoratePosObject :: InterpretUnit u 
+                  => ZDeco -> (Orientation u -> LocGraphic u) -> GenPosObject st u a
+                  -> GenPosObject st u a
+decoratePosObject zdec fn ma = GenPosObject $ \ctx pt s -> 
+    let (a,s1,o1,w1) = getGenPosObject ma ctx pt s
+        uortt        = dinterpF (dc_font_size ctx) o1
+        upt          = dinterpF (dc_font_size ctx) pt
+        (_,w2)       = runLocImage ctx upt $ fn uortt
+        wout         = case zdec of
+                         ANTERIOR -> w2 `mappend` w1
+                         SUPERIOR -> w1  `mappend` w2
+    in (a,s1,o1,wout)
+
+
+
+
+-- | Extend the orientation.
+--
+extendPosObject :: InterpretUnit u 
+                => u -> u -> u -> u -> GenPosObject st u a 
+                -> GenPosObject st u a
+extendPosObject x0 x1 y0 y1 ma = GenPosObject $ \ctx pt s ->
+    let (a,s1,o1,w1) = getGenPosObject ma ctx pt s
+        sz           = dc_font_size ctx        
+        ux0          = normalize sz x0
+        ux1          = normalize sz x1
+        uy0          = normalize sz y0
+        uy1          = normalize sz y1
+        o2           = extendOrientation ux0 ux1 uy0 uy1 o1
+    in (a,s1,o2,w1)
+
+
+-- | Note - this is a bad API, it would be better to have padders
+-- and fillers and not expose the orientation directly.
+-- 
+mapOrientation :: InterpretUnit u
+               => (Orientation u -> Orientation u) 
+               -> GenPosObject st u a -> GenPosObject st u a
+mapOrientation fn mf = GenPosObject $ \ctx pt s -> 
+    let (a,s1,o1,w1) = getGenPosObject mf ctx pt s
+        uort      = fn $ dinterpF (dc_font_size ctx) o1
+        o2        = normalizeF (dc_font_size ctx) uort
+    in (a,s1,o2,w1)
+
+
+--------------------------------------------------------------------------------
+
+
+-- | Illustrate a 'PosObject' by super-imposing its 'Orientation'.
+--
+-- This turns the 'PosObject' into a 'LocImage' drawn at the locus
+-- of the PosObject.
+--
+illustratePosObject :: InterpretUnit u 
+                    => PosObject u a -> LocGraphic u
+illustratePosObject mf  = promoteLoc $ \pt ->   
+    askDC >>= \ctx ->
+    let dpt         = normalizeF (dc_font_size ctx) pt 
+        (_,_,o1,w1) = getGenPosObject mf ctx dpt ()
+        uort        = dinterpF (dc_font_size ctx) o1
+    in adecorate (primGraphic w1) (illustrateOrientation uort `at` pt)
+
+
+illustrateOrientation :: InterpretUnit u 
+                      => Orientation u -> LocGraphic u
+illustrateOrientation (Orientation xmin xmaj ymin ymaj) = promoteLoc $ \pt -> 
+    dinterpCtx 3 >>= \radius -> 
+    let upd = localize (fill_colour blue . dotted_line)
+        bl  = pt .-^ V2 xmin ymin
+        dot = localize (fill_colour red) $ dcDisk DRAW_FILL radius `at` pt
+        hln = upd $ locStraightLine (hvec $ xmin+xmaj) `at` pt .-^ hvec xmin
+        vln = upd $ locStraightLine (vvec $ ymin+ymaj) `at` pt .-^ vvec ymin
+        bdr = upd $ dcRectangle DRAW_STROKE (xmin+xmaj) (ymin+ymaj) `at` bl
+    in mconcat [ bdr, hln, vln, dot ]
+
+
+
+--------------------------------------------------------------------------------
+-- Char PosObjects
+
+
+-- Note - because the TextHeight constructors are so long winded,
+-- using them directly makes for a bad API. Instead we have two 
+-- versions for each function.
+
+-- | Note - no margins are added to the containing rectangle.
+-- 
+-- To get a Char with margins, use 'posText' instead:
+--
+-- > posText ['1']
+-- 
+posChar             :: InterpretUnit u 
+                    => Char -> GenPosGraphic st u
+posChar             = makeCharPO CAP_HEIGHT_PLUS_DESCENDER . CharLiteral
+
+posEscChar          :: InterpretUnit u 
+                    => EscapedChar -> GenPosGraphic st u
+posEscChar          = makeCharPO CAP_HEIGHT_PLUS_DESCENDER
+
+posCharUpright      :: InterpretUnit u 
+                    => Char -> GenPosGraphic st u
+posCharUpright      = makeCharPO JUST_CAP_HEIGHT . CharLiteral
+
+posEscCharUpright   :: InterpretUnit u 
+                    => EscapedChar -> GenPosGraphic st u
+posEscCharUpright   = makeCharPO JUST_CAP_HEIGHT
+
+
+-- | Primtive builder that does not add margins.
+--
+posCharPrim         :: InterpretUnit u 
+                    => Either Char EscapedChar -> GenPosGraphic st u
+posCharPrim = makeCharPO CAP_HEIGHT_PLUS_DESCENDER . either CharLiteral id
+
+
+makeCharPO :: InterpretUnit u 
+           => TextHeight -> EscapedChar -> GenPosGraphic st u
+makeCharPO hspec esc = 
+    makePosObject (charOrientation hspec esc) 
+                  (dcEscapedlabel $ wrapEscChar esc)
+
+
+
+
+-- | Build the Orientation of an EscapedChar.
+-- 
+-- The locus of the Orientation is baseline left - margins are 
+-- added.
+--
+charOrientation :: (DrawingCtxM m, InterpretUnit u)
+                => TextHeight -> EscapedChar -> m (Orientation u)
+charOrientation hspec esc = 
+    (\(V2 x _ ) (ymin,ymaj) -> Orientation 0 x ymin ymaj) 
+      <$> escCharVector esc <*> heightSpan hspec
+
+
+--------------------------------------------------------------------------------
+-- Text PosObjects
+
+
+
+posText     :: InterpretUnit u 
+            => String -> GenPosGraphic st u
+posText     = addMargins . makeTextPO CAP_HEIGHT_PLUS_DESCENDER . escapeString
+
+posEscText  :: InterpretUnit u 
+            => EscapedText -> GenPosGraphic st u
+posEscText  = addMargins . makeTextPO CAP_HEIGHT_PLUS_DESCENDER
+
+
+posTextUpright      :: InterpretUnit u 
+                    => String -> GenPosGraphic st u
+posTextUpright      = addMargins . makeTextPO JUST_CAP_HEIGHT . escapeString
+
+posEscTextUpright   :: InterpretUnit u 
+                    => EscapedText -> GenPosGraphic st u
+posEscTextUpright   = addMargins . makeTextPO JUST_CAP_HEIGHT
+
+-- | Primtive builder that does not add margins.
+--
+posTextPrim         :: InterpretUnit u 
+                    => Either String EscapedText -> GenPosGraphic st u
+posTextPrim = makeTextPO CAP_HEIGHT_PLUS_DESCENDER . either escapeString id
+
+
+multilinePosText :: (Fractional u, InterpretUnit u)
+                 => VAlign -> String -> PosGraphic u
+multilinePosText vspec xs = 
+    multilinePosEscText vspec $ map escapeString $ lines xs
+
+multilinePosEscText :: (Fractional u, InterpretUnit u)
+                    => VAlign -> [EscapedText] -> GenPosGraphic st u
+multilinePosEscText vspec xs = addMargins $ GenPosObject $ \ctx pt s -> 
+      let sep    = runQuery ctx textlineSpace
+      in getGenPosObject (body sep) ctx pt s
+  where
+    body sp = alignColumnSep vspec sp $ 
+                map (makeTextPO CAP_HEIGHT_PLUS_DESCENDER) xs
+
+
+
+-- | Note - this does not add margins.
+--
+makeTextPO :: InterpretUnit u 
+           => TextHeight -> EscapedText -> GenPosGraphic st u
+makeTextPO hspec esc = 
+    makePosObject (textOrientationZero hspec esc) (dcEscapedlabel esc)
+
+
+addMargins :: InterpretUnit u => GenPosObject st u a -> GenPosObject st u a
+addMargins ma = 
+   textMargin >>= \(xsep,ysep) -> extendPosObject xsep xsep ysep ysep ma
+
+-- | Build the Orientation of a single line of EscapedText - 
+-- writing direction zero (left-to-right).
+-- 
+-- The locus of the Orientation is baseline left - margins are 
+-- added.
+--
+textOrientationZero :: (DrawingCtxM m, InterpretUnit u )
+                    => TextHeight -> EscapedText -> m (Orientation u)
+textOrientationZero hspec esc = 
+    (\(V2 x _ ) (ymin,ymaj) -> Orientation 0 x ymin ymaj) 
+      <$> escTextVector esc <*> heightSpan hspec
+
+
+--------------------------------------------------------------------------------
+-- Rotated text
+
+-- | Note - for single line text.
+--
+rposText        :: (Real u, Floating u, InterpretUnit u) 
+                => Radian -> String -> GenPosGraphic st u
+rposText ang    = addMargins . makeRotatedPO ang . escapeString
+
+-- | Note - for single line text.
+--
+rposEscText     :: (Real u, Floating u, InterpretUnit u) 
+                => Radian -> EscapedText -> GenPosGraphic st u
+rposEscText ang = addMargins . makeRotatedPO ang
+
+
+rposChar        :: (Real u, Floating u, InterpretUnit u) 
+                => Radian -> Char -> GenPosGraphic st u
+rposChar ang ch = rposEscText ang $ wrapEscChar $ CharLiteral ch
+
+rposEscChar     :: (Real u, Floating u, InterpretUnit u) 
+                => Radian -> EscapedChar -> GenPosGraphic st u
+rposEscChar ang ch = rposEscText ang $ wrapEscChar ch
+
+
+
+
+makeRotatedPO :: (Real u, Floating u, InterpretUnit u) 
+              => Radian -> EscapedText -> GenPosGraphic st u
+makeRotatedPO ang esc = makePosObject qry body
+  where
+    qry  = rotateOrientation ang <$> 
+             textOrientationZero CAP_HEIGHT_PLUS_DESCENDER esc
+
+    body = incline (dcREscapedlabel esc) ang
+
+
+--------------------------------------------------------------------------------
+-- Kerned text
+
+
+posHKernText :: InterpretUnit u
+            => [KernChar u] -> GenPosGraphic st u
+posHKernText xs = makePosObject (hkernOrientationZero xs) (hkernLine xs)
+
+-- | The query should retrieve the width of one char.
+--
+monospaceText :: InterpretUnit u 
+              => Query u u -> String -> GenPosGraphic st u
+monospaceText qry = monospaceEscText qry . escapeString
+
+
+-- | The query should retrieve the width of one char.
+--
+monospaceEscText :: InterpretUnit u 
+                 => Query u u -> EscapedText -> GenPosGraphic st u
+monospaceEscText qry esc = GenPosObject $ \ctx pt s ->
+    let upt    = dinterpF (dc_font_size ctx) pt
+        uw     = runQuery ctx qry
+        ks     = monos uw $ destrEscapedText id esc
+        ortt   = runQuery ctx $ hkernOrientationZero ks
+        dort   = normalizeF (dc_font_size ctx) ortt
+        (_,w1) = runLocImage ctx upt $ hkernLine ks
+    in (UNil, s, dort, w1)
+
+
+
+
+
+monos :: Num u => u -> [EscapedChar] -> [KernChar u]
+monos w1 (c:cs) = (0,c) : map (\ch -> (w1,ch)) cs
+monos _  []     = []
+
+
+
+-- | Note - always CAP_HEIGHT_PLUS_DESCENDER for this one.
+--
+hkernOrientationZero :: (DrawingCtxM m, InterpretUnit u )
+                     => [KernChar u] -> m (Orientation u)
+hkernOrientationZero xs = 
+    (\(V2 x _ ) (ymin,ymaj) -> Orientation 0 x ymin ymaj) 
+      <$> hkernVector xs <*> heightSpan CAP_HEIGHT_PLUS_DESCENDER
+
+ 
+
+--------------------------------------------------------------------------------
+-- Combining PosObject
+
+
+instance (Monoid a, InterpretUnit u) => ZConcat (GenPosObject st u a) where
+  superior = mappend
+  anterior = flip mappend
+
+
+instance Monoid a => Concat (GenPosObject st u a) where
+  hconcat = genMoveAlign spinemoveH spineRight
+  vconcat = genMoveAlign spinemoveV spineBelow
+
+instance (Monoid a, InterpretUnit u) => CatSpace (GenPosObject st u a) where
+  hspace = genMoveSepH spinemoveH spineRight
+  vspace = genMoveSepV spinemoveV spineBelow
+
+
+
+instance Monoid a => Align (GenPosObject st u a) where
+  halign HALIGN_TOP    = genMoveAlign binmoveHTop    halignTopO
+  halign HALIGN_CENTER = genMoveAlign binmoveHCenter halignCenterO
+  halign HALIGN_BASE   = genMoveAlign binmoveHBottom halignBottomO
+
+  valign VALIGN_LEFT   = genMoveAlign binmoveVLeft   valignLeftO
+  valign VALIGN_CENTER = genMoveAlign binmoveVCenter valignCenterO
+  valign VALIGN_RIGHT  = genMoveAlign binmoveVRight  valignRightO
+
+
+
+genMoveAlign :: Monoid a
+             => (Orientation Double -> Orientation Double -> Vec2 Double) 
+             -> (Orientation Double -> Orientation Double -> Orientation Double) 
+             -> GenPosObject st u a -> GenPosObject st u a -> GenPosObject st u a
+genMoveAlign mkV mkO ma mb = GenPosObject $ \ctx pt s -> 
+    let (a,s1,o1,w1) = getGenPosObject ma ctx pt s
+        (b,s2,o2,w2) = getGenPosObject mb ctx pt s1
+        v1           = mkV o1 o2
+        ortt         = mkO o1 o2
+        w2'          = cpmove v1 w2 
+    in (a `mappend` b, s2, ortt, w1 `mappend` w2')
+
+
+--------------------------------------------------------------------------------
+-- Sep
+
+instance (Monoid a, InterpretUnit u) => AlignSpace (GenPosObject st u a) where
+  halignSpace HALIGN_TOP    = genMoveSepH binmoveHTop    halignTopO
+  halignSpace HALIGN_CENTER = genMoveSepH binmoveHCenter halignCenterO
+  halignSpace HALIGN_BASE   = genMoveSepH binmoveHBottom halignBottomO
+
+  valignSpace VALIGN_LEFT   = genMoveSepV binmoveVLeft   valignLeftO
+  valignSpace VALIGN_CENTER = genMoveSepV binmoveVCenter valignCenterO
+  valignSpace VALIGN_RIGHT  = genMoveSepV binmoveVRight  valignRightO
+
+
+genMoveSepH :: (Monoid a, InterpretUnit u) 
+            => (Orientation Double -> Orientation Double -> Vec2 Double) 
+            -> (Orientation Double -> Orientation Double -> Orientation Double) 
+            -> u
+            -> GenPosObject st u a -> GenPosObject st u a 
+            -> GenPosObject st u a
+genMoveSepH mkV mkO sep ma mb  = GenPosObject $ \ctx pt s -> 
+    let (a,s1,o1,w1) = getGenPosObject ma ctx pt s
+        (b,s2,o2,w2) = getGenPosObject mb ctx pt s1
+        dsep         = normalize (dc_font_size ctx) sep
+        v1           = hvec dsep ^+^ mkV o1 o2
+        ortt         = extendORight dsep $ mkO o1 o2
+        w2'          = cpmove v1 w2
+    in (a `mappend` b, s2, ortt, w1 `mappend` w2')
+
+
+
+genMoveSepV :: (Monoid a, InterpretUnit u)
+            => (Orientation Double -> Orientation Double -> Vec2 Double) 
+            -> (Orientation Double -> Orientation Double -> Orientation Double) 
+            -> u
+            -> GenPosObject st u a -> GenPosObject st u a 
+            -> GenPosObject st u a
+genMoveSepV mkV mkO sep ma mb = GenPosObject $ \ctx pt s -> 
+    let (a,s1,o1,w1) = getGenPosObject ma ctx pt s 
+        (b,s2,o2,w2) = getGenPosObject mb ctx pt s1
+        dsep         = normalize (dc_font_size ctx) sep
+        v1           = vvec (-dsep) ^+^ mkV o1 o2
+        ortt         = extendODown dsep $ mkO o1 o2
+        w2'          = cpmove v1 w2
+    in (a `mappend` b, s2, ortt, w1 `mappend` w2')
+
diff --git a/src/Wumpus/Basic/Kernel/Drawing/TraceDrawing.hs b/src/Wumpus/Basic/Kernel/Drawing/TraceDrawing.hs
--- a/src/Wumpus/Basic/Kernel/Drawing/TraceDrawing.hs
+++ b/src/Wumpus/Basic/Kernel/Drawing/TraceDrawing.hs
@@ -146,8 +146,8 @@
 
 
 
-runTraceDrawing :: TraceDrawing u a -> DrawingContext -> (a, HPrim u)
-runTraceDrawing ma ctx = post $ getGenTraceDrawing ma ctx ()
+runTraceDrawing :: DrawingContext -> TraceDrawing u a -> (a, HPrim u)
+runTraceDrawing ctx ma = post $ getGenTraceDrawing ma ctx ()
   where
     post (a,_,w1) = (a,w1)
 
@@ -156,8 +156,8 @@
 -- | Run the drawing returning only the output it produces, drop
 -- any answer from the monadic computation.
 --
-execTraceDrawing :: TraceDrawing u a -> DrawingContext -> HPrim u
-execTraceDrawing ma ctx = snd $ runTraceDrawing ma ctx
+execTraceDrawing :: DrawingContext -> TraceDrawing u a -> HPrim u
+execTraceDrawing ctx ma = snd $ runTraceDrawing ctx ma
 
 -- | Run the drawing ignoring the output it produces, return the 
 -- answer from the monadic computation.
@@ -166,13 +166,13 @@
 -- opposite behaviour (return the drawing, ignore than the 
 -- answer).
 -- 
-evalTraceDrawing :: TraceDrawing u a -> DrawingContext -> a
-evalTraceDrawing ma ctx = fst $ runTraceDrawing ma ctx
+evalTraceDrawing :: DrawingContext -> TraceDrawing u a -> a
+evalTraceDrawing ctx ma = fst $ runTraceDrawing ctx ma
 
 
-runGenTraceDrawing :: GenTraceDrawing st u a -> DrawingContext -> st 
+runGenTraceDrawing :: DrawingContext -> st -> GenTraceDrawing st u a 
                    -> (a,st,HPrim u)
-runGenTraceDrawing = getGenTraceDrawing
+runGenTraceDrawing ctx st ma = getGenTraceDrawing ma ctx st
 
 
 
@@ -242,7 +242,7 @@
 
 fontDelta :: GenTraceDrawing st u a -> GenTraceDrawing st u a
 fontDelta mf = GenTraceDrawing $ \ctx s -> 
-    let (_,font_attrs) = runQuery textAttr ctx
+    let (_,font_attrs) = runQuery ctx textAttr
         (a,s1,w1)      = getGenTraceDrawing mf ctx s
         prim           = fontDeltaContext font_attrs $ primGroup $ hprimToList w1
     in (a, s1, singleH $ prim1 $ prim)
@@ -250,7 +250,7 @@
 -- Note - this function is in the wrong module....
 --
 evalQuery :: DrawingCtxM m => Query u a -> m a
-evalQuery df = askDC >>= \ctx -> return $ runQuery df ctx
+evalQuery df = askDC >>= \ctx -> return $ runQuery ctx df
 
 
 
@@ -263,7 +263,7 @@
 -- 
 draw :: Image u a -> GenTraceDrawing st u ()
 draw gf = askDC >>= \ctx -> 
-          let (_,w) = runImage gf ctx 
+          let (_,w) = runImage ctx gf
           in trace (singleH w) >> return ()
 
 
@@ -277,7 +277,7 @@
 -- 
 drawi :: Image u a -> GenTraceDrawing st u a
 drawi gf = askDC >>= \ctx -> 
-           let (a,w) = runImage gf ctx
+           let (a,w) = runImage ctx gf
            in trace (singleH w) >> return a
             
 
@@ -304,7 +304,7 @@
 drawli :: InterpretUnit u
        => Anchor u -> LocImage u a -> GenTraceDrawing st u a
 drawli pt gf = askDC >>= \ctx -> 
-               let (a,w) = runLocImage gf ctx pt
+               let (a,w) = runLocImage ctx pt gf
                in trace (singleH w) >> return a
 
 
@@ -328,7 +328,7 @@
 -- 
 drawc :: InterpretUnit u
       => Anchor u -> Anchor u -> ConnectorImage u a -> GenTraceDrawing st u ()
-drawc an0 an1 img = drawci an0 an1 img >> return () 
+drawc an0 an1 gf = drawci an0 an1 gf >> return () 
 
 
 -- | Draw a ConnectorImage with the supplied Points taking the 
@@ -339,7 +339,7 @@
 -- 
 drawci :: InterpretUnit u 
        => Anchor u -> Anchor u -> ConnectorImage u a -> GenTraceDrawing st u a
-drawci p0 p1 img = drawi (connect p0 p1 img)
+drawci p0 p1 gf = drawi (connect gf p0 p1)
 
 
 
@@ -369,7 +369,7 @@
       => (Int,Int) -> LocImage u a -> GenTraceDrawing st u a
 nodei coord gf = askDC >>= \ctx -> 
                  position coord >>= \pt ->
-                 let (a,w) = runLocImage gf ctx pt
+                 let (a,w) = runLocImage ctx pt gf
                  in trace (singleH w) >> return a
  
 
@@ -408,4 +408,4 @@
            ) 
         => a1 -> a2 -> ConnectorImage u a -> GenTraceDrawing st u a
 drawrci a b gf = 
-    let (p0,p1) = radialConnectorPoints a b in drawi (connect p0 p1 gf)
+    let (p0,p1) = radialConnectorPoints a b in drawi (connect gf p0 p1)
diff --git a/src/Wumpus/Basic/Kernel/Objects/AdvObject.hs b/src/Wumpus/Basic/Kernel/Objects/AdvObject.hs
--- a/src/Wumpus/Basic/Kernel/Objects/AdvObject.hs
+++ b/src/Wumpus/Basic/Kernel/Objects/AdvObject.hs
@@ -191,10 +191,10 @@
 makeAdvObject :: InterpretUnit u 
               => Query u (Vec2 u) -> LocImage u a -> AdvObject u a
 makeAdvObject ma gf = AdvObject $ \ctx pt -> 
-    let v1    = runQuery ma ctx
+    let v1    = runQuery ctx ma
         dav1  = DAV $ normalizeF (dc_font_size ctx) v1
         upt   = dinterpF (dc_font_size ctx) pt
-        (a,w) = runLocImage gf ctx upt
+        (a,w) = runLocImage ctx upt gf
     in (a,dav1,w)
 
 
diff --git a/src/Wumpus/Basic/Kernel/Objects/Anchors.hs b/src/Wumpus/Basic/Kernel/Objects/Anchors.hs
--- a/src/Wumpus/Basic/Kernel/Objects/Anchors.hs
+++ b/src/Wumpus/Basic/Kernel/Objects/Anchors.hs
@@ -17,14 +17,11 @@
 -- Anchor points on shapes, bounding boxes, etc.
 --
 -- Anchors are addressable positions, an examplary use is taking
--- anchors on node shapes to get the start and end points for 
--- connectors in a network (graph) diagram.
+-- anchors on node shapes to get the in-bound and out-bound points 
+-- for connectors in a network (graph) diagram.
 -- 
--- \*\* WARNING \*\* - The API here needs some thought as to a
--- good balance of the type classes - in a nutshell \"are corners 
--- better than cardinals\". Originally I tried to follow how I 
--- understand the TikZ anchors to work, but this is perhaps not 
--- ideal for dividing into type-classes.
+-- \*\* WARNING \*\* - the API here probably needs some more 
+-- thought.
 --
 --------------------------------------------------------------------------------
 
diff --git a/src/Wumpus/Basic/Kernel/Objects/Basis.hs b/src/Wumpus/Basic/Kernel/Objects/Basis.hs
--- a/src/Wumpus/Basic/Kernel/Objects/Basis.hs
+++ b/src/Wumpus/Basic/Kernel/Objects/Basis.hs
@@ -81,11 +81,12 @@
 -- it with the graphic from the second.
 --
 class Decorate (f :: * -> * -> *) where
-  decorate   :: ZDeco -> f u a -> f u z -> f u a
-  elaborate  :: ZDeco -> f u a -> (a -> f u z) -> f u a
-  obliterate :: f u a -> f u a
-  hyperlink  :: XLink -> f u a -> f u a
-
+  decorate    :: ZDeco -> f u a -> f u z -> f u a
+  elaborate   :: ZDeco -> f u a -> (a -> f u z) -> f u a
+  obliterate  :: f u a -> f u a
+  hyperlink   :: XLink -> f u a -> f u a
+  svgId       :: String -> f u a -> f u a
+  svgAnnotate :: [SvgAttr] -> f u a -> f u a
 
 sdecorate :: Decorate f => f u a -> f u z -> f u a
 sdecorate = decorate SUPERIOR
diff --git a/src/Wumpus/Basic/Kernel/Objects/Bounded.hs b/src/Wumpus/Basic/Kernel/Objects/Bounded.hs
--- a/src/Wumpus/Basic/Kernel/Objects/Bounded.hs
+++ b/src/Wumpus/Basic/Kernel/Objects/Bounded.hs
@@ -38,6 +38,8 @@
 
   , bbrectangle
 
+  , boundedRect
+
   ) where
 
 import Wumpus.Basic.Kernel.Base.BaseDefs
@@ -61,6 +63,8 @@
 type BoundedLocThetaGraphic u   = LocThetaImage u (BoundingBox u)
 
 
+
+
 -- | 'centerOrthoBBox' : @ theta * bbox -> BBox @
 -- 
 -- Rotate a bounding box by @theta@ about its center. Take the 
@@ -87,7 +91,7 @@
 -- the minimum bounding box with both the bottom-left and 
 -- upper-right corners at the implicit start point.
 --
-emptyBoundedLocGraphic :: InterpretUnit u => LocImage u (BoundingBox u)
+emptyBoundedLocGraphic :: InterpretUnit u => BoundedLocGraphic u 
 emptyBoundedLocGraphic = promoteLoc $ \pt -> 
     replaceAns (BBox pt pt) $ primGraphic mempty
 
@@ -102,7 +106,7 @@
 -- bottom-left and upper-right corners at the implicit start point 
 --
 emptyBoundedLocThetaGraphic :: InterpretUnit u 
-                            => LocThetaImage u (BoundingBox u)
+                            => BoundedLocThetaGraphic u
 emptyBoundedLocThetaGraphic = promoteLocTheta $ \pt _ -> 
     replaceAns (BBox pt pt) $ primGraphic mempty
 
@@ -155,7 +159,9 @@
 
 
 
-
+-- | Draw a bounding box as a stroked rectangle with 
+-- dotted lines.
+--
 bbrectangle :: InterpretUnit u => BoundingBox u -> Graphic u
 bbrectangle (BBox p1@(P2 llx lly) p2@(P2 urx ury))
     | llx == urx && lly == ury = mempty `at` p1
@@ -163,7 +169,25 @@
         localize drawing_props $ rect1 `mappend` cross
   where
     drawing_props = cap_round . dotted_line
-    rect1         = dcRectangle STROKE (urx-llx) (ury-lly) `at` p1
+    rect1         = dcRectangle DRAW_STROKE (urx-llx) (ury-lly) `at` p1
     cross         = straightLine p1 p2 
                       `mappend` straightLine (P2 llx ury) (P2 urx lly)
 
+
+
+-- | 'boundedRect' : @ style * width * height -> LocGraphic @
+--
+-- Create a stroked rectangle - the implicit start point is 
+-- /bottom-left/, return the bounding box of the rectangle as the 
+-- answer.
+-- 
+-- The line properties (colour, pen thickness, etc.) are taken 
+-- from the implicit 'DrawingContext'.
+-- 
+boundedRect :: InterpretUnit u 
+            => DrawMode -> u -> u -> BoundedLocGraphic u 
+boundedRect style w h = promoteLoc $ \pt@(P2 x y) -> 
+    let bb = BBox pt (P2 (x + w) (y + h))
+    in replaceAns bb $ applyLoc (dcRectangle style w h) pt
+
+ 
diff --git a/src/Wumpus/Basic/Kernel/Objects/Connector.hs b/src/Wumpus/Basic/Kernel/Objects/Connector.hs
--- a/src/Wumpus/Basic/Kernel/Objects/Connector.hs
+++ b/src/Wumpus/Basic/Kernel/Objects/Connector.hs
@@ -158,44 +158,51 @@
 
 
 instance Decorate ConnectorImage where
-  decorate zo ma mz = ConnectorImage $ \p0 p1 -> 
+  decorate zo ma mz     = ConnectorImage $ \p0 p1 -> 
     decorate zo (getConnectorImage ma p0 p1) (getConnectorImage mz p0 p1)
 
-  elaborate zo ma f = ConnectorImage $ \p0 p1 -> 
+  elaborate zo ma f     = ConnectorImage $ \p0 p1 -> 
     elaborate zo (getConnectorImage ma p0 p1) 
                  (\a -> getConnectorImage (f a) p0 p1)
 
-  obliterate ma = ConnectorImage $ \p0 p1 -> 
+  obliterate ma         = ConnectorImage $ \p0 p1 -> 
     obliterate $ getConnectorImage ma p0 p1
 
-  hyperlink xl ma = ConnectorImage $ \p0 p1 -> 
+  hyperlink xl ma       = ConnectorImage $ \p0 p1 -> 
     hyperlink xl $ getConnectorImage ma p0 p1
 
+  svgId ss ma           = ConnectorImage $ \p0 p1 -> 
+    svgId ss $ getConnectorImage ma p0 p1
 
+  svgAnnotate attrs ma  = ConnectorImage $ \p0 p1 -> 
+    svgAnnotate attrs $ getConnectorImage ma p0 p1
 
+
+
+
 runConnectorImage :: InterpretUnit u 
-                  => ConnectorImage u a -> DrawingContext 
-                  -> Point2 u -> Point2 u
+                  => DrawingContext -> Point2 u -> Point2 u
+                  -> ConnectorImage u a
                   -> PrimResult u a
-runConnectorImage ma ctx p0 p1 = 
+runConnectorImage ctx p0 p1 ma = 
     let dp0 = normalizeF (dc_font_size ctx) p0
         dp1 = normalizeF (dc_font_size ctx) p1 
-    in runImage (getConnectorImage ma dp0 dp1) ctx
+    in runImage ctx $ getConnectorImage ma dp0 dp1
 
 
 runConnectorQuery :: InterpretUnit u 
-                  => ConnectorQuery u a -> DrawingContext 
-                  -> Point2 u -> Point2 u 
+                  => DrawingContext -> Point2 u -> Point2 u 
+                  -> ConnectorQuery u a
                   -> a
-runConnectorQuery ma ctx p0 p1 = 
+runConnectorQuery ctx p0 p1 ma = 
     let dp0 = normalizeF (dc_font_size ctx) p0
         dp1 = normalizeF (dc_font_size ctx) p1 
-    in runQuery (getConnectorQuery ma dp0 dp1) ctx
+    in runQuery ctx $ getConnectorQuery ma dp0 dp1
 
 
 connect :: InterpretUnit u 
-        => Point2 u -> Point2 u -> ConnectorImage u a -> Image u a
-connect p0 p1 ma = normalizeCtxF p0 >>= \dp0 -> 
+        => ConnectorImage u a -> Point2 u -> Point2 u -> Image u a
+connect ma p0 p1 = normalizeCtxF p0 >>= \dp0 -> 
                    normalizeCtxF p1 >>= \dp1 -> 
                    getConnectorImage ma dp0 dp1
 
diff --git a/src/Wumpus/Basic/Kernel/Objects/Displacement.hs b/src/Wumpus/Basic/Kernel/Objects/Displacement.hs
--- a/src/Wumpus/Basic/Kernel/Objects/Displacement.hs
+++ b/src/Wumpus/Basic/Kernel/Objects/Displacement.hs
@@ -32,7 +32,7 @@
   , dispDirectionTheta
   , dispCardinalTheta
 
-  -- * Named vectors
+  -- * Named vector constructors
 
   , go_up
   , go_down
@@ -53,7 +53,25 @@
   , go_down_left
   , go_down_right
 
+  , theta_up
+  , theta_down
+  , theta_left
+  , theta_right
 
+  , theta_north
+  , theta_south
+  , theta_east
+  , theta_west
+  , theta_north_east
+  , theta_north_west
+  , theta_south_east
+  , theta_south_west
+
+  , theta_up_left
+  , theta_up_right
+  , theta_down_left
+  , theta_down_right
+
   ) where
 
 
@@ -234,6 +252,70 @@
 
 go_down_right :: Num u => u -> Vec2 u
 go_down_right d = V2 d (-d)
+
+
+--------------------------------------------------------------------------------
+
+
+
+theta_up :: Floating u => u -> Radian -> Vec2 u
+theta_up d ang = avec (ang + half_pi) d
+
+theta_down :: Floating u => u -> Radian -> Vec2 u
+theta_down d ang = avec (ang - half_pi) d
+
+
+-- | Parallel (reverse)
+--
+theta_left :: Floating u => u -> Radian -> Vec2 u
+theta_left d ang = avec (ang + pi) d
+
+-- | Parallel (forward)
+--
+theta_right :: Floating u => u -> Radian -> Vec2 u
+theta_right d ang = avec ang d
+
+
+
+theta_north :: Floating u => u -> Radian -> Vec2 u
+theta_north = theta_up
+
+theta_south :: Floating u => u -> Radian -> Vec2 u
+theta_south = theta_down
+
+theta_east :: Floating u => u -> Radian -> Vec2 u
+theta_east = theta_right
+
+theta_west :: Floating u => u -> Radian -> Vec2 u
+theta_west = theta_left
+
+
+theta_north_east :: Floating u => u -> Radian -> Vec2 u
+theta_north_east d ang = avec (ang + quarter_pi) d
+
+theta_north_west :: Floating u => u -> Radian -> Vec2 u
+theta_north_west d ang = avec (ang + 0.75*pi) d
+
+theta_south_east :: Floating u => u -> Radian -> Vec2 u
+theta_south_east d ang = avec (ang - quarter_pi) d
+
+theta_south_west :: Floating u => u -> Radian -> Vec2 u
+theta_south_west d ang = avec (ang + 1.25*pi) d
+
+
+
+theta_up_left :: Floating u => u -> Radian -> Vec2 u
+theta_up_left d = orthoVec (-d) d
+
+theta_up_right :: Floating u => u -> Radian -> Vec2 u
+theta_up_right d = orthoVec d d
+
+theta_down_left :: Floating u => u -> Radian -> Vec2 u
+theta_down_left d = orthoVec (-d) (-d)
+
+theta_down_right :: Floating u => u -> Radian -> Vec2 u
+theta_down_right d = orthoVec d (-d)
+
 
 
 --------------------------------------------------------------------------------
diff --git a/src/Wumpus/Basic/Kernel/Objects/DrawingPrimitives.hs b/src/Wumpus/Basic/Kernel/Objects/DrawingPrimitives.hs
--- a/src/Wumpus/Basic/Kernel/Objects/DrawingPrimitives.hs
+++ b/src/Wumpus/Basic/Kernel/Objects/DrawingPrimitives.hs
@@ -10,10 +10,11 @@
 -- Stability   :  highly unstable
 -- Portability :  GHC 
 --
--- Graphic type - this is largely equivalent to Primitive in
--- Wumpus-Core, but drawing attributes are implicitly supplied 
--- by the DrawingContext.
+-- Primitive drawings - text, paths, lines, rectangles, disks, 
+-- ellipses...
 --
+-- All the primitives take their drawing properties (colour, line 
+-- width, etc.) from the DrawingContext.
 --
 --------------------------------------------------------------------------------
 
@@ -28,6 +29,8 @@
   , vertexPP
   , curvePP
 
+
+  , dcPath
   , dcOpenPath
   , dcClosedPath
 
@@ -204,7 +207,14 @@
 -- Drawing paths (stroke, fill, fillStroke)...
 --
 
+dcPath :: PathMode -> PrimPath -> Graphic u
+dcPath OSTROKE      = dcOpenPath
+dcPath CSTROKE      = dcClosedPath DRAW_STROKE
+dcPath CFILL        = dcClosedPath DRAW_FILL
+dcPath CFILL_STROKE = dcClosedPath DRAW_FILL_STROKE
 
+
+
 -- | 'dcOpenPath' : @ path -> Graphic @
 --
 -- This is the analogue to the 'ostroke' function in 
@@ -224,12 +234,12 @@
 -- Drawing properties (colour, line width, etc.) for the 
 -- respective style are taken from the implicit 'DrawingContext'.
 --
-dcClosedPath :: DrawStyle -> PrimPath -> Graphic u
-dcClosedPath FILL        pp = fillPrim (\rgb -> fill rgb pp)
+dcClosedPath :: DrawMode -> PrimPath -> Graphic u
+dcClosedPath DRAW_FILL        pp = fillPrim (\rgb -> fill rgb pp)
 
-dcClosedPath STROKE      pp = strokePrim (\rgb attr -> cstroke rgb attr pp)
+dcClosedPath DRAW_STROKE      pp = strokePrim (\rgb attr -> cstroke rgb attr pp)
 
-dcClosedPath FILL_STROKE pp = 
+dcClosedPath DRAW_FILL_STROKE pp = 
     fillStrokePrim (\frgb attr srgb -> fillStroke frgb attr srgb pp)
 
 
@@ -437,7 +447,7 @@
 -- The respective line or fill properties for the 'DrawStyle' are 
 -- taken from the implicit 'DrawingContext'.
 -- 
-dcCircle :: InterpretUnit u => DrawStyle -> u -> LocGraphic u
+dcCircle :: InterpretUnit u => DrawMode -> u -> LocGraphic u
 dcCircle style r = promoteLoc $ \pt -> 
     liftQuery (qapplyLoc (circlePath r) pt) >>= dcClosedPath style
 
@@ -473,7 +483,7 @@
 -- The line properties (colour, pen thickness, etc.) are taken 
 -- from the implicit 'DrawingContext'.
 -- 
-dcEllipse :: InterpretUnit u => DrawStyle -> u -> u -> LocGraphic u
+dcEllipse :: InterpretUnit u => DrawMode -> u -> u -> LocGraphic u
 dcEllipse style rx ry = promoteLoc $ \pt ->
    liftQuery (qapplyLoc (ellipsePath rx ry) pt) >>= dcClosedPath style 
 
@@ -488,7 +498,7 @@
 -- are taken from the implicit 'DrawingContext'.
 -- 
 dcREllipse :: InterpretUnit u
-           => DrawStyle -> u -> u -> LocThetaGraphic u
+           => DrawMode -> u -> u -> LocThetaGraphic u
 dcREllipse style rx ry = promoteLocTheta $ \pt ang -> 
     liftQuery (qapplyLocTheta (rellipsePath rx ry) pt ang) >>= 
     dcClosedPath style
@@ -507,7 +517,7 @@
 
 
 
--- | 'strokedRectangle' : @ width * height -> LocGraphic @
+-- | 'strokedRectangle' : @ style * width * height -> LocGraphic @
 --
 -- Create a stroked rectangle 'LocGraphic' - the implicit point is 
 -- bottom-left. 
@@ -515,7 +525,7 @@
 -- The line properties (colour, pen thickness, etc.) are taken 
 -- from the implicit 'DrawingContext'.
 -- 
-dcRectangle :: InterpretUnit u => DrawStyle -> u -> u -> LocGraphic u
+dcRectangle :: InterpretUnit u => DrawMode -> u -> u -> LocGraphic u
 dcRectangle style w h = promoteLoc $ \pt -> 
     liftQuery (qapplyLoc (rectanglePath w h) pt) >>= dcClosedPath style
 
@@ -539,16 +549,16 @@
 -- The fill or stroke properties for the respective DrawStyle are
 -- taken from the implicit 'DrawingContext'.
 -- 
-dcDisk :: InterpretUnit u => DrawStyle -> u -> LocGraphic u
-dcDisk FILL radius = 
+dcDisk :: InterpretUnit u => DrawMode -> u -> LocGraphic u
+dcDisk DRAW_FILL radius = 
     normalizeCtx radius >>= \r -> 
     fillLoc (\rgb pt -> fillEllipse rgb r r pt)
 
-dcDisk STROKE radius = 
+dcDisk DRAW_STROKE radius = 
     normalizeCtx radius >>= \r -> 
     strokeLoc (\rgb attr pt -> strokeEllipse rgb attr r r pt)
 
-dcDisk FILL_STROKE radius = 
+dcDisk DRAW_FILL_STROKE radius = 
     normalizeCtx radius >>= \r -> 
     fillStrokeLoc (\frgb attr srgb pt -> fillStrokeEllipse frgb attr srgb r r pt)
 
@@ -572,14 +582,16 @@
 -- The line properties (colour, pen thickness, etc.) are taken 
 -- from the implicit 'DrawingContext'.
 -- 
-dcEllipseDisk :: InterpretUnit u => DrawStyle -> u -> u -> LocGraphic u
+dcEllipseDisk :: InterpretUnit u 
+              => DrawMode -> u -> u -> LocGraphic u
 dcEllipseDisk style rx ry = 
     normalizeCtx rx >>= \drx -> 
     normalizeCtx ry >>= \dry -> 
     case style of
-      FILL -> fillLoc (\rgb pt -> fillEllipse rgb drx dry pt)
-      STROKE -> strokeLoc (\rgb attr pt -> strokeEllipse rgb attr drx dry pt)
-      FILL_STROKE -> fillStrokeLoc $ 
+      DRAW_FILL -> fillLoc (\rgb pt -> fillEllipse rgb drx dry pt)
+      DRAW_STROKE -> strokeLoc 
+                       (\rgb attr pt -> strokeEllipse rgb attr drx dry pt)
+      DRAW_FILL_STROKE -> fillStrokeLoc $ 
                        (\frgb attr srgb pt -> 
                            fillStrokeEllipse frgb attr srgb drx dry pt)
 
diff --git a/src/Wumpus/Basic/Kernel/Objects/Image.hs b/src/Wumpus/Basic/Kernel/Objects/Image.hs
--- a/src/Wumpus/Basic/Kernel/Objects/Image.hs
+++ b/src/Wumpus/Basic/Kernel/Objects/Image.hs
@@ -142,11 +142,11 @@
   localize upd ma = Query $ \ctx -> getQuery ma (upd ctx)
 
 
-runImage :: Image u a -> DrawingContext -> PrimResult u a
-runImage = getImage
+runImage :: DrawingContext -> Image u a -> PrimResult u a
+runImage ctx ma = getImage ma ctx
 
-runQuery :: Query u a -> DrawingContext -> a
-runQuery = getQuery
+runQuery :: DrawingContext -> Query u a -> a
+runQuery ctx ma = getQuery ma ctx
 
 
 
@@ -159,7 +159,7 @@
 -- | Turn a 'Query' into an 'Image' without graphic content.
 --
 liftQuery :: Query u a -> Image u a
-liftQuery ma = askDC >>= \ctx -> let a = runQuery ma ctx in return a
+liftQuery ma = askDC >>= \ctx -> let a = runQuery ctx ma in return a
 
 
 
@@ -173,7 +173,7 @@
 -- 
 clipImage :: PrimPath -> Image u a -> Image u a
 clipImage pp ma = Image $ \ctx -> 
-     let (a,w) = getImage ma ctx in (a, cpmap (clip pp) w)
+     let (a,w) = getImage ma ctx in (a, cpmap (clipPrim pp) w)
 
 
 
@@ -203,12 +203,12 @@
 
 
 instance Decorate Image where
-  decorate    = decorateImage
-  elaborate   = elaborateImage  
-  obliterate  = obliterateImage
-  hyperlink   = hyperlinkImage
-  
-
+  decorate      = decorateImage
+  elaborate     = elaborateImage  
+  obliterate    = obliterateImage
+  hyperlink     = hyperlinkImage
+  svgId         = svgIdImage  
+  svgAnnotate   = svgAnnotateImage 
 
 -- | Decorate Image.
 --
@@ -239,6 +239,16 @@
 hyperlinkImage xl ma = Image $ \ctx -> step (getImage ma ctx)
   where
     step (a,w) = (a, cpmap (xlinkPrim xl) w)
+
+svgIdImage :: String -> Image u a -> Image u a
+svgIdImage ss ma = Image $ \ctx -> step (getImage ma ctx)
+  where
+    step (a,w) = (a, cpmap (xidPrim ss) w)
+
+svgAnnotateImage :: [SvgAttr] -> Image u a -> Image u a
+svgAnnotateImage attrs ma = Image $ \ctx -> step (getImage ma ctx)
+  where
+    step (a,w) = (a, cpmap (annotateGroup attrs) w)
 
 
 --------------------------------------------------------------------------------
diff --git a/src/Wumpus/Basic/Kernel/Objects/LocImage.hs b/src/Wumpus/Basic/Kernel/Objects/LocImage.hs
--- a/src/Wumpus/Basic/Kernel/Objects/LocImage.hs
+++ b/src/Wumpus/Basic/Kernel/Objects/LocImage.hs
@@ -35,6 +35,7 @@
 
    , promoteLoc
    , applyLoc
+   , supplyLoc
    , qpromoteLoc
    , qapplyLoc
 
@@ -170,18 +171,22 @@
 
   hyperlink xl ma = LocImage $ \pt -> hyperlink xl $ getLocImage ma pt 
 
+  svgId ss ma = LocImage $ \pt -> svgId ss $ getLocImage ma pt 
 
+  svgAnnotate attrs ma = LocImage $ \pt -> svgAnnotate attrs $ getLocImage ma pt
+
+
 runLocImage :: InterpretUnit u 
-            => LocImage u a -> DrawingContext -> Point2 u -> PrimResult u a
-runLocImage ma ctx pt = 
+            => DrawingContext -> Point2 u -> LocImage u a -> PrimResult u a
+runLocImage ctx pt ma = 
     let dpt = normalizeF (dc_font_size ctx) pt 
-    in runImage (getLocImage ma dpt) ctx
+    in runImage ctx $ getLocImage ma dpt
 
 runLocQuery :: InterpretUnit u 
-            => LocQuery u a -> DrawingContext -> Point2 u -> a
-runLocQuery ma ctx pt = 
+            => DrawingContext -> Point2 u -> LocQuery u a -> a
+runLocQuery ctx pt ma = 
     let dpt = normalizeF (dc_font_size ctx) pt 
-    in runQuery (getLocQuery ma dpt) ctx
+    in runQuery ctx $ getLocQuery ma dpt
 
 
 stripLocImage :: LocImage u a -> LocQuery u a
@@ -201,6 +206,12 @@
 applyLoc ma pt = normalizeCtxF pt >>= getLocImage ma
 
 
+-- | Flipped version of 'applyLoc'. 
+-- 
+supplyLoc :: InterpretUnit u => Point2 u -> LocImage u a -> Image u a
+supplyLoc = flip at
+
+
 qpromoteLoc :: InterpretUnit u 
             => (Point2 u -> Query u a) -> LocQuery u a
 qpromoteLoc k = LocQuery $ \pt -> dinterpCtxF pt >>= k
@@ -285,12 +296,14 @@
 
 infixr 1 `at`
 
-
 -- | Downcast a 'LocImage' function by applying it to the supplied 
 -- point, making an 'Image'. 
 -- 
+-- > infixr 1 `at`
+-- 
 at :: InterpretUnit u => LocImage u a -> Point2 u -> Image u a
-at mf pt = normalizeCtxF pt >>= \dpt -> getLocImage mf dpt
+at = applyLoc
+
 
 
 --------------------------------------------------------------------------------
diff --git a/src/Wumpus/Basic/Kernel/Objects/LocThetaImage.hs b/src/Wumpus/Basic/Kernel/Objects/LocThetaImage.hs
--- a/src/Wumpus/Basic/Kernel/Objects/LocThetaImage.hs
+++ b/src/Wumpus/Basic/Kernel/Objects/LocThetaImage.hs
@@ -35,6 +35,7 @@
    
    , promoteLocTheta
    , applyLocTheta
+   , supplyLocTheta
    , qpromoteLocTheta
    , qapplyLocTheta
 
@@ -42,6 +43,7 @@
 
    , incline
    , atIncline
+   , supplyIncline
    
    )
 
@@ -155,38 +157,44 @@
 --
 
 instance Decorate LocThetaImage where
-  decorate zo ma mz = LocThetaImage $ \pt ang -> 
+  decorate zo ma mz     = LocThetaImage $ \pt ang -> 
     decorate zo (getLocThetaImage ma pt ang) (getLocThetaImage mz pt ang)
 
-  elaborate zo ma f = LocThetaImage $ \pt ang -> 
+  elaborate zo ma f     = LocThetaImage $ \pt ang -> 
     elaborate zo (getLocThetaImage ma pt ang) 
                  (\a -> getLocThetaImage (f a) pt ang)
 
-  obliterate ma = LocThetaImage $ \pt ang -> 
+  obliterate ma         = LocThetaImage $ \pt ang -> 
     obliterate $ getLocThetaImage ma pt ang
 
-  hyperlink xl ma = LocThetaImage $ \pt ang -> 
+  hyperlink xl ma       = LocThetaImage $ \pt ang -> 
     hyperlink xl $ getLocThetaImage ma pt ang
+
+  svgId ss ma           = LocThetaImage $ \pt ang -> 
+    svgId ss $ getLocThetaImage ma pt ang
+
+  svgAnnotate attrs ma  = LocThetaImage $ \pt ang -> 
+    svgAnnotate attrs $ getLocThetaImage ma pt ang
            
 
 
 
 runLocThetaImage :: InterpretUnit u 
-                 => LocThetaImage u a -> DrawingContext 
-                 -> Point2 u -> Radian
+                 => DrawingContext -> Point2 u -> Radian
+                 -> LocThetaImage u a 
                  -> PrimResult u a
-runLocThetaImage ma ctx pt incl = 
+runLocThetaImage ctx pt incl ma = 
     let dpt = normalizeF (dc_font_size ctx) pt 
-    in runImage (getLocThetaImage ma dpt incl) ctx
+    in runImage ctx $ getLocThetaImage ma dpt incl
 
 
 runLocThetaQuery :: InterpretUnit u 
-                 => LocThetaQuery u a -> DrawingContext 
-                 -> Point2 u -> Radian  
+                 => DrawingContext -> Point2 u -> Radian  
+                 -> LocThetaQuery u a 
                  -> a
-runLocThetaQuery ma ctx pt incl = 
+runLocThetaQuery ctx pt incl ma = 
     let dpt = normalizeF (dc_font_size ctx) pt 
-    in runQuery (getLocThetaQuery ma dpt incl) ctx
+    in runQuery ctx $ getLocThetaQuery ma dpt incl
 
 
 
@@ -209,10 +217,14 @@
 
 applyLocTheta :: InterpretUnit u 
               => LocThetaImage u a -> Point2 u -> Radian -> Image u a
-applyLocTheta mq pt ang = 
-    normalizeCtxF pt >>= \dpt -> getLocThetaImage mq dpt ang
+applyLocTheta ma pt ang = 
+    normalizeCtxF pt >>= \dpt -> getLocThetaImage ma dpt ang
 
+supplyLocTheta :: InterpretUnit u 
+               => Point2 u -> Radian -> LocThetaImage u a -> Image u a
+supplyLocTheta pt ang ma = applyLocTheta ma pt ang
 
+
 qpromoteLocTheta :: InterpretUnit u 
                  => (Point2 u -> Radian -> Query u a) -> LocThetaQuery u a
 qpromoteLocTheta k = LocThetaQuery $ \pt ang ->
@@ -273,5 +285,10 @@
 
 atIncline :: InterpretUnit u 
           => LocThetaImage u a -> Point2 u -> Radian -> Image u a
-atIncline ma pt incl = 
-    normalizeCtxF pt >>= \dpt -> getLocThetaImage ma dpt incl
+atIncline = applyLocTheta
+
+
+-- | Flipped version of 'incline'
+--
+supplyIncline :: InterpretUnit u => Radian -> LocThetaImage u a -> LocImage u a
+supplyIncline = flip incline
diff --git a/src/Wumpus/Basic/Kernel/Objects/PosObject.hs b/src/Wumpus/Basic/Kernel/Objects/PosObject.hs
deleted file mode 100644
--- a/src/Wumpus/Basic/Kernel/Objects/PosObject.hs
+++ /dev/null
@@ -1,599 +0,0 @@
-{-# LANGUAGE TypeFamilies               #-}
-{-# OPTIONS -Wall #-}
-
---------------------------------------------------------------------------------
--- |
--- Module      :  Wumpus.Basic.Kernel.Objects.PosObject
--- Copyright   :  (c) Stephen Tetley 2011
--- License     :  BSD3
---
--- Maintainer  :  stephen.tetley@gmail.com
--- Stability   :  highly unstable
--- Portability :  GHC 
---
--- Extended Graphic object - a rectangular /positionable/ Image.
--- 
--- This graphic object has a more flexible API for positioning 
--- than other graphic objects. Rather than a LocGraphic which 
--- supports a single method of positioning at some start-point,
--- a @PosGraphic@ can be drawn at its center or locations on its 
--- outer rectangle.
---
---------------------------------------------------------------------------------
-
-module Wumpus.Basic.Kernel.Objects.PosObject
-  (
-
-  -- * Positionable image
-
-    PosObject
-  , DPosObject
-
-  , PosGraphic
-  , DPosGraphic
-
-  -- * Operations
-  , runPosObject
-  , runPosObjectBBox
-
-  , makePosObject
-  , emptyPosObject
-
-  , elaboratePosObject
-  , decoratePosObject
-
-  , extendPosObject
-  , mapOrientation
-
-  , illustratePosObject
-
-  , posChar
-  , posEscChar 
-  , posCharUpright
-  , posEscCharUpright
-  
-  , posCharPrim
-
-  , posText
-  , posEscText 
-  , posTextUpright
-  , posEscTextUpright
-
-  , posTextPrim
-
-  , multilinePosText
-  , multilinePosEscText
-
-  , rposText
-  , rposEscText
-
-  , posHKernText
-
-  , monospaceText
-  , monospaceEscText
-
-  ) where
-
-
-import Wumpus.Basic.Kernel.Base.BaseDefs
-import Wumpus.Basic.Kernel.Base.DrawingContext
-import Wumpus.Basic.Kernel.Base.QueryDC
-import Wumpus.Basic.Kernel.Base.UpdateDC
-import Wumpus.Basic.Kernel.Base.WrappedPrimitive
-import Wumpus.Basic.Kernel.Objects.Basis
-import Wumpus.Basic.Kernel.Objects.Concat
-import Wumpus.Basic.Kernel.Objects.DrawingPrimitives
-import Wumpus.Basic.Kernel.Objects.Image
-import Wumpus.Basic.Kernel.Objects.LocImage
-import Wumpus.Basic.Kernel.Objects.LocThetaImage
-import Wumpus.Basic.Kernel.Objects.Orientation
-
-import Wumpus.Core                              -- package: wumpus-core
-import Wumpus.Core.Colour ( red, blue )
-
-import Data.AffineSpace                         -- package: vector-space
-import Data.VectorSpace
-
-import Control.Applicative
-import Data.Monoid
-
-type DOrt = Orientation Double
-
--- | A positionable \"Object\".
---
-newtype PosObject u a = PosObject 
-          { getPosObject :: DrawingContext -> DPoint2 -> (a, DOrt, CatPrim) }
-
-type instance DUnit (PosObject u a) = u
-    
--- | Version of PosObject specialized to Double for the unit type.
---
-type DPosObject a = PosObject Double a
-
-
--- | Version of PosObject with answer specialized to UNil.
---
-type PosGraphic u = PosObject u (UNil u)
-
--- | Version of PosGraphic specialized to Double for the unit type.
---
-type DPosGraphic = PosGraphic Double
-
-
-
-
-instance Functor (PosObject u) where
-  fmap f mf = PosObject $ \ctx pt -> 
-              let (a,o1,w1) = getPosObject mf ctx pt in (f a,o1,w1)
-
-
-instance Applicative (PosObject u) where
-  pure a    = PosObject $ \_   _  -> (a,mempty,mempty)
-  mf <*> ma = PosObject $ \ctx pt -> 
-              let (f,o1,w1) = getPosObject mf ctx pt
-                  (a,o2,w2) = getPosObject ma ctx pt
-              in (f a, o1 `mappend` o2, w1 `mappend` w2)
-
-
-
-instance Monad (PosObject u) where
-  return a  = PosObject $ \_   _  -> (a,mempty,mempty)
-  mf >>= k  = PosObject $ \ctx pt -> 
-              let (a,o1,w1) = getPosObject mf ctx pt
-                  (b,o2,w2) = getPosObject (k a) ctx pt
-              in (b, o1 `mappend` o2, w1 `mappend` w2)
-
-
-
-instance DrawingCtxM (PosObject u) where
-  askDC           = PosObject $ \ctx _ -> (ctx, mempty, mempty)
-  asksDC fn       = PosObject $ \ctx _ -> (fn ctx, mempty, mempty)
-  localize upd ma = PosObject $ \ctx pt -> getPosObject ma (upd ctx) pt
-
-
-
-
-instance (Monoid a, InterpretUnit u) => Monoid (PosObject u a) where
-  mempty = PosObject $ \_ _ -> (mempty, mempty, mempty)
-  ma `mappend` mb = PosObject $ \ctx pt -> 
-                    let (a,o1,w1) = getPosObject ma ctx pt
-                        (b,o2,w2) = getPosObject mb ctx pt
-                    in (a `mappend` b, o1 `mappend` o2, w1 `mappend` w2)
-
-
-
--- | Running an PosObject produces a LocImage.
---
-runPosObject :: InterpretUnit u 
-             => PosObject u a -> RectAddress -> LocImage u a
-runPosObject ma addr = promoteLoc $ \ot -> 
-    askDC >>= \ctx -> 
-    let dot       = normalizeF (dc_font_size ctx) ot
-        (a,o1,ca) = getPosObject ma ctx dot
-        v1        = vtoOrigin addr o1
-    in replaceAns a $ primGraphic $ cpmove v1 ca
-
-
-
--- | Run a PosObject producing a LocImage (BoundingBox u).
---
-runPosObjectBBox :: InterpretUnit u 
-                 => PosObject u a -> RectAddress -> LocImage u (BoundingBox u)
-runPosObjectBBox ma addr = promoteLoc $ \pt -> 
-    askDC >>= \ctx -> 
-    let sz        = dc_font_size ctx 
-        dpt       = normalizeF sz pt
-        (_,o1,w1) = getPosObject ma ctx dpt
-        v1        = vtoOrigin addr o1
-        bb        = dinterpF sz $ orientationBounds o1 (dpt .+^ v1)
-    in replaceAns bb $ primGraphic $ cpmove v1 w1
-
-
-
-
---------------------------------------------------------------------------------
-
-
--- | 'makePosObject' : @ object_pos * loc_image -> PosObject @ 
---
--- Create a 'PosObject' from an 'Orientation' describing how it
--- is orientated within a border rectangle and a 'LocImage' that 
--- draws it.
---
--- This is the /primary/ constructor for PosObjects. Because the
--- PosObject type is considered as a specialized object it does
--- not have the range of functions of LocImage or LocThetaImage.
--- 
-makePosObject :: InterpretUnit u
-              => Query u (Orientation u) -> LocImage u a -> PosObject u a
-makePosObject ma gf = PosObject $ \ctx pt -> 
-    let ort1  = runQuery ma ctx
-        dort1 = normalizeF (dc_font_size ctx) ort1
-        upt   = dinterpF (dc_font_size ctx) pt
-        (a,w) = runLocImage gf ctx upt
-    in (a,dort1,w)
-
-
--- | 'emptyPosObject' : @ PosObject @
---
--- Build an empty 'PosGraphicObject'.
---
-emptyPosObject :: (Monoid a, InterpretUnit u) => PosObject u a
-emptyPosObject = PosObject $ \_ _ -> (mempty, mempty, mempty) 
-
-    
-
---
--- decorate  - oblivious to /answer/.
--- elaborate - derives annotation from the /answer/ and makes a 
---             cumulative graphic.
---
-
-
-elaboratePosObject :: (Fractional u, Ord u, InterpretUnit u)
-                   => ZDeco -> RectAddress -> LocGraphic u -> PosObject u a
-                   -> PosObject u a
-elaboratePosObject zdec raddr gf ma = decoratePosObject zdec fn ma
-  where
-    fn ortt = moveStart (vtoRectAddress ortt raddr) gf
-
-
-
-decoratePosObject :: InterpretUnit u 
-                  => ZDeco -> (Orientation u -> LocGraphic u) -> PosObject u a
-                  -> PosObject u a
-decoratePosObject zdec fn ma = PosObject $ \ctx pt -> 
-    let (a,o1,w1) = getPosObject ma ctx pt
-        uortt     = dinterpF (dc_font_size ctx) o1
-        upt       = dinterpF (dc_font_size ctx) pt
-        (_,w2)    = runLocImage (fn uortt) ctx upt
-        wout      = case zdec of
-                         ANTERIOR -> w2 `mappend` w1
-                         SUPERIOR -> w1  `mappend` w2
-    in (a,o1,wout)
-
-
-
-
--- | Extend the orientation.
---
-extendPosObject :: InterpretUnit u 
-                => u -> u -> u -> u -> PosObject u a -> PosObject u a
-extendPosObject x0 x1 y0 y1 ma = PosObject $ \ctx pt ->
-    let (a,o1,w1) = getPosObject ma ctx pt
-        sz        = dc_font_size ctx        
-        ux0       = normalize sz x0
-        ux1       = normalize sz x1
-        uy0       = normalize sz y0
-        uy1       = normalize sz y1
-        o2        = extendOrientation ux0 ux1 uy0 uy1 o1
-    in (a,o2,w1)
-
-
--- | Note - this is a bad API, it would be better to have padders
--- and fillers and not expose the orientation directly.
--- 
-mapOrientation :: InterpretUnit u
-               => (Orientation u -> Orientation u) 
-               -> PosObject u a -> PosObject u a
-mapOrientation fn mf = PosObject $ \ctx pt -> 
-    let (a,o1,w1) = getPosObject mf ctx pt
-        uort      = fn $ dinterpF (dc_font_size ctx) o1
-        o2        = normalizeF (dc_font_size ctx) uort
-    in (a,o2,w1)
-
-
---------------------------------------------------------------------------------
-
-
--- | Illustrate a 'PosObject' by super-imposing its 'Orientation'.
---
--- This turns the 'PosObject' into a 'LocImage' drawn at the locus
--- of the PosObject.
---
-illustratePosObject :: InterpretUnit u 
-                   => PosObject u a -> LocGraphic u
-illustratePosObject mf  = promoteLoc $ \pt ->   
-    askDC >>= \ctx ->
-    let dpt       = normalizeF (dc_font_size ctx) pt 
-        (_,o1,w1) = getPosObject mf ctx dpt
-        uort      = dinterpF (dc_font_size ctx) o1
-    in adecorate (primGraphic w1) (illustrateOrientation uort `at` pt)
-
-
-illustrateOrientation :: InterpretUnit u 
-                      => Orientation u -> LocGraphic u
-illustrateOrientation (Orientation xmin xmaj ymin ymaj) = promoteLoc $ \pt -> 
-    dinterpCtx 3 >>= \radius -> 
-    let upd = localize (fill_colour blue . dotted_line)
-        bl  = pt .-^ V2 xmin ymin
-        dot = localize (fill_colour red) $ dcDisk FILL radius `at` pt
-        hln = upd $ locStraightLine (hvec $ xmin+xmaj) `at` pt .-^ hvec xmin
-        vln = upd $ locStraightLine (vvec $ ymin+ymaj) `at` pt .-^ vvec ymin
-        bdr = upd $ dcRectangle STROKE (xmin+xmaj) (ymin+ymaj) `at` bl
-    in mconcat [ bdr, hln, vln, dot ]
-
-
-
---------------------------------------------------------------------------------
--- Char PosObjects
-
-
--- Note - because the TextHeight constructors are so long winded,
--- using them directly makes for a bad API. Instead we have two 
--- versions for each function.
-
--- | Note - no margins are added to the containing rectangle.
--- 
--- To get a Char with margins, use 'posText' instead:
---
--- > posText ['1']
--- 
-posChar             :: InterpretUnit u => Char -> PosGraphic u
-posChar             = makeCharPO CAP_HEIGHT_PLUS_DESCENDER . CharLiteral
-
-posEscChar          :: InterpretUnit u => EscapedChar -> PosGraphic u
-posEscChar          = makeCharPO CAP_HEIGHT_PLUS_DESCENDER
-
-posCharUpright      :: InterpretUnit u => Char -> PosGraphic u
-posCharUpright      = makeCharPO JUST_CAP_HEIGHT . CharLiteral
-
-posEscCharUpright   :: InterpretUnit u => EscapedChar -> PosGraphic u
-posEscCharUpright   = makeCharPO JUST_CAP_HEIGHT
-
-
--- | Primtive builder that does not add margins.
---
-posCharPrim         :: InterpretUnit u 
-                    => Either Char EscapedChar -> PosGraphic u
-posCharPrim = makeCharPO CAP_HEIGHT_PLUS_DESCENDER . either CharLiteral id
-
-
-makeCharPO :: InterpretUnit u 
-           => TextHeight -> EscapedChar -> PosGraphic u
-makeCharPO hspec esc = 
-    makePosObject (charOrientation hspec esc) 
-                  (dcEscapedlabel $ wrapEscChar esc)
-
-
-
-
--- | Build the Orientation of an EscapedChar.
--- 
--- The locus of the Orientation is baseline left - margins are 
--- added.
---
-charOrientation :: (DrawingCtxM m, InterpretUnit u)
-                => TextHeight -> EscapedChar -> m (Orientation u)
-charOrientation hspec esc = 
-    (\(V2 x _ ) (ymin,ymaj) -> Orientation 0 x ymin ymaj) 
-      <$> escCharVector esc <*> heightSpan hspec
-
-
---------------------------------------------------------------------------------
--- Text PosObjects
-
-
-
-posText     :: InterpretUnit u => String -> PosGraphic u
-posText     = addMargins . makeTextPO CAP_HEIGHT_PLUS_DESCENDER . escapeString
-
-posEscText  :: InterpretUnit u => EscapedText -> PosGraphic u
-posEscText  = addMargins . makeTextPO CAP_HEIGHT_PLUS_DESCENDER
-
-
-posTextUpright      :: InterpretUnit u => String -> PosGraphic u
-posTextUpright      = addMargins . makeTextPO JUST_CAP_HEIGHT . escapeString
-
-posEscTextUpright   :: InterpretUnit u => EscapedText -> PosGraphic u
-posEscTextUpright   = addMargins . makeTextPO JUST_CAP_HEIGHT
-
--- | Primtive builder that does not add margins.
---
-posTextPrim         :: InterpretUnit u 
-                    => Either String EscapedText -> PosGraphic u
-posTextPrim = makeTextPO CAP_HEIGHT_PLUS_DESCENDER . either escapeString id
-
-
-multilinePosText :: (Fractional u, InterpretUnit u)
-                 => VAlign -> String -> PosGraphic u
-multilinePosText vspec xs = 
-    multilinePosEscText vspec $ map escapeString $ lines xs
-
-multilinePosEscText :: (Fractional u, InterpretUnit u)
-                    => VAlign -> [EscapedText] -> PosGraphic u
-multilinePosEscText vspec xs = 
-    addMargins $ PosObject $ \ctx pt -> 
-      let sep    = runQuery textlineSpace ctx
-      in getPosObject (body sep) ctx pt
-  where
-    body sp = alignColumnSep vspec sp $ 
-                map (makeTextPO CAP_HEIGHT_PLUS_DESCENDER) xs
-
-
-
--- | Note - this does not add margins.
---
-makeTextPO :: InterpretUnit u 
-           => TextHeight -> EscapedText -> PosGraphic u
-makeTextPO hspec esc = 
-    makePosObject (textOrientationZero hspec esc) (dcEscapedlabel esc)
-
-
-addMargins :: InterpretUnit u => PosObject u a -> PosObject u a
-addMargins ma = 
-   textMargin >>= \(xsep,ysep) -> extendPosObject xsep xsep ysep ysep ma
-
--- | Build the Orientation of a single line of EscapedText - 
--- writing direction zero (left-to-right).
--- 
--- The locus of the Orientation is baseline left - margins are 
--- added.
---
-textOrientationZero :: (DrawingCtxM m, InterpretUnit u )
-                    => TextHeight -> EscapedText -> m (Orientation u)
-textOrientationZero hspec esc = 
-    (\(V2 x _ ) (ymin,ymaj) -> Orientation 0 x ymin ymaj) 
-      <$> escTextVector esc <*> heightSpan hspec
-
-
---------------------------------------------------------------------------------
--- Rotated text
-
--- | Note - for single line text.
---
-rposText        :: (Real u, Floating u, InterpretUnit u) 
-                => Radian -> String -> PosGraphic u
-rposText ang    = addMargins . makeRotatedPO ang . escapeString
-
--- | Note - for single line text.
---
-rposEscText     :: (Real u, Floating u, InterpretUnit u) 
-                => Radian -> EscapedText -> PosGraphic u
-rposEscText ang = addMargins . makeRotatedPO ang
-
-
-makeRotatedPO :: (Real u, Floating u, InterpretUnit u) 
-              => Radian -> EscapedText -> PosGraphic u
-makeRotatedPO ang esc = makePosObject qry body
-  where
-    qry  = rotateOrientation ang <$> 
-             textOrientationZero CAP_HEIGHT_PLUS_DESCENDER esc
-
-    body = incline (dcREscapedlabel esc) ang
-
-
---------------------------------------------------------------------------------
--- Kerned text
-
-
-posHKernText :: InterpretUnit u
-            => [KernChar u] -> PosGraphic u
-posHKernText xs = makePosObject (hkernOrientationZero xs) (hkernLine xs)
-
--- | The query should retrieve the width of one char.
---
-monospaceText :: InterpretUnit u 
-              => Query u u -> String -> PosGraphic u
-monospaceText qry = monospaceEscText qry . escapeString
-
-
--- | The query should retrieve the width of one char.
---
-monospaceEscText :: InterpretUnit u 
-                 => Query u u -> EscapedText -> PosGraphic u
-monospaceEscText qry esc = PosObject $ \ctx pt ->
-    let upt    = dinterpF (dc_font_size ctx) pt
-        uw     = runQuery qry ctx
-        ks     = monos uw $ destrEscapedText id esc
-        ortt   = runQuery (hkernOrientationZero  ks) ctx
-        dort   = normalizeF (dc_font_size ctx) ortt
-        (_,w1) = runLocImage (hkernLine ks) ctx upt
-    in (UNil, dort, w1)
-
-
-
-
-
-monos :: Num u => u -> [EscapedChar] -> [KernChar u]
-monos w1 (c:cs) = (0,c) : map (\ch -> (w1,ch)) cs
-monos _  []     = []
-
-
-
--- | Note - always CAP_HEIGHT_PLUS_DESCENDER for this one.
---
-hkernOrientationZero :: (DrawingCtxM m, InterpretUnit u )
-                     => [KernChar u] -> m (Orientation u)
-hkernOrientationZero xs = 
-    (\(V2 x _ ) (ymin,ymaj) -> Orientation 0 x ymin ymaj) 
-      <$> hkernVector xs <*> heightSpan CAP_HEIGHT_PLUS_DESCENDER
-
- 
-
---------------------------------------------------------------------------------
--- Combining PosObject
-
-
-instance (Monoid a, InterpretUnit u) => ZConcat (PosObject u a) where
-  superior = mappend
-  anterior = flip mappend
-
-
-instance Monoid a => Concat (PosObject u a) where
-  hconcat = genMoveAlign spinemoveH spineRight
-  vconcat = genMoveAlign spinemoveV spineBelow
-
-instance (Monoid a, InterpretUnit u) => CatSpace (PosObject u a) where
-  hspace = genMoveSepH spinemoveH spineRight
-  vspace = genMoveSepV spinemoveV spineBelow
-
-
-
-instance Monoid a => Align (PosObject u a) where
-  halign HALIGN_TOP    = genMoveAlign binmoveHTop    halignTopO
-  halign HALIGN_CENTER = genMoveAlign binmoveHCenter halignCenterO
-  halign HALIGN_BASE   = genMoveAlign binmoveHBottom halignBottomO
-
-  valign VALIGN_LEFT   = genMoveAlign binmoveVLeft   valignLeftO
-  valign VALIGN_CENTER = genMoveAlign binmoveVCenter valignCenterO
-  valign VALIGN_RIGHT  = genMoveAlign binmoveVRight  valignRightO
-
-
-
-genMoveAlign :: Monoid a
-             => (Orientation Double -> Orientation Double -> Vec2 Double) 
-             -> (Orientation Double -> Orientation Double -> Orientation Double) 
-             -> PosObject u a -> PosObject u a -> PosObject u a
-genMoveAlign mkV mkO ma mb = PosObject $ \ctx pt -> 
-    let (a,o1,w1) = getPosObject ma ctx pt
-        (b,o2,w2) = getPosObject mb ctx pt
-        v1        = mkV o1 o2
-        ortt      = mkO o1 o2
-        w2'       = cpmove v1 w2 
-    in (a `mappend` b, ortt, w1 `mappend` w2')
-
-
---------------------------------------------------------------------------------
--- Sep
-
-instance (Monoid a, InterpretUnit u) => AlignSpace (PosObject u a) where
-  halignSpace HALIGN_TOP    = genMoveSepH binmoveHTop    halignTopO
-  halignSpace HALIGN_CENTER = genMoveSepH binmoveHCenter halignCenterO
-  halignSpace HALIGN_BASE   = genMoveSepH binmoveHBottom halignBottomO
-
-  valignSpace VALIGN_LEFT   = genMoveSepV binmoveVLeft   valignLeftO
-  valignSpace VALIGN_CENTER = genMoveSepV binmoveVCenter valignCenterO
-  valignSpace VALIGN_RIGHT  = genMoveSepV binmoveVRight  valignRightO
-
-
-genMoveSepH :: (Monoid a, InterpretUnit u) 
-            => (Orientation Double -> Orientation Double -> Vec2 Double) 
-            -> (Orientation Double -> Orientation Double -> Orientation Double) 
-            -> u
-            -> PosObject u a -> PosObject u a -> PosObject u a
-genMoveSepH mkV mkO sep ma mb  = PosObject $ \ctx pt -> 
-    let (a,o1,w1) = getPosObject ma ctx pt
-        (b,o2,w2) = getPosObject mb ctx pt
-        dsep      = normalize (dc_font_size ctx) sep
-        v1        = hvec dsep ^+^ mkV o1 o2
-        ortt      = extendORight dsep $ mkO o1 o2
-        w2'       = cpmove v1 w2
-    in (a `mappend` b, ortt, w1 `mappend` w2')
-
-
-
-genMoveSepV :: (Monoid a, InterpretUnit u)
-            => (Orientation Double -> Orientation Double -> Vec2 Double) 
-            -> (Orientation Double -> Orientation Double -> Orientation Double) 
-            -> u
-            -> PosObject u a -> PosObject u a -> PosObject u a
-genMoveSepV mkV mkO sep ma mb = PosObject $ \ctx pt -> 
-    let (a,o1,w1) = getPosObject ma ctx pt
-        (b,o2,w2) = getPosObject mb ctx pt
-        dsep      = normalize (dc_font_size ctx) sep
-        v1        = vvec (-dsep) ^+^ mkV o1 o2
-        ortt      = extendODown dsep $ mkO o1 o2
-        w2'       = cpmove v1 w2
-    in (a `mappend` b, ortt, w1 `mappend` w2')
-
diff --git a/src/Wumpus/Basic/Kernel/Objects/Trail.hs b/src/Wumpus/Basic/Kernel/Objects/Trail.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Basic/Kernel/Objects/Trail.hs
@@ -0,0 +1,785 @@
+{-# LANGUAGE TypeFamilies               #-}
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Basic.Kernel.Objects.Trial
+-- Copyright   :  (c) Stephen Tetley 2011
+-- License     :  BSD3
+--
+-- Maintainer  :  stephen.tetley@gmail.com
+-- Stability   :  highly unstable
+-- Portability :  GHC 
+--
+-- /Trails/ - prototype paths. Less resource heavy than the Path
+-- object in Wumpus-Drawing.
+--
+--------------------------------------------------------------------------------
+
+module Wumpus.Basic.Kernel.Objects.Trail
+  (
+
+    TrailSegment(..)
+  , CatTrail
+  , PlacedTrail
+
+  , drawPlacedTrail
+  , drawCatTrail
+
+  , destrPlacedTrail
+  , destrCatTrail
+
+  , placeCatTrail
+  
+  , trailIterateLocus
+
+  , placedTrailPoints
+
+  , rectangleTrail
+  , diamondTrail
+  , polygonTrail
+
+
+  , catline
+  , catcurve
+  
+  , trail_up
+  , trail_down
+  , trail_left
+  , trail_right
+
+  , trail_north
+  , trail_south
+  , trail_east
+  , trail_west
+  , trail_north_east
+  , trail_north_west
+  , trail_south_east
+  , trail_south_west
+
+  , trail_up_left
+  , trail_up_right
+  , trail_down_left
+  , trail_down_right
+
+  , orthoCatline
+
+  , trail_theta_up
+  , trail_theta_down
+  , trail_theta_left
+  , trail_theta_right
+
+  , trail_theta_north
+  , trail_theta_south
+  , trail_theta_east
+  , trail_theta_west
+  , trail_theta_north_east
+  , trail_theta_north_west
+  , trail_theta_south_east
+  , trail_theta_south_west
+
+  , trail_theta_up_left
+  , trail_theta_up_right
+  , trail_theta_down_left
+  , trail_theta_down_right
+
+
+ 
+  , semicircleCW
+  , semicircleCCW
+
+  , minorCircleSweepCW
+  , minorCircleSweepCCW
+  , circleSweepCW
+  , circleSweepCCW
+  , circularArcCW
+  , circularArcCCW
+
+  , sineWave
+  , sineWave1
+  , squareWave
+  , sawtoothWave
+  , squiggleWave
+  , semicircleWave
+
+  , tricurve
+  , rectcurve
+  , trapcurveCW
+  , trapcurveCCW
+  , bowcurve
+  , wedgecurve
+  , loopcurve
+
+  ) where
+
+import Wumpus.Basic.Kernel.Base.BaseDefs
+import Wumpus.Basic.Kernel.Base.QueryDC
+import Wumpus.Basic.Kernel.Objects.Displacement
+import Wumpus.Basic.Kernel.Objects.DrawingPrimitives
+import Wumpus.Basic.Kernel.Objects.Image
+import Wumpus.Basic.Kernel.Objects.LocImage
+import Wumpus.Basic.Utils.HList
+
+import Wumpus.Core                              -- package: wumpus-core
+
+import Data.AffineSpace                         -- package: vector-space
+import Data.VectorSpace
+
+import Data.List ( unfoldr )
+import Data.Monoid
+
+data PlacedTrail u = PlacedTrail
+      { pt_init_vec :: Vec2 u
+      , pt_segments :: [TrailSegment u]
+      }
+  deriving (Eq,Ord,Show)
+
+type instance DUnit (PlacedTrail u) = u
+
+newtype CatTrail u = CatTrail { getCatTrail :: H (TrailSegment u) }
+
+type instance DUnit (CatTrail u) = u
+
+
+data TrailSegment u = TLine (Vec2 u)
+                    | TCurve (Vec2 u) (Vec2 u) (Vec2 u)
+  deriving (Eq,Ord,Show)
+
+type instance DUnit (TrailSegment u) = u
+
+
+instance Functor TrailSegment where
+  fmap f (TLine v1)        = TLine $ fmap f v1
+  fmap f (TCurve v1 v2 v3) = TCurve (fmap f v1) (fmap f v2) (fmap f v3)
+
+
+instance Monoid (CatTrail u) where
+  mempty        = CatTrail emptyH
+  a `mappend` b = CatTrail $ getCatTrail a `appendH` getCatTrail b
+
+
+--------------------------------------------------------------------------------
+
+
+drawCatTrail :: InterpretUnit u => PathMode -> CatTrail u -> LocGraphic u
+drawCatTrail mode (CatTrail ct) = promoteLoc $ \pt -> 
+    drawTrailBody mode (toListH ct) pt 
+
+
+drawPlacedTrail :: InterpretUnit u => PathMode -> PlacedTrail u -> LocGraphic u
+drawPlacedTrail mode (PlacedTrail v0 xs) = promoteLoc $ \pt -> 
+    drawTrailBody mode xs (pt .+^ v0)
+
+
+-- | Note - this optimizes contiguous lines that share the same 
+-- direction. 
+--
+drawTrailBody :: InterpretUnit u 
+              => PathMode -> [TrailSegment u] -> Point2 u -> Graphic u
+drawTrailBody mode ts pt = 
+    normalizeCtxF pt >>= \dpt -> 
+    mapM normalizeCtxF ts >>= \dxs ->
+    dcPath mode $ relPrimPath dpt $ stepA id dxs
+  where
+    stepA f []                   = toListH f
+    stepA f (TLine v1:ys)        = stepB f (vdirection v1) v1 ys
+    stepA f (TCurve v1 v2 v3:ys) = stepA (f `snocH` relCurveTo v1 v2 v3) ys
+
+    stepB f dir v0 (TLine v1:ys) 
+        | vdirection v1 == dir   = stepB f dir (v0 ^+^ v1) ys
+    stepB f _   v0 ys            = stepA (f `snocH` relLineTo v0) ys
+
+
+-- | /Destructor/ for the opaque 'PlacedTrail' type.
+--
+destrPlacedTrail :: PlacedTrail u -> (Vec2 u, [TrailSegment u])
+destrPlacedTrail (PlacedTrail v0 ss) = (v0,ss)
+
+-- | /Destructor/ for the opaque 'CatTrail' type.
+--
+destrCatTrail :: CatTrail u -> [TrailSegment u]
+destrCatTrail = toListH . getCatTrail
+
+
+
+-- | Turn a 'CatTrail' into a 'PlacedTrail'.
+--
+placeCatTrail :: Vec2 u -> CatTrail u -> PlacedTrail u
+placeCatTrail vinit cat = PlacedTrail { pt_init_vec = vinit
+                                      , pt_segments = getCatTrail cat []
+                                      }
+
+
+
+-- | Create a PlacedTrail from the vector list - each vector in the 
+-- input list iterates to the start point rather then the 
+-- cumulative tip.
+--
+-- When the PlacedTrail is run, the supplied point is the /locus/ of 
+-- the path and it does not form part of the path proper.
+-- 
+-- Like 'trailStartIsLocus', this constructor is typically used to 
+-- make /shape paths/. Some shapes are easier to express as 
+-- iterated displacements of the center rather than 
+-- /turtle drawing/. 
+-- 
+trailIterateLocus :: Num u => [Vec2 u] -> PlacedTrail u
+trailIterateLocus []      = PlacedTrail zeroVec []
+trailIterateLocus (v0:xs) = PlacedTrail v0 (step v0 xs)
+  where
+    step v1 []      = [ TLine (v0 ^-^ v1) ]
+    step v1 (v2:vs) = TLine (v2 ^-^ v1) : step v2 vs
+
+
+placedTrailPoints :: InterpretUnit u => PlacedTrail u -> LocQuery u [Point2 u]
+placedTrailPoints (PlacedTrail v0 ts) = qpromoteLoc $ \pt -> 
+    return $ step (pt .+^ v0) ts
+  where
+    step p1 []                    = [p1]
+    step p1 (TLine v1:xs)         = p1 : step (p1 .+^ v1) xs
+    step p1 (TCurve v1 v2 v3 :xs) = let p2 = p1 .+^ v1
+                                        p3 = p2 .+^ v2
+                                        p4 = p3 .+^ v3 
+                                    in p1 : p2 : p3 : step p4 xs
+
+-- | 'rectangleTrail' : @ width * height -> PlacedTrail @
+--
+rectangleTrail :: Fractional u => u -> u -> PlacedTrail u
+rectangleTrail w h = 
+    PlacedTrail { pt_init_vec = ctr_to_bl 
+                , pt_segments = map TLine spec
+                }
+  where
+    ctr_to_bl = vec (negate $ 0.5*w) (negate $ 0.5*h)
+    spec      = [ go_right w, go_up h, go_left w, go_down h ]
+
+
+
+
+-- | 'diamondTrail' : @ half_width * half_height -> PlacedTrail @
+--
+diamondTrail :: Num u => u -> u -> PlacedTrail u
+diamondTrail hw hh = trailIterateLocus [ vs,ve,vn,vw ]
+  where
+    vs = vvec (-hh)
+    ve = hvec hw
+    vn = vvec hh
+    vw = hvec (-hw)
+
+
+-- | 'polygonTrail' : @ num_points * radius -> PlacedTrail @ 
+--
+polygonTrail :: Floating u => Int -> u -> PlacedTrail u
+polygonTrail n radius = trailIterateLocus $ unfoldr phi (0,top)
+  where
+    top                     = 0.5*pi
+    theta                   = (2*pi) / fromIntegral n
+    
+    phi (i,ang) | i < n     = Just (avec ang radius, (i+1,ang+theta))
+                | otherwise = Nothing
+
+
+
+
+catline :: Vec2 u -> CatTrail u 
+catline = CatTrail . wrapH . TLine
+
+
+
+catcurve :: Vec2 u -> Vec2 u -> Vec2 u -> CatTrail u
+catcurve v1 v2 v3 = CatTrail $ wrapH $ TCurve v1 v2 v3
+
+
+trail_up :: Num u => u -> CatTrail u
+trail_up = catline . go_up
+
+trail_down :: Num u => u -> CatTrail u
+trail_down = catline . go_down
+
+trail_left :: Num u => u -> CatTrail u
+trail_left = catline . go_left
+
+trail_right :: Num u => u -> CatTrail u
+trail_right = catline . go_right
+
+
+trail_north :: Num u => u -> CatTrail u
+trail_north = trail_up
+
+trail_south :: Num u => u -> CatTrail u
+trail_south = catline . go_down
+
+trail_east :: Num u => u -> CatTrail u
+trail_east = catline . go_right
+
+trail_west :: Num u => u -> CatTrail u
+trail_west = catline . go_left
+
+
+trail_north_east :: Floating u => u -> CatTrail u
+trail_north_east = catline . go_north_east
+
+trail_north_west :: Floating u => u -> CatTrail u
+trail_north_west = catline . go_north_west
+
+trail_south_east :: Floating u => u -> CatTrail u
+trail_south_east = catline . go_south_east
+
+trail_south_west :: Floating u => u -> CatTrail u
+trail_south_west = catline . go_south_west
+
+
+trail_up_left :: Num u => u -> CatTrail u
+trail_up_left = catline . go_up_left
+
+trail_up_right :: Num u => u -> CatTrail u
+trail_up_right = catline . go_up_right
+
+trail_down_left :: Num u => u -> CatTrail u
+trail_down_left = catline . go_down_left
+
+trail_down_right :: Num u => u -> CatTrail u
+trail_down_right = catline . go_down_right
+
+
+-- | Alternative to @catline@, specifying the vector components 
+-- rather the vector itself.
+--
+orthoCatline :: Floating u => u -> u -> Radian -> CatTrail u 
+orthoCatline x y ang = catline (orthoVec x y ang)
+
+
+trail_theta_up :: Floating u => u -> Radian -> CatTrail u
+trail_theta_up u = catline . theta_up u
+
+trail_theta_down :: Floating u => u -> Radian -> CatTrail u
+trail_theta_down u = catline . theta_down u
+
+trail_theta_left :: Floating u => u -> Radian -> CatTrail u
+trail_theta_left u = catline . theta_left u
+
+trail_theta_right :: Floating u => u -> Radian -> CatTrail u
+trail_theta_right u = catline . theta_right u
+
+
+trail_theta_north :: Floating u => u -> Radian -> CatTrail u
+trail_theta_north = trail_theta_up
+
+trail_theta_south :: Floating u => u -> Radian -> CatTrail u
+trail_theta_south = trail_theta_down
+
+trail_theta_east :: Floating u => u -> Radian -> CatTrail u
+trail_theta_east = trail_theta_right
+
+trail_theta_west :: Floating u => u -> Radian -> CatTrail u
+trail_theta_west = trail_theta_left
+
+
+trail_theta_north_east :: Floating u => u -> Radian -> CatTrail u
+trail_theta_north_east u = catline . theta_north_east u
+
+trail_theta_north_west :: Floating u => u -> Radian -> CatTrail u
+trail_theta_north_west u = catline . theta_north_west u
+
+trail_theta_south_east :: Floating u => u -> Radian -> CatTrail u
+trail_theta_south_east u = catline . theta_south_east u
+
+trail_theta_south_west :: Floating u => u -> Radian -> CatTrail u
+trail_theta_south_west u = catline . theta_south_west u
+
+
+trail_theta_up_left :: Floating u => u -> Radian -> CatTrail u
+trail_theta_up_left u = catline . theta_up_left u
+
+trail_theta_up_right :: Floating u => u -> Radian -> CatTrail u
+trail_theta_up_right u = catline . theta_up_right u
+
+trail_theta_down_left :: Floating u => u -> Radian -> CatTrail u
+trail_theta_down_left u = catline . theta_down_left u
+
+trail_theta_down_right :: Floating u => u -> Radian -> CatTrail u
+trail_theta_down_right u = catline . theta_down_right u
+
+
+
+--------------------------------------------------------------------------------
+
+--
+-- DESIGN NOTE
+--
+-- Angle, unit width and number of repetitions (plus height etc.) 
+-- seems the best API, although this make fitting an issue.
+--
+
+
+sineWave :: (Real u, Floating u) => Int -> u -> Radian -> CatTrail u
+sineWave i unit ang = 
+    mconcat $ replicate i $ sineWave1 (0.25 * unit) unit ang
+
+
+-- | One-phase sine wave. Height is parametric.
+--
+sineWave1 :: (Real u, Floating u)
+              => u -> u -> Radian -> CatTrail u
+sineWave1 h unit ang = 
+              catcurve  v1            (vdiff v1 v2)   (vdiff v2 v3)
+    `mappend` catcurve (vdiff v3 v4)  (vdiff v4 v5)   (vdiff v5 v6)
+    `mappend` catcurve (vdiff v6 v7)  (vdiff v7 v8)   (vdiff v8 v9)
+    `mappend` catcurve (vdiff v9 v10) (vdiff v10 v11) (vdiff v11 v12)
+  where
+    base1 = unit / 12
+    h2    = h * (pi / 6)
+    v1    = orthoVec     base1    h2  ang
+    v2    = orthoVec  (2*base1)   h   ang
+    v3    = orthoVec  (3*base1)   h   ang
+    v4    = orthoVec  (4*base1)   h   ang
+    v5    = orthoVec  (5*base1)   h2  ang
+    v6    = orthoVec  (6*base1)   0   ang
+    v7    = orthoVec  (7*base1) (-h2) ang
+    v8    = orthoVec  (8*base1) (-h)  ang
+    v9    = orthoVec  (9*base1) (-h)  ang
+    v10   = orthoVec (10*base1) (-h)  ang
+    v11   = orthoVec (11*base1) (-h2) ang
+    v12   = orthoVec (12*base1)   0   ang
+
+
+
+kappa :: Floating u => u
+kappa = 4 * ((sqrt 2 - 1) / 3)
+
+
+-- DESIGN NOTE - different functions for CW and CCW or same 
+-- function with @ClockDirection@ as first argument?
+
+
+-- | 'semicircleCW' : @ base_vector -> CatTrail @ 
+-- 
+-- Make a clockwise semicircle from two Bezier curves. Although 
+-- this function produces an approximation of a semicircle, the 
+-- approximation seems fine in practice.
+--
+semicircleCW :: (Real u, Floating u) => Vec2 u -> CatTrail u
+semicircleCW base_vec =
+              catcurve  v1           (vdiff v1 v2) (vdiff v2 v3)
+    `mappend` catcurve (vdiff v3 v4) (vdiff v4 v5) (vdiff v5 v6)
+  where
+    circum  = vlength base_vec
+    radius  = 0.5 * circum
+    ang     = vdirection base_vec
+    rl      = radius * kappa
+    
+    v1      = orthoVec 0 rl ang
+    v2      = orthoVec (radius - rl) radius ang
+    v3      = orthoVec radius radius ang
+
+    v4      = orthoVec (radius + rl) radius ang
+    v5      = orthoVec circum rl ang
+    v6      = orthoVec circum 0 ang
+
+
+-- | 'semicircleCCW' : @ base_vector_vector -> CatTrail @ 
+-- 
+-- Make a counter-clockwise semicircle from two Bezier curves. 
+-- Although this function produces an approximation of a 
+-- semicircle, the approximation seems fine in practice.
+--
+semicircleCCW :: (Real u, Floating u) => Vec2 u -> CatTrail u
+semicircleCCW base_vec =
+              catcurve  v1           (vdiff v1 v2) (vdiff v2 v3)
+    `mappend` catcurve (vdiff v3 v4) (vdiff v4 v5) (vdiff v5 v6)
+  where
+    circum  = vlength base_vec
+    radius  = 0.5 * circum
+    ang     = vdirection base_vec
+    rl      = radius * kappa
+    
+    v1      = orthoVec 0 (-rl) ang
+    v2      = orthoVec (radius - rl) (-radius) ang
+    v3      = orthoVec radius (-radius) ang
+
+    v4      = orthoVec (radius + rl) (-radius) ang
+    v5      = orthoVec circum (-rl) ang
+    v6      = orthoVec circum 0 ang
+
+
+
+
+-- | 'minorCircleSweepCW' : @ angle * radius * inclination -> CatTrail @
+--
+-- > ang should be in the range 0 < ang <= 90deg.
+--
+minorCircleSweepCW :: (Real u, Floating u)
+                   => Radian -> u -> Radian -> CatTrail u
+minorCircleSweepCW ang radius theta = 
+    catcurve (pvec p0 p1) (pvec p1 p2) (pvec p2 p3)
+  where
+    kfactor = fromRadian $ ang / (0.5*pi)
+    rl      = kfactor * radius * kappa
+    totang  = circularModulo $ theta + (half_pi - ang)
+
+    p0      = displace (theta_up    radius theta) zeroPt
+    p1      = displace (theta_right rl     theta) p0
+    p2      = displace (theta_up    rl     totang) p3
+    p3      = displace (avec totang radius) zeroPt
+
+
+-- | 'minorCircleSweepCCW' : @ angle * radius * inclination -> CatTrail @
+--
+-- > ang should be in the range 0 < ang <= 90deg.
+--
+minorCircleSweepCCW :: (Real u, Floating u)
+                    => Radian -> u -> Radian -> CatTrail u
+minorCircleSweepCCW ang radius theta = 
+    catcurve (pvec p0 p1) (pvec p1 p2) (pvec p2 p3)
+  where
+    kfactor = fromRadian $ ang / (0.5*pi)
+    rl      = kfactor * radius * kappa
+    totang  = circularModulo $ theta - half_pi + ang
+
+    p0      = displace (theta_down  radius theta) zeroPt
+    p1      = displace (theta_right rl     theta) p0
+    p2      = displace (theta_down  rl     totang) p3
+    p3      = displace (avec totang radius) zeroPt
+
+
+
+-- | 'circleSweepCW' : @ apex_angle * radius * inclination -> CatTrail @
+--
+-- > ang should be in the range 0 < ang < 360deg.
+--
+-- > if   0 < ang <=  90 returns 1 segment
+-- > if  90 < ang <= 180 returns 2 segments
+-- > if 180 < ang <= 270 returns 3 segments
+-- > if 270 < ang <  360 returns 4 segmenets
+--
+circleSweepCW :: (Real u, Floating u)
+              => Radian -> u -> Radian -> CatTrail u
+circleSweepCW ang radius theta = go (circularModulo ang)
+  where
+    go a | a <= half_pi = wedge1 a
+         | a <= pi      = wedge2 (a/2)
+         | a <= 1.5*pi  = wedge3 (a/3)
+         | otherwise    = wedge4 (a/4)
+    
+    wedge1 a =           minorCircleSweepCW a radius theta
+
+    wedge2 a =           minorCircleSweepCW a radius theta
+               `mappend` minorCircleSweepCW a radius (theta-a)
+
+    wedge3 a =           minorCircleSweepCW a radius theta
+               `mappend` minorCircleSweepCW a radius (theta - a)
+               `mappend` minorCircleSweepCW a radius (theta - 2*a)
+  
+    wedge4 a =           minorCircleSweepCW a radius theta
+               `mappend` minorCircleSweepCW a radius (theta - a)
+               `mappend` minorCircleSweepCW a radius (theta - 2*a)
+               `mappend` minorCircleSweepCW a radius (theta - 3*a)
+
+
+
+
+-- | 'circleSweepCCW' : @ apex_angle * radius * inclination -> CatTrail @
+--
+-- > ang should be in the range 0 < ang < 360deg.
+--
+-- > if   0 < ang <=  90 returns 1 segment
+-- > if  90 < ang <= 180 returns 2 segments
+-- > if 180 < ang <= 270 returns 3 segments
+-- > if 270 < ang <  360 returns 4 segmenets
+--
+circleSweepCCW :: (Real u, Floating u)
+               => Radian -> u -> Radian -> CatTrail u
+circleSweepCCW ang radius theta = go (circularModulo ang)
+  where
+    go a | a <= half_pi = wedge1 a
+         | a <= pi      = wedge2 (a/2)
+         | a <= 1.5*pi  = wedge3 (a/3)
+         | otherwise    = wedge4 (a/4)
+    
+    wedge1 a =           minorCircleSweepCCW a radius theta
+
+    wedge2 a =           minorCircleSweepCCW a radius theta
+               `mappend` minorCircleSweepCCW a radius (theta+a)
+
+    wedge3 a =           minorCircleSweepCCW a radius theta
+               `mappend` minorCircleSweepCCW a radius (theta+a)
+               `mappend` minorCircleSweepCCW a radius (theta+a+a)
+  
+    wedge4 a =           minorCircleSweepCCW a radius theta
+               `mappend` minorCircleSweepCCW a radius (theta+a)
+               `mappend` minorCircleSweepCCW a radius (theta+a+a)
+               `mappend` minorCircleSweepCCW a radius (theta+a+a+a)
+
+
+-- | inclination is the inclination of the chord.
+--
+circularArcCW :: (Real u, Floating u) => Radian -> u -> Radian -> CatTrail u 
+circularArcCW apex_ang radius inclin = 
+    circleSweepCW apex_ang radius (inclin + 0.5 * apex_ang)
+
+
+-- | inclination is the inclination of the chord.
+--
+circularArcCCW :: (Real u, Floating u) => Radian -> u -> Radian -> CatTrail u 
+circularArcCCW apex_ang radius inclin = 
+    circleSweepCCW apex_ang radius (inclin - 0.5 * apex_ang)
+
+
+-- | Proper semicircles do not make a good squiggle (it needs a 
+-- bit of pinch).
+--
+squiggleWave :: (Real u, Floating u) => Int -> u -> Radian -> CatTrail u
+squiggleWave i unit ang = mconcat $ replicate i $ squiggle1 unit ang
+    
+squiggle1 :: (Real u, Floating u) => u -> Radian -> CatTrail u
+squiggle1 unit ang = 
+              catcurve  v1            (vdiff v1 v2)   (vdiff v2 v3)
+    `mappend` catcurve (vdiff v3 v4)  (vdiff v4 v5)   (vdiff v5 v6)
+    `mappend` catcurve (vdiff v6 v7)  (vdiff v7 v8)   (vdiff v8 v9)
+    `mappend` catcurve (vdiff v9 v10) (vdiff v10 v11) (vdiff v11 v12)
+  where
+    four_radius   = unit
+    radius        = 0.25 * four_radius
+    two_radius    = 0.5  * four_radius
+    three_radius  = 0.75 * four_radius
+    rl            = radius * kappa
+    micro         = 0.33 * rl           -- seems good
+    
+    v1            = orthoVec micro rl ang
+    v2            = orthoVec (radius - rl) radius ang
+    v3            = orthoVec radius radius ang
+
+    v4            = orthoVec (radius + rl) radius ang
+    v5            = orthoVec (two_radius - micro) rl ang
+    v6            = orthoVec two_radius  0 ang
+
+    v7            = orthoVec (two_radius + micro) (-rl) ang
+    v8            = orthoVec (three_radius - rl) (-radius) ang
+    v9            = orthoVec three_radius (-radius) ang
+
+    v10           = orthoVec (three_radius + rl) (-radius) ang
+    v11           = orthoVec (four_radius - micro) (-rl) ang
+    v12           = orthoVec four_radius 0 ang
+
+    
+
+squareWave :: Floating u => Int -> u -> Radian -> CatTrail u 
+squareWave n unit ang 
+    | n >  0    = monPreRepeatPost up_half (n - 1,kont) fin
+    | otherwise = mempty
+  where
+    up_half     = catline $ theta_up    (0.25 * unit) ang
+    up_one      = catline $ theta_up    (0.5  * unit) ang
+    down_one    = catline $ theta_down  (0.5  * unit) ang
+    right_half  = catline $ theta_right (0.5  * unit) ang
+
+    kont        = right_half `mappend` down_one `mappend` right_half
+                             `mappend` up_one
+
+    fin         = right_half `mappend` down_one `mappend` right_half
+                             `mappend` up_half
+
+
+
+
+-- |
+--  
+sawtoothWave :: (Real u, Floating u) => Int -> u -> Radian -> CatTrail u 
+sawtoothWave n unit ang 
+    | n >  0    = monPreRepeatPost up_half (n - 1,kont) fin
+    | otherwise = mempty
+  where
+    up_half  = catline $ theta_up_right (0.25 * unit) ang
+    up_one   = catline $ theta_up_right (0.5  * unit) ang
+    down_one = catline $ theta_down_right (0.5 * unit) ang
+
+    kont     = down_one `mappend` up_one
+    fin      = down_one `mappend` up_half
+
+
+
+semicircleWave :: (Real u, Floating u) 
+               => ClockDirection -> Int -> u -> Radian -> CatTrail u
+semicircleWave cdir i unit ang = 
+    mconcat $ replicate i $ fn cdir (avec ang unit)
+  where
+    fn CCW = semicircleCCW
+    fn _   = semicircleCW
+
+
+
+--------------------------------------------------------------------------------
+
+
+
+-- | Curve in a triangle.
+-- 
+tricurve :: Floating u => u -> u -> Radian -> CatTrail u
+tricurve bw h ang = catcurve v1 zeroVec v2
+  where
+    v1 = orthoVec (0.5 * bw) h ang
+    v2 = orthoVec (0.5 * bw) (-h) ang
+
+
+
+-- | Curve in a rectangle.
+-- 
+rectcurve :: Floating u => u -> u -> Radian -> CatTrail u
+rectcurve bw h ang = catcurve v1 v2 v3
+  where
+    v1 = orthoVec 0    h  ang
+    v2 = orthoVec bw   0  ang
+    v3 = orthoVec 0  (-h) ang
+
+-- | Curve in a trapezium (CW).
+-- 
+trapcurveCW :: Floating u => u -> u -> Radian -> Radian -> CatTrail u
+trapcurveCW bw h interior_ang ang = catcurve v1 v2 v3
+  where
+    minor_bw = h / (fromRadian $ tan interior_ang)
+    v1       = orthoVec minor_bw                h  ang
+    v2       = orthoVec (bw - (2 * minor_bw))   0  ang
+    v3       = orthoVec minor_bw              (-h) ang
+
+
+
+-- | Curve in a trapezium (CCW).
+-- 
+trapcurveCCW :: Floating u => u -> u -> Radian -> Radian -> CatTrail u
+trapcurveCCW bw h interior_ang ang = catcurve v1 v2 v3
+  where
+    minor_bw = h / (fromRadian $ tan interior_ang)
+    v1       = orthoVec minor_bw              (-h)  ang
+    v2       = orthoVec (bw - (2 * minor_bw))   0  ang
+    v3       = orthoVec minor_bw                h ang
+
+
+-- | Curve in half a /bowtie/.
+-- 
+bowcurve :: Floating u => u -> u -> Radian -> CatTrail u
+bowcurve bw h ang = catcurve v1 v2 v3
+  where
+    v1 = orthoVec 0    h  ang
+    v2 = orthoVec bw (-h)  ang
+    v3 = orthoVec 0    h ang
+
+
+-- | Wedge curve formed inside a bowtie rotated by 90deg.
+-- 
+wedgecurve :: Floating u => u -> u -> Radian -> CatTrail u
+wedgecurve bw h ang = catcurve v1 v2 v3
+  where
+    v1 = orthoVec   bw    h  ang
+    v2 = orthoVec (-bw)   0  ang
+    v3 = orthoVec   bw  (-h) ang
+
+
+-- | Variation of wedge curve that draws a loop.
+-- 
+loopcurve :: Floating u => u -> u -> Radian -> CatTrail u
+loopcurve bw h ang = catcurve v1 v2 v3
+  where
+    ww = 2.0 * bw 
+    v1 = orthoVec  (1.5 * bw)    h  ang
+    v2 = orthoVec  (-ww)         0  ang
+    v3 = orthoVec  (1.5 * bw)  (-h) ang
diff --git a/src/Wumpus/Basic/VersionNumber.hs b/src/Wumpus/Basic/VersionNumber.hs
--- a/src/Wumpus/Basic/VersionNumber.hs
+++ b/src/Wumpus/Basic/VersionNumber.hs
@@ -23,7 +23,7 @@
 
 -- | Version number
 --
--- > (0,21,0)
+-- > (0,22,0)
 --
 wumpus_basic_version :: (Int,Int,Int)
-wumpus_basic_version = (0,21,0)
+wumpus_basic_version = (0,22,0)
diff --git a/wumpus-basic.cabal b/wumpus-basic.cabal
--- a/wumpus-basic.cabal
+++ b/wumpus-basic.cabal
@@ -1,5 +1,5 @@
 name:             wumpus-basic
-version:          0.21.0
+version:          0.22.0
 license:          BSD3
 license-file:     LICENSE
 copyright:        Stephen Tetley <stephen.tetley@gmail.com>
@@ -30,6 +30,34 @@
   .
   Changelog:
   .
+  v0.21.0 to v0.22.0:
+  .
+  * Reverted argument order of @run@ functions they back to the 
+    @monadLib@ style (args * monadic_operation) rather than @MTL@
+    style (monadic_operation * args). Typographically this seems 
+    better.
+  .
+  * Removed module @Geometry.Paths@ it is superseded in
+    Wumpus-Drawing.
+  .
+  * Added user state to PosObject and moved it into 
+    @Kernel.Drawing@.
+  .
+  * Changed the enumeration @DrawStyle@ to @DrawMode@. Added 
+    another enumeration @PathMode@.
+  .
+  * Changed Chain so that first item in the chain is the start 
+    point (previously the start point was iterated by the chain).
+  .
+  * Removed @ConnectorProps@ from the @DrawingContext@ , they are 
+    now used \"locally\" in Wumpus-Drawing.
+  .
+  * Added more vector constructors to 
+    @Kernel.Objects.Displacement@. 
+  .
+  * Added extra methods to the @Decorate@ class for annotating 
+    SVG elements.
+  .
   v0.20.0 to v0.21.0:
   .
   * The code from the @Kernel.Base.UserState@ module has been 
@@ -44,33 +72,7 @@
   * Rationalized the combinators exported by the drawing objects 
     @Image@, @LocImage@, @LocThetaImage@ and @Connector@.
   . 
-  v0.18.0 to v0.20.0:
   .
-  * Added text advance-vector calculations to @QueryDC@ - 
-    previously they were in Wumpus-Drawing.
-  . 
-  * Changed argument order of @run@ functions to follow the usual
-    style - monadic action first and then dependent parameters 
-    (initial state, reader environment etc.).
-  . 
-  * Changed representation of Chains to a monadic type with an 
-    explicit operation for next position.
-  .
-  * Removed @PrimW@ type - pairs are now used instead. 
-  .
-  * Removed transformer version of @TraceDrawing@. All operations 
-    in TraceDrawing are now specialized to work only on the 
-    @TraceDrawing@ type. Added @UserState@ to TraceDrawing and
-    other drawing monads to compensate for the loss of
-    expressiveness.
-  .
-  * Changed the internals of @AdvObject@ and @PosObject@ so they 
-    are more idiomatic - both are now essentially reader-writer 
-    monads. Added PosObject functions for text primitives (moved 
-    from Wumpus-Drawing).
-  .
-  * Changed the @obliterate@ method of the @Decorate@ class.
-  .
 build-type:         Simple
 stability:          highly unstable
 cabal-version:      >= 1.2
@@ -90,7 +92,7 @@
                       directory       >= 1.0     && <  2.0, 
                       filepath        >= 1.1     && <  2.0,
                       vector-space    >= 0.6     && <  1.0,
-                      wumpus-core     >= 0.51.0  && <  0.52.0
+                      wumpus-core     >= 0.52.0  && <  0.53.0
 
   
   exposed-modules:
@@ -98,7 +100,6 @@
     Wumpus.Basic.Geometry.Base,
     Wumpus.Basic.Geometry.Illustrate,
     Wumpus.Basic.Geometry.Intersection,
-    Wumpus.Basic.Geometry.Paths,
     Wumpus.Basic.Geometry.Quadrant,
     Wumpus.Basic.Geometry.Vertices,
     Wumpus.Basic.Kernel,
@@ -114,6 +115,7 @@
     Wumpus.Basic.Kernel.Drawing.CtxPicture,
     Wumpus.Basic.Kernel.Drawing.LocDrawing,
     Wumpus.Basic.Kernel.Drawing.LocTrace,
+    Wumpus.Basic.Kernel.Drawing.PosObject,
     Wumpus.Basic.Kernel.Drawing.TraceDrawing,
     Wumpus.Basic.Kernel.Objects.AdvObject,
     Wumpus.Basic.Kernel.Objects.Anchors,
@@ -127,7 +129,7 @@
     Wumpus.Basic.Kernel.Objects.LocImage,
     Wumpus.Basic.Kernel.Objects.LocThetaImage,
     Wumpus.Basic.Kernel.Objects.Orientation,
-    Wumpus.Basic.Kernel.Objects.PosObject,
+    Wumpus.Basic.Kernel.Objects.Trail,
     Wumpus.Basic.System.FontLoader,
     Wumpus.Basic.System.FontLoader.AfmParserBase,
     Wumpus.Basic.System.FontLoader.AfmTopLevel,