diff --git a/CHANGES b/CHANGES
--- a/CHANGES
+++ b/CHANGES
@@ -1,4 +1,78 @@
 
+
+0.9.0 to 0.10.0:
+
+  * @Basic.Graphic.BaseClasses@ and @Basic.Graphic.BaseTypes@ 
+    merged into same module so they can depend on each other 
+    without orphans instances.
+
+  * @DrawingF@ renamed to @DrawingR@, the related type synonyms
+    have also been changed, e.g. @LocDrawingF@ is now 
+    @LocDrawingR@.
+
+  * Method names in the @DrawingCtxM@ class changed - @askCtx@ is
+    now @askDC@, @localCtx@ is now @localize@. Removed the 
+    functions @askDF@, @asksDF@, @pureDF@ that worked for 
+    @DrawingF@ (now @DrawingR@), @DrawingR@ now uses the 
+    Applicative\'s @pure@ and the @DrawingCtxM@ class for these 
+    functionalities.
+
+  * @Basic.Graphic.DrawingContext@ - renamed @primary_colour@ to
+    @stroke_colour@ and @secondary_colour@ to @fill_colour@. The 
+    setter functions has been similarly renamed.
+
+  * Added the type synonym @DrawingContextF@ to 
+    @Basic.Graphic.DrawingContext@. Changed relevant function
+    signatures to use it.
+
+  * Re-worked the Path modules - base types entirely different,
+    connectors entirely different, monadic path construction 
+    largely the same.
+
+  * Initial work on round cornered paths.
+ 
+  * Removed the type class @TextAnchor@ from @Basic.Anchors@. 
+    This was a left-over from a previous implementation of 
+    Shapes and is not relevant to the current implementation.
+ 
+  * Added @DirectionContext@ to @Basic.Graphic@.
+
+  * @localLG@ removed it can be acheived with composition -
+    @localize upd . loc_graphic_function@. @lgappend@ is also 
+    removed - it can be recreated applicatively.
+
+0.8.0 to 0.9.0:
+
+  * Re-worked @Basic.Text.LRSymbol@ changed the type name and the
+    types of the run functions. Added more symbols and a new demo 
+    @Symbols.hs@.
+
+  * @ScalingContext@ added to @Basic.Graphic@. Changed 
+    @monoTextWidth@ to take a character count, the old behaviour 
+    is recreated by the new function @monoTextLength@. 
+
+  * @Basic.Graphic.Chain@ removed. It is now superseded by
+    @Basic.Chains@.
+
+  * Added new property to @DrawingContext@ for line spacing 
+    scaling factor, and added a new drawing primitive 
+    @textlineMulti@ for multi-line, left justified labels.
+
+  * Synthezied attribute /getters/ such as @textDimensions@ moved
+    from @Basic.Graphic.DrawingContext@ to the new module
+    @Basic.Graphic.Query@. The type of all the functions has 
+    changed to DrawingF. @lowerxHeight@ is renamed 
+    @monoLowerxHeight@ emphasizing that the metrics pertain to
+    monospaced Courier font.
+
+  * Added Shapes modules.
+ 
+  * TurtleMonad module - the TurtleDrawing type and run functions
+    have been removed and the internals have been reworked. 
+    Turtle is now run solely as a /local effect/ within the 
+    Drawing monad. 
+
+
 0.7.0 to 0.8.0:
 
   * Re-introduced LRText and LRSymbol - they now work with 
diff --git a/demo/ClipPic.hs b/demo/ClipPic.hs
--- a/demo/ClipPic.hs
+++ b/demo/ClipPic.hs
@@ -39,12 +39,14 @@
 pic :: DPicture
 pic = pic1 `nextToV` (stackOver [cpic1, cpic2, cpic3] cpic4)
 
+fillPath :: Num u => Path u -> Graphic u
+fillPath = filledPath . toPrimPathU
 
 pic1 :: DPicture
 pic1 = liftToPictureU $ execDrawing pic_drawing_ctx $ 
-         localCtx (secondaryColour medium_slate_blue) $ do
+         localize (fillColour medium_slate_blue) $ do
             draw $ fillPath path01
-            localCtx (secondaryColour powder_blue) $ 
+            localize (fillColour powder_blue) $ 
                      draw $ fillPath path02
             draw $ fillPath path03
             draw $ fillPath path04
@@ -52,7 +54,7 @@
 
 background :: RGBi -> DPicture 
 background rgb = liftToPictureU $ execDrawing pic_drawing_ctx $ 
-                   localCtx (primaryColour rgb) $ do                  
+                   localize (strokeColour rgb) $ do                  
                      mapM_ iheartHaskell ps
 
    where
diff --git a/demo/ColourCharts.hs b/demo/ColourCharts.hs
--- a/demo/ColourCharts.hs
+++ b/demo/ColourCharts.hs
@@ -43,7 +43,7 @@
 
 
 colourSample :: String -> RGBi -> DPoint2 -> Drawing Double ()
-colourSample name rgb pt = localCtx (secondaryColour rgb) $ do 
+colourSample name rgb pt = localize (fillColour rgb) $ do 
     draw $ borderedRectangle 15 10 `at` pt
     draw $ textline name `at` displace 20 2 pt 
         
diff --git a/demo/ColourDefns.hs b/demo/ColourDefns.hs
--- a/demo/ColourDefns.hs
+++ b/demo/ColourDefns.hs
@@ -8,7 +8,7 @@
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
 -- Stability   :  highly unstable
--- Portability :  GHC with TypeFamilies and more
+-- Portability :  GHC
 --
 -- All the SVG / X11 \"named colours\" listed in tables. 
 --
diff --git a/demo/DotPic.hs b/demo/DotPic.hs
--- a/demo/DotPic.hs
+++ b/demo/DotPic.hs
@@ -51,7 +51,7 @@
     p17 = makeDotPic (dotText "AA") points
  
 std_ctx :: DrawingContext
-std_ctx = secondaryColour peru $ standardContext 12
+std_ctx = fillColour peru $ standardContext 12
 
 points :: [Point2 Double]
 points = [P2 0 0, P2 32 10, P2 64 0, P2 96 10]
@@ -66,10 +66,10 @@
     dashline
     mapM_ (\pt -> drawi $ dotImg `ati` pt) xs
   where
-    dashline = localCtx attrUpd (draw $ openStroke $ vertexPath xs)
+    dashline = localize attrUpd (draw $ openStroke $ vertexPath xs)
 
     attrUpd  :: DrawingContext -> DrawingContext
-    attrUpd  =  dashPattern (evenDashes 1) . primaryColour cadet_blue
+    attrUpd  =  dashPattern (evenDashes 1) . strokeColour cadet_blue
 
 
 
diff --git a/demo/FontPic.hs b/demo/FontPic.hs
--- a/demo/FontPic.hs
+++ b/demo/FontPic.hs
@@ -34,9 +34,9 @@
 
 
 makeLabel :: RGBi -> FontFace -> Int -> DLocGraphic
-makeLabel rgb ff sz = 
-    localLG (primaryColour rgb . fontsize sz . fontface ff) 
-            (textline $ fontMsg ff sz)
+makeLabel rgb ff sz = localize upd . (textline $ fontMsg ff sz)
+  where
+    upd = fillColour rgb . fontsize sz . fontface ff
 
 -- indian_red1
 -- steel_blue
