diff --git a/CHANGES b/CHANGES
--- a/CHANGES
+++ b/CHANGES
@@ -1,5 +1,46 @@
 
 
+0.10.0 to 0.11.0:
+ 
+  * Reworked arrowheads and connectors - connectors are now 
+    configurable: there are functions to make connectors with 
+    a left arrowhead, right arrowhead, none or both.  
+
+  * Reworked shapes - internally shapes now create a @Path@ rather 
+    than a @Graphic@ this means the path can be manipulated (e.g. 
+    round cornered rectangles, diamonds... can be constructed).
+    @Coordinate@ is no longer a @Shape@ - it is now similar object 
+    but of a different type. Likewise, @FreeLabel@ has been 
+    replaced by @Plaintext@ which is not a @Shape@, but has some 
+    similar properties.
+
+  * @Basic.Paths.Base@ - @Path@ type changed, @PathEmpty@ 
+    constructor removed so empty paths cannot be created. This 
+    allows a better API for taking points on a path. It also 
+    means @Path@ is no longer an instance of Monoid. Type changes 
+    to various functions (e.g. @tipR@, @tipL@) reflecting that as 
+    paths cannot now be empty, functions on them can generally be 
+    total. @toPrimPathU@ removed as converting to a PrimPath as 
+    now always /safe/. @tracePoints@ renamed @traceLinePoints@, 
+    @tracePointsCurve@ renamed @traceCurvePoints@, @midpoint@ 
+    renamed @midway@.
+
+  * @Basic.Graphic@ - the types @ConnDrawingR@, @ConnGraphic@ etc.
+    have had their names expanded to @ConnectorDrawingR@, 
+    @ConnectorGraphic@... 
+
+  * @Basic.SafeFont@ - font names changed to use underscore 
+    separators rather than camelCase. Wumpus generally uses 
+    underscored names for /constants/.
+
+  * Removed @conn@ from @Basic.Graphic.Drawing@. Connectors should 
+    be used instead.
+
+  * The class @DrawingCtxM@ now has @Applicative@ as a superclass. 
+
+  * @lineSpacing@ renamed @baselineSpacing@.
+
+
 0.9.0 to 0.10.0:
 
   * @Basic.Graphic.BaseClasses@ and @Basic.Graphic.BaseTypes@ 
diff --git a/demo/ArrowCircuit.hs b/demo/ArrowCircuit.hs
new file mode 100644
--- /dev/null
+++ b/demo/ArrowCircuit.hs
@@ -0,0 +1,82 @@
+{-# LANGUAGE TypeFamilies               #-}
+{-# OPTIONS -Wall #-}
+
+
+-- Acknowledgment - the Arrow diagram is taken from Ross 
+-- Paterson\'s slides /Arrows and Computation/.
+
+
+module ArrowCircuit where
+
+import Wumpus.Basic.Anchors
+import Wumpus.Basic.Arrows
+import Wumpus.Basic.Graphic
+import Wumpus.Basic.Paths 
+import Wumpus.Basic.SafeFonts
+import Wumpus.Basic.Shapes
+
+import Wumpus.Core                      -- package: wumpus-core
+
+import Data.AffineSpace
+
+import System.Directory
+
+
+main :: IO ()
+main = do 
+    createDirectoryIfMissing True "./out/"
+    writeEPS_latin1 "./out/arrow_circuit.eps" pic1
+    writeSVG_latin1 "./out/arrow_circuit.svg" pic1 
+
+times_ctx :: DrawingContext
+times_ctx = fontface times_roman $ standardContext 11
+
+-- Note - quite a bit of this diagram was produced /by eye/, 
+-- rather than using anchors directly - e.g. the placing of the 
+-- ptext labels and the anchors displaced by vectors.
+--
+         
+pic1 :: Picture Double 
+pic1 = liftToPictureU $ execDrawing times_ctx $ do
+    a1 <- drawi $ strokedShape $ translate 0   72 $ rrectangle 12 66 30
+    atext a1 "CONST 0"
+    a2 <- drawi $ strokedShape $ translate 120 60 $ circle 16
+    atext a2 "IF"
+    a3 <- drawi $ strokedShape $ translate 240 28 $ circle 16
+    atext a3 "+1"
+    a4 <- drawi $ strokedShape $ translate 120  0 $ rectangle 66 30
+    atext a4 "DELAY 0"
+    connWith connect (east a1) (east a1 .+^ hvec 76)
+    connWith connect (east a2) (east a2 .+^ hvec 180)
+    connWith connect (north a2 .+^ vvec 40) (north a2)
+    connWith connect (north a3 .+^ vvec 16) (north a3)  
+    connWith vhconn  (south a3) (east a4)
+    connWith (hvhconn (-30)) (west a4)  (southwest a2)
+    ptext (P2  40  10) "next"
+    ptext (P2 152 100) "reset"
+    ptext (P2 252  72) "output"
+    return ()
+
+
+-- Note - conn from Basic.Graphic is now questionable...
+
+connWith :: ( TraceM m, DrawingCtxM m, u ~ MonUnit m
+            , Real u, Floating u, FromPtSize u ) 
+         => ConnectorPath u -> Point2 u -> Point2 u -> m ()
+connWith con p0 p1 = localize doublesize $ 
+    drawi_ $ strokeConnector (rightArrow con tri45) p0 p1
+
+
+atext :: ( CenterAnchor t, DUnit t ~ u
+         , Real u, Floating u, FromPtSize u
+         , TraceM m, DrawingCtxM m, u ~ MonUnit m )
+      => t -> String -> m ()
+atext ancr ss = let (P2 x y) = center ancr in
+   drawi_ $ drawText $ translate x y $ plaintext ss
+
+
+ptext :: ( Real u, Floating u, FromPtSize u
+         , TraceM m, DrawingCtxM m, u ~ MonUnit m )
+      => Point2 u -> String -> m ()
+ptext (P2 x y) ss = localize (fontsize 14 . fontface times_italic) $ 
+    drawi_ $ drawText $ translate x y $ plaintext ss
diff --git a/demo/ClipPic.hs b/demo/ClipPic.hs
--- a/demo/ClipPic.hs
+++ b/demo/ClipPic.hs
@@ -40,7 +40,7 @@
 pic = pic1 `nextToV` (stackOver [cpic1, cpic2, cpic3] cpic4)
 
 fillPath :: Num u => Path u -> Graphic u
-fillPath = filledPath . toPrimPathU
+fillPath = filledPath . toPrimPath
 
 pic1 :: DPicture
 pic1 = liftToPictureU $ execDrawing pic_drawing_ctx $ 
@@ -61,16 +61,16 @@
      ps = unchain (coordinateScalingContext 86 16) $ tableDown 18 8
 
 cpic1 :: DPicture 
-cpic1 = clip (toPrimPathU path01) (background black)
+cpic1 = clip (toPrimPath path01) (background black)
   
 cpic2 :: DPicture 
-cpic2 = clip (toPrimPathU path02) (background medium_violet_red)
+cpic2 = clip (toPrimPath path02) (background medium_violet_red)
 
 cpic3 :: DPicture 
-cpic3 = clip (toPrimPathU path03) (background black)
+cpic3 = clip (toPrimPath path03) (background black)
 
 cpic4 :: DPicture 
-cpic4 = clip (toPrimPathU path04) (background black)
+cpic4 = clip (toPrimPath path04) (background black)
 
 
 iheartHaskell :: Num u => FromPtSize u => Point2 u -> Drawing u () 
diff --git a/demo/FontPic.hs b/demo/FontPic.hs
--- a/demo/FontPic.hs
+++ b/demo/FontPic.hs
@@ -74,18 +74,18 @@
 
 times_pic :: Picture Double
 times_pic = 
-    fontPicture [ (steel_blue,  timesRoman)
-                , (indian_red1, timesItalic)
-                , (steel_blue,  timesBold)
-                , (indian_red1, timesBoldItalic)
+    fontPicture [ (steel_blue,  times_roman)
+                , (indian_red1, times_italic)
+                , (steel_blue,  times_bold)
+                , (indian_red1, times_bold_italic)
                 ] 
 
 helvetica_pic :: Picture Double
 helvetica_pic = 
     fontPicture [ (steel_blue,  helvetica)
-                , (indian_red1, helveticaOblique)
-                , (steel_blue,  helveticaBold)
-                , (indian_red1, helveticaBoldOblique)
+                , (indian_red1, helvetica_oblique)
+                , (steel_blue,  helvetica_bold)
+                , (indian_red1, helvetica_bold_oblique)
                 ] 
 
 
@@ -95,9 +95,9 @@
 courier_pic :: Picture Double
 courier_pic = 
     fontPicture [ (steel_blue,  courier)
-                , (indian_red1, courierOblique)
-                , (steel_blue,  courierBold)
-                , (indian_red1, courierBoldOblique)
+                , (indian_red1, courier_oblique)
+                , (steel_blue,  courier_bold)
+                , (indian_red1, courier_bold_oblique)
                 ] 
 
 
diff --git a/demo/PetriNet.hs b/demo/PetriNet.hs
--- a/demo/PetriNet.hs
+++ b/demo/PetriNet.hs
@@ -46,20 +46,20 @@
               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)
+              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)
+              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)
+              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)
@@ -81,33 +81,32 @@
 
 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
+place x y = greenFill $ drawi $ borderedShape $ 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
+transition x y = greenFill $ drawi $ borderedShape $ 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 ()
 
 
+
+connector' :: ( TraceM m, DrawingCtxM m, u ~ MonUnit m
+         , Real u, Floating u, FromPtSize u ) 
+      => Point2 u -> Point2 u -> m ()
+connector' p0 p1 = drawi_ $ strokeConnector (rightArrow connect tri45) p0 p1
+
+
 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 ()
+connectorC v p0 p1 = 
+    drawi_ $ strokeConnector (rightArrow (vhvconn v) tri45) p0 p1
 
 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 ()
+connectorD u p0 p1 = 
+    drawi_ $ strokeConnector (rightArrow (joint u) tri45) p0 p1
 
 
 lblParensParens :: Num u => LocGraphic u
@@ -118,8 +117,8 @@
 
 
 lblBold' :: Num u => String -> LocGraphic u
-lblBold' ss = localize (fontface helveticaBold) . textline ss
+lblBold' ss = localize (fontface helvetica_bold) . textline ss
 
 
 lblBold :: (Fractional u, Ord u, FromPtSize u) => String -> LocGraphic u
-lblBold ss = localize (fontface helveticaBold) . centermonoTextline ss
+lblBold ss = localize (fontface helvetica_bold) . centermonoTextline ss
diff --git a/demo/Shapes.hs b/demo/Shapes.hs
deleted file mode 100644
--- a/demo/Shapes.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-{-# OPTIONS -Wall #-}
-
-
-module Shapes where
-
-import Wumpus.Basic.Colour.SVGColours
-import Wumpus.Basic.Graphic                     -- package: wumpus-basic
-import Wumpus.Basic.Shapes.Base
-import Wumpus.Basic.Shapes.Derived
-
-import Wumpus.Core                              -- package: wumpus-core
-
-
-import System.Directory
-
-
-
-main :: IO ()
-main = do 
-    createDirectoryIfMissing True "./out/"
-    writeEPS_latin1 "./out/shapes01.eps" pic1
-    writeSVG_latin1 "./out/shapes01.svg" pic1
-    
-
-pic1 :: DPicture
-pic1 = liftToPictureU $ execDrawing (standardContext 14) $ do
-         _ <- drawi $ drawShape $ translate 220 10 $ rotate30
-                                                   $ lrectangle 90 30 "Rectangle"
-         _ <- drawi $ drawShape $ translate 100  0 $ lcircle 10 "C0"
-   
-         _ <- 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 ()
-
-
diff --git a/demo/Symbols.hs b/demo/Symbols.hs
--- a/demo/Symbols.hs
+++ b/demo/Symbols.hs
@@ -29,7 +29,7 @@
     writeSVG_latin1 "./out/symbols.svg" pic1
 
 std_ctx :: DrawingContext
-std_ctx = fontface timesRoman $ standardContext 12
+std_ctx = fontface times_roman $ standardContext 12
 
 pic1 :: DPicture 
 pic1 = liftToPictureU $ execDrawing std_ctx $ do
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
@@ -10,173 +10,19 @@
 -- Stability   :  highly unstable
 -- Portability :  GHC
 --
--- Draw arrows.
---
--- \*\* WARNING \*\* - the types are /wrong/ here and need more 
--- thought.
+-- Shim module for arrow connectors and arrowheads.
 -- 
 --------------------------------------------------------------------------------
 
 module Wumpus.Basic.Arrows
   ( 
-    cline
 
-
-  , arrowTri90
-  , arrowTri60
-  , arrowTri45
-  , arrowOTri90
-  , arrowOTri60
-  , arrowOTri45
-
-  , arrowBarb90
-  , arrowBarb60
-  , arrowBarb45
-    
-  , arrowPerp
-  , arrowRBracket
+    module Wumpus.Basic.Arrows.Tips
+  , module Wumpus.Basic.Arrows.Connectors
 
   ) where
 
 import Wumpus.Basic.Arrows.Tips
-import Wumpus.Basic.Graphic
-import Wumpus.Basic.Paths
-import Wumpus.Basic.Utils.Intersection ( langle )
-
-import Wumpus.Core                      -- package: wumpus-core
-
-import Control.Applicative
-import Data.Monoid
-
-liftConnector :: Connector u -> ConnDrawingR u (Path u)
-liftConnector pF p1 p2 = pure $ pF p1 p2
-
-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 arrtip = openStroke (toPrimPathU bpath) `mappend` arrtip
-   
-
-
-
--- | Returns two items:
--- 
--- 1. Shorten the line by the line width - this stops the path
--- tip puncturing the arrow head (particulary visible on open 
--- triangle tips).
--- 
--- 2. Calculate the direction back along the line at half the 
--- lower_x_height - this gets a good angle for the tip on curved
--- path segments.
---
-rightPathProps :: (Real u, Floating u, FromPtSize u) 
-               => Connector u -> ConnDrawingR u (Path u,Radian)
-rightPathProps pathF p1 p2 = 
-    (\h sw -> (shortenPath h sw, calcTheta h))
-      <$> markHeight <*> lineWidth
-  where
-    long_path          = pathF p1 p2  
-    shortenPath lxh sw = shortenR (lxh + (realToFrac sw)) long_path 
-    calcTheta lxh      = directionR $ shortenR (0.5*lxh) long_path
-
-
-
-
-triTipRight :: (Real u, Floating u, FromPtSize 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      ->
-    return (pathF p1 p2, arrow_pic)
-
-
-
-
--- This version does not /retract/ the path...
---
-barbTipRight :: (Real u, Floating u, FromPtSize 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  ->
-    return (path_zero, arrow_pic)
-  where
-    path_zero = pathF p1 p2
-
-
-
-arrowTri90 :: (Real u, Floating u, FromPtSize u) 
-           => Connector u -> ConnImage u (Path u)
-arrowTri90 pathF = triTipRight pathF tri90
- 
-          
-
-
-arrowTri60 :: (Real u, Floating u, FromPtSize u) 
-           => Connector u -> ConnImage u (Path u)
-arrowTri60 pathF = triTipRight pathF tri60
-
- 
-arrowTri45 :: (Real u, Floating u, FromPtSize u) 
-           => Connector u -> ConnImage u (Path u)
-arrowTri45 pathF = triTipRight pathF tri45
-
-
-arrowOTri90 :: (Real u, Floating u, FromPtSize u) 
-            => Connector u -> ConnImage u (Path u)
-arrowOTri90 pathF = triTipRight pathF otri90
-     
-
-arrowOTri60 :: (Real u, Floating u, FromPtSize u) 
-            => Connector u -> ConnImage u (Path u)
-arrowOTri60 pathF = triTipRight pathF otri60 
-
-
-
-arrowOTri45 :: (Real u, Floating u, FromPtSize u) 
-            => Connector u -> ConnImage u (Path u)
-arrowOTri45 pathF = triTipRight pathF otri45
-
-
-
-arrowBarb90 :: (Real u, Floating u, FromPtSize u) 
-            => Connector u -> ConnImage u (Path u)
-arrowBarb90 pathF = barbTipRight pathF barb90
-
-arrowBarb60 :: (Real u, Floating u, FromPtSize u) 
-            => Connector u -> ConnImage u (Path u)
-arrowBarb60 pathF = barbTipRight pathF barb60
-
-arrowBarb45 :: (Real u, Floating u, FromPtSize u) 
-            => Connector u -> ConnImage u (Path u)
-arrowBarb45 pathF = barbTipRight pathF barb45
-
-
-                     
-arrowPerp :: (Real u, Floating u, FromPtSize 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
+import Wumpus.Basic.Arrows.Connectors
 
 
-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/Connectors.hs b/src/Wumpus/Basic/Arrows/Connectors.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Basic/Arrows/Connectors.hs
@@ -0,0 +1,136 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Basic.Arrows.Connectors
+-- Copyright   :  (c) Stephen Tetley 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  GHC
+--
+-- Draw arrows.
+--
+-- \*\* WARNING \*\* - the types are /wrong/ here and need more 
+-- thought.
+-- 
+--------------------------------------------------------------------------------
+
+module Wumpus.Basic.Arrows.Connectors
+  ( 
+
+    Connector
+  , connector
+  , leftArrow
+  , rightArrow
+  , dblArrow
+  , leftrightArrow
+  , strokeConnector
+
+
+  ) where
+
+import Wumpus.Basic.Arrows.Tips
+import Wumpus.Basic.Graphic
+import Wumpus.Basic.Paths
+
+import Wumpus.Core                      -- package: wumpus-core
+
+import Data.Monoid
+
+-- An arrowhead always know how to draws itself (filled tri, 
+-- stroked barb, etc.)
+--
+-- A Path might will typically be drawn with openStroke,
+-- eventually there might be scope for drawing 
+-- e.g. parallel lines  ====
+--
+
+-- A ConnectorPath gets wrapped with how it is drawn into
+-- another type.
+
+
+-- larrow :: Arrowhead u -> ConnectorPath u -> WrappedConnector u
+
+
+data Connector u = Connector 
+      { connector_path  :: ConnectorPath u
+      , opt_left_arrow  :: Maybe (Arrowhead u)
+      , opt_right_arrow :: Maybe (Arrowhead u)
+      }
+
+
+-- | connector with no arrow heads.
+--
+connector :: ConnectorPath u -> Connector u
+connector cp = 
+    Connector { connector_path  = cp
+              , opt_left_arrow  = Nothing
+              , opt_right_arrow = Nothing
+              }
+
+leftArrow :: ConnectorPath u -> Arrowhead u -> Connector u
+leftArrow cp la =
+    Connector { connector_path  = cp
+              , opt_left_arrow  = Just la
+              , opt_right_arrow = Nothing
+              }
+
+
+rightArrow :: ConnectorPath u -> Arrowhead u -> Connector u
+rightArrow cp ra = 
+    Connector { connector_path  = cp
+              , opt_left_arrow  = Nothing
+              , opt_right_arrow = Just ra
+              }
+
+-- | Same tip both ends.
+--
+dblArrow :: ConnectorPath u -> Arrowhead u -> Connector u
+dblArrow cp arw = leftrightArrow cp arw arw
+
+leftrightArrow :: ConnectorPath u -> Arrowhead u -> Arrowhead u -> Connector u
+leftrightArrow cp la ra =
+    Connector { connector_path  = cp
+              , opt_left_arrow  = Just la
+              , opt_right_arrow = Just ra
+              }
+
+
+strokeConnector :: (Real u, Floating u) 
+                => Connector u -> ConnectorImage u (Path u)
+strokeConnector (Connector cpF opt_la opt_ra) = \p0 p1 ->
+    let pathc = cpF p0 p1 in 
+    (fn pathc opt_la p0 opt_ra p1) >>= \grafic ->
+    intoImage (return pathc) grafic
+  where
+    fn pathc ma p0 mb p1 = do 
+       (path1,tipl) <- applyTipL ma p0 pathc
+       (path2,tipr) <- applyTipR mb p1 path1
+       return $ (openStroke $ toPrimPath path2) `mappend` tipl `mappend` tipr
+   
+
+
+applyTipL :: (Real u, Floating u) 
+          => Maybe (Arrowhead u) -> Point2 u -> Path u 
+          -> DrawingR (Path u, Graphic u)
+applyTipL Nothing    _   pathc = return (pathc,mempty)
+applyTipL (Just arw) ptL pathc = 
+    retract_dist arw >>= \ dx -> 
+    if dx > 0 then return (shortenL dx pathc, grafik) 
+              else return (pathc, grafik)
+  where
+    grafik = (arrow_draw arw) (directionL pathc) ptL
+
+applyTipR :: (Real u, Floating u) 
+          => Maybe (Arrowhead u) -> Point2 u -> Path u 
+          -> DrawingR (Path u, Graphic u)
+applyTipR Nothing    _   pathc = return (pathc,mempty)
+applyTipR (Just arw) ptR pathc = 
+    retract_dist arw >>= \dx -> 
+    if dx > 0 then return (shortenR dx pathc, grafik) 
+              else return (pathc, grafik)
+  where
+    grafik = (arrow_draw arw) (directionR pathc) ptR 
+
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
@@ -20,8 +20,10 @@
 module Wumpus.Basic.Arrows.Tips
   ( 
 
+    Arrowhead(..)
+  , arrowheadTip
 
-    tri90
+  , tri90
   , tri60
   , tri45
   , otri90
@@ -46,8 +48,15 @@
 
 import Control.Applicative
 
+data Arrowhead u = Arrowhead
+      { retract_dist :: DrawingR u
+      , arrow_draw   :: ThetaLocGraphic u 
+      }
 
 
+arrowheadTip :: Arrowhead u -> Radian -> LocGraphic u
+arrowheadTip (Arrowhead _ gf) theta = gf theta
+
 -- | Tiplen is length of the tip \*along the line it follows\*. 
 --
 -- > |\
@@ -85,6 +94,7 @@
     vec_to_lower = avec (circularModulo $ rtheta + halfang) hypo_len 
 
 
+{-
 -- | This one is for triangles when the tip height and tip width
 -- are known.
 --
@@ -97,8 +107,17 @@
     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 
+-}
 
 
+
+
+mark_height_plus_line_width :: (Fractional u, FromPtSize u) => DrawingR u
+mark_height_plus_line_width = 
+    (\h lw -> h + realToFrac lw) <$> markHeight <*> lineWidth
+
+
+
 --------------------------------------------------------------------------------
 
 -- | Tripoints takes the \*tip length\* is the mark height.
@@ -108,22 +127,22 @@
 -- does it!).
 --
 tripointsByAngle :: (Floating u, FromPtSize u)
-                 => Radian -> Radian -> LocDrawingR u (Point2 u, Point2 u)
+                 => Radian ->  ThetaLocDrawingR 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)
+                => (u -> u) -> (u -> u)  
+                -> ThetaLocDrawingR 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
-
+-}
 
 
 
@@ -131,11 +150,8 @@
 -- filled with stroke colour!
 
 triAng :: (Floating u, Real u, FromPtSize u)
-      => Radian 
-      -> Radian
-      -> (PrimPath u -> Graphic u) 
-      -> LocGraphic u
-triAng triang theta gf pt = 
+       => Radian -> (PrimPath u -> Graphic u) -> ThetaLocGraphic u
+triAng triang gf theta pt = 
     tripointsByAngle triang theta pt >>= \(u,v) -> 
     localize bothStrokeColour (gf $  vertexPath [pt,u,v])
 
@@ -143,65 +159,59 @@
 
 -- TODO - maybe filling needs to use swapColours
 
-tri90 :: (Floating u, Real u, FromPtSize u)
-      => Radian -> LocGraphic u
-tri90 theta = triAng (pi/2) theta filledPath
+tri90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
+tri90 = Arrowhead markHeight (triAng (pi/2) filledPath)
 
 
-tri60 :: (Floating u, Real u, FromPtSize u)
-      => Radian -> LocGraphic u
-tri60 theta = triAng (pi/3) theta filledPath
+tri60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
+tri60 = Arrowhead markHeight (triAng (pi/3) filledPath)
 
 
-tri45 :: (Floating u, Real u, FromPtSize u)
-      => Radian -> LocGraphic u
-tri45 theta = triAng (pi/4) theta filledPath
+tri45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
+tri45 = Arrowhead markHeight (triAng (pi/4) filledPath)
 
+otri90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
+otri90 = Arrowhead mark_height_plus_line_width (triAng (pi/2) closedStroke)
 
-otri90 :: (Floating u, Real u, FromPtSize u)
-      => Radian -> LocGraphic u
-otri90 theta = triAng (pi/2) theta closedStroke
+otri60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
+otri60 = Arrowhead mark_height_plus_line_width (triAng (pi/3) closedStroke)
 
+otri45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
+otri45 = Arrowhead mark_height_plus_line_width (triAng (pi/4) closedStroke)
 
-otri60 :: (Floating u, Real u, FromPtSize u)
-      => Radian -> LocGraphic u
-otri60 theta = triAng (pi/3) theta closedStroke
 
-otri45 :: (Floating u, Real u, FromPtSize u)
-      => Radian -> LocGraphic u
-otri45 theta = triAng (pi/4) theta closedStroke
 
-barbAng :: (Floating u, Real u, FromPtSize u)
-      => Radian -> Radian -> LocGraphic u
+barbAng :: (Floating u, Real u, FromPtSize u) => Radian -> ThetaLocGraphic u
 barbAng ang theta pt = 
     tripointsByAngle ang theta pt >>= \(u,v) -> 
     openStroke (vertexPath [u,pt,v])
 
 
-barb90 :: (Floating u, Real u, FromPtSize u) 
-       => Radian -> LocGraphic u
-barb90 = barbAng (pi/2)
+barb90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
+barb90 = Arrowhead (pure 0) (barbAng (pi/2))
 
-barb60 :: (Floating u, Real u, FromPtSize u) 
-       => Radian -> LocGraphic u
-barb60 = barbAng (pi/3)
+barb60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
+barb60 = Arrowhead (pure 0) (barbAng (pi/3))
 
-barb45 :: (Floating u, Real u, FromPtSize u) 
-       => Radian -> LocGraphic u
-barb45 = barbAng (pi/4)
 
+barb45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u
+barb45 = Arrowhead (pure 0) (barbAng (pi/4))
 
 
-perp :: (Floating u, FromPtSize u) => Radian -> LocGraphic u
-perp theta pt =  
+
+perpAng :: (Floating u, FromPtSize u) => ThetaLocGraphic u
+perpAng theta pt =  
     markHeight >>= \ h -> 
     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 -> 
+perp :: (Floating u, FromPtSize u) => Arrowhead u
+perp = Arrowhead (pure 0) perpAng
+
+rbracketAng :: (Floating u, FromPtSize u) => ThetaLocGraphic u
+rbracketAng theta pt = markHalfHeight >>= \hh -> 
    runDirection theta $ 
      displacePerp   hh  pt >>= \p1 ->
      displacePara (-hh) p1 >>= \p0 ->
@@ -209,3 +219,6 @@
      displacePara (-hh) p2 >>= \p3 ->
      return (openStroke $ vertexPath [p0,p1,p2,p3]) 
    
+
+rbracket :: (Floating u, FromPtSize u) => Arrowhead u
+rbracket = Arrowhead (pure 0) rbracketAng
diff --git a/src/Wumpus/Basic/Graphic/Base.hs b/src/Wumpus/Basic/Graphic/Base.hs
--- a/src/Wumpus/Basic/Graphic/Base.hs
+++ b/src/Wumpus/Basic/Graphic/Base.hs
@@ -16,9 +16,10 @@
 -- 
 -- Base classes for monadic drawing.
 --
--- Note on suffix names. Function types suffixed @F@ are functions 
--- from same-to-same, e.g.:
+-- Notes on prefix and 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 
@@ -28,6 +29,12 @@
 --
 -- The suffix @M@ is used for classes defining monadic actions.
 --
+-- The prefix @Loc@ indicates a functional type 
+-- /from Point2 to something.../
+-- 
+-- The prefix @ThetaLoc@ indicates a functional type 
+-- /from Direction (radian) then Point to something.../
+--
 -- \*\* WARNING \*\* - some names are expected to change.
 --
 --------------------------------------------------------------------------------
@@ -77,15 +84,22 @@
   , intoLocImage
   , xlinkImage
 
-  , ConnDrawingR
-  , DConnDrawingR
-  , ConnGraphic
-  , DConnGraphic
-  , ConnImage
-  , DConnImage
+  , ConnectorDrawingR
+  , DConnectorDrawingR
+  , ConnectorGraphic
+  , DConnectorGraphic
+  , ConnectorImage
+  , DConnectorImage
 
-  , intoConnImage
+  , intoConnectorImage
 
+  , ThetaLocDrawingR
+  , DThetaLocDrawingR
+  , ThetaLocGraphic
+  , DThetaLocGraphic
+  , ThetaLocImage
+  , DThetaLocImage
+
   ) where
 
 import Wumpus.Basic.Graphic.DrawingContext
@@ -114,7 +128,7 @@
 class Monad m => TraceM (m :: * -> *) where
   trace  :: HPrim (MonUnit m) -> m ()
 
-class Monad m => DrawingCtxM (m :: * -> *) where
+class (Applicative m, Monad m) => DrawingCtxM (m :: * -> *) where
   askDC    :: m DrawingContext
   localize :: (DrawingContext -> DrawingContext) -> m a -> m a
 
@@ -306,28 +320,46 @@
 --------------------------------------------------------------------------------
 --
 
-type ConnDrawingR u a = Point2 u -> Point2 u -> DrawingR a
+type ConnectorDrawingR u a = Point2 u -> Point2 u -> DrawingR a
 
-type DConnDrawingR a = ConnDrawingR Double a
+type DConnectorDrawingR a = ConnectorDrawingR Double a
 
--- | ConnGraphic is a connector drawn between two points 
+-- | ConnectorGraphic is a connector drawn between two points 
 -- contructing a Graphic.
 --
-type ConnGraphic u = Point2 u -> Point2 u -> Graphic u
+type ConnectorGraphic u = Point2 u -> Point2 u -> Graphic u
 
-type DConnGraphic = ConnGraphic Double
+type DConnectorGraphic = ConnectorGraphic Double
 
 -- | ConImage is a connector drawn between two points 
 -- constructing an Image.
 --
-type ConnImage u a = Point2 u -> Point2 u -> Image u a
+type ConnectorImage u a = Point2 u -> Point2 u -> Image u a
 
-type DConnImage a = ConnImage Double a
+type DConnectorImage a = ConnectorImage Double a
 
 
-intoConnImage :: ConnDrawingR u a -> ConnGraphic u -> ConnImage u a
-intoConnImage f g p1 p2 = DrawingR $ \ctx -> 
+intoConnectorImage :: ConnectorDrawingR u a 
+                   -> ConnectorGraphic u 
+                   -> ConnectorImage u a
+intoConnectorImage f g p1 p2 = DrawingR $ \ctx -> 
     let a = getDrawingR (f p1 p2) ctx; o = getDrawingR (g p1 p2) ctx in (a,o)
+
+
+
+type ThetaLocDrawingR u a = Radian -> LocDrawingR u a 
+
+type DThetaLocDrawingR a = ThetaLocDrawingR Double a
+
+-- | A function from /Radian -\> Point -\> Graphic/...
+--
+type ThetaLocGraphic u = Radian -> LocGraphic u
+
+type DThetaLocGraphic = ThetaLocGraphic Double
+
+type ThetaLocImage u a = Radian -> LocImage u a
+
+type DThetaLocImage a = ThetaLocImage Double a 
 
 
 
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
@@ -27,8 +27,10 @@
   , DrawingT
   , runDrawing
   , execDrawing
+  , evalDrawing
   , runDrawingT
   , execDrawingT
+  , evalDrawingT
 
   , runFdcDrawing
   , execFdcDrawing
@@ -42,11 +44,12 @@
   , draw
   , xdraw
   , drawi
+  , drawi_
   , xdrawi
+  , xdrawi_
 
   , at
   , ati
-  , conn
 
   , node
   , nodei
@@ -181,17 +184,36 @@
 runDrawing :: DrawingContext -> Drawing u a -> (a, HPrim u)
 runDrawing ctx ma = getDrawing ma ctx mempty
 
+-- | Run the drawing returning only the output it produces, drop
+-- any answer from the monadic computation.
+--
 execDrawing :: DrawingContext -> Drawing u a -> HPrim u
 execDrawing ctx ma = snd $ runDrawing ctx ma
 
+-- | Run the drawing ignoring the output it produces, return the 
+-- answer from the monadic computation.
+--
+-- Note - this useful for testing, generally one would want the 
+-- opposite behaviour (return the drawing, ignore than the 
+-- answer).
+-- 
+evalDrawing :: DrawingContext -> Drawing u a -> a
+evalDrawing ctx ma = fst $ runDrawing ctx ma
 
 
+
 runDrawingT :: Monad m => DrawingContext -> DrawingT u m a -> m (a, HPrim u) 
 runDrawingT ctx ma = getDrawingT ma ctx mempty
 
 execDrawingT :: Monad m => DrawingContext -> DrawingT u m a -> m (HPrim u)
 execDrawingT ctx ma = liftM snd $ runDrawingT ctx ma
 
+
+evalDrawingT :: Monad m => DrawingContext -> DrawingT u m a -> m a
+evalDrawingT ctx ma = liftM fst $ runDrawingT ctx ma
+
+
+
 -- | Run the Drawing generating a Picture /within/ a 
 -- \"font delta context\" using the font-family and font-size 
 -- from the intial DrawingContext.
@@ -300,6 +322,12 @@
 drawi img = askDC >>= \ctx -> 
             let (a,o) = runImage ctx img in trace o >> return a
 
+-- | Forgetful 'drawi'.
+--
+drawi_ ::  (TraceM m, DrawingCtxM m, u ~ MonUnit m) => Image u a -> m ()
+drawi_ img = drawi img >> return ()
+
+
 -- | Hyperlink version of 'drawi'.
 --
 xdrawi ::  (TraceM m, DrawingCtxM m, u ~ MonUnit m) 
@@ -307,6 +335,11 @@
 xdrawi xl img = drawi (xlinkImage xl img)
 
 
+-- | Forgetful 'xdrawi'.
+--
+xdrawi_ ::  (TraceM m, DrawingCtxM m, u ~ MonUnit m) 
+        => XLink -> Image u a -> m ()
+xdrawi_ xl img = xdrawi xl img >> return ()
 
 
 infixr 1 `at`, `ati`
@@ -317,11 +350,11 @@
 ati = ($)
 
 
-
+{-
 infixl 1 `conn`
-conn :: ConnImage u a -> Point2 u -> LocImage u a
+conn :: ConnectorImage u a -> Point2 u -> LocImage u a
 conn = ($)
-
+-}
 
 node :: (TraceM m, DrawingCtxM m, PointSupplyM m, u ~ MonUnit m) 
      => LocGraphic u -> m ()
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
@@ -119,6 +119,11 @@
 borderedPath pp = 
     withBorderedAttr $ \frgb attr srgb -> singleH $ fillStroke frgb attr srgb pp
 
+
+-- Note - clipping needs a picture as well as a path, so there is
+-- no analogous @clippedPath@ function.
+
+
 --------------------------------------------------------------------------------
 -- 
 
@@ -142,11 +147,13 @@
 
 
 
--- | Point is the baseline left of the bottom line.
+-- | Point is the baseline left of the bottom line, text is 
+-- left-aligned.
 --
 textlineMulti :: Fractional u => [String] -> LocGraphic u
 textlineMulti xs baseline_left = liftM snd $ 
-    lineSpacing >>= \dy -> foldrM (foldStep dy) (baseline_left,mempty) xs
+    baselineSpacing >>= \dy -> 
+    foldrM (foldStep dy) (baseline_left,mempty) xs
   where
     foldStep dy str (pt,gfic) = (\a -> (pt .+^ vvec dy, a `mappend` gfic))
                                     <$> textline str pt
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
@@ -34,7 +34,7 @@
   , fontSize
   , markHeight
   , markHalfHeight
-  , lineSpacing
+  , baselineSpacing
 
   -- 
   , monoCharWidth
@@ -46,6 +46,8 @@
   , monoLowerxHeight
   , monoDescenderDepth
   , monoTextDimensions
+  , monoMultiLineTextHeight
+  , monoDefaultPadding
   , monoVecToCenter  
   ) where
 