diff --git a/demo/PetriNet.hs b/demo/PetriNet.hs
new file mode 100644
--- /dev/null
+++ b/demo/PetriNet.hs
@@ -0,0 +1,125 @@
+{-# LANGUAGE TypeFamilies               #-}
+{-# OPTIONS -Wall #-}
+
+-- Acknowledgment - the petri net is taken from Claus Reinke\'s
+-- paper /Haskell-Coloured Petri Nets/.
+
+
+module PetriNet where
+
+import Wumpus.Basic.Anchors
+import Wumpus.Basic.Arrows
+import Wumpus.Basic.Colour.SVGColours
+import Wumpus.Basic.Graphic                     -- package: wumpus-basic
+import Wumpus.Basic.Paths
+import Wumpus.Basic.Shapes.Base
+import Wumpus.Basic.Shapes.Derived
+import Wumpus.Basic.SafeFonts
+
+import Wumpus.Core                              -- package: wumpus-core
+
+
+import System.Directory
+
+
+
+main :: IO ()
+main = do 
+    createDirectoryIfMissing True "./out/"
+    writeEPS_latin1 "./out/petri_net.eps" petri_net
+    writeSVG_latin1 "./out/petri_net.svg" petri_net
+    
+
+
+petri_net :: DPicture
+petri_net = liftToPictureU $ execDrawing (standardContext 14) $ do
+              pw     <- place 0 140
+              tu1    <- transition 70 140
+              rtw    <- place 140 140
+              tu2    <- transition 210 140
+              w      <- place 280 140
+              tu3    <- transition 350 140
+              res    <- place 280 70
+              pr     <- place 0 0
+              tl1    <- transition 70 0
+              rtr    <- place 140 0
+              tl2    <- transition 210 0
+              r      <- place 280 0
+              tl3    <- transition 350 0
+              connector (east pw)  (west tu1)              
+              connector (east tu1) (west rtw)
+              connector (east rtw) (west tu2)
+              connector (east tu2) (west w)
+              connector (east w)   (west tu3)
+              connectorC 32 (north tu3) (north pw)
+              connector (east pr)  (west tl1)              
+              connector (east tl1) (west rtr)
+              connector (east rtr) (west tl2)
+              connector (east tl2) (west r)
+              connector (east r)   (west tl3)
+              connectorC (-32) (south tl3) (south pr)
+              connector (southwest res) (northeast tl2)
+              connector (northwest tl3) (southeast res)
+              connectorD 6    (southwest tu3) (northeast res)
+              connectorD (-6) (southwest tu3) (northeast res) 
+              connectorD 6    (northwest res) (southeast tu2)
+              connectorD (-6) (northwest res) (southeast tu2) 
+              draw $ lblParensParens `at` (P2 (-36) 150)
+              draw $ lblParensParens `at` (P2 300 60)
+              draw $ lblParensParensParens `at` (P2 (-52) (-14))
+              draw $ lblBold "processing_w"   `at` (southwards 12 pw)
+              draw $ lblBold "ready_to_write" `at` (southwards 12 rtw)
+              draw $ lblBold "writing"        `at` (southwards 12 w)
+              draw $ lblBold' "resource"      `at` (P2 300 72)
+              draw $ lblBold "processing_r"   `at` (northwards 12 pr)
+              draw $ lblBold "ready_to_read"  `at` (northwards 12 rtr)
+              draw $ lblBold "reading"        `at` (northwards 12 r)
+              return ()
+
+greenFill :: DrawingCtxM m => m a -> m a
+greenFill = localize (fillColour lime_green)
+
+place :: (Real u, Floating u, DrawingCtxM m, TraceM m, u ~ MonUnit m) 
+      => u -> u -> m (Circle u)
+place x y = greenFill $ drawi $ drawShape $ translate x y $ circle 14
+
+transition :: (Real u, Floating u, DrawingCtxM m, TraceM m, u ~ MonUnit m) 
+           => u -> u -> m (Rectangle u)
+transition x y = greenFill $ drawi $ drawShape $ translate x y $ rectangle 32 22
+
+connector :: ( Real u, Floating u, FromPtSize u
+             , DrawingCtxM m, TraceM m, u ~ MonUnit m )
+          => Point2 u -> Point2 u -> m ()
+connector p1 p2 = do
+   _ <- drawi $ arrowTri60 connect `conn` p1 $ p2
+   return ()
+
+
+connectorC :: ( Real u, Floating u, FromPtSize u
+             , DrawingCtxM m, TraceM m, u ~ MonUnit m )
+           => u -> Point2 u -> Point2 u -> m ()
+connectorC v p1 p2 = do
+    _ <- drawi $ arrowTri60 (vhvconn v) `conn` p1 $ p2
+    return ()
+
+connectorD :: ( Real u, Floating u, FromPtSize u
+             , DrawingCtxM m, TraceM m, u ~ MonUnit m )
+           => u -> Point2 u -> Point2 u -> m ()
+connectorD u p1 p2 = do
+    _ <- drawi $ arrowTri60 (joint u) `conn` p1 $ p2
+    return ()
+
+
+lblParensParens :: Num u => LocGraphic u
+lblParensParens = localize (fontface helvetica) . textline "(),()"
+
+lblParensParensParens :: Num u => LocGraphic u
+lblParensParensParens = localize (fontface helvetica) . textline "(),(),()"
+
+
+lblBold' :: Num u => String -> LocGraphic u
+lblBold' ss = localize (fontface helveticaBold) . textline ss
+
+
+lblBold :: (Fractional u, Ord u, FromPtSize u) => String -> LocGraphic u
+lblBold ss = localize (fontface helveticaBold) . centermonoTextline ss
diff --git a/demo/Picture.hs b/demo/Picture.hs
--- a/demo/Picture.hs
+++ b/demo/Picture.hs
@@ -135,17 +135,17 @@
 
 rect_red :: DPicture
 rect_red = liftToPictureU $ execDrawing pic_drawing_ctx $ 
-              localCtx (secondaryColour indian_red)
+              localize (fillColour indian_red)
                        (draw $ borderedRectangle 30 10 `at` (P2 0 10))
                  
 rect_green :: DPicture
 rect_green = liftToPictureU $ execDrawing pic_drawing_ctx $ 
-              localCtx (secondaryColour olive_drab)
+              localize (fillColour olive_drab)
                        (draw $ borderedRectangle 15 15 `at` (P2 10 10))
 
 
 rect_blue :: DPicture
 rect_blue = liftToPictureU $ execDrawing pic_drawing_ctx $ 
-              localCtx (secondaryColour powder_blue)
+              localize (fillColour powder_blue)
                        (draw $ borderedRectangle 20 30 `at` (P2 10 0))
 
diff --git a/demo/Shapes.hs b/demo/Shapes.hs
--- a/demo/Shapes.hs
+++ b/demo/Shapes.hs
@@ -1,20 +1,12 @@
-{-# LANGUAGE TypeFamilies               #-}
 {-# OPTIONS -Wall #-}
 
--- Acknowledgment - the petri net is taken from Claus Reinke\'s
--- paper /Haskell-Coloured Petri Nets/.
 
-
 module Shapes where
 
-import Wumpus.Basic.Anchors
-import Wumpus.Basic.Arrows
 import Wumpus.Basic.Colour.SVGColours
 import Wumpus.Basic.Graphic                     -- package: wumpus-basic
-import Wumpus.Basic.Paths
 import Wumpus.Basic.Shapes.Base
 import Wumpus.Basic.Shapes.Derived
-import Wumpus.Basic.SafeFonts
 
 import Wumpus.Core                              -- package: wumpus-core
 
@@ -28,8 +20,6 @@
     createDirectoryIfMissing True "./out/"
     writeEPS_latin1 "./out/shapes01.eps" pic1
     writeSVG_latin1 "./out/shapes01.svg" pic1
-    writeEPS_latin1 "./out/petri_net.eps" petri_net
-    writeSVG_latin1 "./out/petri.svg" petri_net
     
 
 pic1 :: DPicture
@@ -38,104 +28,10 @@
                                                    $ lrectangle 90 30 "Rectangle"
          _ <- drawi $ drawShape $ translate 100  0 $ lcircle 10 "C0"
    
-         _ <- localCtx (primaryColour red) $ 
+         _ <- localize (strokeColour red) $ 
                        drawi $ drawShape $ translate 220 10 $ rotate30 $ coordinate
          _ <- drawi $ drawShape $ translate 0   40 $ ldiamond 10 10 "d1"
          _ <- drawi $ drawShape $ translate 400 50 $ lrectangle 20 100 "R2"
          return ()
 
 
-
-
-petri_net :: DPicture
-petri_net = liftToPictureU $ execDrawing (standardContext 14) $ do
-              pw     <- place 0 140
-              tu1    <- transition 70 140
-              rtw    <- place 140 140
-              tu2    <- transition 210 140
-              w      <- place 280 140
-              tu3    <- transition 350 140
-              res    <- place 280 70
-              pr     <- place 0 0
-              tl1    <- transition 70 0
-              rtr    <- place 140 0
-              tl2    <- transition 210 0
-              r      <- place 280 0
-              tl3    <- transition 350 0
-              connector (east pw)  (west tu1)              
-              connector (east tu1) (west rtw)
-              connector (east rtw) (west tu2)
-              connector (east tu2) (west w)
-              connector (east w)   (west tu3)
-              connectorC 32 (north tu3) (north pw)
-              connector (east pr)  (west tl1)              
-              connector (east tl1) (west rtr)
-              connector (east rtr) (west tl2)
-              connector (east tl2) (west r)
-              connector (east r)   (west tl3)
-              connectorC (-32) (south tl3) (south pr)
-              connector (southwest res) (northeast tl2)
-              connector (northwest tl3) (southeast res)
-              connectorD 6    (southwest tu3) (northeast res)
-              connectorD (-6) (southwest tu3) (northeast res) 
-              connectorD 6    (northwest res) (southeast tu2)
-              connectorD (-6) (northwest res) (southeast tu2) 
-              draw $ lblParensParens `at` (P2 (-36) 150)
-              draw $ lblParensParens `at` (P2 300 60)
-              draw $ lblParensParensParens `at` (P2 (-52) (-14))
-              draw $ lblBold "processing_w"   `at` (southwards 12 pw)
-              draw $ lblBold "ready_to_write" `at` (southwards 12 rtw)
-              draw $ lblBold "writing"        `at` (southwards 12 w)
-              draw $ lblBold' "resource"      `at` (P2 300 72)
-              draw $ lblBold "processing_r"   `at` (northwards 12 pr)
-              draw $ lblBold "ready_to_read"  `at` (northwards 12 rtr)
-              draw $ lblBold "reading"        `at` (northwards 12 r)
-              return ()
-
-greenFill :: DrawingCtxM m => m a -> m a
-greenFill = localCtx (secondaryColour lime_green)
-
-place :: (Real u, Floating u, DrawingCtxM m, TraceM m, u ~ MonUnit m) 
-      => u -> u -> m (Circle u)
-place x y = greenFill $ drawi $ drawShape $ translate x y $ circle 14
-
-transition :: (Real u, Floating u, DrawingCtxM m, TraceM m, u ~ MonUnit m) 
-           => u -> u -> m (Rectangle u)
-transition x y = greenFill $ drawi $ drawShape $ translate x y $ rectangle 32 22
-
-connector :: ( Real u, Floating u, FromPtSize u
-             , DrawingCtxM m, TraceM m, u ~ MonUnit m )
-          => Point2 u -> Point2 u -> m ()
-connector p1 p2 = do
-   _ <- drawi $ arrowTri60 connectS `conn` p1 $ p2
-   return ()
-
-
-connectorC :: ( Real u, Floating u, FromPtSize u
-             , DrawingCtxM m, TraceM m, u ~ MonUnit m )
-           => u -> Point2 u -> Point2 u -> m ()
-connectorC v p1 p2 = do
-    _ <- drawi $ arrowTri60 (arbv v) `conn` p1 $ p2
-    return ()
-
-connectorD :: ( Real u, Floating u, FromPtSize u
-             , DrawingCtxM m, TraceM m, u ~ MonUnit m )
-           => u -> Point2 u -> Point2 u -> m ()
-connectorD u p1 p2 = do
-    _ <- drawi $ arrowTri60 (joint u) `conn` p1 $ p2
-    return ()
-
-
-lblParensParens :: Num u => LocGraphic u
-lblParensParens = localLG (fontface helvetica) $ textline "(),()"
-
-lblParensParensParens :: Num u => LocGraphic u
-lblParensParensParens = localLG (fontface helvetica) $ textline "(),(),()"
-
-
-lblBold' :: Num u => String -> LocGraphic u
-lblBold' ss = localLG (fontface helveticaBold) $ textline ss
-
-
-lblBold :: (Fractional u, Ord u, FromPtSize u) => String -> LocGraphic u
-lblBold ss = localLG (fontface helveticaBold) $ centermonoTextline ss
diff --git a/demo/Symbols.hs b/demo/Symbols.hs
--- a/demo/Symbols.hs
+++ b/demo/Symbols.hs
@@ -2,7 +2,7 @@
 
 module Symbols where
 
-import Wumpus.Basic.Graphic
+import Wumpus.Basic.Graphic hiding ( perpendicular )
 import Wumpus.Basic.SafeFonts
 import Wumpus.Basic.Text.LRSymbol
 import Wumpus.Basic.Text.LRText
diff --git a/src/Wumpus/Basic/Anchors.hs b/src/Wumpus/Basic/Anchors.hs
--- a/src/Wumpus/Basic/Anchors.hs
+++ b/src/Wumpus/Basic/Anchors.hs
@@ -9,7 +9,7 @@
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
 -- Stability   :  highly unstable
--- Portability :  GHC with TypeFamilies and more
+-- Portability :  GHC
 --
 -- Anchor points on shapes.
 --
@@ -25,7 +25,6 @@
     CenterAnchor(..)
   , CardinalAnchor(..)
   , CardinalAnchor2(..)
-  , TextAnchor(..)
   , RadialAnchor(..)
 
   -- * extended anchor points
@@ -66,12 +65,6 @@
   southeast :: DUnit t ~ u => t -> Point2 u
   southwest :: DUnit t ~ u => t -> Point2 u
   northwest :: DUnit t ~ u => t -> Point2 u
-
--- | 'textAnchor' is the Bottom left corner 
--- on the baseline.
---
-class TextAnchor t where
-  baselineSW :: DUnit t ~ u => t -> Point2 u
 
 
 -- | Anchor on a border that can be identified with and angle.
diff --git a/src/Wumpus/Basic/Arrows.hs b/src/Wumpus/Basic/Arrows.hs
--- a/src/Wumpus/Basic/Arrows.hs
+++ b/src/Wumpus/Basic/Arrows.hs
@@ -8,18 +8,18 @@
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
 -- Stability   :  highly unstable
--- Portability :  GHC with TypeFamilies and more
+-- Portability :  GHC
 --
--- Anchor points on shapes.
+-- Draw arrows.
 --
--- \*\* WARNING \*\* this module is an experiment, and may 
--- change significantly or even be dropped from future revisions.
+-- \*\* WARNING \*\* - the types are /wrong/ here and need more 
+-- thought.
 -- 
 --------------------------------------------------------------------------------
 
 module Wumpus.Basic.Arrows
   ( 
-    line
+    cline
 
 
   , arrowTri90
@@ -34,6 +34,7 @@
   , arrowBarb45
     
   , arrowPerp
+  , arrowRBracket
 
   ) where
 
@@ -47,17 +48,22 @@
 import Control.Applicative
 import Data.Monoid
 
-liftConnPath :: ConnPath u -> ConnDrawingF u (Path u)
-liftConnPath pF p1 p2 = pureDF $ pF p1 p2
+liftConnector :: Connector u -> ConnDrawingR u (Path u)
+liftConnector pF p1 p2 = pure $ pF p1 p2
 
-line :: Num u => ConnPath u -> ConnImage u (Path u)
-line pathF = intoConnImage (liftConnPath pathF) (pathGraphic pathF)
+cline :: Num u => Connector u -> ConnImage u (Path u)
+cline pathF = intoConnImage (liftConnector pathF) (pathGraphic pathF)
 
+-- ... No - can\'t a add tips to this one.
+--
+pathGraphic :: Num u => Connector u -> ConnGraphic u
+pathGraphic bpath = \p1 p2 -> openStroke $ toPrimPathU $ bpath p1 p2
 
+
 -- Here the path is already shortened - we have accounted for the
 -- points already, so it is just a graphic. 
 lineTipR :: Num u => Path u -> Graphic u -> Graphic u
-lineTipR bpath tip = openStroke (toPrimPathU bpath) `mappend` tip
+lineTipR bpath arrtip = openStroke (toPrimPathU bpath) `mappend` arrtip
    
 
 
@@ -73,7 +79,7 @@
 -- path segments.
 --
 rightPathProps :: (Real u, Floating u, FromPtSize u) 
-               => ConnPath u -> ConnDrawingF u (Path u,Radian)
+               => Connector u -> ConnDrawingR u (Path u,Radian)
 rightPathProps pathF p1 p2 = 
     (\h sw -> (shortenPath h sw, calcTheta h))
       <$> markHeight <*> lineWidth
@@ -86,7 +92,7 @@
 
 
 triTipRight :: (Real u, Floating u, FromPtSize u) 
-            => ConnPath u -> (Radian -> LocGraphic u) -> ConnImage u (Path u) 
+            => Connector u -> (Radian -> LocGraphic u) -> ConnImage u (Path u) 
 triTipRight pathF tipF p1 p2 =
     rightPathProps pathF p1 p2          >>= \(shortF,theta) -> 
     lineTipR shortF (tipF theta p2)     >>= \arrow_pic      ->
@@ -98,7 +104,7 @@
 -- This version does not /retract/ the path...
 --
 barbTipRight :: (Real u, Floating u, FromPtSize u) 
-             => ConnPath u -> (Radian -> LocGraphic u) -> ConnImage u (Path u)  
+             => Connector u -> (Radian -> LocGraphic u) -> ConnImage u (Path u)  
 barbTipRight pathF tipF p1 p2 = 
     rightPathProps pathF p1 p2          >>= \(_,theta) -> 
     lineTipR path_zero (tipF theta p2)  >>= \arrow_pic  ->
@@ -109,58 +115,68 @@
 
 
 arrowTri90 :: (Real u, Floating u, FromPtSize u) 
-           => ConnPath u -> ConnImage u (Path u)
+           => Connector u -> ConnImage u (Path u)
 arrowTri90 pathF = triTipRight pathF tri90
  
           
 
 
 arrowTri60 :: (Real u, Floating u, FromPtSize u) 
-           => ConnPath u -> ConnImage u (Path u)
+           => Connector u -> ConnImage u (Path u)
 arrowTri60 pathF = triTipRight pathF tri60
 
  
 arrowTri45 :: (Real u, Floating u, FromPtSize u) 
-           => ConnPath u -> ConnImage u (Path u)
+           => Connector u -> ConnImage u (Path u)
 arrowTri45 pathF = triTipRight pathF tri45
 
 
 arrowOTri90 :: (Real u, Floating u, FromPtSize u) 
-            => ConnPath u -> ConnImage u (Path u)
+            => Connector u -> ConnImage u (Path u)
 arrowOTri90 pathF = triTipRight pathF otri90
      
 
 arrowOTri60 :: (Real u, Floating u, FromPtSize u) 
-            => ConnPath u -> ConnImage u (Path u)
+            => Connector u -> ConnImage u (Path u)
 arrowOTri60 pathF = triTipRight pathF otri60 
 
 
 
 arrowOTri45 :: (Real u, Floating u, FromPtSize u) 
-            => ConnPath u -> ConnImage u (Path u)
+            => Connector u -> ConnImage u (Path u)
 arrowOTri45 pathF = triTipRight pathF otri45
 
 
 
 arrowBarb90 :: (Real u, Floating u, FromPtSize u) 
-            => ConnPath u -> ConnImage u (Path u)
+            => Connector u -> ConnImage u (Path u)
 arrowBarb90 pathF = barbTipRight pathF barb90
 
 arrowBarb60 :: (Real u, Floating u, FromPtSize u) 
-            => ConnPath u -> ConnImage u (Path u)
+            => Connector u -> ConnImage u (Path u)
 arrowBarb60 pathF = barbTipRight pathF barb60
 
 arrowBarb45 :: (Real u, Floating u, FromPtSize u) 
-            => ConnPath u -> ConnImage u (Path u)
+            => Connector u -> ConnImage u (Path u)
 arrowBarb45 pathF = barbTipRight pathF barb45
 
 
                      
 arrowPerp :: (Real u, Floating u, FromPtSize u) 
-          => ConnPath u -> ConnImage u (Path u)
+          => Connector u -> ConnImage u (Path u)
 arrowPerp pathF p1 p2 = 
     lineTipR path_zero perp_tip >>= \arrow_pic -> return (path_zero, arrow_pic)
   where
     path_zero = pathF  p1 p2
     theta     = langle p1 p2
     perp_tip  = perp theta p2
+
+
+arrowRBracket :: (Real u, Floating u, FromPtSize u) 
+              => Connector u -> ConnImage u (Path u)
+arrowRBracket pathF p1 p2 = 
+    lineTipR path_zero perp_tip >>= \arrow_pic -> return (path_zero, arrow_pic)
+  where
+    path_zero = pathF  p1 p2
+    theta     = langle p1 p2
+    perp_tip  = rbracket theta p2
diff --git a/src/Wumpus/Basic/Arrows/Tips.hs b/src/Wumpus/Basic/Arrows/Tips.hs
--- a/src/Wumpus/Basic/Arrows/Tips.hs
+++ b/src/Wumpus/Basic/Arrows/Tips.hs
@@ -8,7 +8,7 @@
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
 -- Stability   :  highly unstable
--- Portability :  GHC with TypeFamilies and more
+-- Portability :  GHC
 --
 -- Anchor points on shapes.
 --
@@ -34,6 +34,8 @@
 
   , perp
 
+  , rbracket
+
   ) where
 
 import Wumpus.Basic.Graphic
@@ -44,21 +46,87 @@
 
 import Control.Applicative
 
--- | tripoints takes dimensions from the xlowerHeight.
+
+
+-- | Tiplen is length of the tip \*along the line it follows\*. 
 --
-tripoints :: (Floating u, FromPtSize u)
-          => Radian -> Radian -> LocDrawingF u (Point2 u, Point2 u)
-tripoints triang theta tip = 
-    (\h -> let d = h / (fromRadian $ cos halfang) 
-           in (tip .-^ v1 d, tip .-^ v2 d))
-      <$> markHeight
+-- > |\
+-- > | \
+-- > | /
+-- > |/
+-- > 
+-- > |  |  -- tip len
+--
+
+-- | Tip width is the distance between upper and lower 
+-- arrow points.
+--
+-- >       __
+-- > |\    
+-- > | \   tip
+-- > | /   width
+-- > |/    __
+-- >       
+
+
+
+-- | This one is for triangular tips defined by their tip angle
+-- e.g. 90deg, 60deg, 45deg.
+--
+-- The tip width will be variable (tip length should be the 
+-- markHeight).
+-- 
+triVecsByAngle :: Floating u => u -> Radian -> Radian -> (Vec2 u, Vec2 u)
+triVecsByAngle tiplen halfang theta = (vec_to_upper, vec_to_lower)
   where
-    halfang = 0.5 * triang
-    v1 d    = avec (theta + halfang) d
-    v2 d    = avec (theta - halfang) d
+    hypo_len     = tiplen / (fromRadian $ cos halfang)
+    rtheta       = pi + theta        -- theta in the opposite direction
+    vec_to_upper = avec (circularModulo $ rtheta - halfang) hypo_len
+    vec_to_lower = avec (circularModulo $ rtheta + halfang) hypo_len 
 
 
+-- | This one is for triangles when the tip height and tip width
+-- are known.
+--
+triVecsByDist  :: (Real u, Floating u) 
+               => u -> u -> Radian -> (Vec2 u, Vec2 u)
+triVecsByDist tiplen half_tipwidth theta = (vec_to_upper, vec_to_lower)
+  where
+    hypo_len     = sqrt $ (tiplen*tiplen) + (half_tipwidth*half_tipwidth)
+    halfang      = toRadian $ atan (half_tipwidth / tiplen) 
+    rtheta       = pi + theta        -- theta in the opposite direction
+    vec_to_upper = avec (circularModulo $ rtheta - halfang) hypo_len
+    vec_to_lower = avec (circularModulo $ rtheta + halfang) hypo_len 
 
+
+--------------------------------------------------------------------------------
+
+-- | Tripoints takes the \*tip length\* is the mark height.
+--
+-- This means that the 90deg tip has a tip width greater-than the
+-- mark height (but that is okay - seemingly this is how TikZ 
+-- does it!).
+--
+tripointsByAngle :: (Floating u, FromPtSize u)
+                 => Radian -> Radian -> LocDrawingR u (Point2 u, Point2 u)
+tripointsByAngle triang theta tip = 
+    (\h -> let (vupper,vlower) = triVecsByAngle h (0.5*triang) theta
+           in  (tip .+^ vupper, tip .+^ vlower))
+      <$> markHeight
+
+
+
+tripointsByDist :: (Real u, Floating u, FromPtSize u)
+                => (u -> u) -> (u -> u) -> Radian 
+                -> LocDrawingR u (Point2 u, Point2 u)
+tripointsByDist lenF halfwidthF theta tip = 
+    (\h -> let (vup,vlo) = triVecsByDist (lenF h) (halfwidthF $ 0.5*h) theta
+           in  (tip .+^ vup, tip .+^ vlo))
+      <$> markHeight
+
+
+
+
 -- width = xchar_height
 -- filled with stroke colour!
 
@@ -68,8 +136,8 @@
       -> (PrimPath u -> Graphic u) 
       -> LocGraphic u
 triAng triang theta gf pt = 
-    tripoints triang theta pt >>= \(u,v) -> 
-    localDF bothPrimary (gf $  vertexPath [pt,u,v])
+    tripointsByAngle triang theta pt >>= \(u,v) -> 
+    localize bothStrokeColour (gf $  vertexPath [pt,u,v])
 
 
 
@@ -106,7 +174,8 @@
 barbAng :: (Floating u, Real u, FromPtSize u)
       => Radian -> Radian -> LocGraphic u
 barbAng ang theta pt = 
-    tripoints ang theta pt >>= \(u,v) -> openStroke (vertexPath [u,pt,v])
+    tripointsByAngle ang theta pt >>= \(u,v) -> 
+    openStroke (vertexPath [u,pt,v])
 
 
 barb90 :: (Floating u, Real u, FromPtSize u) 
@@ -129,3 +198,14 @@
     let v = makeV h in openStroke $ vertexPath [ pt .+^ v, pt .-^ v]
   where
     makeV h  = avec (theta + pi/2) (0.5 * h)
+
+
+rbracket :: (Floating u, FromPtSize u) => Radian -> LocGraphic u
+rbracket theta pt = markHalfHeight >>= \hh -> 
+   runDirection theta $ 
+     displacePerp   hh  pt >>= \p1 ->
+     displacePara (-hh) p1 >>= \p0 ->
+     displacePerp (-hh) pt >>= \p2 ->
+     displacePara (-hh) p2 >>= \p3 ->
+     return (openStroke $ vertexPath [p0,p1,p2,p3]) 
+   
diff --git a/src/Wumpus/Basic/Colour/SVGColours.hs b/src/Wumpus/Basic/Colour/SVGColours.hs
--- a/src/Wumpus/Basic/Colour/SVGColours.hs
+++ b/src/Wumpus/Basic/Colour/SVGColours.hs
@@ -7,8 +7,8 @@
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
--- Stability   :  highly unstable
--- Portability :  GHC with TypeFamilies and more
+-- Stability   :  unstable
+-- Portability :  GHC
 --
 -- The SVG \'named colours\', as rgb [0,1] values 
 --
diff --git a/src/Wumpus/Basic/Colour/X11Colours.hs b/src/Wumpus/Basic/Colour/X11Colours.hs
--- a/src/Wumpus/Basic/Colour/X11Colours.hs
+++ b/src/Wumpus/Basic/Colour/X11Colours.hs
@@ -7,8 +7,8 @@
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
--- Stability   :  highly unstable
--- Portability :  GHC with TypeFamilies and more
+-- Stability   :  unstable
+-- Portability :  GHC
 --
 -- The X11 \'named colours\', as rgb [0,1] values 
 --
diff --git a/src/Wumpus/Basic/Dots.hs b/src/Wumpus/Basic/Dots.hs
--- a/src/Wumpus/Basic/Dots.hs
+++ b/src/Wumpus/Basic/Dots.hs
@@ -11,7 +11,7 @@
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
 -- Stability   :  highly unstable
--- Portability :  GHC with TypeFamilies, GADTs and more
+-- Portability :  GHC
 --
 -- Dots with anchors.
 --
@@ -139,8 +139,8 @@
                              $ rectangleLines ctr hw hh
 
 rectangleLDO :: (Real u, Floating u) 
-             => u -> u -> LocDrawingF u (DotAnchor u)
-rectangleLDO w h pt = pureDF $ rectangleAnchor (w*0.5) (h*0.5) pt
+             => u -> u -> LocDrawingR u (DotAnchor u)
+rectangleLDO w h pt = pure $ rectangleAnchor (w*0.5) (h*0.5) pt
 
 
 circleAnchor :: Floating u => u -> Point2 u -> DotAnchor u
@@ -148,7 +148,7 @@
                                  (\theta -> ctr .+^ (avec theta rad))
                                  (radialCardinal rad ctr)
 
-circleLDO :: (Floating u, FromPtSize u) => LocDrawingF u (DotAnchor u)
+circleLDO :: (Floating u, FromPtSize u) => LocDrawingR u (DotAnchor u)
 circleLDO pt = (\diam -> circleAnchor (diam * 0.5) pt) <$> markHeight 
 
 
diff --git a/src/Wumpus/Basic/Dots/Primitive.hs b/src/Wumpus/Basic/Dots/Primitive.hs
--- a/src/Wumpus/Basic/Dots/Primitive.hs
+++ b/src/Wumpus/Basic/Dots/Primitive.hs
@@ -8,7 +8,7 @@
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
 -- Stability   :  highly unstable
--- Portability :  GHC with TypeFamilies and more
+-- Portability :  GHC
 --
 -- Marks - dots without anchor handles.
 --
@@ -116,26 +116,27 @@
 
 
 markHLine :: (Fractional u, FromPtSize u) => LocGraphic u 
-markHLine = standardSize (\h -> axialLine (hvec h))
+markHLine = standardSize $ \h -> axialLine (hvec h)
     
 
 markVLine :: (Fractional u, FromPtSize u) => LocGraphic u 
-markVLine = standardSize (\h -> axialLine (vvec h)) 
+markVLine = standardSize $ \h -> axialLine (vvec h) 
 
 
 markX :: (Fractional u, FromPtSize u) => LocGraphic u
-markX = standardSize (\h -> let w = 0.75 * h in
-                            axialLine (vec w h) `lgappend` axialLine (vec (-w) h))
+markX = standardSize $ \h -> 
+    let w = 0.75 * h 
+    in mappend <$> axialLine (vec w h) <*> axialLine (vec (-w) h)
 
 
 
 markPlus :: (Fractional u, FromPtSize u) =>  LocGraphic u
-markPlus = markVLine `lgappend` markHLine
+markPlus = mappend <$> markVLine <*> markHLine
 
 
 markCross :: (Floating u, FromPtSize u) =>  LocGraphic u
-markCross = standardSize 
-             (\h -> axialLine (avec ang h) `lgappend` axialLine (avec (-ang) h))
+markCross = standardSize $ \h -> 
+    mappend <$> axialLine (avec ang h) <*> axialLine (avec (-ang) h)
   where
     ang = pi*0.25  
 
@@ -144,7 +145,7 @@
 -- needs horizontal pinch...
 
 pathDiamond :: (Fractional u, FromPtSize u) 
-            => Point2 u -> DrawingF (PrimPath u)
+            => Point2 u -> DrawingR (PrimPath u)
 pathDiamond pt = (\h -> let hh    = 0.66 * h; hw = 0.5 * h 
                         in vertexPath [dvs hh, dve hw,dvn hh, dvw hw])
                    <$> markHeight
@@ -205,7 +206,8 @@
 
 
 markAsterisk :: (Floating u, FromPtSize u) => LocGraphic u
-markAsterisk = standardSize (\h -> lineF1 h `lgappend` lineF2 h `lgappend` lineF3 h)
+markAsterisk = standardSize $ \h -> 
+    (\a b c -> a `mappend` b `mappend` c) <$> lineF1 h <*> lineF2 h <*> lineF3 h
   where
     ang       = (pi*2) / 6
     lineF1 z  = axialLine (vvec z)
@@ -215,15 +217,15 @@
 
 
 markOPlus :: (Fractional u, FromPtSize u) => LocGraphic u
-markOPlus = markCircle `lgappend` markPlus
+markOPlus = mappend <$> markCircle <*> markPlus
 
 
 markOCross :: (Floating u, FromPtSize u) => LocGraphic u
-markOCross = markCircle `lgappend` markCross
+markOCross = mappend <$> markCircle <*> markCross
 
 
 markFOCross :: (Floating u, FromPtSize u) => LocGraphic u
-markFOCross = markCross `lgappend` markBCircle 
+markFOCross = liftA2 mappend markCross markBCircle 
 
 
 -- bkCircle :: (Fractional u, FromPtSize u) => LocGraphic u
diff --git a/src/Wumpus/Basic/Graphic.hs b/src/Wumpus/Basic/Graphic.hs
--- a/src/Wumpus/Basic/Graphic.hs
+++ b/src/Wumpus/Basic/Graphic.hs
@@ -17,8 +17,8 @@
 
 module Wumpus.Basic.Graphic
   (
-    module Wumpus.Basic.Graphic.BaseClasses
-  , module Wumpus.Basic.Graphic.BaseTypes
+    module Wumpus.Basic.Graphic.Base
+  , module Wumpus.Basic.Graphic.DirectionContext
   , module Wumpus.Basic.Graphic.Drawing
   , module Wumpus.Basic.Graphic.DrawingContext
   , module Wumpus.Basic.Graphic.PrimGraphic
@@ -26,8 +26,8 @@
   , module Wumpus.Basic.Graphic.ScalingContext
   ) where
 
-import Wumpus.Basic.Graphic.BaseClasses
-import Wumpus.Basic.Graphic.BaseTypes
+import Wumpus.Basic.Graphic.Base
+import Wumpus.Basic.Graphic.DirectionContext
 import Wumpus.Basic.Graphic.Drawing
 import Wumpus.Basic.Graphic.DrawingContext
 import Wumpus.Basic.Graphic.PrimGraphic
diff --git a/src/Wumpus/Basic/Graphic/Base.hs b/src/Wumpus/Basic/Graphic/Base.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Basic/Graphic/Base.hs
@@ -0,0 +1,334 @@
+{-# LANGUAGE TypeFamilies               #-}
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Basic.Graphic.Base
+-- Copyright   :  (c) Stephen Tetley 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  stephen.tetley@gmail.com
+-- Stability   :  highly unstable
+-- Portability :  GHC 
+--
+-- Base types for Drawing Objects, Graphics / Images (a Graphic 
+-- that also returns an answer), etc.
+-- 
+-- Base classes for monadic drawing.
+--
+-- Note on suffix names. Function types suffixed @F@ are functions 
+-- from same-to-same, e.g.:
+--
+-- > type Point2F u = Point2 u -> Point2 u
+--
+-- Functional types subfixed @R@ are functions from some static 
+-- context to the answer type (c.f the ReaderMonad), e.g.:
+--
+-- > newtype DrawingR a = DrawingR { getDrawingR :: DrawingContext -> a }
+--
+-- The suffix @M@ is used for classes defining monadic actions.
+--
+-- \*\* WARNING \*\* - some names are expected to change.
+--
+--------------------------------------------------------------------------------
+
+module Wumpus.Basic.Graphic.Base
+  (
+    
+  -- * Drawing monads.
+    MonUnit
+  , TraceM(..)
+  , DrawingCtxM(..)
+  , asksDC
+ 
+  , PointSupplyM(..)
+
+  -- * Base types
+  , HPrim
+  , hprimToList
+  , singleH
+
+  , Point2F
+  , DPoint2F
+
+  , DrawingR
+  , LocDrawingR
+  , DLocDrawingR
+
+  , runDrawingR
+
+  , Graphic
+  , DGraphic
+  
+
+  , runGraphic
+  , xlinkGraphic
+
+  , LocGraphic
+  , DLocGraphic
+
+  , Image
+  , DImage
+  , LocImage
+  , DLocImage
+
+  , runImage
+  , intoImage
+  , intoLocImage
+  , xlinkImage
+
+  , ConnDrawingR
+  , DConnDrawingR
+  , ConnGraphic
+  , DConnGraphic
+  , ConnImage
+  , DConnImage
+
+  , intoConnImage
+
+  ) where
+
+import Wumpus.Basic.Graphic.DrawingContext
+import Wumpus.Basic.Utils.HList
+
+import Wumpus.Core                      -- package: wumpus-core
+
+
+import Control.Applicative
+import Data.Monoid
+
+
+--------------------------------------------------------------------------------
+-- Monadic drawing
+
+-- | DUnit is always for fully saturated type constructors, so 
+-- (seemingly) an equivalent type family is needed for monads.
+
+type family MonUnit m :: * 
+
+
+-- | Collect elementary graphics as part of a larger drawing.
+--
+-- TraceM works much like a writer monad.
+--
+class Monad m => TraceM (m :: * -> *) where
+  trace  :: HPrim (MonUnit m) -> m ()
+
+class Monad m => DrawingCtxM (m :: * -> *) where
+  askDC    :: m DrawingContext
+  localize :: (DrawingContext -> DrawingContext) -> m a -> m a
+
+
+-- | Project a value out of a context.
+--
+asksDC :: DrawingCtxM m => (DrawingContext -> a) -> m a
+asksDC f = askDC >>= (return . f)
+
+
+
+
+
+
+-- | A monad that supplies points, e.g. a turtle monad. 
+--
+class Monad m => PointSupplyM (m :: * -> *) where
+  position :: u ~ MonUnit m => m (Point2 u)
+ 
+
+--------------------------------------------------------------------------------
+-- Base types
+
+-- | Graphics objects, even simple ones (line, arrow, dot) might 
+-- need more than one primitive (path or text label) for their
+-- construction. Hence, the primary representation that all the 
+-- others are built upon must support /concatenation/ of 
+-- primitives. 
+--
+-- Wumpus-Core has a type Picture - made from one or more 
+-- Primitives - but Pictures include support for affine frames. 
+-- For drawing many simple graphics (dots, connector lines...) 
+-- that do not need individual affine transformations this is a 
+-- penalty. A list of Primitives is therefore more suitable 
+-- representation, and a Hughes list which supports
+-- efficient concatenation is wise.
+--
+newtype HPrim u = HPrim { getHPrim :: H (PrimElement u) }
+
+-- Note - only a Monoid instance for HPrim - they cannot be 
+-- shown, fmapped etc.
+
+instance Monoid (HPrim u) where
+  mempty          = HPrim emptyH
+  ha `mappend` hb = HPrim $ getHPrim ha `appendH` getHPrim hb
+
+
+hprimToList :: HPrim u -> [PrimElement u]
+hprimToList = toListH . getHPrim
+
+
+singleH :: PrimElement u -> HPrim u
+singleH = HPrim . wrapH 
+
+-- | Point transformation function.
+--
+type Point2F u = Point2 u -> Point2 u
+
+type DPoint2F = Point2F Double
+
+--------------------------------------------------------------------------------
+--
+
+-- | Drawings in Wumpus-Basic have an implicit /graphics state/ 
+-- the @DrawingContext@, the most primitive building block is 
+-- a function from the DrawingContext to some polymorphic answer.
+-- 
+-- This functional type is represented concretely as @DrawingR@.
+-- 
+-- > DrawingR :: DrawingContext -> a 
+--
+newtype DrawingR a = DrawingR { getDrawingR :: DrawingContext -> a }
+
+
+instance Functor DrawingR where
+  fmap f ma = DrawingR $ \ctx -> f $ getDrawingR ma ctx 
+
+-- The monoid instance seems sensible...
+--
+instance Monoid a => Monoid (DrawingR a) where 
+  mempty          = DrawingR $ \_   -> mempty
+  fa `mappend` fb = DrawingR $ \ctx -> 
+                      getDrawingR fa ctx `mappend` getDrawingR fb ctx
+
+-- Applicative
+
+instance Applicative DrawingR where
+  pure a    = DrawingR $ \_   -> a
+  mf <*> ma = DrawingR $ \ctx -> let f = getDrawingR mf ctx
+                                     a = getDrawingR ma ctx
+                                 in f a
+
+-- Monad 
+
+instance Monad DrawingR where
+  return a  = DrawingR $ \_   -> a
+  ma >>= k  = DrawingR $ \ctx -> let a = getDrawingR ma ctx
+                                 in (getDrawingR . k) a ctx 
+
+
+instance DrawingCtxM DrawingR where
+  askDC           = DrawingR $ \ctx -> ctx
+  localize upd df = DrawingR $ \ctx -> getDrawingR df (upd ctx)
+  
+
+-- | Run a /Drawing Function/ with the supplied /Drawing Context/.
+--
+runDrawingR :: DrawingContext -> DrawingR a -> a
+runDrawingR ctx df = getDrawingR df ctx
+
+
+
+
+type LocDrawingR u a = Point2 u -> DrawingR a 
+
+type DLocDrawingR a = LocDrawingR Double a
+
+
+--------------------------------------------------------------------------------
+
+
+-- Simple drawing - representing one or more prims
+
+type Graphic u = DrawingR (HPrim u)
+
+type DGraphic = Graphic Double
+
+
+runGraphic :: DrawingContext -> Graphic u -> HPrim u
+runGraphic ctx gf = (getDrawingR gf) ctx
+
+
+xlinkGraphic :: XLink -> Graphic u -> Graphic u
+xlinkGraphic xlink gf = DrawingR $ \ctx -> 
+    let xs = hprimToList $ runGraphic ctx gf 
+    in (singleH $ xlinkGroup xlink xs)
+
+
+--------------------------------------------------------------------------------
+
+
+-- | Commonly graphics take a start point as well as a drawing 
+-- context.
+-- 
+-- Here they are called a LocGraphic - graphic with a (starting) 
+-- location.
+--
+type LocGraphic u = Point2 u -> Graphic u
+
+type DLocGraphic = LocGraphic Double
+
+
+
+
+--------------------------------------------------------------------------------
+
+
+-- | Images return a value as well as drawing. A /node/ is a 
+-- typical example - nodes are drawing but the also support 
+-- taking anchor points.
+--
+type Image u a = DrawingR (a, HPrim u)
+
+type DImage a = Image Double a
+
+type LocImage u a = Point2 u -> Image u a
+
+type DLocImage a = LocImage Double a
+
+runImage :: DrawingContext -> Image u a -> (a,HPrim u)
+runImage ctx img = (getDrawingR img) ctx
+
+
+intoImage :: DrawingR a -> Graphic u -> Image u a
+intoImage f g = DrawingR $ \ctx -> 
+    let a = getDrawingR f ctx; o = getDrawingR g ctx in (a,o)
+
+
+intoLocImage :: LocDrawingR u a -> LocGraphic u -> LocImage u a
+intoLocImage f g pt = DrawingR $ \ctx -> 
+    let a = getDrawingR (f pt) ctx; o = getDrawingR (g pt) ctx in (a,o)
+
+
+xlinkImage :: XLink -> Image u a -> Image u a
+xlinkImage xlink img = DrawingR $ \ctx -> 
+    let (a,hp) = runImage ctx img 
+    in (a, singleH $ xlinkGroup xlink $ hprimToList hp)
+
+--------------------------------------------------------------------------------
+--
+
+type ConnDrawingR u a = Point2 u -> Point2 u -> DrawingR a
+
+type DConnDrawingR a = ConnDrawingR Double a
+
+-- | ConnGraphic is a connector drawn between two points 
+-- contructing a Graphic.
+--
+type ConnGraphic u = Point2 u -> Point2 u -> Graphic u
+
+type DConnGraphic = ConnGraphic Double
+
+-- | ConImage is a connector drawn between two points 
+-- constructing an Image.
+--
+type ConnImage u a = Point2 u -> Point2 u -> Image u a
+
+type DConnImage a = ConnImage Double a
+
+
+intoConnImage :: ConnDrawingR u a -> ConnGraphic u -> ConnImage u a
+intoConnImage f g p1 p2 = DrawingR $ \ctx -> 
+    let a = getDrawingR (f p1 p2) ctx; o = getDrawingR (g p1 p2) ctx in (a,o)
+
+
+
+
diff --git a/src/Wumpus/Basic/Graphic/BaseClasses.hs b/src/Wumpus/Basic/Graphic/BaseClasses.hs
deleted file mode 100644
--- a/src/Wumpus/Basic/Graphic/BaseClasses.hs
+++ /dev/null
@@ -1,87 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE TypeFamilies               #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# OPTIONS -Wall #-}
-
---------------------------------------------------------------------------------
--- |
--- Module      :  Wumpus.Basic.Graphic.BaseClasses
--- Copyright   :  (c) Stephen Tetley 2010
--- License     :  BSD3
---
--- Maintainer  :  stephen.tetley@gmail.com
--- Stability   :  unstable
--- Portability :  GHC 
---
--- Base classes and type families.
---
--- Drawing is always built on TraceM and DrawingCtxM, it may use
--- PointSupplyM for chains or turtle drawing.
---
---------------------------------------------------------------------------------
-
-module Wumpus.Basic.Graphic.BaseClasses
-  (
-    MonUnit
-  , TraceM(..)
-  , DrawingCtxM(..)
-  , asksCtx  
-
-  , ScalingM(..)
- 
-  , PointSupplyM(..)
-
-  ) where
-
-import Wumpus.Basic.Graphic.BaseTypes ( HPrim )
-import Wumpus.Basic.Graphic.DrawingContext
- 
-
-import Wumpus.Core                              -- package: wumpus-core
-
-
-
-
--- DUnit is always for fully saturated type constructors, so 
--- (seemingly) an equivalent type family is needed for monads.
-
-type family MonUnit m :: * 
-
-
--- | Collect elementary graphics as part of a larger drawing.
---
--- TraceM works much like a writer monad.
---
-class Monad m => TraceM (m :: * -> *) where
-  trace  :: HPrim (MonUnit m) -> m ()
-
-class Monad m => DrawingCtxM (m :: * -> *) where
-  askCtx    :: m DrawingContext
-  localCtx  :: (DrawingContext -> DrawingContext) -> m a -> m a
-
-
--- | Project a value out of a context.
---
-asksCtx :: DrawingCtxM m => (DrawingContext -> a) -> m a
-asksCtx f = askCtx >>= (return . f)
-
-
--- | Scaling...
---
-class ScalingM m where
-  type XDim m :: *
-  type YDim m :: *
-  scaleX :: (u ~ MonUnit m, ux ~ XDim m) => ux -> m u
-  scaleY :: (u ~ MonUnit m, uy ~ YDim m) => uy -> m u
-  scalePt  :: (u ~ MonUnit m, ux ~ XDim m, uy ~ YDim m) 
-           => ux -> uy -> m (Point2 u)
-  scaleVec :: (u ~ MonUnit m, ux ~ XDim m, uy ~ YDim m) 
-           => ux -> uy -> m (Vec2 u)
-
-
--- | A monad that supplies points, e.g. a turtle monad. 
---
-class Monad m => PointSupplyM (m :: * -> *) where
-  position :: u ~ MonUnit m => m (Point2 u)
- 
diff --git a/src/Wumpus/Basic/Graphic/BaseTypes.hs b/src/Wumpus/Basic/Graphic/BaseTypes.hs
deleted file mode 100644
--- a/src/Wumpus/Basic/Graphic/BaseTypes.hs
+++ /dev/null
@@ -1,301 +0,0 @@
-{-# OPTIONS -Wall #-}
-
---------------------------------------------------------------------------------
--- |
--- Module      :  Wumpus.Basic.Graphic.Image
--- Copyright   :  (c) Stephen Tetley 2010
--- License     :  BSD3
---
--- Maintainer  :  stephen.tetley@gmail.com
--- Stability   :  highly unstable
--- Portability :  GHC 
---
--- Base types for Drawing Objects, Graphics / Images (a Graphic 
--- that also returns an answer), etc.
---
--- \*\* WARNING \*\* - some names are expected to change 
--- particularly the naming of the /append/ and /concat/ functions.
---
---------------------------------------------------------------------------------
-
-module Wumpus.Basic.Graphic.BaseTypes
-  (
-    
-
-    HPrim
-  , hprimToList
-  , singleH
-
-  , Point2F
-  , DPoint2F
-
-  , DrawingF
-  , LocDrawingF
-  , DLocDrawingF
-
-  , runDF
-  , pureDF 
-  , askDF
-  , asksDF
-  , localDF
-
-  , Graphic
-  , DGraphic
-  
-
-  , runGraphic
-  , xlinkGraphic
-
-  , LocGraphic
-  , DLocGraphic
-  , localLG
-  , lgappend
-
-  , Image
-  , DImage
-  , LocImage
-  , DLocImage
-
-  , runImage
-  , intoImage
-  , intoLocImage
-  , xlinkImage
-
-  , ConnDrawingF
-  , DConnDrawingF
-  , ConnGraphic
-  , DConnGraphic
-  , ConnImage
-  , DConnImage
-
-  , intoConnImage
-
-  ) where
-
-import Wumpus.Basic.Graphic.DrawingContext
-import Wumpus.Basic.Utils.HList
-
-import Wumpus.Core                      -- package: wumpus-core
-
-
-import Control.Applicative
-import Data.Monoid
-
-
-
--- | Graphics objects, even simple ones (line, arrow, dot) might 
--- need more than one primitive (path or text label) for their
--- construction. Hence, the primary representation that all the 
--- others are built upon must support /concatenation/ of 
--- primitives. 
---
--- Wumpus-Core has a type Picture - made from one or more 
--- Primitives - but Pictures include support for affine frames. 
--- For drawing many simple graphics (dots, connector lines...) 
--- that do not need individual affine transformations this is a 
--- penalty. A list of Primitives is therefore more suitable 
--- representation, and a Hughes list which supports
--- efficient concatenation is wise.
---
-newtype HPrim u = HPrim { getHPrim :: H (PrimElement u) }
-
--- Note - only a Monoid instance for HPrim - they cannot be 
--- shown, fmapped etc.
-
-instance Monoid (HPrim u) where
-  mempty          = HPrim emptyH
-  ha `mappend` hb = HPrim $ getHPrim ha `appendH` getHPrim hb
-
-
-hprimToList :: HPrim u -> [PrimElement u]
-hprimToList = toListH . getHPrim
-
-
-singleH :: PrimElement u -> HPrim u
-singleH = HPrim . wrapH 
-
--- | Point transformation function.
---
-type Point2F u = Point2 u -> Point2 u
-
-type DPoint2F = Point2F Double
-
---------------------------------------------------------------------------------
---
-
--- | Drawings in Wumpus-Basic have an implicit /graphics state/ 
--- the @DrawingContext@, the most primitive building block is 
--- a function from the DrawingContext to some polymorphic answer.
--- 
--- This functional type is represented concretely as @DrawingF@.
--- 
--- > DrawingF :: DrawingContext -> a 
---
-newtype DrawingF a = DrawingF { getDrawingF :: DrawingContext -> a }
-
-
-instance Functor DrawingF where
-  fmap f ma = DrawingF $ \ctx -> f $ getDrawingF ma ctx 
-
--- The monoid instance seems sensible...
---
-instance Monoid a => Monoid (DrawingF a) where 
-  mempty          = DrawingF $ \_   -> mempty
-  fa `mappend` fb = DrawingF $ \ctx -> 
-                      getDrawingF fa ctx `mappend` getDrawingF fb ctx
-
--- Applicative
-
-instance Applicative DrawingF where
-  pure a    = DrawingF $ \_   -> a
-  mf <*> ma = DrawingF $ \ctx -> let f = getDrawingF mf ctx
-                                     a = getDrawingF ma ctx
-                                 in f a
-
--- Monad 
-
-instance Monad DrawingF where
-  return a  = DrawingF $ \_   -> a
-  ma >>= k  = DrawingF $ \ctx -> let a = getDrawingF ma ctx
-                                 in (getDrawingF . k) a ctx 
-
--- | Run a /Drawing Function/ with the supplied /Drawing Context/.
---
-runDF :: DrawingContext -> DrawingF a -> a
-runDF ctx df = getDrawingF df ctx
-
-
--- | Wrap a value into a DrawingF.
---
--- Note the value is /pure/ it does depend on the DrawingContext
--- (it is /context free/).
---
-pureDF :: a -> DrawingF a
-pureDF a = DrawingF $ \ _ctx -> a 
-
-askDF :: DrawingF DrawingContext
-askDF = DrawingF id
-
-asksDF :: (DrawingContext -> a) -> DrawingF a
-asksDF fn = DrawingF $ \ctx -> fn ctx
-
-localDF :: (DrawingContext -> DrawingContext) 
-        -> DrawingF a -> DrawingF a
-localDF upd gf = DrawingF $ \ctx -> getDrawingF gf (upd ctx)
-
-
-
-type LocDrawingF u a = Point2 u -> DrawingF a 
-
-type DLocDrawingF a = LocDrawingF Double a
-
-
---------------------------------------------------------------------------------
-
-
--- Simple drawing - representing one or more prims
-
-type Graphic u = DrawingF (HPrim u)
-
-type DGraphic = Graphic Double
-
-
-runGraphic :: DrawingContext -> Graphic u -> HPrim u
-runGraphic ctx gf = (getDrawingF gf) ctx
-
-
-xlinkGraphic :: XLink -> Graphic u -> Graphic u
-xlinkGraphic xlink gf = askDF >>= \ctx -> 
-    let xs = hprimToList $ runGraphic ctx gf in pureDF (singleH $ xlinkGroup xlink xs)
-
-
---------------------------------------------------------------------------------
-
-
--- | Commonly graphics take a start point as well as a drawing 
--- context.
--- 
--- Here they are called a LocGraphic - graphic with a (starting) 
--- location.
---
-type LocGraphic u = Point2 u -> Graphic u
-
-type DLocGraphic = LocGraphic Double
-
-
-localLG :: 
-    (DrawingContext -> DrawingContext) -> LocGraphic u -> LocGraphic u
-localLG upd img = \pt -> localDF upd (img pt) 
-
-
--- | Composition operator for LocGraphic - both LocGraphics
--- are drawn at the same origin and the results concatenated.
---
---
-lgappend :: LocGraphic u -> LocGraphic u -> LocGraphic u
-lgappend f g = \pt -> f pt `mappend` g pt
-
-
---------------------------------------------------------------------------------
-
-
--- | Images return a value as well as drawing. A /node/ is a 
--- typical example - nodes are drawing but the also support 
--- taking anchor points.
---
-type Image u a = DrawingF (a, HPrim u)
-
-type DImage a = Image Double a
-
-type LocImage u a = Point2 u -> Image u a
-
-type DLocImage a = LocImage Double a
-
-runImage :: DrawingContext -> Image u a -> (a,HPrim u)
-runImage ctx img = (getDrawingF img) ctx
-
-
-intoImage :: DrawingF a -> Graphic u -> Image u a
-intoImage f g = DrawingF $ \ctx -> 
-    let a = getDrawingF f ctx; o = getDrawingF g ctx in (a,o)
-
-
-intoLocImage :: LocDrawingF u a -> LocGraphic u -> LocImage u a
-intoLocImage f g pt = DrawingF $ \ctx -> 
-    let a = getDrawingF (f pt) ctx; o = getDrawingF (g pt) ctx in (a,o)
-
-
-xlinkImage :: XLink -> Image u a -> Image u a
-xlinkImage xlink img = askDF >>= \ctx -> 
-    let (a,hp) = runImage ctx img 
-    in pureDF (a, singleH $ xlinkGroup xlink $ hprimToList hp)
-
---------------------------------------------------------------------------------
---
-
-type ConnDrawingF u a = Point2 u -> Point2 u -> DrawingF a
-
-type DConnDrawingF a = ConnDrawingF Double a
-
--- | ConnGraphic is a connector drawn between two points 
--- contructing a Graphic.
---
-type ConnGraphic u = Point2 u -> Point2 u -> Graphic u
-
-type DConnGraphic = ConnGraphic Double
-
--- | ConImage is a connector drawn between two points 
--- constructing an Image.
---
-type ConnImage u a = Point2 u -> Point2 u -> Image u a
-
-type DConnImage a = ConnImage Double a
-
-
-intoConnImage :: ConnDrawingF u a -> ConnGraphic u -> ConnImage u a
-intoConnImage f g p1 p2 = DrawingF $ \ctx -> 
-    let a = getDrawingF (f p1 p2) ctx; o = getDrawingF (g p1 p2) ctx in (a,o)
-
-
-
-
diff --git a/src/Wumpus/Basic/Graphic/DirectionContext.hs b/src/Wumpus/Basic/Graphic/DirectionContext.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Basic/Graphic/DirectionContext.hs
@@ -0,0 +1,140 @@
+{-# LANGUAGE TypeFamilies               #-}
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Basic.Graphic.DirectionContext
+-- Copyright   :  (c) Stephen Tetley 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  stephen.tetley@gmail.com
+-- Stability   :  unstable
+-- Portability :  GHC
+--
+-- Reader monad over (angular) direction.
+--
+--
+--------------------------------------------------------------------------------
+
+module Wumpus.Basic.Graphic.DirectionContext
+  (
+
+    DirectionM(..)
+  , Direction
+  , runDirection
+  , DirectionT
+  , runDirectionT
+
+  , displacePerp
+  , displacePara
+
+  ) where
+
+import Wumpus.Basic.Graphic.Base
+
+import Wumpus.Core				-- package: wumpus-core
+
+import Data.AffineSpace                         -- package: vector-space
+
+import Control.Applicative
+
+
+-- Should this use MonUnit for consistency ??
+
+class Monad m => DirectionM m where
+  localTheta    :: Radian -> m a -> m a
+  asksTheta     :: (Radian -> a) -> m a 
+  parallel      :: Floating u => u -> m (Vec2 u)
+  perpendicular :: Floating u => u -> m (Vec2 u)
+
+
+--
+newtype Direction a = Direction { getDirection :: Radian -> a }
+
+
+
+instance Functor Direction where
+  fmap f ma = Direction $ \r -> let a = getDirection ma r in f a
+
+instance Applicative Direction where
+  pure a    = Direction $ \_ -> a
+  mf <*> ma = Direction $ \r -> let f = getDirection mf r
+                                    a = getDirection ma r
+             			in (f a)
+
+instance Monad Direction where
+  return a = Direction $ \_ -> a
+  m >>= k  = Direction $ \r -> let a = getDirection m r
+    	     	               in (getDirection . k) a r
+
+
+
+runDirection :: Radian -> Direction a -> a
+runDirection theta sf = (getDirection sf) theta
+
+
+instance DirectionM Direction where
+  localTheta theta ma = Direction $ \_ -> getDirection ma theta
+  asksTheta fn        = Direction $ \r -> fn r
+  parallel d          = Direction $ \r -> avec (circularModulo r) d
+  perpendicular d     = Direction $ \r -> 
+                          avec (circularModulo $ (0.5*pi) + r) d  
+
+
+--------------------------------------------------------------------------------
+-- Transformer
+
+newtype DirectionT m a = DirectionT { getDirectionT :: Radian -> m a }
+
+type instance MonUnit (DirectionT m) = MonUnit m
+
+instance Monad m => Functor (DirectionT m) where
+  fmap f ma = DirectionT $ \r -> getDirectionT ma r >>= \a -> return (f a)
+
+instance Monad m => Applicative (DirectionT m) where
+  pure a    = DirectionT $ \_ -> return a
+  mf <*> ma = DirectionT $ \r -> getDirectionT mf r >>= \f -> 
+                                 getDirectionT ma r >>= \a ->
+             			 return (f a)
+
+instance Monad m => Monad (DirectionT m) where
+  return a = DirectionT $ \_ -> return a
+  m >>= k  = DirectionT $ \r -> getDirectionT m r >>= \a -> 
+    	     	      	     	(getDirectionT . k) a r
+
+
+
+instance Monad m => DirectionM (DirectionT m) where
+  localTheta theta ma = DirectionT $ \_ -> getDirectionT ma theta
+  asksTheta fn        = DirectionT $ \r -> return (fn r)
+  parallel d          = DirectionT $ \r -> return (avec (circularModulo r) d)
+  perpendicular d     = DirectionT $ \r -> 
+                          return (avec (circularModulo $ (0.5*pi) + r) d)
+
+
+-- Cross instances - needed to run SalingT /locally/ in Drawing.
+
+instance DrawingCtxM m => DrawingCtxM (DirectionT m) where
+  askDC           = DirectionT $ \_ -> askDC >>= \dctx -> return dctx
+  localize ctx mf = DirectionT $ \r -> localize ctx (getDirectionT mf r)
+
+
+instance (Monad m, TraceM m) => TraceM (DirectionT m) where
+  trace a  = DirectionT $ \_ -> trace a 
+
+
+
+
+
+runDirectionT :: Radian -> DirectionT m a -> m a
+runDirectionT theta sf = (getDirectionT sf) theta
+
+
+--------------------------------------------------------------------------------
+
+displacePerp :: (DirectionM m, Floating u) => u -> Point2 u -> m (Point2 u)
+displacePerp u pt = perpendicular u >>= \v -> return (pt .+^ v)
+
+
+displacePara :: (DirectionM m, Floating u) => u -> Point2 u -> m (Point2 u)
+displacePara u pt = parallel u >>= \v -> return (pt .+^ v)
diff --git a/src/Wumpus/Basic/Graphic/Drawing.hs b/src/Wumpus/Basic/Graphic/Drawing.hs
--- a/src/Wumpus/Basic/Graphic/Drawing.hs
+++ b/src/Wumpus/Basic/Graphic/Drawing.hs
@@ -54,8 +54,7 @@
   ) where
 
 
-import Wumpus.Basic.Graphic.BaseClasses
-import Wumpus.Basic.Graphic.BaseTypes
+import Wumpus.Basic.Graphic.Base
 import Wumpus.Basic.Graphic.DrawingContext
  
 
@@ -157,14 +156,14 @@
 -- DrawingCtxM
 
 instance DrawingCtxM (Drawing u) where
-  askCtx         = Drawing $ \ctx s -> (ctx, s)
-  localCtx cF ma = Drawing $ \ctx  s -> getDrawing ma (cF ctx) s
+  askDC           = Drawing $ \ctx s -> (ctx, s)
+  localize upd ma = Drawing $ \ctx s -> getDrawing ma (upd ctx) s
 
 
 
 instance Monad m => DrawingCtxM (DrawingT u m) where
-  askCtx         = DrawingT $ \ctx s -> return (ctx,s)
-  localCtx cF ma = DrawingT $ \ctx s -> getDrawingT ma (cF ctx) s
+  askDC           = DrawingT $ \ctx s -> return (ctx,s)
+  localize upd ma = DrawingT $ \ctx s -> getDrawingT ma (upd ctx) s
 
 
 
@@ -281,7 +280,7 @@
 -- This operation is analogeous to @tell@ in a Writer monad.
 -- 
 draw :: (TraceM m, DrawingCtxM m, u ~ MonUnit m) => Graphic u -> m ()
-draw gf = askCtx >>= \ctx -> trace (runGraphic ctx gf)
+draw gf = askDC >>= \ctx -> trace (runGraphic ctx gf)
 
 -- | Hyperlink version of 'draw'.
 --
@@ -298,7 +297,7 @@
 -- monad, and the result is returned.
 -- 
 drawi ::  (TraceM m, DrawingCtxM m, u ~ MonUnit m) => Image u a -> m a
-drawi img = askCtx >>= \ctx -> 
+drawi img = askDC >>= \ctx -> 
             let (a,o) = runImage ctx img in trace o >> return a
 
 -- | Hyperlink version of 'drawi'.
@@ -326,13 +325,13 @@
 
 node :: (TraceM m, DrawingCtxM m, PointSupplyM m, u ~ MonUnit m) 
      => LocGraphic u -> m ()
-node gfL = askCtx   >>= \ctx -> 
+node gfL = askDC   >>= \ctx -> 
            position >>= \pt  -> trace (runGraphic ctx $ gfL pt)
 
 
 nodei :: (TraceM m, DrawingCtxM m, PointSupplyM m, u ~ MonUnit m) 
      => LocImage u a -> m a
-nodei imgL = askCtx   >>= \ctx -> 
+nodei imgL = askDC   >>= \ctx -> 
              position >>= \pt  -> 
              let (a,o) = runImage ctx (imgL pt) in trace o >> return a
 
diff --git a/src/Wumpus/Basic/Graphic/DrawingContext.hs b/src/Wumpus/Basic/Graphic/DrawingContext.hs
--- a/src/Wumpus/Basic/Graphic/DrawingContext.hs
+++ b/src/Wumpus/Basic/Graphic/DrawingContext.hs
@@ -8,7 +8,7 @@
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
 -- Stability   :  highly unstable
--- Portability :  GHC with TypeFamilies and more
+-- Portability :  GHC
 --
 -- Drawing attributes
 --
@@ -25,8 +25,10 @@
 
   -- * Drawing context
     DrawingContext(..)
+  , DrawingContextF
 
   , standardContext
+  , default_drawing_context
 
   -- * Modifiers 
   -- ** Line widths
@@ -34,6 +36,16 @@
   , ultrathick
   , thin
 
+  -- ** Line caps
+  , capButt
+  , capRound
+  , capSquare
+
+  -- ** Line joins
+  , joinMiter
+  , joinRound
+  , joinBevel
+
   -- ** Dash Pattern
   , dashPattern
   , unit_dash_pattern
@@ -42,20 +54,20 @@
   , doublegaps
   , doubledashes
 
-  -- ** Font properties
+  -- * Font properties
   , fontsize
   , fontface
 
-  -- ** Mark drawing size
+  -- * Font / mark drawing size
   , doublesize
   , halfsize
 
-  -- ** Colour
+  -- * Colour
   , swapColours
-  , bothPrimary
-  , bothSecondary
-  , primaryColour
-  , secondaryColour 
+  , bothStrokeColour
+  , bothFillColour
+  , strokeColour
+  , fillColour 
 
 
 
@@ -73,32 +85,34 @@
 data DrawingContext = DrawingContext
       { stroke_props          :: StrokeAttr
       , font_props            :: FontAttr
-      , primary_colour        :: RGBi      -- usually the stroke colour
-      , secondary_colour      :: RGBi      -- usually the fill colour
+      , stroke_colour         :: RGBi      -- also text colour...
+      , fill_colour           :: RGBi      
       , line_spacing_factor   :: Double
       }
   deriving (Eq,Show)
 
+type DrawingContextF = DrawingContext -> DrawingContext
 
+
 standardContext :: FontSize -> DrawingContext
 standardContext sz = 
-    DrawingContext { stroke_props           = default_stroke_attr
-                   , font_props             = FontAttr sz courier
-                   , primary_colour         = black
-                   , secondary_colour       = light_gray
-                   , line_spacing_factor    = 1.2  
+    DrawingContext { stroke_props         = default_stroke_attr
+                   , font_props           = FontAttr sz courier
+                   , stroke_colour        = black
+                   , fill_colour          = light_gray
+                   , line_spacing_factor  = 1.2  
                    }
 
 
-
+default_drawing_context :: DrawingContext
+default_drawing_context = 
+    standardContext (font_size wumpus_default_font)
 
 
-updateStrokeProps :: (StrokeAttr -> StrokeAttr) 
-                  -> DrawingContext -> DrawingContext
+updateStrokeProps :: (StrokeAttr -> StrokeAttr) -> DrawingContextF
 updateStrokeProps fn = (\s i -> s { stroke_props = fn i }) <*> stroke_props
 
-updateFontProps :: (FontAttr -> FontAttr) 
-                -> DrawingContext -> DrawingContext
+updateFontProps :: (FontAttr -> FontAttr) -> DrawingContextF
 updateFontProps fn = (\s i -> s { font_props = fn i }) <*> font_props
 
 
@@ -120,7 +134,7 @@
 thin_line           :: Double
 thin_line           = 0.5
 
-setLineWidth       :: Double -> DrawingContext -> DrawingContext
+setLineWidth       :: Double -> DrawingContextF
 setLineWidth d      = updateStrokeProps (\s -> s { line_width = d })
 
 -- | Set the line width to a /thick/.
@@ -128,18 +142,47 @@
 -- Note this context update is /oblivious/ - operationally the 
 -- line width is set to exactly @2.0@.
 --
-thick               :: DrawingContext -> DrawingContext
+thick               :: DrawingContextF
 thick               = setLineWidth thick_line
 
-ultrathick          :: DrawingContext -> DrawingContext
+ultrathick          :: DrawingContextF
 ultrathick          = setLineWidth ultra_thick_line
 
-thin                :: DrawingContext -> DrawingContext
+thin                :: DrawingContextF
 thin                = setLineWidth thin_line
 
+
+setLineCap          :: LineCap -> DrawingContextF
+setLineCap d        = updateStrokeProps (\s -> s { line_cap = d })
+
+
+capButt             :: DrawingContextF
+capButt             = setLineCap CapButt
+
+capRound            :: DrawingContextF
+capRound            = setLineCap CapRound
+
+capSquare           :: DrawingContextF
+capSquare           = setLineCap CapSquare
+
+
+setLineJoin         :: LineJoin -> DrawingContextF
+setLineJoin d       = updateStrokeProps (\s -> s { line_join = d })
+
+
+joinMiter           :: DrawingContextF
+joinMiter           = setLineJoin JoinMiter
+
+joinRound           :: DrawingContextF
+joinRound           = setLineJoin JoinRound
+
+joinBevel           :: DrawingContextF
+joinBevel           = setLineJoin JoinBevel
+
+
 --------------------------------------------------------------------------------
 
-dashPattern         :: DashPattern -> DrawingContext -> DrawingContext
+dashPattern         :: DashPattern -> DrawingContextF
 dashPattern d       = updateStrokeProps (\s -> s { dash_pattern = d })        
 
 unit_dash_pattern   :: DashPattern
@@ -171,10 +214,10 @@
 --------------------------------------------------------------------------------
 
 
-fontface            :: FontFace -> DrawingContext -> DrawingContext
+fontface            :: FontFace -> DrawingContextF
 fontface ff         = updateFontProps (\(FontAttr sz _) -> FontAttr sz ff)
 
-fontsize            :: Int -> DrawingContext -> DrawingContext
+fontsize            :: Int -> DrawingContextF
 fontsize sz         = updateFontProps (\(FontAttr _ ff) -> FontAttr sz ff)
 
 --------------------------------------------------------------------------------
@@ -182,7 +225,7 @@
 -- | Set the font size to double the current size, note the font
 -- size also controls the size of dots, arrowsheads etc.
 -- 
-doublesize          :: DrawingContext -> DrawingContext
+doublesize          :: DrawingContextF
 doublesize          = (\s sz -> fontsize (sz*2) s) <*> (font_size . font_props)
 
 
@@ -192,30 +235,30 @@
 -- As fontsize is an integer this is not exact - half size of
 -- 15pt type is 7pt.
 -- 
-halfsize            :: DrawingContext -> DrawingContext
+halfsize            :: DrawingContextF
 halfsize            = (\s sz -> fontsize (sz `div` 2) s) 
                         <*> (font_size . font_props)
 
 
 --------------------------------------------------------------------------------
 
-swapColours :: DrawingContext -> DrawingContext
+swapColours :: DrawingContextF
 swapColours = 
-    (\s a b -> s { primary_colour = b, secondary_colour = a })
-        <*> primary_colour <*> secondary_colour
+    (\s a b -> s { stroke_colour = b, fill_colour = a })
+        <*> stroke_colour <*> fill_colour
 
-bothPrimary :: DrawingContext -> DrawingContext
-bothPrimary = (\s a -> s { secondary_colour = a }) <*> primary_colour
+bothStrokeColour :: DrawingContextF
+bothStrokeColour = (\s a -> s { fill_colour = a }) <*> stroke_colour
 
-bothSecondary :: DrawingContext -> DrawingContext
-bothSecondary = (\s a -> s { primary_colour = a }) <*> secondary_colour
+bothFillColour :: DrawingContextF
+bothFillColour = (\s a -> s { stroke_colour = a }) <*> fill_colour
 
 
 
-primaryColour :: RGBi -> DrawingContext -> DrawingContext
-primaryColour rgb = \s -> s { primary_colour = rgb } 
+strokeColour :: RGBi -> DrawingContextF
+strokeColour rgb = \s -> s { stroke_colour = rgb } 
 
 
-secondaryColour :: RGBi -> DrawingContext -> DrawingContext
-secondaryColour rgb = \s -> s { secondary_colour = rgb } 
+fillColour :: RGBi -> DrawingContextF
+fillColour rgb = \s -> s { fill_colour = rgb } 
 
diff --git a/src/Wumpus/Basic/Graphic/PrimGraphic.hs b/src/Wumpus/Basic/Graphic/PrimGraphic.hs
--- a/src/Wumpus/Basic/Graphic/PrimGraphic.hs
+++ b/src/Wumpus/Basic/Graphic/PrimGraphic.hs
@@ -49,6 +49,7 @@
 
   , straightLine
   , straightLineBetween
+  , curveBetween
 
   , strokedRectangle
   , filledRectangle
@@ -66,7 +67,7 @@
 
   ) where
 
-import Wumpus.Basic.Graphic.BaseTypes
+import Wumpus.Basic.Graphic.Base
 import Wumpus.Basic.Graphic.DrawingContext
 import Wumpus.Basic.Graphic.Query
 
@@ -217,6 +218,10 @@
 
 straightLineBetween :: Fractional u => Point2 u -> Point2 u -> Graphic u
 straightLineBetween p1 p2 = openStroke $ path p1 [lineTo p2]
+
+curveBetween :: Fractional u 
+             => Point2 u -> Point2 u -> Point2 u -> Point2 u -> Graphic u
+curveBetween sp cp1 cp2 ep = openStroke $ path sp [curveTo cp1 cp2 ep]
 
 
 
diff --git a/src/Wumpus/Basic/Graphic/Query.hs b/src/Wumpus/Basic/Graphic/Query.hs
--- a/src/Wumpus/Basic/Graphic/Query.hs
+++ b/src/Wumpus/Basic/Graphic/Query.hs
@@ -8,7 +8,7 @@
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
 -- Stability   :  highly unstable
--- Portability :  GHC with TypeFamilies and more
+-- Portability :  GHC
 --
 -- Querying the Drawing Context.
 --
@@ -33,6 +33,7 @@
   , lineWidth
   , fontSize
   , markHeight
+  , markHalfHeight
   , lineSpacing
 
   -- 
@@ -48,7 +49,7 @@
   , monoVecToCenter  
   ) where
 
-import Wumpus.Basic.Graphic.BaseTypes
+import Wumpus.Basic.Graphic.Base
 import Wumpus.Basic.Graphic.DrawingContext
 
 
@@ -57,54 +58,57 @@
 import Control.Applicative
 
 
-textAttr :: DrawingF (RGBi,FontAttr)
-textAttr = (,) <$> asksDF primary_colour <*> asksDF font_props
+textAttr :: (Applicative m, DrawingCtxM m) => m (RGBi,FontAttr)
+textAttr = (,) <$> asksDC stroke_colour <*> asksDC font_props
 
 -- | Because @textAttr@ is so commonly used here is a functional
 -- version that avoids tupling.
 --
-withTextAttr :: (RGBi -> FontAttr -> a) -> DrawingF a
-withTextAttr fn = fn <$> asksDF primary_colour <*> asksDF font_props
+withTextAttr :: (Applicative m, DrawingCtxM m) 
+             => (RGBi -> FontAttr -> a) -> m a
+withTextAttr fn = fn <$> asksDC stroke_colour <*> asksDC font_props
 
 
-strokeAttr :: DrawingF (RGBi, StrokeAttr)
-strokeAttr = (,) <$> asksDF primary_colour <*> asksDF stroke_props
+strokeAttr :: (Applicative m, DrawingCtxM m) => m (RGBi, StrokeAttr)
+strokeAttr = (,) <$> asksDC stroke_colour <*> asksDC stroke_props
 
-withStrokeAttr :: (RGBi -> StrokeAttr -> a) -> DrawingF a
-withStrokeAttr fn = fn <$> asksDF primary_colour <*> asksDF stroke_props
+withStrokeAttr :: (Applicative m, DrawingCtxM m) 
+               => (RGBi -> StrokeAttr -> a) -> m a
+withStrokeAttr fn = fn <$> asksDC stroke_colour <*> asksDC stroke_props
 
 
-fillAttr :: DrawingF RGBi
-fillAttr = asksDF secondary_colour
+fillAttr :: (Applicative m, DrawingCtxM m) => m RGBi
+fillAttr = asksDC fill_colour
 
-withFillAttr :: (RGBi -> a) -> DrawingF a
-withFillAttr fn = fn <$> asksDF secondary_colour
+withFillAttr :: (Applicative m, DrawingCtxM m) => (RGBi -> a) -> m a
+withFillAttr fn = fn <$> asksDC fill_colour
 
-borderedAttr :: DrawingF (RGBi, StrokeAttr, RGBi)
-borderedAttr = (,,) <$> asksDF secondary_colour <*> asksDF stroke_props 
-                                                <*> asksDF primary_colour
+borderedAttr :: (Applicative m, DrawingCtxM m) => m (RGBi, StrokeAttr, RGBi)
+borderedAttr = (,,) <$> asksDC fill_colour <*> asksDC stroke_props 
+                                           <*> asksDC stroke_colour
 
-withBorderedAttr :: (RGBi -> StrokeAttr -> RGBi -> a) -> DrawingF a
+withBorderedAttr :: (Applicative m, DrawingCtxM m) 
+                 => (RGBi -> StrokeAttr -> RGBi -> a) -> m a
 withBorderedAttr fn = 
-    fn <$> asksDF secondary_colour <*> asksDF stroke_props 
-                                   <*> asksDF primary_colour
+    fn <$> asksDC fill_colour <*> asksDC stroke_props 
+                              <*> asksDC stroke_colour
 
 
 
 
-lineWidth :: DrawingF Double
-lineWidth = line_width <$> asksDF stroke_props
+lineWidth :: (Applicative m, DrawingCtxM m) => m Double
+lineWidth = line_width <$> asksDC stroke_props
 
-fontSize :: DrawingF Int
-fontSize = font_size <$> asksDF font_props
+fontSize :: (Applicative m, DrawingCtxM m) => m Int
+fontSize = font_size <$> asksDC font_props
 
 
 
 
 -- Maybe these functions are better as queries - i.e. functions
--- of type DrawingF, e.g.
+-- of type DrawingR, e.g.
 -- 
--- > lineSpacing :: Fractional u => DrawingF u
+-- > lineSpacing :: Fractional u => DrawingR u
 -- 
 -- Then the /client/ can just bound the answer directly
 -- rather than using 
@@ -112,19 +116,26 @@
 -- > askDF lineSpacing >>= \u -> ...
 --
 
-lineSpacing :: Fractional u => DrawingF u
+lineSpacing :: (Applicative m, DrawingCtxM m, Fractional u) => m u
 lineSpacing = 
     (\sz factor -> realToFrac $ factor * fromIntegral sz)
-      <$> asksDF (font_size . font_props) <*> asksDF line_spacing_factor
+      <$> asksDC (font_size . font_props) <*> asksDC line_spacing_factor
 
--- | A Mark is consider to be the height of a lowercase letter
--- in the current font.
--- 
--- Note better to use xlowerHeight
+-- | The /mark/ height is the height of a lowercase letter in the 
+-- current font.
+--
+-- Arrowheads, dots etc. should generally be drawn at the mark 
+-- height.
 -- 
-markHeight :: FromPtSize u => DrawingF u
-markHeight = (fromPtSize . xcharHeight . font_size) <$> asksDF font_props
+markHeight :: (Applicative m, DrawingCtxM m, FromPtSize u) => m u
+markHeight = (fromPtSize . xcharHeight . font_size) <$> asksDC font_props
 
+
+markHalfHeight :: (Applicative m, DrawingCtxM m, Fractional u, FromPtSize u) 
+               => m u
+markHalfHeight = (0.5*) <$> markHeight
+
+
 -- Note - there are probably enough functions that use just 
 -- markHeight to merit a withMarkHeight function.
 
@@ -135,28 +146,28 @@
 
 --------------------------------------------------------------------------------
 
-withFontSize :: (FontSize -> u) -> DrawingF u
-withFontSize fn = fn . font_size <$> asksDF font_props
+withFontSize :: (Applicative m, DrawingCtxM m) => (FontSize -> u) -> m u
+withFontSize fn = (fn . font_size) <$> asksDC font_props
 
-monoCharWidth :: FromPtSize u => DrawingF u
+monoCharWidth :: (Applicative m, DrawingCtxM m, FromPtSize u) => m u
 monoCharWidth = withFontSize (fromPtSize . charWidth)
 
-monoSpacerWidth :: FromPtSize u => DrawingF u
+monoSpacerWidth :: (Applicative m, DrawingCtxM m, FromPtSize u) => m u
 monoSpacerWidth = withFontSize (fromPtSize . spacerWidth)
 
 
-monoTextWidth :: FromPtSize u => Int -> DrawingF u
+monoTextWidth :: (Applicative m, DrawingCtxM m, FromPtSize u) => Int -> m u
 monoTextWidth n = withFontSize $ \sz -> fromPtSize $ textWidth sz n
 
 
-monoTextLength :: FromPtSize u => String -> DrawingF u
+monoTextLength :: (Applicative m, DrawingCtxM m, FromPtSize u) => String -> m u
 monoTextLength ss = monoTextWidth $ charCount ss
 
 
-monoTextHeight :: FromPtSize u => DrawingF u
+monoTextHeight :: (Applicative m, DrawingCtxM m, FromPtSize u) => m u
 monoTextHeight = withFontSize (fromPtSize . textHeight)
 
-monoNumeralHeight :: FromPtSize u => DrawingF u
+monoNumeralHeight :: (Applicative m, DrawingCtxM m, FromPtSize u) => m u
 monoNumeralHeight = withFontSize (fromPtSize . numeralHeight)
 
 
@@ -164,10 +175,10 @@
 --  
 -- \'x\' has no ascenders or descenders. 
 -- 
-monoLowerxHeight :: FromPtSize u => DrawingF u
+monoLowerxHeight :: (Applicative m, DrawingCtxM m, FromPtSize u) => m u
 monoLowerxHeight = withFontSize (fromPtSize . xcharHeight)
 
-monoDescenderDepth :: FromPtSize u => DrawingF u
+monoDescenderDepth :: (Applicative m, DrawingCtxM m, FromPtSize u) => m u
 monoDescenderDepth = withFontSize (fromPtSize . descenderDepth)
 
 
@@ -177,16 +188,18 @@
 -- Note - the width will generally be a over-estimate for 
 -- non-monospaced fonts.
 -- 
-monoTextDimensions :: (Num u, Ord u, FromPtSize u) => String -> DrawingF (u,u)
+monoTextDimensions :: (Applicative m, DrawingCtxM m, Num u, Ord u, FromPtSize u)
+                   => String -> m (u,u)
 monoTextDimensions ss = 
     (\sz -> post $ textBounds sz zeroPt ss) 
-      <$> asksDF (font_size . font_props)
+      <$> asksDC (font_size . font_props)
   where
     post bb = (boundaryWidth bb, boundaryHeight bb)
 
 
 -- | Vector from baseline left to center
-monoVecToCenter :: (Fractional u, Ord u, FromPtSize u) 
-                => String -> DrawingF (Vec2 u)
+monoVecToCenter :: ( Applicative m, DrawingCtxM m
+                   , Fractional u, Ord u, FromPtSize u ) 
+                => String -> m (Vec2 u)
 monoVecToCenter ss = (\(w,h) dy -> vec (0.5*w) (0.5*h - dy)) 
                        <$> monoTextDimensions ss <*> monoDescenderDepth
diff --git a/src/Wumpus/Basic/Graphic/ScalingContext.hs b/src/Wumpus/Basic/Graphic/ScalingContext.hs
--- a/src/Wumpus/Basic/Graphic/ScalingContext.hs
+++ b/src/Wumpus/Basic/Graphic/ScalingContext.hs
@@ -17,8 +17,10 @@
 
 module Wumpus.Basic.Graphic.ScalingContext
   (
-    ScalingContext(..)
 
+    ScalingM(..)
+  , ScalingContext(..)
+
   , Scaling
   , runScaling
   , ScalingT
@@ -33,12 +35,28 @@
 
   ) where
 
-import Wumpus.Basic.Graphic.BaseClasses
+import Wumpus.Basic.Graphic.Base
 
 import Wumpus.Core				-- package: wumpus-core
 
 import Control.Applicative
 
+
+
+-- | Scaling...
+--
+class Monad m => ScalingM m where
+  type XDim m :: *
+  type YDim m :: *
+  scaleX :: (u ~ MonUnit m, ux ~ XDim m) => ux -> m u
+  scaleY :: (u ~ MonUnit m, uy ~ YDim m) => uy -> m u
+  scalePt  :: (u ~ MonUnit m, ux ~ XDim m, uy ~ YDim m) 
+           => ux -> uy -> m (Point2 u)
+  scaleVec :: (u ~ MonUnit m, ux ~ XDim m, uy ~ YDim m) 
+           => ux -> uy -> m (Vec2 u)
+
+
+
 data ScalingContext ux uy u = ScalingContext
       { scale_in_x  :: ux -> u
       , scale_in_y  :: uy -> u
@@ -128,8 +146,8 @@
 -- Cross instances - needed to run SalingT /locally/ in Drawing.
 
 instance DrawingCtxM m => DrawingCtxM (ScalingT ux uy u m) where
-  askCtx   = ScalingT $ \_ -> askCtx >>= \dctx -> return dctx
-  localCtx ctx mf = ScalingT $ \sctx -> localCtx ctx (getScalingT mf sctx)
+  askDC           = ScalingT $ \_    -> askDC >>= \dctx -> return dctx
+  localize upd mf = ScalingT $ \sctx -> localize upd (getScalingT mf sctx)
 
 
 instance (Monad m, TraceM m, u ~ MonUnit m) => TraceM (ScalingT ux uy u m) where
diff --git a/src/Wumpus/Basic/Monads/TurtleMonad.hs b/src/Wumpus/Basic/Monads/TurtleMonad.hs
--- a/src/Wumpus/Basic/Monads/TurtleMonad.hs
+++ b/src/Wumpus/Basic/Monads/TurtleMonad.hs
@@ -125,8 +125,8 @@
 -- Cross instances
 
 instance DrawingCtxM m => DrawingCtxM (TurtleT u m) where
-  askCtx   = TurtleT $ \s -> askCtx >>= \ ctx -> return (ctx,s)
-  localCtx ctx mf = TurtleT $ \s -> localCtx ctx (getTurtleT mf s)
+  askDC           = TurtleT $ \s -> askDC >>= \ ctx -> return (ctx,s)
+  localize upd mf = TurtleT $ \s -> localize upd (getTurtleT mf s)
 
 
 -- This needs undecidable instances...
diff --git a/src/Wumpus/Basic/Paths/Base.hs b/src/Wumpus/Basic/Paths/Base.hs
--- a/src/Wumpus/Basic/Paths/Base.hs
+++ b/src/Wumpus/Basic/Paths/Base.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# OPTIONS -Wall #-}
 
@@ -22,23 +23,38 @@
 module Wumpus.Basic.Paths.Base
   ( 
 
-    Path(..)
-  , PathSeg(..)
-  , Curve(..)
-  , Line(..)
-  , emptyPath
-  , pline
-  , pcurve
-  , addSegment
-  , segmentLength
-  , segmentStart
-  , segmentEnd
+    Path
+  , DPath
+  , length
+  , line
+  , curve
+  , tracePoints
+  , curveByAngles
 
   , toPrimPath 
   , toPrimPathU
-  , subdivide
-  , subdividet
-    
+
+
+  , tipL
+  , tipR
+
+  , shortenBoth
+  , shortenL
+  , shortenR
+  , directionL
+  , directionR
+
+  , midpoint
+
+  , PathViewL(..)
+  , DPathViewL
+  , PathViewR(..)
+  , DPathViewR
+  , PathSegment(..)
+  , DPathSegment
+  , pathViewL
+  , pathViewR
+
   ) where
 
 
@@ -48,77 +64,127 @@
 import Data.VectorSpace
 
 import Data.Maybe
-import Data.Sequence ( Seq, ViewL(..), viewl, (|>)  )
+import Data.Monoid
+import Data.Sequence ( Seq, (><), ViewL(..), viewl
+                     , ViewR(..), viewr, (<|) , (|>) )
 import qualified Data.Sequence as S
 
--- Note - path doesn\'t need a drawing context for 
--- construction...
---
--- type PathF u = Point2 u -> Point2 u -> Path u
-
+import Prelude hiding ( length )
 
-data Path u = Path 
-       { path_length    :: u 
-       , path_elements  :: Seq (PathSeg u)
-       }
+data Path u = PathEmpty 
+            | Path { _path_length   :: u 
+                   , _path_start    :: Point2 u
+                   , _path_elements :: Seq (PathSeg u)
+                   , _path_end      :: Point2 u
+                   }
   deriving (Eq,Ord,Show)
 
+type DPath = Path Double
 
+-- Annotating each segment with length is \*\* good \*\*.
+-- Makes it much more efficient to find the midpoint.
+--
+-- But what do we do about the start point:
+--
+-- a) put it in the segment - too much info in the type, allows 
+-- consistency problems vis-a-vis gaps in the path.
+--
+-- b) leave it out - too little info in the type, allows 
+-- consistency problems with length.
+--
+-- Option (a) is probably most convenient espcially as the 
+-- constructors won\'t be exported.
+
 -- Annotation is length...
 -- 
-data PathSeg u = LineSeg  u (Line u)
-               | CurveSeg u (Curve u)
+data PathSeg u = LineSeg  { _line_length  :: u 
+                          , _line_start   :: Point2 u
+                          , _line_end     :: Point2 u
+                          }
+               | CurveSeg { _curve_length :: u 
+                          , _curve_start  :: Point2 u
+                          , _ctrl_pt_one  :: Point2 u
+                          , _ctrl_pt_two  :: Point2 u
+                          , _curve_end    :: Point2 u
+                          }
   deriving (Eq,Ord,Show)
 
 
-data Curve u = Curve 
-      { curve_start :: Point2 u
-      , ctrl_point1 :: Point2 u
-      , ctrl_point2 :: Point2 u
-      , curve_end   :: Point2 u
-      }
-  deriving (Eq,Ord,Show)
+type instance DUnit (Path u)    = u
+type instance DUnit (PathSeg u) = u
 
-data Line u = Line 
-      { line_start  :: Point2 u
-      , line_end    :: Point2 u 
-      }
-  deriving (Eq,Ord,Show)
 
 
-emptyPath :: Num u => Path u 
-emptyPath = Path 0 S.empty
+length :: Num u => Path u -> u
+length PathEmpty      = 0
+length (Path u _ _ _) = u
 
+append :: Floating u => Path u -> Path u -> Path u
+append PathEmpty b         = b
+append a         PathEmpty = a
+append (Path len1 start1 se1 end1) (Path len2 start2 se2 end2) 
+    | end1 == start2 = Path (len1+len2) start1 (se1 >< se2) end2 
+    | otherwise      = let join      = lineSegment end1 start2
+                           total_len = len1 + len2 + segmentLength join
+                       in Path total_len start1 (se1 >< (join <| se2)) end2 
 
-addSegment :: Num u => Path u -> PathSeg u -> Path u
-addSegment (Path n se) e@(LineSeg u _)  = Path (n+u) (se |> e)
-addSegment (Path n se) e@(CurveSeg u _) = Path (n+u) (se |> e)
 
+instance Floating u => Monoid (Path u) where
+  mempty  = PathEmpty
+  mappend = append
+
+
+
 segmentLength :: PathSeg u -> u
-segmentLength (LineSeg  u _) = u
-segmentLength (CurveSeg u _) = u
+segmentLength (LineSeg u _ _)       = u
+segmentLength (CurveSeg u _ _ _ _)  = u
 
+
 segmentStart :: PathSeg u -> Point2 u
-segmentStart (LineSeg  _ (Line p0 _))      = p0
-segmentStart (CurveSeg _ (Curve p0 _ _ _)) = p0
+segmentStart (LineSeg  _ p0 _)      = p0
+segmentStart (CurveSeg _ p0 _ _ _)  = p0
 
 segmentEnd :: PathSeg u -> Point2 u
-segmentEnd (LineSeg  _ (Line _ p1))      = p1
-segmentEnd (CurveSeg _ (Curve _ _ _ p3)) = p3
+segmentEnd (LineSeg  _ _ p1)        = p1
+segmentEnd (CurveSeg _ _ _ _ p3)    = p3
 
 
 
 
-pline :: Floating u => Point2 u -> Point2 u -> PathSeg u 
-pline p0 p1 = LineSeg (vlength $ pvec p0 p1) (Line p0 p1)
+lineSegment :: Floating u => Point2 u -> Point2 u -> PathSeg u 
+lineSegment p0 p1 = let v = vlength $ pvec p0 p1 in LineSeg v p0 p1
 
-pcurve :: (Floating u, Ord u)
-       => Point2 u -> Point2 u -> Point2 u -> Point2 u -> PathSeg u 
-pcurve p0 p1 p2 p3 = 
-    let c = Curve p0 p1 p2 p3 in CurveSeg (curveLength c) c
+line :: Floating u => Point2 u -> Point2 u -> Path u 
+line p0 p1 = let v = vlength $ pvec p0 p1 
+             in Path v p0 (S.singleton $ LineSeg v p0 p1) p1
+   
 
+curve :: (Floating u, Ord u)
+      => Point2 u -> Point2 u -> Point2 u -> Point2 u -> Path u 
+curve p0 p1 p2 p3 = let v = curveLength p0 p1 p2 p3
+                    in Path v p0 (S.singleton $ CurveSeg v p0 p1 p2 p3) p3
 
--- | Turn a BasicPath into an ordinary Path.
+
+tracePoints :: Floating u => [Point2 u] -> Path u
+tracePoints []       = PathEmpty
+tracePoints [a]      = line a a
+tracePoints (a:b:xs) = step (line a b) b xs
+  where
+    step acc _ []     = acc
+    step acc e (y:ys) = step (acc `mappend` line e y) y ys
+
+
+curveByAngles :: (Floating u, Ord u) 
+              => Point2 u -> Radian -> Radian -> Point2 u -> Path u
+curveByAngles start cin cout end = curve start (start .+^ v1) (end .+^ v2) end
+  where
+    sz     = 0.375 * (vlength $ pvec start end)
+    v1     = avec cin  sz
+    v2     = avec cout sz
+
+
+
+-- | Turn a Path into an ordinary PrimPath.
 --
 -- An empty path returns Nothing - the path representation in 
 -- Wumpus-Core does not allow empty paths - a path must always
@@ -129,21 +195,22 @@
 -- segment.
 --
 toPrimPath :: Path u -> Maybe (PrimPath u)
-toPrimPath = step1 . viewl . path_elements
+toPrimPath PathEmpty         = Nothing
+toPrimPath (Path _ _ segs _) = step1 $ viewl segs
   where
-    step1 EmptyL               = Nothing
-    step1 (e :< se)            = let (p1,s) = elemP e in 
-                                 Just $ path p1 $ s : step2 (viewl se)
+    step1 EmptyL                  = Nothing
+    step1 (e :< se)               = let (start,a) = seg1 e in 
+                                    Just $ path start $ a : step2 (viewl se)
 
-    step2 EmptyL               = []
-    step2 (e :< se)            = snd (elemP e) : step2 (viewl se)
+    step2 EmptyL                  = []
+    step2 (e :< se)               = seg2 e : step2 (viewl se)
     
-    elemP (LineSeg  _ l)       = elemL l
-    elemP (CurveSeg _ c)       = elemC c
+    seg1 (LineSeg  _ p0 p1)       = (p0, lineTo p1)
+    seg1 (CurveSeg _ p0 p1 p2 p3) = (p0, curveTo p1 p2 p3)
  
-    elemL (Line p1 p2)         = (p1, lineTo p2)
-    elemC (Curve p1 p2 p3 p4)  = (p1, curveTo p2 p3 p4)
-
+    seg2 (LineSeg  _ _  p1)       = lineTo p1
+    seg2 (CurveSeg _ _  p1 p2 p3) = curveTo p1 p2 p3
+ 
 toPrimPathU :: Path u -> PrimPath u
 toPrimPathU = fromMaybe errK . toPrimPath
   where
@@ -154,14 +221,18 @@
 --------------------------------------------------------------------------------
 -- Curve length
 
-curveLength :: (Floating u, Ord u) => Curve u -> u
-curveLength = gravesenLength 0.1
+data StrictCurve u = Curve !(Point2 u) !(Point2 u) !(Point2 u) !(Point2 u)
 
+curveLength :: (Floating u, Ord u)      
+            => Point2 u -> Point2 u -> Point2 u -> Point2 u -> u
+curveLength p0 p1 p2 p3 = gravesenLength 0.1 $ Curve p0 p1 p2 p3
+
+
 -- | Jens Gravesen\'s bezier arc-length approximation. 
 --
 -- Note this implementation is parametrized on error tolerance.
 --
-gravesenLength :: (Floating u, Ord u) => u -> Curve u -> u
+gravesenLength :: (Floating u, Ord u) => u -> StrictCurve u -> u
 gravesenLength err_tol crv = step crv where
   step c = let l1 = ctrlPolyLength c
                l0 = cordLength c
@@ -170,12 +241,12 @@
               else 0.5*l0 + 0.5*l1
 
 
-ctrlPolyLength :: Floating u => Curve u -> u
+ctrlPolyLength :: Floating u => StrictCurve u -> u
 ctrlPolyLength (Curve p0 p1 p2 p3) = len p0 p1 + len p1 p2 + len p2 p3
   where
     len pa pb = vlength $ pvec pa pb
 
-cordLength :: Floating u => Curve u -> u
+cordLength :: Floating u => StrictCurve u -> u
 cordLength (Curve p0 _ _ p3) = vlength $ pvec p0 p3
 
 
@@ -187,7 +258,8 @@
 
 -- | Curve subdivision via de Casteljau\'s algorithm.
 --
-subdivide :: Fractional u => Curve u -> (Curve u, Curve u)
+subdivide :: Fractional u 
+          => StrictCurve u -> (StrictCurve u, StrictCurve u)
 subdivide (Curve p0 p1 p2 p3) =
     (Curve p0 p01 p012 p0123, Curve p0123 p123 p23 p3)
   where
@@ -201,7 +273,7 @@
 -- | subdivide with an affine weight along the line...
 --
 subdividet :: Real u
-           => u -> Curve u -> (Curve u, Curve u)
+           => u -> StrictCurve u -> (StrictCurve u, StrictCurve u)
 subdividet t (Curve p0 p1 p2 p3) = 
     (Curve p0 p01 p012 p0123, Curve p0123 p123 p23 p3)
   where
@@ -215,3 +287,196 @@
 affineCombination :: Real u => u -> Point2 u -> Point2 u -> Point2 u
 affineCombination a p1 p2 = p1 .+^ a *^ (p2 .-. p1)
 
+--------------------------------------------------------------------------------
+-- tips 
+
+tipL :: Path u -> Maybe (Point2 u)
+tipL PathEmpty       = Nothing
+tipL (Path _ sp _ _) = Just sp
+
+
+tipR :: Path u -> Maybe (Point2 u)
+tipR PathEmpty       = Nothing
+tipR (Path _ _ _ ep) = Just ep
+
+
+-- | Shorten both ends...
+--
+shortenBoth :: (Real u, Floating u) => u -> Path u -> Path u
+shortenBoth u p = shortenL u $ shortenR u p
+
+--------------------------------------------------------------------------------
+-- shorten from the left...
+
+shortenL :: (Real u, Floating u) => u -> Path u -> Path u
+shortenL _ PathEmpty          = PathEmpty
+shortenL n (Path u _ segs ep) 
+    | n >= u                  = PathEmpty
+    | otherwise               = step n (viewl segs)
+  where
+    step _ EmptyL     = PathEmpty
+    step d (e :< se)  = let z  = segmentLength e in
+                        case compare d z of
+                          GT -> step (d-z) (viewl se)
+                          EQ -> makeLeftPath (u-n) se ep
+                          LT -> let e1 = shortenSegL d e
+                                in Path (u-n) (segmentStart e1) (e1 <| se) ep
+
+
+makeLeftPath :: u -> Seq (PathSeg u) -> Point2 u -> Path u
+makeLeftPath u se ep = 
+    case viewl se of
+      EmptyL   -> PathEmpty 
+      (e :< _) -> Path u (segmentStart e) se ep
+
+
+shortenSegL :: (Real u, Floating u) => u -> PathSeg u -> PathSeg u
+shortenSegL n (LineSeg  u p0 p1)        = 
+    LineSeg  (u-n) (shortenLineL n p0 p1) p1
+
+shortenSegL n (CurveSeg u p0 p1 p2 p3)  = 
+    let (Curve p0' p1' p2' p3') = snd $ subdividet (n/u) (Curve p0 p1 p2 p3)
+    in CurveSeg (u-n) p0' p1' p2' p3'
+
+
+shortenLineL :: (Real u, Floating u) 
+             => u -> Point2 u -> Point2 u -> Point2 u
+shortenLineL n p0 p1 = p0 .+^ v
+  where
+    v0 = p1 .-. p0
+    v  = avec (direction v0) n
+
+
+
+--------------------------------------------------------------------------------
+-- shorten from the right ...
+ 
+shortenR :: (Real u, Floating u) => u -> Path u -> Path u
+shortenR _ PathEmpty          = PathEmpty
+shortenR n (Path u sp segs _) 
+    | n >= u                  = PathEmpty
+    | otherwise               = step n (viewr segs)
+  where
+    step _ EmptyR     = PathEmpty
+    step d (se :> e)  = let z = segmentLength e in
+                        case compare d z of
+                          GT -> step (d-z) (viewr se)
+                          EQ -> makeRightPath n sp se
+                          LT -> let e1 = shortenSegR d e
+                                in Path (u-n) sp (se |> e1) (segmentEnd e1)
+                         
+
+makeRightPath :: u -> Point2 u -> Seq (PathSeg u) -> Path u
+makeRightPath u sp se = 
+    case viewr se of
+      EmptyR   -> PathEmpty 
+      (_ :> e) -> Path u sp se (segmentEnd e)
+
+
+
+shortenSegR :: (Real u, Floating u) => u -> PathSeg u -> PathSeg u
+shortenSegR n (LineSeg  u p0 p1)        = 
+    LineSeg  (u-n) p0 (shortenLineR n p0 p1) 
+
+shortenSegR n (CurveSeg u p0 p1 p2 p3)  = 
+    let (Curve p0' p1' p2' p3') = fst $ subdividet ((u-n)/u) (Curve p0 p1 p2 p3)
+    in CurveSeg (u-n) p0' p1' p2' p3'
+
+
+shortenLineR :: (Real u, Floating u) 
+             => u -> Point2 u -> Point2 u -> Point2 u
+shortenLineR n p0 p1 = p1 .+^ v
+  where
+    v0 = p0 .-. p1
+    v  = avec (direction v0) n
+
+
+
+
+--------------------------------------------------------------------------------
+-- line direction
+
+-- | Direction of empty path is considered to be 0.
+--
+directionL :: (Real u, Floating u) => Path u -> Radian
+directionL PathEmpty        = 0
+directionL (Path _ _ se _)  = step $ viewl se
+  where
+    step (LineSeg  _ p0 p1 :< _)      = lineDirection p1 p0  -- 1-to-0
+    step (CurveSeg _ p0 p1 _ _ :< _)  = lineDirection p1 p0
+    step _                            = 0
+
+
+-- | Direction of empty path is considered to be 0.
+--
+directionR :: (Real u, Floating u) => Path u -> Radian
+directionR PathEmpty       = 0
+directionR (Path _ _ se _) = step $ viewr se
+  where
+    step (_ :> LineSeg  _ p0 p1)      = lineDirection p0 p1
+    step (_ :> CurveSeg _ _  _ p2 p3) = lineDirection p2 p3
+    step _                            = 0
+
+{-
+-- Note - previously Paths were using this version of 
+-- lineDirection
+-- 
+-- Needs testing as to whether the new one does what is expected. 
+--
+lineDirection :: (Real u, Floating u) => Point2 u -> Point2 u -> Radian
+lineDirection p0 p1 = direction (pvec p0 p1)
+-}
+
+
+
+--------------------------------------------------------------------------------
+
+
+-- Return direction as well because the calculation is expensive...
+--
+midpoint :: (Real u, Floating u) => Path u -> Maybe (Point2 u, Radian)
+midpoint pa = let u = length pa in
+  if u == 0 then Nothing 
+            else let pa1 = shortenR (u/2) pa 
+                 in fmap (\a -> (a,directionR pa1)) $ tipR pa1
+
+
+--------------------------------------------------------------------------------
+
+data PathViewL u = EmptyPathL
+                 | PathSegment u :<< Path u
+  deriving (Eq,Ord,Show) 
+
+type DPathViewL = PathViewL Double
+
+data PathViewR u = EmptyPathR
+                 | Path u :>> PathSegment u
+  deriving (Eq,Ord,Show) 
+
+type DPathViewR = PathViewR Double
+
+
+data PathSegment u = Line1  (Point2 u) (Point2 u)
+                   | Curve1 (Point2 u) (Point2 u) (Point2 u) (Point2 u)
+  deriving (Eq,Ord,Show) 
+
+type DPathSegment = PathSegment Double
+
+type instance DUnit (PathViewL u)   = u
+type instance DUnit (PathViewR u)   = u
+type instance DUnit (PathSegment u) = u
+
+pathViewL :: Num u => Path u -> PathViewL u
+pathViewL PathEmpty          = EmptyPathL
+pathViewL (Path u _ segs ep) = case viewl segs of
+    EmptyL                         -> EmptyPathL 
+    (LineSeg v p0 p1 :< se)        -> Line1 p0 p1 :<< Path (u-v) p1 se ep
+    (CurveSeg v p0 p1 p2 p3 :< se) -> Curve1 p0 p1 p2 p3 :<< Path (u-v) p3 se ep
+
+
+pathViewR :: Num u => Path u -> PathViewR u
+pathViewR PathEmpty          = EmptyPathR
+pathViewR (Path u _ segs ep) = case viewr segs of
+    EmptyR                         -> EmptyPathR
+    (se :> LineSeg v p0 p1)        -> Path (u-v) p1 se ep :>> Line1 p0 p1
+    (se :> CurveSeg v p0 p1 p2 p3) -> Path (u-v) p3 se ep :>> Curve1 p0 p1 p2 p3
diff --git a/src/Wumpus/Basic/Paths/Connectors.hs b/src/Wumpus/Basic/Paths/Connectors.hs
--- a/src/Wumpus/Basic/Paths/Connectors.hs
+++ b/src/Wumpus/Basic/Paths/Connectors.hs
@@ -10,8 +10,7 @@
 -- Stability   :  highly unstable
 -- Portability :  GHC
 --
--- Extended path type - more amenable for complex drawings than
--- the type in Wumpus-Core.
+-- Library of connector paths...
 --
 -- \*\* WARNING \*\* this module is an experiment, and may 
 -- change significantly or even be dropped from future revisions.
@@ -21,191 +20,67 @@
 module Wumpus.Basic.Paths.Connectors 
   ( 
 
-    ConnPath
-  , connectS
+    Connector
+  , connect
   , vhconn
   , hvconn
-  , arbv
-  , arbh
+  , vhvconn
+  , hvhconn
   , curveconn
   , joint
-  , pathGraphic
-  , fillPath
 
-  , shorten
-  , shortenL
-  , shortenR
-  , midpoint
-  , directionL
-  , directionR
 
+
   ) where
 
-import Wumpus.Basic.Graphic
 import Wumpus.Basic.Paths.Base
-import Wumpus.Basic.Paths.Construction
 
 import Wumpus.Core                              -- package: wumpus-core
 
 import Data.AffineSpace                         -- package: vector-space
 
-import Data.Sequence
+import Prelude hiding ( length )
 
-type ConnPath u = Point2 u -> Point2 u -> Path u
+type Connector u = Point2 u -> Point2 u -> Path u
 
-connectS :: Floating u => ConnPath u
-connectS = \p1 p2 -> execPath p1 $ lineto p2
+connect :: Floating u => Connector u
+connect = line
 
-vhconn :: Floating u => ConnPath u
-vhconn p1 p2 = execPath p1 $ verticalHorizontal p2
+vhconn :: Floating u => Connector u
+vhconn p1@(P2 x1 _) p2@(P2 _ y2) = 
+    let mid = P2 x1 y2 in tracePoints [p1, mid, p2]
 
-hvconn :: Floating u => ConnPath u
-hvconn p1 p2 = execPath p1 $ horizontalVertical p2
+hvconn :: Floating u => Connector u
+hvconn p1@(P2 _ y1) p2@(P2 x2 _) = 
+    let mid = P2 x2 y1 in tracePoints [p1, mid, p2]
 
-arbv :: Floating u => u -> ConnPath u
-arbv v p1@(P2 x1 y1) (P2 x2 y2) = execPath p1 $ vline v >> hline dx >> vline dy
+vhvconn :: Floating u => u -> Connector u
+vhvconn v p1@(P2 x1 _) p2@(P2 x2 _) = tracePoints [p1, a1, a2, p2]
   where
-    dx = x2 - x1
-    dy = y2 - (y1+v)
+    a1 = p1 .+^ vvec v
+    a2 = a1 .+^ hvec (x2 - x1)
 
 
-arbh :: Floating u => u -> ConnPath u
-arbh h p1@(P2 x1 y1) (P2 x2 y2) = execPath p1 $ hline h >> vline dy >> hline dx
+hvhconn :: Floating u => u -> Connector u
+hvhconn h p1@(P2 _ y1) p2@(P2 _ y2) = tracePoints [p1,a1,a2,p2]
   where
-    dx = x2 - (x1+h)
-    dy = y2 - y1
+    a1 = p1 .+^ hvec h
+    a2 = a1 .+^ vvec (y2 - y1)
 
-curveconn :: (Floating u, Ord u) => Radian -> Radian -> ConnPath u
-curveconn r1 r2 p1 p2 = execPath p1 $ curveto r1 r2 p2
+curveconn :: (Floating u, Ord u) => Radian -> Radian -> Connector u
+curveconn r1 r2 p1 p2 = curveByAngles p1 r1 r2 p2
 
 
-joint :: (Real u, Floating u) => u -> ConnPath u 
+joint :: (Real u, Floating u) => u -> Connector u 
 joint u p1@(P2 x1 y1) p2@(P2 x2 y2) = 
-    execPath p1 $ lineto (mid_pt .+^ avec perp_ang u) >> lineto p2
+    tracePoints [p1, mid_pt .+^ avec perp_ang u, p2]
   where
     mid_pt    = P2 (x1 + 0.5*(x2-x1)) (y1 + 0.5*(y2-y1))
     perp_ang  = (pi*0.5) + direction (pvec p2 p1) 
 
--- This one might be more useful...
--- 
--- ... No - can\'t a add tips to this one.
---
-pathGraphic :: Num u => ConnPath u -> ConnGraphic u
-pathGraphic bpath = \p1 p2 -> openStroke $ toPrimPathU $ bpath p1 p2
 
 
--- Mind out for name clash...
 
--- | Closes and fills a path
---
-fillPath :: Num u => Path u -> Graphic u
-fillPath = filledPath . toPrimPathU
-
-
-
-shorten  :: (Real u, Floating u, Ord u) => u -> Path u -> Path u
-shorten u p = shortenL u $ shortenR u p
-
 --------------------------------------------------------------------------------
--- shorten from the left...
 
-shortenL :: (Real u, Floating u, Ord u) => u -> Path u -> Path u
-shortenL n (Path u bp) | n >= u         = emptyPath
-                       | otherwise      = step n (viewl bp)
-  where
-    step _ EmptyL     = emptyPath
-    step d (e :< se)  = let z = segmentLength e in
-                        case compare d z of
-                          GT -> step (d-z) (viewl se)
-                          EQ -> Path (u-n) se
-                          _  -> Path (u-n) (shortenSegL d e <| se)
 
-
-shortenSegL :: (Real u, Floating u) => u -> PathSeg u -> PathSeg u
-shortenSegL n (LineSeg  u l) = LineSeg  (u-n) (shortenLineL n l) 
-shortenSegL n (CurveSeg u c) = CurveSeg (u-n) (snd $ subdividet (n/u) c)
-
-shortenLineL :: (Real u, Floating u) => u -> Line u -> Line u
-shortenLineL n (Line p1 p2) = Line (p1 .+^ v) p2
-  where
-    v0 = p2 .-. p1
-    v  = avec (direction v0) n
-    
---------------------------------------------------------------------------------
--- shorten from the right ...
- 
-shortenR :: (Real u, Floating u, Ord u) => u -> Path u -> Path u
-shortenR n (Path u bp) | n >= u         = emptyPath
-                       | otherwise      = step n (viewr bp)
-  where
-    step _ EmptyR     = emptyPath
-    step d (se :> e)  = let z = segmentLength e in
-                        case compare d z of
-                          GT -> step (d-z) (viewr se)
-                          EQ -> Path (u-n) se
-                          _  -> Path (u-n) (se |> shortenSegR d e)
-
-
-
-shortenSegR :: (Real u, Floating u) => u -> PathSeg u -> PathSeg u
-shortenSegR n (LineSeg  u l) = LineSeg  (u-n) (shortenLineR n l) 
-shortenSegR n (CurveSeg u c) = CurveSeg (u-n) (fst $ subdividet ((u-n)/u) c)
-
-
-shortenLineR :: (Real u, Floating u) => u -> Line u -> Line u
-shortenLineR n (Line p1 p2) = Line p1 (p2 .+^ v)
-  where
-    v0 = p1 .-. p2
-    v  = avec (direction v0) n
-
-
-
---------------------------------------------------------------------------------
-
--- This should return direction as well...
---
-midpoint :: (Real u, Floating u) => Path u -> Point2 u
-midpoint (Path u bp) = step (u/2) (viewl bp)
-  where
-    step _ EmptyL    = zeroPt
-    step d (e :< se) = let z = segmentLength e in
-                       case compare d z of
-                         GT -> step (d-z) (viewl se)
-                         EQ -> segmentEnd e
-                         _  -> segmentEnd $ shortenSegR d e 
-
-
-
-
-
---------------------------------------------------------------------------------
--- tangents
-
-
-directionL :: (Real u, Floating u) => Path u -> Radian
-directionL (Path _ se) = step $ viewl se
-  where
-    step (LineSeg  _ l :< _) = lineDirectionL l 
-    step (CurveSeg _ c :< _) = curveDirectionL c
-    step _                   = 0
-
-directionR :: (Real u, Floating u) => Path u -> Radian
-directionR (Path _ se) = step $ viewr se
-  where
-    step (_ :> LineSeg  _ l) = lineDirectionR l 
-    step (_ :> CurveSeg _ c) = curveDirectionR c
-    step _                   = 0
-
-
-lineDirectionL :: (Real u, Floating u) => Line u -> Radian
-lineDirectionL (Line p0 p1) = direction (pvec p1 p0)
-
-lineDirectionR :: (Real u, Floating u) => Line u -> Radian
-lineDirectionR (Line p0 p1) = direction (pvec p0 p1)
-
-curveDirectionL :: (Real u, Floating u) => Curve u -> Radian
-curveDirectionL (Curve p0 p1 _ _) = direction $ pvec p1 p0
-
-curveDirectionR :: (Real u, Floating u) => Curve u -> Radian
-curveDirectionR (Curve _ _ p2 p3) = direction $ pvec p2 p3
- 
diff --git a/src/Wumpus/Basic/Paths/Construction.hs b/src/Wumpus/Basic/Paths/Construction.hs
--- a/src/Wumpus/Basic/Paths/Construction.hs
+++ b/src/Wumpus/Basic/Paths/Construction.hs
@@ -12,7 +12,7 @@
 -- Stability   :  highly unstable
 -- Portability :  GHC
 --
--- Build paths.
+-- Build paths monadically.
 --
 -- \*\* WARNING \*\* this module is an experiment, and may 
 -- change significantly or even be dropped from future revisions.
@@ -25,12 +25,17 @@
     PathM
   , runPath
   , execPath
+
+  , tip
+
   , lineto
   , rlineto
-  , vline
   , hline
+  , vline
+
   , bezierto
   , curveto
+
   , verticalHorizontal
   , horizontalVertical
 
@@ -43,15 +48,29 @@
 import Data.AffineSpace                         -- package: vector-space
 
 import Control.Applicative
+import Data.Maybe
+import Data.Monoid
 
-data PathState u = PathState 
+
+-- Are connectors and paths quite different things?
+--
+-- It looks like they are - connectors always know start and end 
+-- points.
+--
+
+
+-- State monad version is quite good - it ameliorates the problem
+-- of joing to the end point of an empty path...
+
+data St u = St
       { current_point :: Point2 u 
-      , path_accum    :: Path u
+      , path_acc      :: Path u
       }
 
-newtype PathM u a = PathM { getPathM :: PathState u -> (a,PathState u) }
 
+newtype PathM u a = PathM { getPathM :: St u -> (a,St u) }
 
+
 instance Functor (PathM u) where
   fmap f mf = PathM $ \s -> let (a,s1) = getPathM mf s in (f a,s1)
 
@@ -68,77 +87,64 @@
                             (getPathM . k) a s1
 
 
--- Design note - it is probably best to follow LRText and have
--- the path monad isolated from the trace monad. While it would 
--- be nice to trace arbitrary labels as we go, state changes to the 
--- DrawingCtx would make things complicated.
---
 
-{-
-openStrokePathM :: (Num u, TraceM m, DrawingCtxM m, u ~ MonUnit m) 
-                => Point2 u -> PathM u a -> m a
-openStrokePathM pt ma = let (a,p) = runPath pt ma  in 
-    draw (openStroke $ toPrimPathU p) >> return a
--}
-
--- Running the path is agnostic to the DrawingCtx.
-
-runPath :: Num u => Point2 u -> PathM u a -> (a, Path u)
-runPath start mf = let (a,s') = getPathM mf s in (a, path_accum s')
+-- Running the path is (probably) agnostic to the DrawingCtx.
+--
+runPath :: Floating u => Point2 u -> PathM u a -> (a, Path u)
+runPath start mf = let (a,s') = getPathM mf s in (a, path_acc s')
   where
-    s = PathState { current_point = start
-                  , path_accum    = emptyPath
-                  }
+    s = St { current_point = start
+           , path_acc      = mempty
+           }
 
-execPath :: Num u => Point2 u -> PathM u a -> Path u
+execPath :: Floating u => Point2 u -> PathM u a -> Path u
 execPath start mf = snd $ runPath start mf
 
+snocline :: Floating u => Vec2 u -> PathM u ()
+snocline v = PathM $ \(St pt ac) -> let ep = pt .+^ v 
+                                    in ((), St ep (ac `mappend` line pt ep))
 
-exchTip :: Point2 u -> (Point2 u -> Path u -> Path u) -> PathM u ()
-exchTip new updP = 
-    PathM $ \(PathState old bp) -> ((), PathState new (updP old bp)) 
 
 tip :: PathM u (Point2 u)
 tip = PathM $ \s -> (current_point s,s)
 
 
 lineto :: Floating u => Point2 u -> PathM u ()
-lineto end = exchTip end upd
-  where
-    upd start bp = bp `addSegment` pline start end
-
+lineto pt = PathM $ \(St p0 ac) -> ((), St pt (ac `mappend` line p0 pt))
 
 rlineto :: Floating u => Vec2 u -> PathM u ()
 rlineto (V2 dx dy) = tip >>= \(P2 x y) -> lineto (P2 (x+dx) (y+dy))
 
+
 hline :: Floating u => u -> PathM u ()
-hline dx = tip >>= \(P2 x y) -> lineto (P2 (x+dx) y)
+hline len = snocline (hvec len) 
 
 vline :: Floating u => u -> PathM u ()
-vline dy = tip >>= \(P2 x y) -> lineto (P2 x (y+dy))
- 
+vline len = snocline (vvec len) 
 
+
+
 bezierto :: (Floating u, Ord u) 
          => Point2 u -> Point2 u -> Point2 u -> PathM u ()
-bezierto cp1 cp2 end = exchTip end upd 
-  where
-    upd start bp = bp `addSegment` pcurve start cp1 cp2 end
+bezierto c1 c2 ep = PathM $ \(St p0 ac) -> 
+    ((), St ep (ac `mappend` curve p0 c1 c2 ep))
 
 
+
+
+
+--
+
+
 curveto :: (Floating u, Ord u) 
         => Radian -> Radian -> Point2 u -> PathM u ()
-curveto cin cout end = exchTip end upd
-  where 
-    upd start bp = bp `addSegment` pcurveAng start cin cout end
+curveto cin cout end = PathM $ \(St p0 ac) -> 
+    let seg  = curveByAngles p0 cin cout end 
+        ac1  = ac `mappend` seg
+        end1 = fromMaybe end $ tipR ac1
+    in ((), St end1 ac1) 
 
 
-pcurveAng :: (Floating u, Ord u) 
-        => Point2 u -> Radian -> Radian -> Point2 u -> PathSeg u
-pcurveAng start cin cout end = pcurve start (start .+^ v1) (end .+^ v2) end
-  where
-    sz     = 0.375 * (vlength $ pvec start end)
-    v1     = avec cin  sz
-    v2     = avec cout sz
 
 
 verticalHorizontal :: Floating u => Point2 u -> PathM u ()
@@ -148,3 +154,4 @@
 horizontalVertical :: Floating u => Point2 u -> PathM u ()
 horizontalVertical (P2 x y) = 
     tip >>= \(P2 _ y0) -> lineto (P2 x y0) >> lineto (P2 x y)
+
diff --git a/src/Wumpus/Basic/Paths/RoundCorners.hs b/src/Wumpus/Basic/Paths/RoundCorners.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Basic/Paths/RoundCorners.hs
@@ -0,0 +1,114 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Basic.Paths.RoundCorners
+-- Copyright   :  (c) Stephen Tetley 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  GHC
+--
+-- Drawing round cornered polygons.
+-- 
+--------------------------------------------------------------------------------
+
+module Wumpus.Basic.Paths.RoundCorners
+  ( 
+    cornerCurve
+  , illustratePath
+  , roundEvery
+
+  ) where
+
+import Wumpus.Basic.Colour.SVGColours
+import Wumpus.Basic.Graphic
+import Wumpus.Basic.Paths.Base hiding ( length )
+import Wumpus.Basic.Utils.Intersection
+
+
+import Wumpus.Core                              -- package: wumpus-core
+
+import Data.AffineSpace                         -- package: vector-space
+
+import Data.Monoid
+
+
+-- | The length of the control-point vector wants to be slighly 
+-- longer than half of /d/ (d - being the distance between the 
+-- /truncated/ points and the corner).
+--
+cornerCurve :: (Real u, Floating u) 
+            => Point2 u -> Point2 u -> Point2 u -> Path u
+cornerCurve p1 p2 p3 = curve p1 cp1 cp2 p3
+  where
+    len1 = 0.6 *  (vlength $ pvec p1 p2)
+    len2 = 0.6 *  (vlength $ pvec p3 p2)
+    cp1  = p1 .+^ (avec (langle p1 p2) len1)
+    cp2  = p3 .+^ (avec (langle p3 p2) len2)
+
+
+roundEvery :: (Real u, Floating u) 
+           => u -> [Point2 u] -> Path u 
+roundEvery u (start:b:c:xs) = step (twoParts u start b c) (b:c:xs)
+  where
+    step acc (m:n:o:ps)     = step (acc `mappend` twoParts u m n o) (n:o:ps)
+    step acc [n,o]          = acc `mappend` twoParts u n o start
+                                  `mappend` twoParts u o start b 
+    step acc _              = acc
+roundEvery _ _              = mempty
+
+
+-- | Two parts - line and corner curve...
+--
+twoParts :: (Real u, Floating u) 
+         => u ->  Point2 u -> Point2 u -> Point2 u -> Path u
+twoParts u a b c = line p1 p2 `mappend` cornerCurve p2 b p3
+  where
+    p1 = a .+^ (avec (direction $ pvec a b) u)
+    p2 = b .+^ (avec (direction $ pvec b a) u)
+    p3 = b .+^ (avec (direction $ pvec b c) u)
+ 
+
+
+--------------------------------------------------------------------------------
+-- 
+
+-- This needs moving outside of the Path modules as it has 
+-- dependencies on SVGColour and Graphic (the Path modules should
+-- be /neutral/ to wards depenedencies on other parts of 
+-- Wumpus-Basic).
+--
+
+illustratePath :: Fractional u => Path u -> Graphic u
+illustratePath = localize (strokeColour black) . step1 . pathViewL
+  where
+    step1 EmptyPathL = mempty
+    step1 (e :<< se) = drawPathBoth e `mappend` rest (pathViewL se)
+
+    rest EmptyPathL = mempty
+    rest (e :<< se) = drawPath1 e `mappend` rest (pathViewL se)
+
+drawPathBoth :: Fractional u => PathSegment u -> Graphic u
+drawPathBoth pa@(Line1 p1 _)      = drawPath1 pa `mappend` pathPoint p1
+drawPathBoth pa@(Curve1 p1 _ _ _) = drawPath1 pa `mappend` pathPoint p1
+
+drawPath1 :: Fractional u => PathSegment u -> Graphic u
+drawPath1 (Line1 p1 p2)        = 
+    straightLineBetween p1 p2 `mappend` pathPoint p2
+
+drawPath1 (Curve1 p1 p2 p3 p4) =  
+    mconcat [ bezierCtrl p1 p2, bezierCtrl p4 p3, curveBetween p1 p2 p3 p4
+            , pathPoint p4]
+
+
+bezierCtrl :: Fractional u => Point2 u -> Point2 u -> Graphic u
+bezierCtrl p1 p2 = 
+    localize (strokeColour light_steel_blue . fillColour red) $
+      straightLineBetween p1 p2 `mappend` filledDisk 1 p2
+
+
+pathPoint :: Num u => Point2 u -> Graphic u
+pathPoint = localize bothStrokeColour . filledDisk 1
+
diff --git a/src/Wumpus/Basic/Shapes/Base.hs b/src/Wumpus/Basic/Shapes/Base.hs
--- a/src/Wumpus/Basic/Shapes/Base.hs
+++ b/src/Wumpus/Basic/Shapes/Base.hs
@@ -50,6 +50,21 @@
 import Data.Monoid
 
 
+-- | Note - this formulation prevents rounded corner shapes...
+--
+-- Currently shapes that aren\'t paths:
+--
+-- > Coordinate
+-- > FreeLabel
+--
+-- Alternative 
+--
+-- > out_fun :: ShapeCTM u -> (Path u,sh)
+--
+-- All shapes expect FreeLabel are oblivious to the 
+-- DrawingContext for the /shape/
+--
+
 data Shape u sh =  Shape 
       { src_ctm :: ShapeCTM u 
       , out_fun :: ShapeCTM u -> Image u sh
diff --git a/src/Wumpus/Basic/Shapes/Derived.hs b/src/Wumpus/Basic/Shapes/Derived.hs
--- a/src/Wumpus/Basic/Shapes/Derived.hs
+++ b/src/Wumpus/Basic/Shapes/Derived.hs
@@ -119,7 +119,7 @@
 
 outputRect :: (Real u, Floating u) 
            => u -> u -> ShapeLabel u -> ShapeCTM u -> Image u (Rectangle u)
-outputRect hw hh shl ctm = intoImage (pureDF a) (drawRect a `mappend` label) 
+outputRect hw hh shl ctm = intoImage (return a) (drawRect a `mappend` label) 
   where
     a     = Rectangle { rect_ctm = ctm, rect_hw = hw, rect_hh = hh }
     label = runShapeLabel ctm shl
@@ -193,7 +193,7 @@
 
 outputCirc :: (Real u, Floating u) 
            => u -> ShapeLabel u -> ShapeCTM u -> Image u (Circle u)
-outputCirc rad shl ctm = intoImage (pureDF a) (drawCirc a `mappend` label) 
+outputCirc rad shl ctm = intoImage (return a) (drawCirc a `mappend` label) 
   where
     a     = Circle { circ_ctm = ctm, circ_radius = rad }
     label = runShapeLabel ctm shl
@@ -234,13 +234,13 @@
                    }
 
 outputCoord :: (Real u, Floating u) => ShapeCTM u -> Image u (Coordinate u)
-outputCoord ctm = intoImage (pureDF a) (drawCoord a) 
+outputCoord ctm = intoImage (return a) (drawCoord a) 
   where
     a = Coordinate { coord_ctm = ctm }
 
 
 drawCoord :: (Real u, Floating u) => Coordinate u -> Graphic u
-drawCoord coord = localDF swapColours $ filledEllipse 2 2 (center coord)
+drawCoord coord = localize swapColours $ filledEllipse 2 2 (center coord)
 
 --------------------------------------------------------------------------------
 -- Diamond
@@ -288,7 +288,7 @@
 
 outputDia :: (Real u, Floating u) 
           => u -> u -> ShapeLabel u -> ShapeCTM u -> Image u (Diamond u)
-outputDia hw hh shl ctm = intoImage (pureDF a) (drawDia a `mappend` label) 
+outputDia hw hh shl ctm = intoImage (return a) (drawDia a `mappend` label) 
   where
     a     = Diamond { dia_ctm = ctm, dia_hw = hw, dia_hh = hh }
     label = runShapeLabel ctm shl
@@ -335,7 +335,7 @@
 
 outputEll :: (Real u, Floating u) 
           => u -> u -> ShapeLabel u -> ShapeCTM u -> Image u (Ellipse u)
-outputEll rx ry shl ctm = intoImage (pureDF a) (drawEll a `mappend` label)
+outputEll rx ry shl ctm = intoImage (return a) (drawEll a `mappend` label)
   where
     a     = Ellipse { ell_ctm = ctm, ell_rx = rx, ell_ry = ry }
     label = runShapeLabel ctm shl
diff --git a/src/Wumpus/Basic/Text/LRText.hs b/src/Wumpus/Basic/Text/LRText.hs
--- a/src/Wumpus/Basic/Text/LRText.hs
+++ b/src/Wumpus/Basic/Text/LRText.hs
@@ -117,10 +117,10 @@
 
 runLRText :: (Num u, FromPtSize u) => LRText u a -> LocImage u a
 runLRText ma = \pt -> envZero >>= \e1 -> 
-                   let (a,st) = getLRText ma e1 st_zero 
-                   in mkline pt (acc_chr st) >>= \g1 ->
-                      localDF (fontface symbol) (mkline pt (acc_sym st)) >>= \g2 ->
-                      return (a,g1 `mappend` g2)
+    let (a,st) = getLRText ma e1 st_zero 
+    in mkline pt (acc_chr st) >>= \g1 ->
+       localize (fontface symbol) (mkline pt (acc_sym st)) >>= \g2 ->
+       return (a,g1 `mappend` g2)
   where
     mkline pt h = case toListH h of
                    [] -> return mempty
@@ -137,7 +137,7 @@
              , acc_sym         = emptyH }
  
 
-envZero :: FromPtSize u => DrawingF (Env u)
+envZero :: FromPtSize u => DrawingR (Env u)
 envZero = (\sz -> Env { char_width   = fromPtSize $ charWidth sz
                       , spacer_width = fromPtSize $ spacerWidth sz })
             <$> fontSize
diff --git a/src/Wumpus/Basic/Utils/Intersection.hs b/src/Wumpus/Basic/Utils/Intersection.hs
--- a/src/Wumpus/Basic/Utils/Intersection.hs
+++ b/src/Wumpus/Basic/Utils/Intersection.hs
@@ -8,7 +8,7 @@
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
 -- Stability   :  highly unstable
--- Portability :  GHC with TypeFamilies and more
+-- Portability :  GHC
 --
 -- Intersection of line to line and line to plane
 -- 
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,9,0)
+-- > (0,10,0)
 --
 wumpus_basic_version :: (Int,Int,Int)
-wumpus_basic_version = (0,9,0)
+wumpus_basic_version = (0,10,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.9.0
+version:          0.10.0
 license:          BSD3
 license-file:     LICENSE
 copyright:        Stephen Tetley <stephen.tetley@gmail.com>
@@ -14,66 +14,57 @@
   library turns out to be much more demanding than designing a 
   low-level one (Wumpus-Core). 
   .
-  A few of the modules (SafeFonts, SVGColours, X11Colours) are
-  fairly stable others simply aren\'t and may even disappear in
-  subsequent updates.
+  Some of the modules (SafeFonts, SVGColours, X11Colours) are
+  relatively stable. The core modules of @Basic.Graphic@ (@Base@,
+  @PrimGraphic@, @DrawingContext@) are quite weather-beaten if 
+  not exactly stable, although the newer modules 
+  (@ScalingContext@, @DirectionContext@) are still quite green.
+  Other modules (Paths, Chains, Shapes) are essentially sketches 
+  and may be radically different in subsequent updates.
   .
   .
   Changelog:
   .
-  0.8.0 to 0.9.0:
-  .
-  * Re-worked @Basic.Text.LRSymbol@ changed the type name and the
-    types of the run functions. Added more symbols and a new demo 
-    @Symbols.hs@.
+  0.9.0 to 0.10.0:
   .
-  * @ScalingContext@ added to @Basic.Graphic@. Changed 
-    @monoTextWidth@ to take a character count, the old behaviour 
-    is recreated by the new function @monoTextLength@. 
+  * @Basic.Graphic.BaseClasses@ and @Basic.Graphic.BaseTypes@ 
+    merged into same module so they can depend on each other 
+    without orphans instances.
   .
-  * @Basic.Graphic.Chain@ removed. It is now superseded by
-    @Basic.Chains@.
+  * @DrawingF@ renamed to @DrawingR@, the related type synonyms
+    have also been changed, e.g. @LocDrawingF@ is now 
+    @LocDrawingR@.
   .
-  * Added new property to @DrawingContext@ for line spacing 
-    scaling factor, and added a new drawing primitive 
-    @textlineMulti@ for multi-line, left justified labels.
+  * Method names in the @DrawingCtxM@ class changed - @askCtx@ is
+    now @askDC@, @localCtx@ is now @localize@. Removed the 
+    functions @askDF@, @asksDF@, @pureDF@ that worked for 
+    @DrawingF@ (now @DrawingR@), @DrawingR@ now uses the 
+    Applicative\'s @pure@ and the @DrawingCtxM@ class for these 
+    functionalities.
   .
-  * Synthezied attribute /getters/ such as @textDimensions@ moved
-    from @Basic.Graphic.DrawingContext@ to the new module
-    @Basic.Graphic.Query@. The type of all the functions has 
-    changed to DrawingF. @lowerxHeight@ is renamed 
-    @monoLowerxHeight@ emphasizing that the metrics pertain to
-    monospaced Courier font.
+  * @Basic.Graphic.DrawingContext@ - renamed @primary_colour@ to
+    @stroke_colour@ and @secondary_colour@ to @fill_colour@. The 
+    setter functions has been similarly renamed.
   .
-  * Added Shapes modules.
-  . 
-  * TurtleMonad module - the TurtleDrawing type and run functions
-    have been removed and the internals have been reworked. 
-    Turtle is now run solely as a /local effect/ within the 
-    Drawing monad. 
+  * Added the type synonym @DrawingContextF@ to 
+    @Basic.Graphic.DrawingContext@. Changed relevant function
+    signatures to use it.
   .
-  0.7.0 to 0.8.0:
+  * Re-worked the Path modules - base types entirely different,
+    connectors entirely different, monadic path construction 
+    largely the same.
   .
-  * Re-introduced LRText and LRSymbol - they now work with 
-    Wumpus-Core\'s kerning support.
+  * Initial work on round cornered paths.
   . 
-  * Changes to @Graphic.Basic.BaseTypes@ - @DrawingObject@ 
-    renamed to @DrawingF@. @HPrim@ wrapped as a newtype to 
-    support a Monoid instance. Removed @appendGraphic@ and @gcat@ 
-    as they can be achieved with @mappend@ and @mconcat@. 
-    @appendAt@ renamed to @lgappend@. @PointT@ remaned to 
-    @PointF@.
-  .
-  * Changes to @Graphic.Basic.Drawing@ - @drawAt@, @drawAtImg@, 
-    @drawConn@, @drawConnImg@ all removed. They are replaced 
-    by @draw@ and @drawi@ together with then new @at@ and @conn@
-    combinators.
-  .
-  * Changes to @Basic.Graphic.PrimGraphic@ - @localDrawingContext@
-    renamed to @localLG@ and moved to @Basic.Graphic.BaseTypes@.
+  * Removed the type class @TextAnchor@ from @Basic.Anchors@. 
+    This was a left-over from a previous implementation of 
+    Shapes and is not relevant to the current implementation.
+  . 
+  * Added @DirectionContext@ to @Basic.Graphic@.
   .
-  * Updates to @Basic.SafeFonts@ to work with changes to 
-    @Wumpus.Core@.
+  * @localLG@ removed it can be acheived with composition -
+    @localize upd . loc_graphic_function@. @lgappend@ is also 
+    removed - it can be recreated applicatively.
   .
   .
 build-type:         Simple
@@ -88,6 +79,7 @@
   demo/ColourCharts.hs,
   demo/ColourDefns.hs,
   demo/FontPic.hs,
+  demo/PetriNet.hs,
   demo/Picture.hs,
   demo/Shapes.hs,
   demo/Symbols.hs
@@ -97,7 +89,7 @@
   build-depends:      base            <  5, 
                       containers      >= 0.3     && <= 0.4, 
                       vector-space    >= 0.6,
-                      wumpus-core     == 0.34.0
+                      wumpus-core     == 0.35.0
 
   
   exposed-modules:
@@ -112,8 +104,8 @@
     Wumpus.Basic.Dots,
     Wumpus.Basic.Dots.Primitive,
     Wumpus.Basic.Graphic,
-    Wumpus.Basic.Graphic.BaseClasses,
-    Wumpus.Basic.Graphic.BaseTypes,
+    Wumpus.Basic.Graphic.Base,
+    Wumpus.Basic.Graphic.DirectionContext,
     Wumpus.Basic.Graphic.Drawing,
     Wumpus.Basic.Graphic.DrawingContext,
     Wumpus.Basic.Graphic.PrimGraphic,
@@ -125,6 +117,7 @@
     Wumpus.Basic.Paths.Base,
     Wumpus.Basic.Paths.Connectors,
     Wumpus.Basic.Paths.Construction,
+    Wumpus.Basic.Paths.RoundCorners,
     Wumpus.Basic.SafeFonts,
     Wumpus.Basic.Shapes.Base,
     Wumpus.Basic.Shapes.Derived,