@@ -58,37 +60,34 @@
 import Control.Applicative
 
 
-textAttr :: (Applicative m, DrawingCtxM m) => m (RGBi,FontAttr)
+textAttr :: 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 :: (Applicative m, DrawingCtxM m) 
-             => (RGBi -> FontAttr -> a) -> m a
+withTextAttr :: DrawingCtxM m => (RGBi -> FontAttr -> a) -> m a
 withTextAttr fn = fn <$> asksDC stroke_colour <*> asksDC font_props
 
 
-strokeAttr :: (Applicative m, DrawingCtxM m) => m (RGBi, StrokeAttr)
+strokeAttr :: DrawingCtxM m => m (RGBi, StrokeAttr)
 strokeAttr = (,) <$> asksDC stroke_colour <*> asksDC stroke_props
 
-withStrokeAttr :: (Applicative m, DrawingCtxM m) 
-               => (RGBi -> StrokeAttr -> a) -> m a
+withStrokeAttr :: DrawingCtxM m => (RGBi -> StrokeAttr -> a) -> m a
 withStrokeAttr fn = fn <$> asksDC stroke_colour <*> asksDC stroke_props
 
 
-fillAttr :: (Applicative m, DrawingCtxM m) => m RGBi
+fillAttr :: DrawingCtxM m => m RGBi
 fillAttr = asksDC fill_colour
 
-withFillAttr :: (Applicative m, DrawingCtxM m) => (RGBi -> a) -> m a
+withFillAttr :: DrawingCtxM m => (RGBi -> a) -> m a
 withFillAttr fn = fn <$> asksDC fill_colour
 
-borderedAttr :: (Applicative m, DrawingCtxM m) => m (RGBi, StrokeAttr, RGBi)
+borderedAttr :: DrawingCtxM m => m (RGBi, StrokeAttr, RGBi)
 borderedAttr = (,,) <$> asksDC fill_colour <*> asksDC stroke_props 
                                            <*> asksDC stroke_colour
 
-withBorderedAttr :: (Applicative m, DrawingCtxM m) 
-                 => (RGBi -> StrokeAttr -> RGBi -> a) -> m a
+withBorderedAttr :: DrawingCtxM m => (RGBi -> StrokeAttr -> RGBi -> a) -> m a
 withBorderedAttr fn = 
     fn <$> asksDC fill_colour <*> asksDC stroke_props 
                               <*> asksDC stroke_colour
@@ -96,28 +95,21 @@
 
 
 
-lineWidth :: (Applicative m, DrawingCtxM m) => m Double
+lineWidth :: DrawingCtxM m => m Double
 lineWidth = line_width <$> asksDC stroke_props
 
-fontSize :: (Applicative m, DrawingCtxM m) => m Int
+fontSize :: DrawingCtxM m => m Int
 fontSize = font_size <$> asksDC font_props
 
 
 
 
--- Maybe these functions are better as queries - i.e. functions
--- of type DrawingR, e.g.
--- 
--- > lineSpacing :: Fractional u => DrawingR u
--- 
--- Then the /client/ can just bound the answer directly
--- rather than using 
---
--- > askDF lineSpacing >>= \u -> ...
---
 
-lineSpacing :: (Applicative m, DrawingCtxM m, Fractional u) => m u
-lineSpacing = 
+-- | Vertical distance between baselines of consecutive text 
+-- lines.
+--
+baselineSpacing :: (DrawingCtxM m, Fractional u) => m u
+baselineSpacing = 
     (\sz factor -> realToFrac $ factor * fromIntegral sz)
       <$> asksDC (font_size . font_props) <*> asksDC line_spacing_factor
 
@@ -127,12 +119,11 @@
 -- Arrowheads, dots etc. should generally be drawn at the mark 
 -- height.
 -- 
-markHeight :: (Applicative m, DrawingCtxM m, FromPtSize u) => m u
+markHeight :: (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 :: (DrawingCtxM m, Fractional u, FromPtSize u) => m u
 markHalfHeight = (0.5*) <$> markHeight
 
 
@@ -146,28 +137,28 @@
 
 --------------------------------------------------------------------------------
 
-withFontSize :: (Applicative m, DrawingCtxM m) => (FontSize -> u) -> m u
+withFontSize :: DrawingCtxM m => (FontSize -> u) -> m u
 withFontSize fn = (fn . font_size) <$> asksDC font_props
 
-monoCharWidth :: (Applicative m, DrawingCtxM m, FromPtSize u) => m u
+monoCharWidth :: (DrawingCtxM m, FromPtSize u) => m u
 monoCharWidth = withFontSize (fromPtSize . charWidth)
 
-monoSpacerWidth :: (Applicative m, DrawingCtxM m, FromPtSize u) => m u
+monoSpacerWidth :: (DrawingCtxM m, FromPtSize u) => m u
 monoSpacerWidth = withFontSize (fromPtSize . spacerWidth)
 
 
-monoTextWidth :: (Applicative m, DrawingCtxM m, FromPtSize u) => Int -> m u
+monoTextWidth :: (DrawingCtxM m, FromPtSize u) => Int -> m u
 monoTextWidth n = withFontSize $ \sz -> fromPtSize $ textWidth sz n
 
 
-monoTextLength :: (Applicative m, DrawingCtxM m, FromPtSize u) => String -> m u
+monoTextLength :: (DrawingCtxM m, FromPtSize u) => String -> m u
 monoTextLength ss = monoTextWidth $ charCount ss
 
 
-monoTextHeight :: (Applicative m, DrawingCtxM m, FromPtSize u) => m u
+monoTextHeight :: (DrawingCtxM m, FromPtSize u) => m u
 monoTextHeight = withFontSize (fromPtSize . textHeight)
 
-monoNumeralHeight :: (Applicative m, DrawingCtxM m, FromPtSize u) => m u
+monoNumeralHeight :: (DrawingCtxM m, FromPtSize u) => m u
 monoNumeralHeight = withFontSize (fromPtSize . numeralHeight)
 
 
@@ -175,10 +166,10 @@
 --  
 -- \'x\' has no ascenders or descenders. 
 -- 
-monoLowerxHeight :: (Applicative m, DrawingCtxM m, FromPtSize u) => m u
+monoLowerxHeight :: (DrawingCtxM m, FromPtSize u) => m u
 monoLowerxHeight = withFontSize (fromPtSize . xcharHeight)
 
-monoDescenderDepth :: (Applicative m, DrawingCtxM m, FromPtSize u) => m u
+monoDescenderDepth :: (DrawingCtxM m, FromPtSize u) => m u
 monoDescenderDepth = withFontSize (fromPtSize . descenderDepth)
 
 
@@ -188,7 +179,7 @@
 -- Note - the width will generally be a over-estimate for 
 -- non-monospaced fonts.
 -- 
-monoTextDimensions :: (Applicative m, DrawingCtxM m, Num u, Ord u, FromPtSize u)
+monoTextDimensions :: (DrawingCtxM m, Num u, Ord u, FromPtSize u)
                    => String -> m (u,u)
 monoTextDimensions ss = 
     (\sz -> post $ textBounds sz zeroPt ss) 
@@ -197,9 +188,22 @@
     post bb = (boundaryWidth bb, boundaryHeight bb)
 
 
+monoMultiLineTextHeight :: (DrawingCtxM m, Fractional u, FromPtSize u) 
+                        => Int -> m u
+monoMultiLineTextHeight n | n < 0   = pure 0
+monoMultiLineTextHeight n           = 
+    (\h lsf -> h + (fromIntegral $ n-1) * (h * realToFrac lsf))
+      <$> monoTextHeight <*> asksDC line_spacing_factor
+ 
+
+-- | The default padding is half of the /char width/.
+--
+monoDefaultPadding :: (DrawingCtxM m, Fractional u, FromPtSize u) => m u
+monoDefaultPadding = (0.5*) <$> monoCharWidth
+
 -- | Vector from baseline left to center
-monoVecToCenter :: ( Applicative m, DrawingCtxM m
-                   , Fractional u, Ord u, FromPtSize u ) 
+--
+monoVecToCenter :: (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/Paths/Base.hs b/src/Wumpus/Basic/Paths/Base.hs
--- a/src/Wumpus/Basic/Paths/Base.hs
+++ b/src/Wumpus/Basic/Paths/Base.hs
@@ -26,15 +26,16 @@
     Path
   , DPath
   , length
+  , append
+  , pconcat
   , line
   , curve
-  , tracePoints
+  , traceLinePoints
+  , traceCurvePoints
   , curveByAngles
 
   , toPrimPath 
-  , toPrimPathU
 
-
   , tipL
   , tipR
 
@@ -44,7 +45,12 @@
   , directionL
   , directionR
 
-  , midpoint
+  , midway
+  , midway_
+  , atstart
+  , atstart_
+  , atend
+  , atend_
 
   , PathViewL(..)
   , DPathViewL
@@ -63,16 +69,14 @@
 import Data.AffineSpace
 import Data.VectorSpace
 
-import Data.Maybe
-import Data.Monoid
+import Data.List ( foldl' ) 
 import Data.Sequence ( Seq, (><), ViewL(..), viewl
                      , ViewR(..), viewr, (<|) , (|>) )
 import qualified Data.Sequence as S
 
 import Prelude hiding ( length )
 
-data Path u = PathEmpty 
-            | Path { _path_length   :: u 
+data Path u = Path { _path_length   :: u 
                    , _path_start    :: Point2 u
                    , _path_elements :: Seq (PathSeg u)
                    , _path_end      :: Point2 u
@@ -82,7 +86,7 @@
 type DPath = Path Double
 
 -- Annotating each segment with length is \*\* good \*\*.
--- Makes it much more efficient to find the midpoint.
+-- Makes it much more efficient to find the midway point.
 --
 -- But what do we do about the start point:
 --
@@ -116,24 +120,17 @@
 
 
 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 
 
-
-instance Floating u => Monoid (Path u) where
-  mempty  = PathEmpty
-  mappend = append
-
-
+pconcat :: Floating u => Path u -> [Path u] -> Path u
+pconcat p0 ps = foldl' append p0 ps
 
 segmentLength :: PathSeg u -> u
 segmentLength (LineSeg u _ _)       = u
@@ -164,16 +161,35 @@
 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
 
-
-tracePoints :: Floating u => [Point2 u] -> Path u
-tracePoints []       = PathEmpty
-tracePoints [a]      = line a a
-tracePoints (a:b:xs) = step (line a b) b xs
+-- | 'traceLinePoints' throws a runtime error if the supplied list
+-- is empty. 
+--
+traceLinePoints :: Floating u => [Point2 u] -> Path u
+traceLinePoints []       = error "traceLinePoints - empty point list."
+traceLinePoints [a]      = line a a
+traceLinePoints (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
+    step acc e (y:ys) = step (acc `append` line e y) y ys
 
 
+-- | 'traceCurvePoints' consumes 4 points from the list on the 
+-- intial step (start, control1, control2, end) then steps 
+-- through the list taking 3 points at a time thereafter
+-- (control1,control2, end). Leftover points are discarded.    
+-- 
+-- 'traceCurvePoints' throws a runtime error if the supplied list
+-- is has less than 4 elements (start, control1, control2, end). 
+--
+traceCurvePoints :: (Floating u, Ord u) => [Point2 u] -> Path u
+traceCurvePoints (a:b:c:d:xs) = step (curve a b c d) d xs
+  where
+    step acc p0 (x:y:z:zs) = step (acc `append` curve p0 x y z) z zs
+    step acc _  _          = acc
+
+traceCurvePoints _            = error "tracePointsCurve - less than 4 elems."
+
+
 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
@@ -186,21 +202,16 @@
 
 -- | 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
--- have at least start point.
---
 -- Assumes path is properly formed - i.e. end point of one 
 -- segment is the same point as the start point of the next
 -- segment.
 --
-toPrimPath :: Path u -> Maybe (PrimPath u)
-toPrimPath PathEmpty         = Nothing
+toPrimPath :: Path u -> PrimPath u
 toPrimPath (Path _ _ segs _) = step1 $ viewl segs
   where
-    step1 EmptyL                  = Nothing
+    step1 EmptyL                  = error "toPrimPath - (not) unreachable."
     step1 (e :< se)               = let (start,a) = seg1 e in 
-                                    Just $ path start $ a : step2 (viewl se)
+                                    path start $ a : step2 (viewl se)
 
     step2 EmptyL                  = []
     step2 (e :< se)               = seg2 e : step2 (viewl se)
@@ -210,11 +221,6 @@
  
     seg2 (LineSeg  _ _  p1)       = lineTo p1
     seg2 (CurveSeg _ _  p1 p2 p3) = curveTo p1 p2 p3
- 
-toPrimPathU :: Path u -> PrimPath u
-toPrimPathU = fromMaybe errK . toPrimPath
-  where
-    errK = error "toPathU - empty Path"
 
 
 
@@ -250,7 +256,7 @@
 cordLength (Curve p0 _ _ p3) = vlength $ pvec p0 p3
 
 
--- | midpoint between two points
+-- | mid-point between two points
 --
 pointMidpoint :: Fractional u => Point2 u -> Point2 u -> Point2 u
 pointMidpoint p0 p1 = p0 .+^ v1 ^/ 2 where v1 = p1 .-. p0
@@ -290,31 +296,34 @@
 --------------------------------------------------------------------------------
 -- tips 
 
-tipL :: Path u -> Maybe (Point2 u)
-tipL PathEmpty       = Nothing
-tipL (Path _ sp _ _) = Just sp
+tipL :: Path u -> Point2 u
+tipL (Path _ sp _ _) = sp
 
 
-tipR :: Path u -> Maybe (Point2 u)
-tipR PathEmpty       = Nothing
-tipR (Path _ _ _ ep) = Just ep
+tipR :: Path u -> Point2 u
+tipR (Path _ _ _ ep) = ep
 
 
 -- | Shorten both ends...
 --
+-- u should be less-than half the path length
+--
 shortenBoth :: (Real u, Floating u) => u -> Path u -> Path u
 shortenBoth u p = shortenL u $ shortenR u p
 
 --------------------------------------------------------------------------------
 -- shorten from the left...
 
+-- | Note - shortening a line from the left by 
+-- greater-than-or-equal its length is operationally equivalent 
+-- to making a zero-length line at the end point.
+--
 shortenL :: (Real u, Floating u) => u -> Path u -> Path u
-shortenL _ PathEmpty          = PathEmpty
 shortenL n (Path u _ segs ep) 
-    | n >= u                  = PathEmpty
+    | n >= u                  = line ep ep
     | otherwise               = step n (viewl segs)
   where
-    step _ EmptyL     = PathEmpty
+    step _ EmptyL     = line ep ep      -- should be unreachable
     step d (e :< se)  = let z  = segmentLength e in
                         case compare d z of
                           GT -> step (d-z) (viewl se)
@@ -323,10 +332,10 @@
                                 in Path (u-n) (segmentStart e1) (e1 <| se) ep
 
 
-makeLeftPath :: u -> Seq (PathSeg u) -> Point2 u -> Path u
+makeLeftPath :: Floating u => u -> Seq (PathSeg u) -> Point2 u -> Path u
 makeLeftPath u se ep = 
     case viewl se of
-      EmptyL   -> PathEmpty 
+      EmptyL   -> line ep ep
       (e :< _) -> Path u (segmentStart e) se ep
 
 
@@ -351,13 +360,16 @@
 --------------------------------------------------------------------------------
 -- shorten from the right ...
  
+-- | Note - shortening a line from the right by 
+-- greater-than-or-equal its length is operationally equivalent 
+-- to making a zero-length line at the start point.
+--
 shortenR :: (Real u, Floating u) => u -> Path u -> Path u
-shortenR _ PathEmpty          = PathEmpty
 shortenR n (Path u sp segs _) 
-    | n >= u                  = PathEmpty
+    | n >= u                  = line sp sp
     | otherwise               = step n (viewr segs)
   where
-    step _ EmptyR     = PathEmpty
+    step _ EmptyR     = line sp sp      -- should be unreachable
     step d (se :> e)  = let z = segmentLength e in
                         case compare d z of
                           GT -> step (d-z) (viewr se)
@@ -366,10 +378,10 @@
                                 in Path (u-n) sp (se |> e1) (segmentEnd e1)
                          
 
-makeRightPath :: u -> Point2 u -> Seq (PathSeg u) -> Path u
+makeRightPath :: Floating u => u -> Point2 u -> Seq (PathSeg u) -> Path u
 makeRightPath u sp se = 
     case viewr se of
-      EmptyR   -> PathEmpty 
+      EmptyR   -> line sp sp
       (_ :> e) -> Path u sp se (segmentEnd e)
 
 
@@ -399,33 +411,22 @@
 -- | 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
+    step _                            = 0       -- should be unreachable
 
 
 -- | 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
+    step _                            = 0       -- should be unreachable             
 
-{-
--- 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)
--}
 
 
 
@@ -434,22 +435,44 @@
 
 -- 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
+midway :: (Real u, Floating u) => Path u -> (Point2 u, Radian)
+midway pa@(Path u sp _ _) 
+    | u == 0    = (sp,0)
+    | otherwise = let pa1 = shortenR (u/2) pa in (tipR pa1, directionR pa1)
 
+-- Just the midway point.
+--
+midway_ :: (Real u, Floating u) => Path u -> Point2 u
+midway_ = fst . midway
 
+
+atstart :: (Real u, Floating u) => Path u -> (Point2 u, Radian)
+atstart pa@(Path _ sp _ _) = (sp, directionL pa)
+
+atstart_ :: Path u -> Point2 u
+atstart_ (Path _ sp _ _) = sp
+
+
+atend :: (Real u, Floating u) => Path u -> (Point2 u, Radian)
+atend pa@(Path _ _ _ ep) = (ep, directionR pa)
+ 
+
+atend_ :: Path u -> Point2 u
+atend_ (Path _ _ _ ep) = ep
+
+
+-- nearstart, nearend, verynear ...
+
+
 --------------------------------------------------------------------------------
 
-data PathViewL u = EmptyPathL
+data PathViewL u = PathOneL (PathSegment u)
                  | PathSegment u :<< Path u
   deriving (Eq,Ord,Show) 
 
 type DPathViewL = PathViewL Double
 
-data PathViewR u = EmptyPathR
+data PathViewR u = PathOneR (PathSegment u)
                  | Path u :>> PathSegment u
   deriving (Eq,Ord,Show) 
 
@@ -467,16 +490,29 @@
 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
+pathViewL (Path u _ segs ep) = go (viewl segs)
+  where
+    go EmptyL                   = error "pathViewL - (not) unreachable."
+     
+    go (LineSeg v p0 p1 :< se)
+        | S.null se             = PathOneL (Line1 p0 p1)
+        | otherwise             = Line1 p0 p1 :<< Path (u-v) p1 se ep
 
+    go (CurveSeg v p0 p1 p2 p3 :< se) 
+        | S.null se             = PathOneL (Curve1 p0 p1 p2 p3)
+        | otherwise             = 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
+pathViewR (Path u _ segs ep) = go (viewr segs)
+  where
+    go EmptyR                   = error "pathViewR - (not) unreachable."
+
+    go (se :> LineSeg v p0 p1) 
+        | S.null se             = PathOneR (Line1 p0 p1)
+        | otherwise             = Path (u-v) p1 se ep :>> Line1 p0 p1
+
+    go (se :> CurveSeg v p0 p1 p2 p3) 
+        | S.null se             = PathOneR (Curve1 p0 p1 p2 p3)
+        | otherwise             = 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
@@ -20,7 +20,7 @@
 module Wumpus.Basic.Paths.Connectors 
   ( 
 
-    Connector
+    ConnectorPath
   , connect
   , vhconn
   , hvconn
@@ -41,39 +41,39 @@
 
 import Prelude hiding ( length )
 
-type Connector u = Point2 u -> Point2 u -> Path u
+type ConnectorPath u = Point2 u -> Point2 u -> Path u
 
-connect :: Floating u => Connector u
+connect :: Floating u => ConnectorPath u
 connect = line
 
-vhconn :: Floating u => Connector u
+vhconn :: Floating u => ConnectorPath u
 vhconn p1@(P2 x1 _) p2@(P2 _ y2) = 
-    let mid = P2 x1 y2 in tracePoints [p1, mid, p2]
+    let mid = P2 x1 y2 in traceLinePoints [p1, mid, p2]
 
-hvconn :: Floating u => Connector u
+hvconn :: Floating u => ConnectorPath u
 hvconn p1@(P2 _ y1) p2@(P2 x2 _) = 
-    let mid = P2 x2 y1 in tracePoints [p1, mid, p2]
+    let mid = P2 x2 y1 in traceLinePoints [p1, mid, p2]
 
-vhvconn :: Floating u => u -> Connector u
-vhvconn v p1@(P2 x1 _) p2@(P2 x2 _) = tracePoints [p1, a1, a2, p2]
+vhvconn :: Floating u => u -> ConnectorPath u
+vhvconn v p1@(P2 x1 _) p2@(P2 x2 _) = traceLinePoints [p1, a1, a2, p2]
   where
     a1 = p1 .+^ vvec v
     a2 = a1 .+^ hvec (x2 - x1)
 
 
-hvhconn :: Floating u => u -> Connector u
-hvhconn h p1@(P2 _ y1) p2@(P2 _ y2) = tracePoints [p1,a1,a2,p2]
+hvhconn :: Floating u => u -> ConnectorPath u
+hvhconn h p1@(P2 _ y1) p2@(P2 _ y2) = traceLinePoints [p1,a1,a2,p2]
   where
     a1 = p1 .+^ hvec h
     a2 = a1 .+^ vvec (y2 - y1)
 
-curveconn :: (Floating u, Ord u) => Radian -> Radian -> Connector u
+curveconn :: (Floating u, Ord u) => Radian -> Radian -> ConnectorPath u
 curveconn r1 r2 p1 p2 = curveByAngles p1 r1 r2 p2
 
 
-joint :: (Real u, Floating u) => u -> Connector u 
+joint :: (Real u, Floating u) => u -> ConnectorPath u 
 joint u p1@(P2 x1 y1) p2@(P2 x2 y2) = 
-    tracePoints [p1, mid_pt .+^ avec perp_ang u, p2]
+    traceLinePoints [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) 
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
@@ -42,14 +42,14 @@
   ) where
 
 import Wumpus.Basic.Paths.Base
+import Wumpus.Basic.Utils.HList
 
 import Wumpus.Core                              -- package: wumpus-core
 
 import Data.AffineSpace                         -- package: vector-space
 
 import Control.Applicative
-import Data.Maybe
-import Data.Monoid
+import Data.List
 
 
 -- Are connectors and paths quite different things?
@@ -60,11 +60,11 @@
 
 
 -- State monad version is quite good - it ameliorates the problem
--- of joing to the end point of an empty path...
+-- of joining to the end point of an empty path...
 
 data St u = St
       { current_point :: Point2 u 
-      , path_acc      :: Path u
+      , path_acc      :: H (Path u)
       }
 
 
@@ -91,18 +91,21 @@
 -- 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')
+runPath start mf = 
+    let (a,s') = getPathM mf s in (a, post $ toListH $ path_acc s')
   where
     s = St { current_point = start
-           , path_acc      = mempty
+           , path_acc      = emptyH
            }
+    post []     = line start start
+    post (x:xs) = foldl' append x xs  
 
 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))
+                                    in ((), St ep (ac `snocH` line pt ep))
 
 
 tip :: PathM u (Point2 u)
@@ -110,7 +113,7 @@
 
 
 lineto :: Floating u => Point2 u -> PathM u ()
-lineto pt = PathM $ \(St p0 ac) -> ((), St pt (ac `mappend` line p0 pt))
+lineto pt = PathM $ \(St p0 ac) -> ((), St pt (ac `snocH` line p0 pt))
 
 rlineto :: Floating u => Vec2 u -> PathM u ()
 rlineto (V2 dx dy) = tip >>= \(P2 x y) -> lineto (P2 (x+dx) (y+dy))
@@ -127,7 +130,7 @@
 bezierto :: (Floating u, Ord u) 
          => Point2 u -> Point2 u -> Point2 u -> PathM u ()
 bezierto c1 c2 ep = PathM $ \(St p0 ac) -> 
-    ((), St ep (ac `mappend` curve p0 c1 c2 ep))
+    ((), St ep (ac `snocH` curve p0 c1 c2 ep))
 
 
 
@@ -140,8 +143,8 @@
         => Radian -> Radian -> Point2 u -> PathM u ()
 curveto cin cout end = PathM $ \(St p0 ac) -> 
     let seg  = curveByAngles p0 cin cout end 
-        ac1  = ac `mappend` seg
-        end1 = fromMaybe end $ tipR ac1
+        ac1  = ac `snocH` seg
+        end1 = tipR seg
     in ((), St end1 ac1) 
 
 
diff --git a/src/Wumpus/Basic/Paths/RoundCorners.hs b/src/Wumpus/Basic/Paths/RoundCorners.hs
--- a/src/Wumpus/Basic/Paths/RoundCorners.hs
+++ b/src/Wumpus/Basic/Paths/RoundCorners.hs
@@ -34,7 +34,6 @@
 
 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).
@@ -49,22 +48,26 @@
     cp2  = p3 .+^ (avec (langle p3 p2) len2)
 
 
+-- | 'roundEvery' throws a runtime error if the input list has
+-- less than 3 eleemnts.
+--
 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 (m:n:o:ps)     = step (acc `append` twoParts u m n o) (n:o:ps)
+    step acc [n,o]          = acc `append` twoParts u n o start
+                                  `append` twoParts u o start b 
     step acc _              = acc
-roundEvery _ _              = mempty
 
+roundEvery _ _              = error "roundEvery - input list too short."
 
+
 -- | 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
+twoParts u a b c = line p1 p2 `append` cornerCurve p2 b p3
   where
     p1 = a .+^ (avec (direction $ pvec a b) u)
     p2 = b .+^ (avec (direction $ pvec b a) u)
@@ -84,11 +87,11 @@
 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)
+    step1 (PathOneL e)  = drawPath1 e
+    step1 (e :<< se)    = drawPathBoth e `mappend` rest (pathViewL se)
 
-    rest EmptyPathL = mempty
-    rest (e :<< se) = drawPath1 e `mappend` rest (pathViewL se)
+    rest (PathOneL e)   = drawPath1 e
+    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
@@ -99,8 +102,8 @@
     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]
+    mconcat [bezierCtrl p1 p2, bezierCtrl p4 p3, curveBetween p1 p2 p3 p4
+                             , pathPoint p4 ]
 
 
 bezierCtrl :: Fractional u => Point2 u -> Point2 u -> Graphic u
diff --git a/src/Wumpus/Basic/SafeFonts.hs b/src/Wumpus/Basic/SafeFonts.hs
--- a/src/Wumpus/Basic/SafeFonts.hs
+++ b/src/Wumpus/Basic/SafeFonts.hs
@@ -18,22 +18,22 @@
 module Wumpus.Basic.SafeFonts
   ( 
   -- * Times Roman
-    timesRoman
-  , timesItalic
-  , timesBold
-  , timesBoldItalic
+    times_roman
+  , times_italic
+  , times_bold
+  , times_bold_italic
 
   -- * Helvetica
   , helvetica
-  , helveticaOblique
-  , helveticaBold
-  , helveticaBoldOblique
+  , helvetica_oblique
+  , helvetica_bold
+  , helvetica_bold_oblique
 
   -- * Courier
   , courier
-  , courierOblique
-  , courierBold
-  , courierBoldOblique
+  , courier_oblique
+  , courier_bold
+  , courier_bold_oblique
 
   -- * Symbol
   , symbol
@@ -56,29 +56,29 @@
 
 -- | Times-Roman
 -- 
-timesRoman :: FontFace
-timesRoman = 
+times_roman :: FontFace
+times_roman = 
     FontFace "Times-Roman" "Times New Roman" SVG_REGULAR latin1_font_encoder
 
 -- | Times Italic
 --
-timesItalic :: FontFace
-timesItalic = 
+times_italic :: FontFace
+times_italic = 
     FontFace "Times-Italic" "Times New Roman" SVG_ITALIC latin1_font_encoder
                        
 -- | Times Bold
 --
-timesBold :: FontFace
-timesBold = 
+times_bold :: FontFace
+times_bold = 
     FontFace "Times-Bold" "Times New Roman" SVG_BOLD latin1_font_encoder
 
 -- | Times Bold Italic
 --
-timesBoldItalic :: FontFace
-timesBoldItalic = FontFace "Times-BoldItalic" 
-                           "Times New Roman" 
-                           SVG_BOLD_ITALIC 
-                           latin1_font_encoder
+times_bold_italic :: FontFace
+times_bold_italic = FontFace "Times-BoldItalic" 
+                             "Times New Roman" 
+                             SVG_BOLD_ITALIC 
+                             latin1_font_encoder
 
 
 --------------------------------------------------------------------------------
@@ -92,24 +92,24 @@
 
 -- | Helvetica Oblique
 --
-helveticaOblique :: FontFace
-helveticaOblique = 
+helvetica_oblique :: FontFace
+helvetica_oblique = 
     FontFace "Helvetica-Oblique" "Helvetica" SVG_OBLIQUE latin1_font_encoder
 
 -- | Helvetica Bold
 -- 
-helveticaBold :: FontFace
-helveticaBold = 
+helvetica_bold :: FontFace
+helvetica_bold = 
     FontFace "Helvetica-Bold" "Helvetica" SVG_BOLD latin1_font_encoder
 
 
 -- | Helvetica Bold Oblique
 --
-helveticaBoldOblique :: FontFace
-helveticaBoldOblique = FontFace "Helvetica-Bold-Oblique" 
-                                "Helvetica" 
-                                SVG_BOLD_OBLIQUE 
-                                latin1_font_encoder
+helvetica_bold_oblique :: FontFace
+helvetica_bold_oblique = FontFace "Helvetica-Bold-Oblique" 
+                                  "Helvetica" 
+                                  SVG_BOLD_OBLIQUE 
+                                  latin1_font_encoder
 
 
 
@@ -122,24 +122,24 @@
 
 -- | Courier Oblique
 -- 
-courierOblique :: FontFace
-courierOblique = 
+courier_oblique :: FontFace
+courier_oblique = 
     FontFace "Courier-Oblique" "Courier New" SVG_OBLIQUE latin1_font_encoder
 
 -- | Courier Bold
 -- 
-courierBold :: FontFace
-courierBold = 
+courier_bold :: FontFace
+courier_bold = 
     FontFace "Courier-Bold" "Courier New" SVG_BOLD latin1_font_encoder
 
 
 -- | Courier Bold Oblique
 -- 
-courierBoldOblique :: FontFace
-courierBoldOblique = FontFace "Courier-Bold-Oblique" 
-                              "Courier New" 
-                              SVG_BOLD_OBLIQUE 
-                              latin1_font_encoder
+courier_bold_oblique :: FontFace
+courier_bold_oblique = FontFace "Courier-Bold-Oblique" 
+                                "Courier New" 
+                                SVG_BOLD_OBLIQUE 
+                                latin1_font_encoder
 
 --------------------------------------------------------------------------------
 -- Symbol
diff --git a/src/Wumpus/Basic/Shapes.hs b/src/Wumpus/Basic/Shapes.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Basic/Shapes.hs
@@ -0,0 +1,29 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Basic.Shapes
+-- Copyright   :  (c) Stephen Tetley 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  GHC
+--
+-- Shim module for Shapes.
+-- 
+--------------------------------------------------------------------------------
+
+module Wumpus.Basic.Shapes
+  ( 
+    module Wumpus.Basic.Shapes.Base
+  , module Wumpus.Basic.Shapes.Coordinate
+  , module Wumpus.Basic.Shapes.Derived
+  , module Wumpus.Basic.Shapes.Plaintext
+
+  ) where
+
+import Wumpus.Basic.Shapes.Base
+import Wumpus.Basic.Shapes.Coordinate
+import Wumpus.Basic.Shapes.Derived hiding ( mkRectangle )
+import Wumpus.Basic.Shapes.Plaintext
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
@@ -14,6 +14,9 @@
 --
 -- Common core for shapes
 -- 
+-- \*\* WARNING \*\* - the types of Shapes and Plaintext are not
+-- ideal and are pending revision.
+--
 --------------------------------------------------------------------------------
 
 module Wumpus.Basic.Shapes.Base
@@ -21,8 +24,11 @@
 
 
     Shape(..)
+  , ShapeConstructor
 
-  , drawShape
+  , borderedShape
+  , filledShape
+  , strokedShape
 
   -- * ShapeCTM 
   , ShapeCTM(..)
@@ -31,23 +37,16 @@
   , ctmDisplace
   , ctmCenter
 
-  , ShapeLabel
-  , runShapeLabel
-  , nolabel
-  , shapelabel
 
   ) where
 
 import Wumpus.Basic.Graphic
-
+import Wumpus.Basic.Paths
 
 import Wumpus.Core                              -- package: wumpus-core
 
-import Data.AffineSpace                         -- package: vector-space
 
-
 import Control.Applicative
-import Data.Monoid
 
 
 -- | Note - this formulation prevents rounded corner shapes...
@@ -65,21 +64,32 @@
 -- DrawingContext for the /shape/
 --
 
-data Shape u sh =  Shape 
-      { src_ctm :: ShapeCTM u 
-      , out_fun :: ShapeCTM u -> Image u sh
+data Shape u t =  Shape 
+      { src_ctm   :: ShapeCTM u 
+      , path_fun  :: ShapeCTM u -> Path u
+      , cons_fun   :: ShapeCTM u -> t u
       }
 
 type instance DUnit (Shape u sh) = u
 
 
+type ShapeConstructor u t = ShapeCTM u -> t u 
 
 
 
-drawShape :: Shape u sh -> Image u sh
-drawShape (Shape { src_ctm = ctm, out_fun = fn }) = fn ctm 
+borderedShape :: Num u => Shape u t -> Image u (t u)
+borderedShape (Shape { src_ctm = ctm, path_fun = pf, cons_fun = objf }) = 
+   intoImage (pure $ objf ctm) (borderedPath $ toPrimPath $ pf ctm)
 
+filledShape :: Num u => Shape u t -> Image u (t u)
+filledShape (Shape { src_ctm = ctm, path_fun = pf, cons_fun = objf }) = 
+   intoImage (pure $ objf ctm) (filledPath $ toPrimPath $ pf ctm)
 
+strokedShape :: Num u => Shape u t -> Image u (t u)
+strokedShape (Shape { src_ctm = ctm, path_fun = pf, cons_fun = objf }) = 
+   intoImage (pure $ objf ctm) (closedStroke $ toPrimPath $ pf ctm)
+
+
 instance (Real u, Floating u) => Rotate (Shape u sh) where
   rotate r = updateCTM (rotateCTM r)
 
@@ -90,7 +100,7 @@
   translate x y = updateCTM (translateCTM x y)
 
 updateCTM :: (ShapeCTM u -> ShapeCTM u) -> Shape u sh -> Shape u sh
-updateCTM fn (Shape ctm out) = Shape (fn ctm) out
+updateCTM fn (Shape ctm pf mkf) = Shape (fn ctm) pf mkf
 
 --------------------------------------------------------------------------------
 -- CTM
@@ -106,7 +116,7 @@
       , ctm_scale_y             :: !u
       , ctm_rotation            :: Radian
       }
-  deriving (Eq,Show)
+  deriving (Eq,Ord,Show)
 
 type instance DUnit (ShapeCTM u) = u
 
@@ -150,28 +160,3 @@
 ctmCenter = ctmDisplace zeroPt
 
 
-newtype ShapeLabel u = ShapeLabel { getShapeLabel :: ShapeCTM u -> Graphic u }
-
-runShapeLabel :: ShapeCTM u -> ShapeLabel u -> Graphic u
-runShapeLabel ctm sl = getShapeLabel sl ctm
-
-nolabel :: ShapeLabel u
-nolabel = ShapeLabel $ \_ -> mempty
-
--- | No scaling - change font size if needed.
---
-shapelabel :: (Real u, Floating u, FromPtSize u) 
-             => String -> ShapeLabel u
-shapelabel text = 
-   ShapeLabel $ \(ShapeCTM { ctm_trans_x=dx, ctm_trans_y=dy
-                           , ctm_rotation = ang }) ->
-                   monoVecToCenter text >>= \v -> 
-                   let ctr = P2 dx dy; bl = ctr .-^ v in 
-                   rotTextline ang text (rotateAbout ang ctr bl)
-
-
-rotTextline :: (Real u, Floating u) => Radian -> String -> LocGraphic u
-rotTextline theta ss baseline_left = 
-    withTextAttr $ \rgb attr -> 
-        singleH $ rotatePrim theta $ textlabel rgb attr ss baseline_left
-     
diff --git a/src/Wumpus/Basic/Shapes/Coordinate.hs b/src/Wumpus/Basic/Shapes/Coordinate.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Basic/Shapes/Coordinate.hs
@@ -0,0 +1,88 @@
+{-# LANGUAGE TypeFamilies               #-}
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Basic.Shapes.Coordinate
+-- Copyright   :  (c) Stephen Tetley 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  GHC
+--
+-- Coordinate is a bit like a shape but does not generate a path 
+-- and cannot be scaled or rotated (it can be translated).
+-- 
+-- \*\* WARNING \*\* - the types of Shapes and Coordinate are not
+-- ideal and are pending revision.
+--
+--------------------------------------------------------------------------------
+
+module Wumpus.Basic.Shapes.Coordinate
+  (
+    CoordinateAnchor
+  , DCoordinateAnchor
+  , Coordinate
+  , DCoordinate
+  , coordinate
+
+  , coordinateMark
+
+  ) where
+
+import Wumpus.Basic.Anchors
+import Wumpus.Basic.Graphic
+
+import Wumpus.Core                              -- package: wumpus-core
+
+
+
+
+
+--------------------------------------------------------------------------------
+-- | Coordinate
+
+data CoordinateAnchor u = CoordinateAnchor
+      { coord_x   :: !u
+      , coord_y   :: !u
+      }
+  deriving (Eq,Ord,Show)
+
+type DCoordinateAnchor = CoordinateAnchor Double
+
+type instance DUnit (CoordinateAnchor u) = u
+
+newtype Coordinate u = Coordinate { getCoordinate :: CoordinateAnchor u }
+  deriving (Eq,Ord,Show)
+
+type DCoordinate = Coordinate Double
+
+type instance DUnit (Coordinate u) = u
+
+
+instance (Real u, Floating u) => CenterAnchor (CoordinateAnchor u) where
+  center (CoordinateAnchor x y) = P2 x y
+
+instance Num u => Translate (Coordinate u) where
+  translate dx dy = Coordinate . fn . getCoordinate 
+    where 
+      fn (CoordinateAnchor x y) = CoordinateAnchor (x+dx) (y+dy)
+
+-- Need a differentiation at the type level between a coord
+-- that can be translated (moved) and a coord that anchors...
+
+coordinate :: Num u => Point2 u -> Coordinate u
+coordinate (P2 x y) = Coordinate $ CoordinateAnchor { coord_x = x, coord_y = y }
+
+-- Note - should @coordinate@ take a point, Shapes don\'t.
+
+
+coordinateMark :: (Real u, Floating u) 
+               => Coordinate u -> Image u (CoordinateAnchor u)
+coordinateMark x = intoImage (return $ getCoordinate x) (drawCoord x)
+
+drawCoord :: (Real u, Floating u) => Coordinate u -> Graphic u
+drawCoord coord = 
+   localize bothStrokeColour $ filledEllipse 2 2 (center $ getCoordinate coord)
+
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
@@ -13,7 +13,10 @@
 -- Stability   :  highly unstable
 -- Portability :  GHC
 --
+-- Simple shapes - rectangle, circle diamond, ellipse.
 -- 
+-- \*\* WARNING \*\* - the types of Shapes and Plaintext are not
+-- ideal and are pending revision.
 -- 
 --------------------------------------------------------------------------------
 
@@ -22,35 +25,31 @@
     Rectangle
   , DRectangle
   , rectangle
-  , lrectangle
+  , rrectangle
 
+  , mkRectangle   -- hidden in Shim module
+
   , Circle
   , DCircle
   , circle
-  , lcircle
 
-  , Coordinate
-  , DCoordinate
-  , coordinate
 
   , Diamond
   , DDiamond
   , diamond
-  , ldiamond
+  , rdiamond
 
+
   , Ellipse
   , DEllipse
   , ellipse
-  , lellipse
 
-  , FreeLabel
-  , DFreeLabel
-  , freelabel
 
   ) where
 
 import Wumpus.Basic.Anchors
-import Wumpus.Basic.Graphic
+import Wumpus.Basic.Paths
+import Wumpus.Basic.Paths.RoundCorners
 import Wumpus.Basic.Shapes.Base
 import Wumpus.Basic.Utils.Intersection
 
@@ -58,9 +57,11 @@
 
 import Data.AffineSpace                         -- package: vector-space 
 
-import Data.Monoid
 
+remapPoints :: (Real u, Floating u) => [Point2 u] -> ShapeCTM u -> [Point2 u]
+remapPoints xs ctm = map (ctmDisplace `flip` ctm) xs
 
+
 --------------------------------------------------------------------------------
 -- Rectangle
 
@@ -69,7 +70,7 @@
       , rect_hw     :: !u
       , rect_hh     :: !u 
       }
-  deriving (Eq,Show)
+  deriving (Eq,Ord,Show)
 
 type DRectangle = Rectangle Double
 
@@ -104,37 +105,43 @@
     where 
       ctr = ctmCenter $ rect_ctm rect
 
-rectangle :: (Real u, Floating u) => u -> u -> Shape u (Rectangle u)
-rectangle w h = Shape { src_ctm = identityCTM
-                      , out_fun = outputRect (0.5*w) (0.5*h) nolabel
-                      }
 
+-- | 'rectangle'  : @ width * height -> shape @
+--
+rectangle :: (Real u, Floating u) => u -> u -> Shape u Rectangle
+rectangle w h = 
+    Shape { src_ctm   = identityCTM
+          , path_fun  = traceLinePoints . rectanglePoints (0.5*w) (0.5*h)
+          , cons_fun  = mkRectangle (0.5*w) (0.5*h)  
+          }
 
-lrectangle :: (Real u, Floating u, FromPtSize u) 
-           => u -> u -> String -> Shape u (Rectangle u)
-lrectangle w h ss = Shape { src_ctm = identityCTM
-                          , out_fun = outputRect (0.5*w) (0.5*h) (shapelabel ss)
-                          }
+-- | 'rectangle'  : @ round_length * width * height -> shape @
+--
+rrectangle :: (Real u, Floating u) => u -> u -> u -> Shape u Rectangle
+rrectangle round_dist w h = 
+    Shape { src_ctm   = identityCTM
+          , path_fun  = roundEvery round_dist . rectanglePoints (0.5*w) (0.5*h)
+          , cons_fun  = mkRectangle (0.5*w) (0.5*h)  
+          }
 
 
-outputRect :: (Real u, Floating u) 
-           => u -> u -> ShapeLabel u -> ShapeCTM u -> Image u (Rectangle u)
-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
 
+mkRectangle :: u -> u -> ShapeConstructor u Rectangle
+mkRectangle hw hh = \ctm -> 
+    Rectangle { rect_ctm = ctm, rect_hw = hw, rect_hh = hh }
 
-drawRect :: (Real u, Floating u) => Rectangle u -> Graphic u
-drawRect = borderedPath . rectPath
 
 
-rectPath :: (Real u, Floating u) => Rectangle u -> PrimPath u
-rectPath rect = vertexPath [ southwest rect
-                           , southeast rect
-                           , northeast rect
-                           , northwest rect
-                           ]
+-- Note - the Paths modules should define a function for building
+-- rectangles (and polygons, bezier curves / ellipses ...)
+--
+rectanglePoints :: (Real u, Floating u) => u -> u -> ShapeCTM u -> [Point2 u]
+rectanglePoints hw hh = remapPoints [ se, ne, nw, sw ]
+  where
+    se = P2   hw  (-hh)
+    ne = P2   hw    hh
+    nw = P2 (-hw)   hh
+    sw = P2 (-hw) (-hh) 
 
 
 
@@ -162,86 +169,46 @@
 calcCircPoint f (Circle { circ_ctm = ctm, circ_radius = rad }) =
     let pt = f rad in ctmDisplace pt ctm
 
-instance (Real u, Floating u) => CardinalAnchor (Circle u) where
-  north = calcCircPoint $ \ r -> P2 0  r
-  south = calcCircPoint $ \ r -> P2 0 (-r)
-  east  = calcCircPoint $ \ r -> P2 r  0
-  west  = calcCircPoint $ \ r -> P2 (-r) 0
 
+
 instance (Real u, Floating u) => RadialAnchor (Circle u) where
   radialAnchor theta = calcCircPoint $ \r -> zeroPt .+^ avec theta r
 
+instance (Real u, Floating u) => CardinalAnchor (Circle u) where
+  north = calcCircPoint $ \r -> P2 0    r
+  south = calcCircPoint $ \r -> P2 0  (-r)
+  east  = calcCircPoint $ \r -> P2 r    0
+  west  = calcCircPoint $ \r -> P2 (-r) 0
 
+
 instance (Real u, Floating u) => CardinalAnchor2 (Circle u) where
   northeast = radialAnchor (0.25*pi)
   southeast = radialAnchor (1.75*pi)
   southwest = radialAnchor (1.25*pi)
   northwest = radialAnchor (0.75*pi)
 
-
-circle :: (Real u, Floating u) => u -> Shape u (Circle u)
-circle radius = Shape { src_ctm = identityCTM
-                      , out_fun = outputCirc radius nolabel
-                      }
-
-
-lcircle :: (Real u, Floating u, FromPtSize u) 
-        => u -> String -> Shape u (Circle u)
-lcircle radius ss = Shape { src_ctm = identityCTM
-                          , out_fun = outputCirc radius (shapelabel ss)
-                          }
-
-outputCirc :: (Real u, Floating u) 
-           => u -> ShapeLabel u -> ShapeCTM u -> Image u (Circle u)
-outputCirc rad shl ctm = intoImage (return a) (drawCirc a `mappend` label) 
-  where
-    a     = Circle { circ_ctm = ctm, circ_radius = rad }
-    label = runShapeLabel ctm shl
+-- | 'circle'  : @ radius -> shape @
+--
+circle :: (Real u, Floating u) => u -> Shape u Circle
+circle radius = 
+    Shape { src_ctm  = identityCTM
+          , path_fun = traceCurvePoints . circlePoints radius
+          , cons_fun = mkCircle radius
+          }
 
 
-drawCirc :: (Real u, Floating u) => Circle u -> Graphic u
-drawCirc = borderedPath . circlePath
+mkCircle :: u -> ShapeConstructor u Circle
+mkCircle radius = \ctm -> Circle { circ_ctm = ctm, circ_radius = radius }
 
 
-circlePath :: (Real u, Floating u) => Circle u -> PrimPath u
-circlePath = curvedPath . circlePoints 
-
-circlePoints :: (Real u, Floating u) => Circle u -> [Point2 u]
-circlePoints (Circle { circ_ctm=ctm, circ_radius=radius }) = map fn all_points
+circlePoints :: (Real u, Floating u) => u -> ShapeCTM u -> [Point2 u]
+circlePoints radius ctm = map fn all_points
   where
     fn pt       = ctmDisplace pt ctm
     all_points  = bezierCircle 2 radius zeroPt 
 
 
---------------------------------------------------------------------------------
--- | Coordinate
 
-data Coordinate u = Coordinate
-      { coord_ctm   :: ShapeCTM u 
-      }
-
-type DCoordinate = Coordinate Double
-
-type instance DUnit (Coordinate u) = u
-
-instance (Real u, Floating u) => CenterAnchor (Coordinate u) where
-  center = ctmCenter . coord_ctm
-
-
-coordinate :: (Real u, Floating u) => Shape u (Coordinate u)
-coordinate = Shape { src_ctm = identityCTM
-                   , out_fun = outputCoord
-                   }
-
-outputCoord :: (Real u, Floating u) => ShapeCTM u -> Image u (Coordinate u)
-outputCoord ctm = intoImage (return a) (drawCoord a) 
-  where
-    a = Coordinate { coord_ctm = ctm }
-
-
-drawCoord :: (Real u, Floating u) => Coordinate u -> Graphic u
-drawCoord coord = localize swapColours $ filledEllipse 2 2 (center coord)
-
 --------------------------------------------------------------------------------
 -- Diamond
 
@@ -261,6 +228,10 @@
   center = ctmCenter . dia_ctm
 
 
+
+
+
+
 calcDiaPoint :: (Real u, Floating u) 
              => (u -> u -> Point2 u) -> Diamond u -> Point2 u
 calcDiaPoint f (Diamond { dia_ctm = ctm, dia_hw = hw, dia_hh = hh }) =
@@ -272,35 +243,47 @@
   east  = calcDiaPoint $ \ hw _  -> P2 hw 0
   west  = calcDiaPoint $ \ hw _  -> P2 (-hw) 0
 
-diamond :: (Real u, Floating u) => u -> u -> Shape u (Diamond u)
-diamond hw hh = Shape { src_ctm = identityCTM
-                      , out_fun = outputDia hw hh nolabel
-                      }
 
 
-ldiamond :: (Real u, Floating u, FromPtSize u) 
-         => u -> u -> String -> Shape u (Diamond u)
-ldiamond hw hh ss = Shape { src_ctm = identityCTM
-                          , out_fun = outputDia hw hh (shapelabel ss)
-                          }
 
+-- | 'diamond'  : @ half_width * half_height -> shape @
+--
+-- Note - args might change to tull_width and full_height...
+--
+diamond :: (Real u, Floating u) => u -> u -> Shape u Diamond
+diamond hw hh = 
+    Shape { src_ctm  = identityCTM
+          , path_fun = traceLinePoints . diamondPoints hw hh
+          , cons_fun = mkDiamond hw hh
+          }
 
+-- | 'rdiamond'  : @ round_length * half_width * half_height -> shape @
+--
+-- Note - args might change to full_width and full_height...
+--
+rdiamond :: (Real u, Floating u) => u -> u -> u -> Shape u Diamond
+rdiamond round_dist hw hh = 
+    Shape { src_ctm  = identityCTM
+          , path_fun = roundEvery round_dist . diamondPoints hw hh
+          , cons_fun = mkDiamond hw hh
+          }
 
-outputDia :: (Real u, Floating u) 
-          => u -> u -> ShapeLabel u -> ShapeCTM u -> Image u (Diamond u)
-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
 
-drawDia :: (Real u, Floating u) => Diamond u -> Graphic u
-drawDia = borderedPath . diamondPath
 
 
-diamondPath :: (Real u, Floating u) => Diamond u -> PrimPath u
-diamondPath dia = vertexPath [ south dia, east dia, north dia, west dia ]
+mkDiamond :: (Real u, Floating u) => u -> u -> ShapeConstructor u Diamond
+mkDiamond hw hh = \ctm -> Diamond { dia_ctm = ctm, dia_hw = hw, dia_hh = hh }
 
 
+diamondPoints :: (Real u, Floating u) => u -> u -> ShapeCTM u -> [Point2 u]
+diamondPoints hw hh = remapPoints [ s, e, n, w ]
+  where
+    s = P2   0  (-hh)
+    e = P2   hw    0
+    n = P2   0    hh
+    w = P2 (-hw)   0 
+
+
 --------------------------------------------------------------------------------
 -- Ellipse
 
@@ -321,91 +304,52 @@
   center = ctmCenter . ell_ctm
 
 
-ellipse :: (Real u, Floating u) => u -> u -> Shape u (Ellipse u)
-ellipse rx ry = Shape { src_ctm = identityCTM
-                      , out_fun = outputEll rx ry nolabel
-                      }
-
-lellipse :: (Real u, Floating u, FromPtSize u) 
-         => u -> u -> String -> Shape u (Ellipse u)
-lellipse rx ry ss = Shape { src_ctm = identityCTM
-                          , out_fun = outputEll rx ry (shapelabel ss)
-                          }
-
+calcEllPoint :: (Real u, Floating u) 
+              => (u -> Point2 u) -> Ellipse u -> Point2 u
+calcEllPoint f (Ellipse { ell_ctm = ctm, ell_rx = rx, ell_ry = ry }) =
+    let p   = f rx; p'  = scaleEll rx ry p
+    in ctmDisplace p' ctm
 
-outputEll :: (Real u, Floating u) 
-          => u -> u -> ShapeLabel u -> ShapeCTM u -> Image u (Ellipse u)
-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
+instance (Real u, Floating u) => RadialAnchor (Ellipse u) where
+  radialAnchor theta = calcEllPoint $ \rx -> zeroPt .+^ avec theta rx
 
 
-drawEll :: (Real u, Floating u) => Ellipse u -> Graphic u
-drawEll = borderedPath . ellipsePath
+instance (Real u, Floating u) => CardinalAnchor (Ellipse u) where
+  north = radialAnchor (0.5*pi)
+  south = radialAnchor (1.5*pi)
+  east  = radialAnchor  0
+  west  = radialAnchor  pi
 
 
-ellipsePath :: (Real u, Floating u) => Ellipse u -> PrimPath u
-ellipsePath = curvedPath . ellipsePoints
-
-ellipsePoints :: (Real u, Floating u) => Ellipse u -> [Point2 u]
-ellipsePoints (Ellipse { ell_ctm=ctm, ell_rx=rx, ell_ry=ry }) = 
-    map (ctmDisplace `flip` ctm) all_points
-  where
-    all_points  = map (rescale rx ry) $ bezierCircle 2 rx zeroPt 
+instance (Real u, Floating u) => CardinalAnchor2 (Ellipse u) where
+  northeast = radialAnchor (0.25*pi)
+  southeast = radialAnchor (1.75*pi)
+  southwest = radialAnchor (1.25*pi)
+  northwest = radialAnchor (0.75*pi)
 
 
--- | x_radius is the unit length.
+-- | 'ellipse'  : @ x_radii * y_radii -> shape @
 --
-rescale :: (Scale t, Fractional u, u ~ DUnit t) => u -> u -> t -> t
-rescale rx ry = scale 1 (ry/rx) 
+ellipse :: (Real u, Floating u) => u -> u -> Shape u Ellipse
+ellipse rx ry = 
+    Shape { src_ctm  = identityCTM
+          , path_fun = traceCurvePoints . ellipsePoints rx ry
+          , cons_fun = mkEllipse rx ry  
+          }
 
 
---------------------------------------------------------------------------------
--- Free label
 
--- Free label is a rectangle that /is not drawn/, the 
--- constructor should always create some text.
-
-newtype FreeLabel u = FreeLabel { getFreeLabel :: Rectangle u }
-
-
-type DFreeLabel = FreeLabel Double
+mkEllipse :: (Real u, Floating u) => u -> u -> ShapeConstructor u Ellipse
+mkEllipse rx ry = \ctm -> Ellipse { ell_ctm = ctm, ell_rx = rx, ell_ry = ry }
 
-type instance DUnit (FreeLabel u) = u
+ellipsePoints :: (Real u, Floating u) => u -> u -> ShapeCTM u -> [Point2 u]
+ellipsePoints rx ry ctm = 
+    map ((ctmDisplace `flip` ctm) . scaleEll rx ry) $ bezierCircle 2 rx zeroPt 
 
 
-instance (Real u, Floating u) => CenterAnchor (FreeLabel u) where
-  center = center . getFreeLabel
+-- | x_radius is the unit length.
+--
+scaleEll :: (Scale t, Fractional u, u ~ DUnit t) => u -> u -> t -> t
+scaleEll rx ry = scale 1 (ry/rx) 
 
 
-instance (Real u, Floating u) => CardinalAnchor (FreeLabel u) where
-  north = north . getFreeLabel
-  south = south . getFreeLabel
-  east  = east . getFreeLabel
-  west  = west . getFreeLabel
-
-instance (Real u, Floating u) => CardinalAnchor2 (FreeLabel u) where
-  northeast = northeast . getFreeLabel
-  southeast = southeast . getFreeLabel
-  southwest = southwest . getFreeLabel
-  northwest = northwest . getFreeLabel
-
-instance (Real u, Floating u) => RadialAnchor (FreeLabel u) where
-  radialAnchor theta = radialAnchor theta . getFreeLabel
-
-freelabel :: (Real u, Floating u, FromPtSize u) 
-          => String -> Shape u (FreeLabel u)
-freelabel ss = Shape { src_ctm = identityCTM
-                     , out_fun = outputStringLbl ss
-                     }
-
-outputStringLbl :: (Real u, Floating u, FromPtSize u) 
-                => String -> ShapeCTM u -> Image u (FreeLabel u)
-outputStringLbl ss ctm = 
-    intoImage (monoTextDimensions ss >>= \(w,h) -> return (mkrect w h)) label
-  where
-    mkrect w h = FreeLabel $ Rectangle { rect_ctm = ctm
-                                       , rect_hw  = 0.5*w
-                                       , rect_hh  = 0.5*h }
-    label = runShapeLabel ctm (shapelabel ss)
diff --git a/src/Wumpus/Basic/Shapes/Plaintext.hs b/src/Wumpus/Basic/Shapes/Plaintext.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Basic/Shapes/Plaintext.hs
@@ -0,0 +1,150 @@
+{-# LANGUAGE TypeFamilies               #-}
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Basic.Shapes.Plaintext
+-- Copyright   :  (c) Stephen Tetley 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  GHC
+--
+-- Plaintext is a bit like a shape but does not generate a path 
+-- and cannot be scaled (it can be rotated or translated).
+--
+-- \*\* WARNING \*\* - the types of Shapes and Plaintext are not
+-- ideal and are pending revision.
+-- 
+--------------------------------------------------------------------------------
+
+module Wumpus.Basic.Shapes.Plaintext
+  (
+
+    PlaintextAnchor
+  , DPlaintextAnchor
+  , Plaintext
+  , DPlaintext
+
+  , plaintext
+  , drawText
+
+  ) where
+
+import Wumpus.Basic.Anchors
+import Wumpus.Basic.Graphic
+import Wumpus.Basic.Shapes.Base
+import Wumpus.Basic.Shapes.Derived
+
+import Wumpus.Core                              -- package: wumpus-core
+
+import Data.AffineSpace                         -- package: vector-space
+
+import Control.Applicative
+
+
+
+
+--------------------------------------------------------------------------------
+-- Free label
+
+-- Free label is a rectangle that /is not drawn/, the 
+-- constructor should always create some text.
+
+newtype PlaintextAnchor u = PlaintextAnchor  { getPlaintext :: Rectangle u }
+
+
+type DPlaintextAnchor = PlaintextAnchor Double
+
+type instance DUnit (PlaintextAnchor u) = u
+
+
+data Plaintext u = Plaintext
+      { text_text :: String     -- Note - generalize this for multi-line...
+      , text_x    :: !u
+      , text_y    :: !u
+      , text_ang  :: !Radian
+      }
+  deriving (Eq,Ord,Show)
+
+type DPlaintext = Plaintext Double
+
+type instance DUnit (Plaintext u) = u
+
+
+instance (Real u, Floating u) => CenterAnchor (PlaintextAnchor u) where
+  center = center . getPlaintext
+
+
+instance (Real u, Floating u) => CardinalAnchor (PlaintextAnchor u) where
+  north = north . getPlaintext
+  south = south . getPlaintext
+  east  = east . getPlaintext
+  west  = west . getPlaintext
+
+instance (Real u, Floating u) => CardinalAnchor2 (PlaintextAnchor u) where
+  northeast = northeast . getPlaintext
+  southeast = southeast . getPlaintext
+  southwest = southwest . getPlaintext
+  northwest = northwest . getPlaintext
+
+instance (Real u, Floating u) => RadialAnchor (PlaintextAnchor u) where
+  radialAnchor theta = radialAnchor theta . getPlaintext
+
+
+
+instance Rotate (Plaintext u) where
+  rotate dr = (\s i -> s { text_ang = i+dr }) <*> text_ang
+
+-- Note - cannot scale Plaintext
+
+
+instance Num u => Translate (Plaintext u) where
+  translate dx dy = (\s x y -> s { text_x = x+dx, text_y = y+dy }) 
+                      <*> text_x <*> text_y
+
+
+
+plaintext :: Num u => String -> Plaintext u
+plaintext ss = Plaintext { text_text  = ss
+                         , text_x     = 0
+                         , text_y     = 0
+                         , text_ang   = 0 }
+
+
+
+
+drawText :: (Real u, Floating u, FromPtSize u)
+         => Plaintext u -> Image u (PlaintextAnchor u)
+drawText x = intoImage (oneLineRect x) (drawOneLine x)
+
+
+
+oneLineRect :: (Fractional u, Ord u, FromPtSize u) 
+        => Plaintext u -> DrawingR (PlaintextAnchor u)
+oneLineRect ptext = 
+    monoTextDimensions (text_text ptext) >>= \(w,h) -> 
+    return (PlaintextAnchor $ mkRectangle (0.5*w) (0.5*h) ctm)
+  where
+    ctm = ShapeCTM { ctm_trans_x    = text_x ptext
+                   , ctm_trans_y    = text_y ptext
+                   , ctm_scale_x    = 1
+                   , ctm_scale_y    = 1
+                   , ctm_rotation   = text_ang ptext
+                   }
+
+drawOneLine :: (Real u, Floating u, FromPtSize u) 
+            => Plaintext u -> Graphic u 
+drawOneLine (Plaintext { text_text = ss, text_x=dx, text_y=dy
+                       , text_ang = ang }) =
+    monoVecToCenter ss >>= \v -> 
+    let ctr = P2 dx dy; bl = ctr .-^ v in 
+    rotTextline ang ss (rotateAbout ang ctr bl)
+
+
+
+rotTextline :: (Real u, Floating u) => Radian -> String -> LocGraphic u
+rotTextline theta ss baseline_left = 
+    withTextAttr $ \rgb attr -> 
+        singleH $ rotatePrim theta $ textlabel rgb attr ss baseline_left
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,10,0)
+-- > (0,11,0)
 --
 wumpus_basic_version :: (Int,Int,Int)
-wumpus_basic_version = (0,10,0)
+wumpus_basic_version = (0,11,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.10.0
+version:          0.11.0
 license:          BSD3
 license-file:     LICENSE
 copyright:        Stephen Tetley <stephen.tetley@gmail.com>
@@ -16,55 +16,67 @@
   .
   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.
+  @PrimGraphic@, @DrawingContext@) seem to support a good set
+  primitive functions, but the exact types of drawing objects do 
+  not feel right at the moment. Other modules (Paths, Chains, 
+  Shapes) are essentially sketches and are expected to be
+  substantially revised in subsequent updates.
   .
+  Version 0.11.0 is an interim release. It is expected that the 
+  next release will substantially rework Shapes and likely change
+  the @Graphic.Base@ types. As quite a large amount of code has 
+  already changed since version 0.10.0 (to support better 
+  arrowheads and connectors) it seems sensible to release 0.11.0 
+  now, rather than have a huge delta after Shapes have been 
+  reworked again. The current versions of @Wumpus-Tree@ and 
+  @Wumpus-Microprint@ will work with version 0.11.0 if their 
+  respective @.cabal@ files are edited to bump the version number. 
+  There will be no matching releases to work automatically with 
+  version 0.11.0 of Wumpus-Basic.
   .
   Changelog:
   .
-  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.
+  0.10.0 to 0.11.0:
+  . 
+  * Reworked arrowheads and connectors - connectors are now 
+    configurable: there are functions to make connectors with 
+    a left arrowhead, right arrowhead, none or both.  
   .
-  * @DrawingF@ renamed to @DrawingR@, the related type synonyms
-    have also been changed, e.g. @LocDrawingF@ is now 
-    @LocDrawingR@.
+  * Reworked shapes - internally shapes now create a @Path@ rather 
+    than a @Graphic@ this means the path can be manipulated (e.g. 
+    round cornered rectangles, diamonds... can be constructed).
+    @Coordinate@ is no longer a @Shape@ - it is now similar object 
+    but of a different type. Likewise, @FreeLabel@ has been 
+    replaced by @Plaintext@ which is not a @Shape@, but has some 
+    similar properties. Unfortunately, the Shape types are still 
+    difficult to work with and a larger reworking is still 
+    necessary.
   .
-  * 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.Paths.Base@ - @Path@ type changed, @PathEmpty@ 
+    constructor removed so empty paths cannot be created. This 
+    allows a better API for taking points on a path. It also 
+    means @Path@ is no longer an instance of Monoid. Type changes 
+    to various functions (e.g. @tipR@, @tipL@) reflecting that as 
+    paths cannot now be empty, functions on them can generally be 
+    total. @toPrimPathU@ removed as converting to a PrimPath as 
+    now always /safe/. @tracePoints@ renamed @traceLinePoints@, 
+    @tracePointsCurve@ renamed @traceCurvePoints@, @midpoint@ 
+    renamed @midway@.
   .
-  * @Basic.Graphic.DrawingContext@ - renamed @primary_colour@ to
-    @stroke_colour@ and @secondary_colour@ to @fill_colour@. The 
-    setter functions has been similarly renamed.
+  * @Basic.Graphic@ - the types @ConnDrawingR@, @ConnGraphic@ etc.
+    have had their names expanded to @ConnectorDrawingR@, 
+    @ConnectorGraphic@... 
   .
-  * Added the type synonym @DrawingContextF@ to 
-    @Basic.Graphic.DrawingContext@. Changed relevant function
-    signatures to use it.
+  * @Basic.SafeFont@ - font names changed to use underscore 
+    separators rather than camelCase. Wumpus generally uses 
+    underscored names for /constants/.
   .
-  * Re-worked the Path modules - base types entirely different,
-    connectors entirely different, monadic path construction 
-    largely the same.
+  * Removed @conn@ from @Basic.Graphic.Drawing@. Connectors should 
+    be used instead.
   .
-  * 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@.
+  * The class @DrawingCtxM@ now has @Applicative@ as a superclass. 
   .
-  * @localLG@ removed it can be acheived with composition -
-    @localize upd . loc_graphic_function@. @lgappend@ is also 
-    removed - it can be recreated applicatively.
+  * @lineSpacing@ renamed @baselineSpacing@.
   .
   .
 build-type:         Simple
@@ -74,14 +86,14 @@
 extra-source-files:
   CHANGES,
   LICENSE,
-  demo/DotPic.hs,
+  demo/ArrowCircuit.hs,
   demo/ClipPic.hs,
   demo/ColourCharts.hs,
   demo/ColourDefns.hs,
+  demo/DotPic.hs,
   demo/FontPic.hs,
   demo/PetriNet.hs,
   demo/Picture.hs,
-  demo/Shapes.hs,
   demo/Symbols.hs
 
 library
@@ -95,6 +107,7 @@
   exposed-modules:
     Wumpus.Basic.Anchors,
     Wumpus.Basic.Arrows,
+    Wumpus.Basic.Arrows.Connectors,
     Wumpus.Basic.Arrows.Tips,
     Wumpus.Basic.Chains,
     Wumpus.Basic.Chains.Base,
@@ -119,8 +132,11 @@
     Wumpus.Basic.Paths.Construction,
     Wumpus.Basic.Paths.RoundCorners,
     Wumpus.Basic.SafeFonts,
+    Wumpus.Basic.Shapes,
     Wumpus.Basic.Shapes.Base,
+    Wumpus.Basic.Shapes.Coordinate,
     Wumpus.Basic.Shapes.Derived,
+    Wumpus.Basic.Shapes.Plaintext,
     Wumpus.Basic.Text.LRSymbol,
     Wumpus.Basic.Text.LRText,
     Wumpus.Basic.Utils.HList,