diff --git a/CHANGES b/CHANGES
--- a/CHANGES
+++ b/CHANGES
@@ -1,4 +1,53 @@
 
+0.7.0 to 0.8.0:
+
+  * Re-introduced LRText and LRSymbol - they now work with 
+    Wumpus-Core\'s kerning support.
+ 
+  * Changes to @Graphic.Basic.BaseTypes@ - @DrawingObject@ 
+    renamed to @DrawingF@. @HPrim@ wrapped as a newtype to 
+    support a Monoid instance. Removed @appendGraphic@ and @gcat@ 
+    as they can be achieved with @mappend@ and @mconcat@. 
+    @appendAt@ renamed to @lgappend@. @PointT@ remaned to 
+    @PointF@.
+
+  * Changes to @Graphic.Basic.Drawing@ - @drawAt@, @drawAtImg@, 
+    @drawConn@, @drawConnImg@ all removed. They are replaced 
+    by @draw@ and @drawi@ together with then new @at@ and @conn@
+    combinators.
+
+  * Changes to @Basic.Graphic.PrimGraphic@ - @localDrawingContext@
+    renamed to @localLG@ and moved to @Basic.Graphic.BaseTypes@.
+
+  * Updates to @Basic.SafeFonts@ to work with changes to 
+    @Wumpus.Core@.
+
+0.6.0 to 0.7.0:
+
+  * Major rework of Graphic types, the old types (AGraphic, 
+    GraphicF etc.) and the old drawing monads have been removed. 
+    The new types are based on the AGraphic and related types but 
+    their implementation is different. The new types track the 
+    /graphics state/ within the type (the DrawingContext) plus 
+    how to draw themselves. For real drawings, graphics are 
+    collected with a Writer-like monad the @Basic.Graphic.Drawing@ 
+    monad which replaces the DrawingCtx and Trace monads. The 
+    Turtle monad remains and has been updated to work with the new
+    drawing monads.
+
+  * LRText and LRSymbol modules temporarily removed as they 
+    contradict the new, optimized kerning functionality in 
+    @Wumpus.Core@.
+
+0.5.0 to 0.6.0:
+
+  * Updates to work with wumpus-core-0.30.0.
+
+  * The code from @Basic.Graphic@ has been moved in to 
+    @Basic.Graphic.Primitive@ - this module is due a major 
+    overhaul. @Basic.Graphic@ is now an /import/ shim for
+    @Basic.Graphic.Primitive@.
+
 0.4.0 to 0.5.0:
 
   * Re-worked the PictureLanguage module.
diff --git a/demo/ColourCharts.hs b/demo/ColourCharts.hs
--- a/demo/ColourCharts.hs
+++ b/demo/ColourCharts.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -Wall #-}
 
-module ColourChart where
+module ColourCharts where
 
 import ColourDefns
 
@@ -41,8 +41,8 @@
 colourSample :: String -> RGBi -> ChainT Double (Drawing Double) ()
 colourSample name rgb = localCtx (secondaryColour rgb) $ do 
     { pt <- position 
-    ; drawAt pt (borderedRectangle 15 10)
-    ; drawAt (displace 20 2 pt) (textline name)
+    ; draw $ borderedRectangle 15 10 `at` pt
+    ; draw $ textline name `at` displace 20 2 pt 
     }    
 
 
diff --git a/demo/DotPic.hs b/demo/DotPic.hs
--- a/demo/DotPic.hs
+++ b/demo/DotPic.hs
@@ -64,7 +64,7 @@
            => DotLocImage u -> [Point2 u] -> Picture u
 makeDotPic dotImg xs = liftToPictureU $ execDrawing std_ctx $ do 
     dashline
-    mapM_ (\pt -> drawAtImg pt dotImg) xs
+    mapM_ (\pt -> drawi $ dotImg `ati` pt) xs
   where
     dashline = localCtx attrUpd (draw $ openStroke $ vertexPath xs)
 
diff --git a/demo/Picture.hs b/demo/Picture.hs
--- a/demo/Picture.hs
+++ b/demo/Picture.hs
@@ -130,22 +130,22 @@
 picAnno pic msg = alignHSep HCenter 30 pic lbl
   where
     lbl = liftToPictureU $ execDrawing pic_drawing_ctx $ 
-            drawAt zeroPt (textline msg)
+            draw $ textline msg `at` zeroPt
 
 
 rect_red :: DPicture
 rect_red = liftToPictureU $ execDrawing pic_drawing_ctx $ 
               localCtx (secondaryColour indian_red)
-                       (drawAt (P2 0 10) $ borderedRectangle 30 10)
+                       (draw $ borderedRectangle 30 10 `at` (P2 0 10))
                  
 rect_green :: DPicture
 rect_green = liftToPictureU $ execDrawing pic_drawing_ctx $ 
               localCtx (secondaryColour olive_drab)
-                       (drawAt (P2 10 10) $ borderedRectangle 15 15)
+                       (draw $ borderedRectangle 15 15 `at` (P2 10 10))
 
 
 rect_blue :: DPicture
 rect_blue = liftToPictureU $ execDrawing pic_drawing_ctx $ 
               localCtx (secondaryColour powder_blue)
-                       (drawAt (P2 10 0) $ borderedRectangle 20 30)
+                       (draw $ borderedRectangle 20 30 `at` (P2 10 0))
 
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
@@ -46,10 +46,10 @@
 import Wumpus.Core                      -- package: wumpus-core
 
 import Control.Applicative
-
+import Data.Monoid
 
-liftPathF :: PathF u -> ConnDrawingObject u (Path u)
-liftPathF pF p1 p2 = DrawingObject $ \ _ -> pF p1 p2
+liftPathF :: PathF u -> ConnDrawingF u (Path u)
+liftPathF pF p1 p2 = pureDF $ pF p1 p2
 
 line :: Num u => PathF u -> ConnImage u (Path u)
 line pathF = intoConnImage (liftPathF pathF) (pathGraphic pathF)
@@ -58,7 +58,7 @@
 -- Here the path is already shortened - we have accounted for the
 -- points already, so it is just a graphic. 
 lineTipR :: Num u => Path u -> Graphic u -> Graphic u
-lineTipR bpath tip = openStroke (toPrimPathU bpath) `appendGraphic` tip
+lineTipR bpath tip = openStroke (toPrimPathU bpath) `mappend` tip
    
 
 
@@ -74,10 +74,10 @@
 -- path segments.
 --
 rightPathProps :: (Real u, Floating u, FromPtSize u) 
-               => PathF u -> ConnDrawingObject u (Path u,Radian)
+               => PathF u -> ConnDrawingF u (Path u,Radian)
 rightPathProps pathF p1 p2 = 
     (\h sw -> (shortenPath h sw, calcTheta h))
-      <$> asksObj lowerxHeight <*> asksObj (line_width . stroke_props)  
+      <$> asksDF lowerxHeight <*> asksDF (line_width . stroke_props)  
   where
     long_path          = pathF p1 p2  
     shortenPath lxh sw = shortenR (lxh + (realToFrac sw)) long_path 
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
@@ -47,11 +47,11 @@
 -- | tripoints takes dimensions from the xlowerHeight.
 --
 tripoints :: (Floating u, FromPtSize u)
-          => Radian -> Radian -> LocDrawingObject u (Point2 u, Point2 u)
+          => Radian -> Radian -> LocDrawingF u (Point2 u, Point2 u)
 tripoints triang theta tip = 
     (\h -> let d = h / (fromRadian $ cos halfang) 
            in (tip .-^ v1 d, tip .-^ v2 d))
-      <$> asksObj lowerxHeight
+      <$> asksDF lowerxHeight
   where
     halfang = 0.5 * triang
     v1 d    = avec (theta + halfang) d
@@ -124,7 +124,7 @@
 
 perp :: (Floating u, FromPtSize u) => Radian -> LocGraphic u
 perp theta pt =  
-    asksObj lowerxHeight >>= \ h -> 
+    asksDF lowerxHeight >>= \ h -> 
     let v = makeV h in openStroke $ vertexPath [ pt .+^ v, pt .-^ v]
   where
     makeV h  = avec (theta + pi/2) (0.5 * h)
diff --git a/src/Wumpus/Basic/Dots.hs b/src/Wumpus/Basic/Dots.hs
--- a/src/Wumpus/Basic/Dots.hs
+++ b/src/Wumpus/Basic/Dots.hs
@@ -139,8 +139,8 @@
                              $ rectangleLines ctr hw hh
 
 rectangleLDO :: (Real u, Floating u) 
-             => u -> u -> LocDrawingObject u (DotAnchor u)
-rectangleLDO w h pt = liftDrawingObject $ rectangleAnchor (w*0.5) (h*0.5) pt
+             => u -> u -> LocDrawingF u (DotAnchor u)
+rectangleLDO w h pt = pureDF $ rectangleAnchor (w*0.5) (h*0.5) pt
 
 
 circleAnchor :: Floating u => u -> Point2 u -> DotAnchor u
@@ -148,8 +148,8 @@
                                  (\theta -> ctr .+^ (avec theta rad))
                                  (radialCardinal rad ctr)
 
-circleLDO :: (Floating u, FromPtSize u) => LocDrawingObject u (DotAnchor u)
-circleLDO pt = (\diam -> circleAnchor (diam * 0.5) pt) <$> asksObj markHeight 
+circleLDO :: (Floating u, FromPtSize u) => LocDrawingF u (DotAnchor u)
+circleLDO pt = (\diam -> circleAnchor (diam * 0.5) pt) <$> asksDF markHeight 
 
 
 
@@ -161,13 +161,13 @@
 
 dotChar :: (Floating u, Real u, FromPtSize u) 
         => Char -> DotLocImage u
-dotChar ch pt = asksObj (textDimensions [ch]) >>= \(w,h) -> 
+dotChar ch pt = asksDF (textDimensions [ch]) >>= \(w,h) -> 
                 intoLocImage (rectangleLDO w h) (markChar ch) pt
 
 
 dotText :: (Floating u, Real u, FromPtSize u) 
         => String -> DotLocImage u 
-dotText ss pt = asksObj (textDimensions ss) >>= \(w,h) -> 
+dotText ss pt = asksDF (textDimensions ss) >>= \(w,h) -> 
                 intoLocImage (rectangleLDO w h) (markText ss) pt
 
 
@@ -201,7 +201,7 @@
 
 
 dotSquare :: (Floating u, Real u, FromPtSize u) => DotLocImage u
-dotSquare pt = asksObj markHeight >>= \ h ->
+dotSquare pt = asksDF markHeight >>= \ h ->
                intoLocImage (rectangleLDO h h) markSquare pt
 
 
diff --git a/src/Wumpus/Basic/Dots/Primitive.hs b/src/Wumpus/Basic/Dots/Primitive.hs
--- a/src/Wumpus/Basic/Dots/Primitive.hs
+++ b/src/Wumpus/Basic/Dots/Primitive.hs
@@ -56,6 +56,7 @@
 
 import Control.Applicative
 import Data.List
+import Data.Monoid
 
 -- Marks should be the height of a lower-case letter...
 
@@ -81,11 +82,11 @@
 -- | A mark is the height of a lowercase \'x\'.
 -- 
 standardSize :: FromPtSize u => (u -> LocGraphic u) -> LocGraphic u
-standardSize f = \pt -> asksObj markHeight >>= \h -> f h pt
+standardSize f = \pt -> asksDF markHeight >>= \h -> f h pt
 
 halfHeightSize :: (Fractional u, FromPtSize u) 
                => (u -> LocGraphic u) -> LocGraphic u
-halfHeightSize f = \pt -> asksObj markHeight >>= \h -> f (h * 0.5) pt
+halfHeightSize f = \pt -> asksDF markHeight >>= \h -> f (h * 0.5) pt
 
 
 
@@ -101,7 +102,7 @@
 -- Note - eta-expanded (?)
 --
 markText :: (Fractional u, FromPtSize u) => String -> LocGraphic u
-markText ss pt = asksObj (textDimensions ss) >>= \(w,h) -> 
+markText ss pt = asksDF (textDimensions ss) >>= \(w,h) -> 
                  shiftOrigin (0.5 * (-w)) (0.5 * (-h)) (textline ss) pt
 
 
@@ -125,17 +126,17 @@
 
 markX :: (Fractional u, FromPtSize u) => LocGraphic u
 markX = standardSize (\h -> let w = 0.75 * h in
-                            axialLine (vec w h) `appendAt` axialLine (vec (-w) h))
+                            axialLine (vec w h) `lgappend` axialLine (vec (-w) h))
 
 
 
 markPlus :: (Fractional u, FromPtSize u) =>  LocGraphic u
-markPlus = markVLine `appendAt` markHLine
+markPlus = markVLine `lgappend` markHLine
 
 
 markCross :: (Floating u, FromPtSize u) =>  LocGraphic u
 markCross = standardSize 
-             (\h -> axialLine (avec ang h) `appendAt` axialLine (avec (-ang) h))
+             (\h -> axialLine (avec ang h) `lgappend` axialLine (avec (-ang) h))
   where
     ang = pi*0.25  
 
@@ -144,10 +145,10 @@
 -- needs horizontal pinch...
 
 pathDiamond :: (Fractional u, FromPtSize u) 
-            => Point2 u -> DrawingObject (PrimPath u)
+            => Point2 u -> DrawingF (PrimPath u)
 pathDiamond pt = (\h -> let hh    = 0.66 * h; hw = 0.5 * h 
                         in vertexPath [dvs hh, dve hw,dvn hh, dvw hw])
-                   <$> asksObj markHeight
+                   <$> asksDF markHeight
   where
     dvs hh = pt .+^ vvec (-hh)
     dve hw = pt .+^ hvec hw
@@ -189,15 +190,15 @@
 
 
 markPentagon :: (Floating u, FromPtSize u) => LocGraphic u
-markPentagon pt = asksObj markHeight >>= \h ->
+markPentagon pt = asksDF markHeight >>= \h ->
                   closedStroke $ vertexPath $ polygonPoints 5 (0.5*h) pt
 
  
 
 
 markStar :: (Floating u, FromPtSize u) => LocGraphic u 
-markStar pt = asksObj markHeight >>= \h -> 
-              let (p:ps) = polygonPoints 5 (0.5*h) pt in gcat (fn p) $ map fn ps
+markStar pt = asksDF markHeight >>= \h -> 
+              let ps = polygonPoints 5 (0.5*h) pt in mconcat $ map fn ps
   where
     fn p1  = openStroke $ path pt [lineTo p1] 
 
@@ -205,7 +206,7 @@
 
 
 markAsterisk :: (Floating u, FromPtSize u) => LocGraphic u
-markAsterisk = standardSize (\h -> lineF1 h `appendAt` lineF2 h `appendAt` lineF3 h)
+markAsterisk = standardSize (\h -> lineF1 h `lgappend` lineF2 h `lgappend` lineF3 h)
   where
     ang       = (pi*2) / 6
     lineF1 z  = axialLine (vvec z)
@@ -215,15 +216,15 @@
 
 
 markOPlus :: (Fractional u, FromPtSize u) => LocGraphic u
-markOPlus = markCircle `appendAt` markPlus
+markOPlus = markCircle `lgappend` markPlus
 
 
 markOCross :: (Floating u, FromPtSize u) => LocGraphic u
-markOCross = markCircle `appendAt` markCross
+markOCross = markCircle `lgappend` markCross
 
 
 markFOCross :: (Floating u, FromPtSize u) => LocGraphic u
-markFOCross = markCross `appendAt` markBCircle 
+markFOCross = markCross `lgappend` markBCircle 
 
 
 -- bkCircle :: (Fractional u, FromPtSize u) => LocGraphic u
diff --git a/src/Wumpus/Basic/Graphic/BaseTypes.hs b/src/Wumpus/Basic/Graphic/BaseTypes.hs
--- a/src/Wumpus/Basic/Graphic/BaseTypes.hs
+++ b/src/Wumpus/Basic/Graphic/BaseTypes.hs
@@ -23,28 +23,33 @@
     
 
     HPrim
-  , Point2T
-  , DPoint2T
+  , hprimToList
+  , singleH
 
-  , DrawingObject(..)
-  , LocDrawingObject
-  , DLocDrawingObject
+  , Point2F
+  , DPoint2F
 
-  , liftDrawingObject 
+  , DrawingF
+  , LocDrawingF
+  , DLocDrawingF
 
+  , runDF
+  , pureDF 
+  , askDF
+  , asksDF
+  , localDF
+
   , Graphic
   , DGraphic
-  , appendGraphic
-  , gcat
   
-  , asksObj
-  , localCtxObj
 
   , runGraphic
+  , xlinkGraphic
 
   , LocGraphic
   , DLocGraphic
-  , appendAt
+  , localLG
+  , lgappend
 
   , Image
   , DImage
@@ -54,9 +59,10 @@
   , runImage
   , intoImage
   , intoLocImage
+  , xlinkImage
 
-  , ConnDrawingObject
-  , DConnDrawingObject
+  , ConnDrawingF
+  , DConnDrawingF
   , ConnGraphic
   , DConnGraphic
   , ConnImage
@@ -73,9 +79,7 @@
 
 
 import Control.Applicative
-
-
-
+import Data.Monoid
 
 
 
@@ -93,79 +97,118 @@
 -- representation, and a Hughes list which supports
 -- efficient concatenation is wise.
 --
-type HPrim u = H (PrimElement u)
+newtype HPrim u = HPrim { getHPrim :: H (PrimElement u) }
 
+-- Note - only a Monoid instance for HPrim - they cannot be 
+-- shown, fmapped etc.
 
--- | Point transformation function.
---
-type Point2T u = Point2 u -> Point2 u
+instance Monoid (HPrim u) where
+  mempty          = HPrim emptyH
+  ha `mappend` hb = HPrim $ getHPrim ha `appendH` getHPrim hb
 
-type DPoint2T = Point2T Double
 
+hprimToList :: HPrim u -> [PrimElement u]
+hprimToList = toListH . getHPrim
 
-newtype DrawingObject a = DrawingObject { 
-          getDrawingObject :: DrawingContext -> a }
 
+singleH :: PrimElement u -> HPrim u
+singleH = HPrim . wrapH 
 
+-- | Point transformation function.
+--
+type Point2F u = Point2 u -> Point2 u
 
-type LocDrawingObject u a = Point2 u -> DrawingObject a 
+type DPoint2F = Point2F Double
 
-type DLocDrawingObject a = LocDrawingObject Double a
+--------------------------------------------------------------------------------
+--
 
+-- | Drawings in Wumpus-Basic have an implicit /graphics state/ 
+-- the @DrawingContext@, the most primitive building block is 
+-- a function from the DrawingContext to some polymorphic answer.
+-- 
+-- This functional type is represented concretely as @DrawingF@.
+-- 
+-- > DrawingF :: DrawingContext -> a 
+--
+newtype DrawingF a = DrawingF { getDrawingF :: DrawingContext -> a }
 
 
-instance Functor DrawingObject where
-  fmap f ma = DrawingObject $ \ctx -> f $ getDrawingObject ma ctx 
+instance Functor DrawingF where
+  fmap f ma = DrawingF $ \ctx -> f $ getDrawingF ma ctx 
 
+-- The monoid instance seems sensible...
+--
+instance Monoid a => Monoid (DrawingF a) where 
+  mempty          = DrawingF $ \_   -> mempty
+  fa `mappend` fb = DrawingF $ \ctx -> 
+                      getDrawingF fa ctx `mappend` getDrawingF fb ctx
 
 -- Applicative
 
-instance Applicative DrawingObject where
-  pure a    = DrawingObject $ \_   -> a
-  mf <*> ma = DrawingObject $ \ctx -> let f = getDrawingObject mf ctx
-                                          a = getDrawingObject ma ctx
-                                      in f a
+instance Applicative DrawingF where
+  pure a    = DrawingF $ \_   -> a
+  mf <*> ma = DrawingF $ \ctx -> let f = getDrawingF mf ctx
+                                     a = getDrawingF ma ctx
+                                 in f a
 
 -- Monad 
 
-instance Monad DrawingObject where
-  return a  = DrawingObject $ \_   -> a
-  ma >>= k  = DrawingObject $ \ctx -> let a = getDrawingObject ma ctx
-                                      in (getDrawingObject . k) a ctx 
+instance Monad DrawingF where
+  return a  = DrawingF $ \_   -> a
+  ma >>= k  = DrawingF $ \ctx -> let a = getDrawingF ma ctx
+                                 in (getDrawingF . k) a ctx 
 
+-- | Run a /Drawing Function/ with the supplied /Drawing Context/.
+--
+runDF :: DrawingContext -> DrawingF a -> a
+runDF ctx df = getDrawingF df ctx
 
-liftDrawingObject :: a -> DrawingObject a
-liftDrawingObject a = DrawingObject $ \ _ctx -> a 
 
--- Simple drawing - representing one or more prims
+-- | Wrap a value into a DrawingF.
+--
+-- Note the value is /pure/ it does depend on the DrawingContext
+-- (it is /context free/).
+--
+pureDF :: a -> DrawingF a
+pureDF a = DrawingF $ \ _ctx -> a 
 
-type Graphic u = DrawingObject (HPrim u)
+askDF :: DrawingF DrawingContext
+askDF = DrawingF id
 
-type DGraphic = Graphic Double
+asksDF :: (DrawingContext -> a) -> DrawingF a
+asksDF fn = DrawingF $ \ctx -> fn ctx
 
+localDF :: (DrawingContext -> DrawingContext) 
+        -> DrawingF a -> DrawingF a
+localDF upd gf = DrawingF $ \ctx -> getDrawingF gf (upd ctx)
 
-appendGraphic :: Graphic u -> Graphic u -> Graphic u
-appendGraphic gf1 gf2 = DrawingObject $ \ctx ->          
-      (getDrawingObject gf1 ctx) `appendH` (getDrawingObject gf2 ctx)
 
-gcat :: Graphic u -> [Graphic u] -> Graphic u
-gcat a = step a 
-  where
-    step ac []     = ac
-    step ac (x:xs) = step (ac `appendGraphic` x) xs
- 
 
-asksObj :: (DrawingContext -> a) -> DrawingObject a
-asksObj fn = DrawingObject $ \ctx -> fn ctx
+type LocDrawingF u a = Point2 u -> DrawingF a 
 
-localCtxObj :: (DrawingContext -> DrawingContext) 
-            -> DrawingObject a -> DrawingObject a
-localCtxObj upd gf = DrawingObject $ \ctx -> getDrawingObject gf (upd ctx)
+type DLocDrawingF a = LocDrawingF Double a
 
+
+--------------------------------------------------------------------------------
+
+
+-- Simple drawing - representing one or more prims
+
+type Graphic u = DrawingF (HPrim u)
+
+type DGraphic = Graphic Double
+
+
 runGraphic :: DrawingContext -> Graphic u -> HPrim u
-runGraphic ctx gf = (getDrawingObject gf) ctx
+runGraphic ctx gf = (getDrawingF gf) ctx
 
 
+xlinkGraphic :: XLink -> Graphic u -> Graphic u
+xlinkGraphic xlink gf = askDF >>= \ctx -> 
+    let xs = hprimToList $ runGraphic ctx gf in pureDF (singleH $ xlinkGroup xlink xs)
+
+
 --------------------------------------------------------------------------------
 
 
@@ -180,14 +223,17 @@
 type DLocGraphic = LocGraphic Double
 
 
+localLG :: 
+    (DrawingContext -> DrawingContext) -> LocGraphic u -> LocGraphic u
+localLG upd img = \pt -> localDF upd (img pt) 
 
 
 -- | Composition operator for LocGraphic - both LocGraphics
 -- are drawn at the same origin and the results concatenated.
 --
 --
-appendAt :: LocGraphic u -> LocGraphic u -> LocGraphic u
-appendAt f g = \pt -> f pt `appendGraphic` g pt
+lgappend :: LocGraphic u -> LocGraphic u -> LocGraphic u
+lgappend f g = \pt -> f pt `mappend` g pt
 
 
 --------------------------------------------------------------------------------
@@ -197,7 +243,7 @@
 -- typical example - nodes are drawing but the also support 
 -- taking anchor points.
 --
-type Image u a = DrawingObject (a, HPrim u)
+type Image u a = DrawingF (a, HPrim u)
 
 type DImage a = Image Double a
 
@@ -206,24 +252,31 @@
 type DLocImage a = LocImage Double a
 
 runImage :: DrawingContext -> Image u a -> (a,HPrim u)
-runImage ctx img = (getDrawingObject img) ctx
+runImage ctx img = (getDrawingF img) ctx
 
 
-intoImage :: DrawingObject a -> Graphic u -> Image u a
-intoImage f g = DrawingObject $ \ctx -> 
-    let a = getDrawingObject f ctx; o = getDrawingObject g ctx in (a,o)
+intoImage :: DrawingF a -> Graphic u -> Image u a
+intoImage f g = DrawingF $ \ctx -> 
+    let a = getDrawingF f ctx; o = getDrawingF g ctx in (a,o)
 
 
-intoLocImage :: LocDrawingObject u a -> LocGraphic u -> LocImage u a
-intoLocImage f g pt = DrawingObject $ \ctx -> 
-    let a = getDrawingObject (f pt) ctx
-        o = getDrawingObject (g pt) ctx 
-    in (a,o)
+intoLocImage :: LocDrawingF u a -> LocGraphic u -> LocImage u a
+intoLocImage f g pt = DrawingF $ \ctx -> 
+    let a = getDrawingF (f pt) ctx; o = getDrawingF (g pt) ctx in (a,o)
 
-type ConnDrawingObject u a = Point2 u -> Point2 u -> DrawingObject a
 
-type DConnDrawingObject a = ConnDrawingObject Double a
+xlinkImage :: XLink -> Image u a -> Image u a
+xlinkImage xlink img = askDF >>= \ctx -> 
+    let (a,hp) = runImage ctx img 
+    in pureDF (a, singleH $ xlinkGroup xlink $ hprimToList hp)
 
+--------------------------------------------------------------------------------
+--
+
+type ConnDrawingF u a = Point2 u -> Point2 u -> DrawingF a
+
+type DConnDrawingF a = ConnDrawingF Double a
+
 -- | ConnGraphic is a connector drawn between two points 
 -- contructing a Graphic.
 --
@@ -239,8 +292,10 @@
 type DConnImage a = ConnImage Double a
 
 
-intoConnImage :: ConnDrawingObject u a -> ConnGraphic u -> ConnImage u a
-intoConnImage f g p1 p2 = DrawingObject $ \ctx -> 
-    let a = getDrawingObject (f p1 p2) ctx
-        o = getDrawingObject (g p1 p2) ctx 
-    in (a,o)
+intoConnImage :: ConnDrawingF u a -> ConnGraphic u -> ConnImage u a
+intoConnImage f g p1 p2 = DrawingF $ \ctx -> 
+    let a = getDrawingF (f p1 p2) ctx; o = getDrawingF (g p1 p2) ctx in (a,o)
+
+
+
+
diff --git a/src/Wumpus/Basic/Graphic/Chain.hs b/src/Wumpus/Basic/Graphic/Chain.hs
--- a/src/Wumpus/Basic/Graphic/Chain.hs
+++ b/src/Wumpus/Basic/Graphic/Chain.hs
@@ -38,7 +38,7 @@
 
 
 newtype ChainT u m a = ChainT { 
-          getChainT :: Point2T u -> Point2 u -> m (a, Point2 u) }
+          getChainT :: Point2F u -> Point2 u -> m (a, Point2 u) }
 
 
 type instance MonUnit (ChainT u m) = u
@@ -68,7 +68,7 @@
   position = ChainT $ \rf s -> return (s, rf s)
 
 runChainT :: Monad m 
-          => Point2T u -> Point2 u -> ChainT u m a -> m a
+          => Point2F u -> Point2 u -> ChainT u m a -> m a
 runChainT f pt0 ma = liftM fst $ getChainT ma f pt0
 
 horizontal :: (Num u, Monad m)
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
@@ -14,13 +14,9 @@
 -- Stability   :  unstable
 -- Portability :  GHC 
 --
--- Drawing with trace and drawing context (i.e. reader monad
--- of attributes - fill_colour etc.).
---
--- \*\* WARNING \*\* - some names are expected to change 
--- particularly the naming of the @draw@, @drawAt@, @node@, @...@ 
--- functions.
---
+-- Drawing with /trace/ - a Writer like monad collecting 
+-- intermediate graphics - and /drawing context/ - a reader monad
+-- of attributes - font_face, fill_colour etc.
 --
 --------------------------------------------------------------------------------
 
@@ -33,14 +29,27 @@
   , execDrawing
   , runDrawingT
   , execDrawingT
+
+  , runFdcDrawing
+  , execFdcDrawing
+  , runFdcDrawingT
+  , execFdcDrawingT
+
   , liftToPictureU
+  , liftToPictureMb
+  , mbPictureU
  
   , draw
-  , drawAt
-  , drawAtImg
-  , drawConn
-  , drawConnImg
+  , xdraw
+  , drawi
+  , xdrawi
+
+  , at
+  , ati
+  , conn
+
   , node
+  , nodei
 
   ) where
 
@@ -48,14 +57,13 @@
 import Wumpus.Basic.Graphic.BaseClasses
 import Wumpus.Basic.Graphic.BaseTypes
 import Wumpus.Basic.Graphic.DrawingContext
-import Wumpus.Basic.Utils.HList
  
 
 import Wumpus.Core                              -- package: wumpus-core
 
 import Control.Applicative
 import Control.Monad
-
+import Data.Monoid
 
 
 
@@ -129,24 +137,20 @@
 
 -- TraceM 
 --
--- Note -  @ state `appendH` a @ means the first expression in a 
--- monadic drawing is top of the Z-Order.
--- 
--- This is the matches a list of Prims in Wumpus-Core where the 
--- first element is drawn on top, however is not necessarily
--- intuitive if you regard the do-block as a sequence of 
--- /actions/.
+-- Note -  @ state `mappend` a @ means the first expression in a 
+-- monadic drawing is the first element in the output file. It is
+-- also \*\* at the back \*\* in the the Z-Order.
 --
--- Ideally some control over the Z-Order, possibly adding 
--- /layers/ to the drawing model would be valuable. 
+-- Some control over the Z-Order, possibly by adding /layers/ to 
+-- the drawing model would be valuable. 
 -- 
 
 instance TraceM (Drawing u) where
-  trace a = Drawing $ \_ s -> ((),s `appendH` a)
+  trace a = Drawing $ \_ s -> ((), s `mappend` a)
 
 
 instance Monad m => TraceM (DrawingT u m) where
-  trace a = DrawingT $ \_ s -> return ((),s `appendH` a)
+  trace a = DrawingT $ \_ s -> return ((), s `mappend` a)
 
 
 
@@ -176,7 +180,7 @@
 
 
 runDrawing :: DrawingContext -> Drawing u a -> (a, HPrim u)
-runDrawing ctx ma = getDrawing ma ctx emptyH
+runDrawing ctx ma = getDrawing ma ctx mempty
 
 execDrawing :: DrawingContext -> Drawing u a -> HPrim u
 execDrawing ctx ma = snd $ runDrawing ctx ma
@@ -184,50 +188,149 @@
 
 
 runDrawingT :: Monad m => DrawingContext -> DrawingT u m a -> m (a, HPrim u) 
-runDrawingT ctx ma = getDrawingT ma ctx emptyH
+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
 
+-- | Run the Drawing generating a Picture /within/ a 
+-- \"font delta context\" using the font-family and font-size 
+-- from the intial DrawingContext.
+--
+-- Using a /font delta context/ can reduce the code size of the
+-- generated SVG file (PostScript ignores the FDC).
+--
+runFdcDrawing :: (Real u, Floating u, FromPtSize u)
+             => DrawingContext -> Drawing u a -> (a, Maybe (Picture u))
+runFdcDrawing ctx ma = 
+    let (a,hp) = runDrawing ctx ma
+        ps     = hprimToList hp
+        fdc    = font_props ctx
+    in if null ps then (a, Nothing)
+                 else (a, Just $ fontDeltaContext fdc $ frame ps)
 
+-- | /exec/ version of 'runFdcContext'.
+--
+execFdcDrawing :: (Real u, Floating u, FromPtSize u)
+             => DrawingContext -> Drawing u a -> Maybe (Picture u)
+execFdcDrawing ctx ma = snd $ runFdcDrawing ctx ma
+
+-- | Transformer version of 'runFdcDrawing'.
+--
+runFdcDrawingT :: (Real u, Floating u, FromPtSize u, Monad m)
+             => DrawingContext -> DrawingT u m a -> m (a, Maybe (Picture u))
+runFdcDrawingT ctx ma = 
+    runDrawingT ctx ma >>= \(a,hp) -> 
+    let ps     = hprimToList hp
+        fdc    = font_props ctx
+    in if null ps then return (a, Nothing)
+                  else return (a, Just $ fontDeltaContext fdc $ frame ps)
+  
+-- | Transformer version of 'execFdcDrawing'.
+--       
+execFdcDrawingT :: (Real u, Floating u, FromPtSize u, Monad m)
+             => DrawingContext -> DrawingT u m a -> m (Maybe (Picture u))
+execFdcDrawingT ctx ma = liftM snd $ runFdcDrawingT ctx ma
+
+-- | /Unsafe/ promotion of @HPrim@ to @Picture@.
+--
+-- If the HPrim is empty, a run-time error is thrown.
+-- 
 liftToPictureU :: (Real u, Floating u, FromPtSize u) => HPrim u -> Picture u
-liftToPictureU hf = let prims = toListH hf in 
-                    if null prims then errK else frame prims
+liftToPictureU hf = 
+    let prims = hprimToList hf in if null prims then errK else frame prims
   where
-    errK = error "liftToPictureU - empty prims list."
+    errK = error "toPictureU - empty prims list."
 
+-- | /Safe/ promotion of @HPrim@ to @(Maybe Picture)@.
+--
+-- If the HPrim is empty, then @Nothing@ is returned.
+-- 
+liftToPictureMb :: (Real u, Floating u, FromPtSize u) 
+               => HPrim u -> Maybe (Picture u)
+liftToPictureMb hf = let prims = hprimToList hf in 
+    if null prims then Nothing else Just (frame prims)
+
+
+
+-- | /Unsafe/ promotion of @(Maybe Picture)@ to @Picture@.
+--
+-- This is equivalent to:
+--
+-- > fromMaybe (error "empty") $ pic
+--
+-- This function is solely a convenience, using it saves one 
+-- import and a few characters.
+--
+-- If the supplied value is @Nothing@ a run-time error is thrown.
+-- 
+mbPictureU :: (Real u, Floating u, FromPtSize u) 
+           => Maybe (Picture u) -> Picture u
+mbPictureU Nothing  = error "mbPictureU - empty picture."
+mbPictureU (Just a) = a
+
+
+
 --------------------------------------------------------------------------------
 
+-- | Draw a Graphic taking the drawing style from the 
+-- /drawing context/. 
+--
+-- This operation is analogeous to @tell@ in a Writer monad.
+-- 
 draw :: (TraceM m, DrawingCtxM m, u ~ MonUnit m) => Graphic u -> m ()
 draw gf = askCtx >>= \ctx -> trace (runGraphic ctx gf)
 
-drawAt :: (TraceM m, DrawingCtxM m, u ~ MonUnit m) 
-       => Point2 u ->LocGraphic u -> m ()
-drawAt pt gfL = askCtx >>= \ctx -> trace (runGraphic ctx (gfL pt))
+-- | Hyperlink version of 'draw'.
+--
+xdraw :: (TraceM m, DrawingCtxM m, u ~ MonUnit m) 
+      => XLink -> Graphic u -> m ()
+xdraw xl gf = draw (xlinkGraphic xl gf)
 
-drawAtImg :: (TraceM m, DrawingCtxM m, u ~ MonUnit m) 
-          => Point2 u -> LocImage u a -> m a
-drawAtImg pt imgL = askCtx >>= \ctx -> 
-                    let (a,o) = runImage ctx (imgL pt)
-                    in trace o >> return a
 
 
-     
-drawConn :: (TraceM m, DrawingCtxM m, u ~ MonUnit m) 
-         => Point2 u -> Point2 u -> ConnGraphic u -> m ()
-drawConn p1 p2 connL = askCtx >>= \ctx -> trace (runGraphic ctx (connL p1 p2))
-     
-drawConnImg :: (TraceM m, DrawingCtxM m, u ~ MonUnit m) 
-            => Point2 u -> Point2 u -> ConnImage u a -> m a
-drawConnImg p1 p2 connL = askCtx >>= \ctx -> 
-                          let (a,o) = runImage ctx (connL p1 p2)
-                          in trace o >> return a
-            
+-- | Draw an Image taking the drawing style from the 
+-- /drawing context/. 
+--
+-- The graphic representation of the Image is drawn in the Trace 
+-- monad, and the result is returned.
+-- 
+drawi ::  (TraceM m, DrawingCtxM m, u ~ MonUnit m) => Image u a -> m a
+drawi img = askCtx >>= \ctx -> 
+            let (a,o) = runImage ctx img in trace o >> return a
 
+-- | Hyperlink version of 'drawi'.
+--
+xdrawi ::  (TraceM m, DrawingCtxM m, u ~ MonUnit m) 
+       => XLink -> Image u a -> m a
+xdrawi xl img = drawi (xlinkImage xl img)
 
+
+
+
+infixr 1 `at`, `ati`
+at :: LocGraphic u -> Point2 u -> Graphic u
+at = ($)
+
+ati :: LocImage u a -> Point2 u -> Image u a
+ati = ($)
+
+
+
+infixl 1 `conn`
+conn :: ConnImage u a -> Point2 u -> LocImage u a
+conn = ($)
+
+
 node :: (TraceM m, DrawingCtxM m, PointSupplyM m, u ~ MonUnit m) 
      => LocGraphic u -> m ()
 node gfL = askCtx   >>= \ctx -> 
            position >>= \pt  -> trace (runGraphic ctx $ gfL pt)
 
+
+nodei :: (TraceM m, DrawingCtxM m, PointSupplyM m, u ~ MonUnit m) 
+     => LocImage u a -> m a
+nodei imgL = askCtx   >>= \ctx -> 
+             position >>= \pt  -> 
+             let (a,o) = runImage ctx (imgL pt) in trace o >> return a
 
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
@@ -29,12 +29,15 @@
   , filledPath
   , borderedPath
   , textline
+  , hkernline
+  , vkernline
+
+
   , strokedEllipse
   , filledEllipse  
   , borderedEllipse
 
   , supplyPt
-  , localDrawingContext
   , localPoint
   , displace
 
@@ -58,7 +61,6 @@
 
 import Wumpus.Basic.Graphic.DrawingContext
 import Wumpus.Basic.Graphic.BaseTypes
-import Wumpus.Basic.Utils.HList
 
 import Wumpus.Core                              -- package: wumpus-core
 
@@ -70,62 +72,81 @@
             => DrawingContext -> Graphic u -> Maybe (Picture u)
 drawGraphic ctx gf = post $ runGraphic ctx gf
   where
-    post hf = let xs = toListH hf in 
+    post hf = let xs = hprimToList hf in 
               if null xs then Nothing else Just (frame xs)
 
 drawGraphicU :: (Real u, Floating u, FromPtSize u) 
              => DrawingContext -> Graphic u -> Picture u
 drawGraphicU ctx gf = post $ runGraphic ctx gf
   where
-    post hf = let xs = toListH hf in 
+    post hf = let xs = hprimToList hf in 
               if null xs then errK else frame xs
     errK    = error "drawGraphicU - empty Graphic."
 
 
+
+
 -- having the same names is actually not so useful...
 
 openStroke :: Num u => PrimPath u -> Graphic u
-openStroke pp = (\rgb attr -> wrapH $ ostroke rgb attr pp) 
-                    <$> asksObj primary_colour <*> asksObj stroke_props
+openStroke pp = (\rgb attr -> singleH $ ostroke rgb attr pp) 
+                    <$> asksDF primary_colour <*> asksDF stroke_props
 
 
 closedStroke :: Num u => PrimPath u -> Graphic u
-closedStroke pp = (\rgb attr -> wrapH $ cstroke rgb attr pp) 
-                      <$> asksObj primary_colour <*> asksObj stroke_props
+closedStroke pp = (\rgb attr -> singleH $ cstroke rgb attr pp) 
+                      <$> asksDF primary_colour <*> asksDF stroke_props
 
 
 filledPath :: Num u => PrimPath u -> Graphic u
-filledPath pp = (\rgb -> wrapH $ fill rgb pp) 
-                    <$> asksObj secondary_colour
+filledPath pp = (\rgb -> singleH $ fill rgb pp) 
+                    <$> asksDF secondary_colour
 
 
 borderedPath :: Num u => PrimPath u -> Graphic u
 borderedPath pp = 
-    (\frgb attr srgb -> wrapH $ fillStroke frgb attr srgb pp) 
-        <$> asksObj secondary_colour <*> asksObj stroke_props <*> asksObj primary_colour
+    (\frgb attr srgb -> singleH $ fillStroke frgb attr srgb pp) 
+        <$> asksDF secondary_colour <*> asksDF stroke_props 
+                                    <*> asksDF primary_colour
 
 
+--------------------------------------------------------------------------------
+-- 
+
 textline :: Num u => String -> LocGraphic u
 textline ss baseline_left =
-    (\(rgb,attr) -> wrapH $ textlabel rgb attr ss baseline_left) 
-       <$> asksObj textAttr
+    (\(rgb,attr) -> singleH $ textlabel rgb attr ss baseline_left) 
+       <$> asksDF textAttr
 
+hkernline :: Num u => [KerningChar u] -> LocGraphic u
+hkernline ks baseline_left = 
+    (\(rgb,attr) -> singleH $ hkernlabel rgb attr ks baseline_left) 
+       <$> asksDF textAttr
 
+vkernline :: Num u => [KerningChar u] -> LocGraphic u
+vkernline ks baseline_left = 
+    (\(rgb,attr) -> singleH $ vkernlabel rgb attr ks baseline_left) 
+       <$> asksDF textAttr
+
+
+--------------------------------------------------------------------------------
+
+
 strokedEllipse :: Num u => u -> u -> LocGraphic u
 strokedEllipse hw hh pt =  
-    (\rgb attr -> wrapH $ strokeEllipse rgb attr hw hh pt) 
-       <$> asksObj primary_colour <*> asksObj stroke_props
+    (\rgb attr -> singleH $ strokeEllipse rgb attr hw hh pt) 
+       <$> asksDF primary_colour <*> asksDF stroke_props
 
 filledEllipse :: Num u => u -> u -> LocGraphic u
 filledEllipse hw hh pt =  
-    (\rgb -> wrapH $ fillEllipse rgb hw hh pt) 
-       <$> asksObj secondary_colour
+    (\rgb -> singleH $ fillEllipse rgb hw hh pt) 
+       <$> asksDF secondary_colour
 
 borderedEllipse :: Num u => u -> u -> LocGraphic u
 borderedEllipse hw hh pt = 
-    (\frgb attr srgb -> wrapH $ fillStrokeEllipse frgb attr srgb hw hh pt) 
-        <$> asksObj secondary_colour <*> asksObj stroke_props 
-        <*> asksObj primary_colour
+    (\frgb attr srgb -> singleH $ fillStrokeEllipse frgb attr srgb hw hh pt) 
+        <$> asksDF secondary_colour <*> asksDF stroke_props 
+        <*> asksDF primary_colour
 
 
 --------------------------------------------------------------------------------
@@ -142,9 +163,6 @@
 displace dx dy (P2 x y) = P2 (x+dx) (y+dy)
 
 
-localDrawingContext :: 
-    (DrawingContext -> DrawingContext) -> LocGraphic u -> LocGraphic u
-localDrawingContext upd img = \pt -> localCtxObj upd (img pt) 
 
 localPoint :: (Point2 u -> Point2 u) -> LocGraphic u -> LocGraphic u
 localPoint upd gf = \pt -> gf (upd pt)
diff --git a/src/Wumpus/Basic/Monads/TurtleMonad.hs b/src/Wumpus/Basic/Monads/TurtleMonad.hs
--- a/src/Wumpus/Basic/Monads/TurtleMonad.hs
+++ b/src/Wumpus/Basic/Monads/TurtleMonad.hs
@@ -133,6 +133,9 @@
   trace a  = TurtleT $ \_ s -> trace a >> return ((),s)
 
 
+instance (Monad m, u ~ MonUnit m, Num u) => PointSupplyM (TurtleT u m) where
+  position = getPos
+
 --------------------------------------------------------------------------------
 
 
@@ -171,19 +174,22 @@
   yStep    = TurtleDrawing $ yStep
 
 
--- Lifters no longer supplied...
+
 -- TraceM 
 
 instance TraceM (TurtleDrawing u) where
   trace a = TurtleDrawing $ trace a
 
-
-
 -- DrawingCtxM
 
 instance DrawingCtxM (TurtleDrawing u) where
   askCtx          = TurtleDrawing $ askCtx
   localCtx ctx ma = TurtleDrawing $ localCtx ctx (getTurtleDrawing ma)
+
+-- PointSupplyM
+
+instance Num u => PointSupplyM (TurtleDrawing u) where
+  position = getPos
 
 
 runTurtleDrawing :: Num 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
@@ -36,7 +36,6 @@
   , courierBoldOblique
 
   -- * Symbol
-  -- $symboldoc
   , symbol
 
   ) where
@@ -45,95 +44,114 @@
 
 import Wumpus.Core
 
-{-
-
- Times-Roman  Times-Italic  Times-Bold  Times-BoldItalic
- Helvetica  Helvetica-Oblique  Helvetica-Bold  Helvetica-Bold-Oblique
- Courier  Courier-Oblique  Courier-Bold  Courier-Bold-Oblique
- Symbol
+-- Supported fonts are:
+--
+-- Times-Roman  Times-Italic       Times-Bold      Times-BoldItalic
+-- Helvetica    Helvetica-Oblique  Helvetica-Bold  Helvetica-Bold-Oblique
+-- Courier      Courier-Oblique    Courier-Bold    Courier-Bold-Oblique
+-- Symbol
 
--}
 --------------------------------------------------------------------------------
--- Times-Roman
+-- 
 
+-- | Times-Roman
+-- 
 timesRoman :: FontFace
-timesRoman = FontFace "Times-Roman" "Times New Roman" SVG_REGULAR
-
--- Times Italic
+timesRoman = 
+    FontFace "Times-Roman" "Times New Roman" SVG_REGULAR latin1_font_encoder
 
+-- | Times Italic
+--
 timesItalic :: FontFace
-timesItalic = FontFace "Times-Italic" "Times New Roman" SVG_ITALIC
-
--- Times Bold
-
+timesItalic = 
+    FontFace "Times-Italic" "Times New Roman" SVG_ITALIC latin1_font_encoder
+                       
+-- | Times Bold
+--
 timesBold :: FontFace
-timesBold = FontFace "Times-Bold" "Times New Roman" SVG_BOLD
-
--- Times Bold Italic
+timesBold = 
+    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
+timesBoldItalic = FontFace "Times-BoldItalic" 
+                           "Times New Roman" 
+                           SVG_BOLD_ITALIC 
+                           latin1_font_encoder
 
 
 --------------------------------------------------------------------------------
 -- Helvetica
 
+-- | Helvetica 
+--
 helvetica :: FontFace
-helvetica = FontFace "Helvetica" "Helvetica" SVG_REGULAR
+helvetica = FontFace "Helvetica" "Helvetica" SVG_REGULAR latin1_font_encoder
 
 
--- Helvetica Oblique
-
+-- | Helvetica Oblique
+--
 helveticaOblique :: FontFace
-helveticaOblique = FontFace "Helvetica-Oblique" "Helvetica" SVG_OBLIQUE
-
--- Helvetica Bold
+helveticaOblique = 
+    FontFace "Helvetica-Oblique" "Helvetica" SVG_OBLIQUE latin1_font_encoder
 
+-- | Helvetica Bold
+-- 
 helveticaBold :: FontFace
-helveticaBold = FontFace "Helvetica-Bold" "Helvetica" SVG_BOLD
+helveticaBold = 
+    FontFace "Helvetica-Bold" "Helvetica" SVG_BOLD latin1_font_encoder
 
 
--- Helvetica Bold Oblique
-
+-- | Helvetica Bold Oblique
+--
 helveticaBoldOblique :: FontFace
-helveticaBoldOblique = 
-    FontFace "Helvetica-Bold-Oblique" "Helvetica" SVG_BOLD_OBLIQUE
+helveticaBoldOblique = FontFace "Helvetica-Bold-Oblique" 
+                                "Helvetica" 
+                                SVG_BOLD_OBLIQUE 
+                                latin1_font_encoder
 
 
 
 --------------------------------------------------------------------------------
--- Courier
 
+-- | Courier
+-- 
 courier :: FontFace
-courier = FontFace "Courier" "Courier New" SVG_REGULAR
-
--- Courier Oblique
+courier = FontFace "Courier" "Courier New" SVG_REGULAR latin1_font_encoder
 
+-- | Courier Oblique
+-- 
 courierOblique :: FontFace
-courierOblique = FontFace "Courier-Oblique" "Courier New" SVG_OBLIQUE
-
--- Courier Bold
+courierOblique = 
+    FontFace "Courier-Oblique" "Courier New" SVG_OBLIQUE latin1_font_encoder
 
+-- | Courier Bold
+-- 
 courierBold :: FontFace
-courierBold = FontFace "Courier-Bold" "Courier New" SVG_BOLD
+courierBold = 
+    FontFace "Courier-Bold" "Courier New" SVG_BOLD latin1_font_encoder
 
 
--- Courier Bold Oblique
-
+-- | Courier Bold Oblique
+-- 
 courierBoldOblique :: FontFace
-courierBoldOblique = 
-    FontFace "Courier-Bold-Oblique" "Courier New" SVG_BOLD_OBLIQUE
+courierBoldOblique = FontFace "Courier-Bold-Oblique" 
+                              "Courier New" 
+                              SVG_BOLD_OBLIQUE 
+                              latin1_font_encoder
 
 --------------------------------------------------------------------------------
 -- Symbol
 
--- $symboldoc
--- Symbol does not appear to be well supported by SVG.
--- It renders in Chrome but not in Firefox.
-
+-- | Symbol
+--
+-- Note - Symbol does not appear to be well supported by some SVG
+-- renders. Seemingly Chrome is fine but Firefox defaults to some
+-- serif font.
+-- 
 symbol :: FontFace
-symbol = FontFace "Symbol" "Symbol" SVG_REGULAR
+symbol = FontFace "Symbol" "Symbol" SVG_REGULAR symbol_font_encoder
 
 
 
diff --git a/src/Wumpus/Basic/Text/LRSymbol.hs b/src/Wumpus/Basic/Text/LRSymbol.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Basic/Text/LRSymbol.hs
@@ -0,0 +1,213 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Basic.Text.LRSymbol
+-- Copyright   :  (c) Stephen Tetley 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  GHC
+--
+-- Named literals from Symbol font, drawn with the LRText monad.
+-- 
+-- Note - currently the techinique used here generates adequate
+-- PostScript, but very ineficient SVG.
+-- 
+-- Also uUpsilon is not mapped to the correct character...
+--
+--------------------------------------------------------------------------------
+
+module Wumpus.Basic.Text.LRSymbol
+  ( 
+
+  -- * Lower case Greek letters
+
+    alpha
+  , beta
+  , gamma
+  , delta
+  , epsilon
+  , zeta
+  , eta
+  , theta
+  , iota
+  , kappa
+  , lambda
+  , mu
+  , nu
+  , xi
+  , pi
+  , rho
+  , sigma
+  , tau
+  , upsilon
+  , phi
+  , chi
+  , psi
+  , omega
+
+  -- * Upper case Greek letters
+  , uGamma
+  , uDelta
+  , uTheta
+  , uLambda
+  , uXi
+  , uPi
+  , uSigma
+  , uUpsilon
+  , uPhi
+  , uPsi
+  , uOmega
+
+  , otimes
+  , oplus
+
+  ) where
+
+
+import Wumpus.Basic.Text.LRText
+
+
+import Prelude hiding ( pi )
+
+-- Note - due to a optimization in Wumpus-Core, the PostScript
+-- generated by the techinique here - writing a 
+-- (single-character) label one at a time - isn\'t too bad as 
+-- Wumpus-Core only issues a findfont command when the font 
+-- changes. 
+-- 
+-- However for SVG the result is very poor - one text element 
+-- including an orientation changing matrix transforming for 
+-- each character.
+-- 
+-- Wumpus-Core\'s SVG rendering will work at some point.
+-- 
+
+
+--------------------------------------------------------------------------------
+-- lower case
+
+
+alpha       :: Num u => TextM u ()
+alpha       = symb 'a'
+
+beta        :: Num u => TextM u ()
+beta        = symb 'b'
+
+gamma       :: Num u => TextM u ()
+gamma       = symb 'g'
+
+delta       :: Num u => TextM u ()
+delta       = symb 'd'
+
+epsilon     :: Num u => TextM u ()
+epsilon     = symb 'e'
+
+zeta        :: Num u => TextM u ()
+zeta        = symb 'z'
+
+eta         :: Num u => TextM u ()
+eta         = symb 'h'
+
+theta       :: Num u => TextM u ()
+theta       = symb 'q'
+
+iota        :: Num u => TextM u ()
+iota        = symb 'i'
+
+kappa       :: Num u => TextM u ()
+kappa       = symb 'k'
+
+lambda      :: Num u => TextM u ()
+lambda      = symb 'l'
+
+mu          :: Num u => TextM u ()
+mu          = symb 'm'
+
+nu          :: Num u => TextM u ()
+nu          = symb 'n'
+
+xi          :: Num u => TextM u ()
+xi          = symb 'x'
+
+pi          :: Num u => TextM u ()
+pi          = symb 'p'
+
+rho         :: Num u => TextM u ()
+rho         = symb 'r'
+
+sigma       :: Num u => TextM u ()
+sigma       = symb 's'
+
+tau         :: Num u => TextM u ()
+tau         = symb 't'
+
+upsilon     :: Num u => TextM u ()
+upsilon     = symb 'u'
+
+phi         :: Num u => TextM u ()
+phi         = symb 'j'
+
+chi         :: Num u => TextM u ()
+chi         = symb 'c'
+
+psi         :: Num u => TextM u ()
+psi         = symb 'y'
+
+omega       :: Num u => TextM u ()
+omega       = symb 'w'
+
+
+--------------------------------------------------------------------------------
+-- upper case
+
+uGamma      :: Num u => TextM u ()
+uGamma      = symb 'G'
+
+uDelta      :: Num u => TextM u ()
+uDelta      = symb 'D'
+
+uTheta      :: Num u => TextM u ()
+uTheta      = symb 'Q'
+
+uLambda     :: Num u => TextM u ()
+uLambda     = symb 'L'
+
+uXi         :: Num u => TextM u ()
+uXi         = symb 'X'
+
+uPi         :: Num u => TextM u ()
+uPi         = symb 'P'
+
+uSigma      :: Num u => TextM u ()
+uSigma      = symb 'S'
+
+-- | Not working in PostScript, @\&\#161;@ works for SVG but 
+-- PostScript needs an encoding table for Symbol-Font not Latin1!
+--
+-- For PostScript, Latin1 @161@ maps to @exclamdown@ not 
+-- @Upsilon1@, extending Wumpus-Core to support this will require 
+-- quite some work...
+--
+uUpsilon    :: Num u => TextM u ()
+uUpsilon    = symbEscInt 161
+
+uPhi        :: Num u => TextM u ()
+uPhi        = symb 'F'
+
+uPsi        :: Num u => TextM u ()
+uPsi        = symb 'Y'
+
+uOmega      :: Num u => TextM u ()
+uOmega      = symb 'W'
+
+
+--------------------------------------------------------------------------------
+
+otimes      :: Num u => TextM u ()
+otimes      = symbi 0xc4
+
+oplus       :: Num u => TextM u ()
+oplus       = symbi 0xc5
diff --git a/src/Wumpus/Basic/Text/LRText.hs b/src/Wumpus/Basic/Text/LRText.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Basic/Text/LRText.hs
@@ -0,0 +1,197 @@
+{-# LANGUAGE TypeFamilies               #-}
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Basic.Text.LRText
+-- Copyright   :  (c) Stephen Tetley 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  GHC
+--
+-- LRText monad - left-to-right text, with kerning.
+-- 
+-- Note - because Wumpus has no access to the metrics data inside
+-- a font file, the default spacing is not good and it is 
+-- expected that kerning will need to be added per-letter for
+-- variable width fonts.
+--
+-- This module makes precise text spacing \*possible\* - it does 
+-- not make it \*easy\*.
+-- 
+--------------------------------------------------------------------------------
+
+module Wumpus.Basic.Text.LRText
+  ( 
+
+
+    TextM
+  , runTextM
+  , execTextM
+
+  , kern
+  , char
+  , symb
+  , symbi
+  , symbEscInt
+
+  ) where
+
+import Wumpus.Basic.Graphic
+import Wumpus.Basic.SafeFonts
+import Wumpus.Basic.Utils.HList
+
+import Wumpus.Core                              -- package: wumpus-core
+
+import Control.Applicative
+import Control.Monad
+import Data.Char ( chr )
+import Data.Monoid
+
+
+
+
+
+-- Need a note in wumpus-core and here about space:preserve
+
+-- Note - if we have font change (e.g. to symbol font) then we 
+-- have to generate more than one hkernline.
+-- 
+-- If one wants to be really prissy about optimization, one could
+-- generate two simultaneous and overlayed lines - one in regular 
+-- font, one in Symbol. 
+--
+-- Result should be a LocGraphic (so cannot do a trace as we go). 
+--
+
+-- Note - the the state tracks two kernlines: one for symbols,  
+
+data St u = St 
+      { delta_chr       :: !u
+      , delta_sym       :: !u
+      , acc_chr         :: H (KerningChar u)
+      , acc_sym         :: H (KerningChar u)
+      }
+
+
+data Env u = Env 
+      { char_width      :: !u
+      , spacer_width    :: !u
+      }
+
+-- Note - unlike Turtle for example, Text is a monad not a 
+-- transformer.
+--
+-- The rationale for this is to avoid complications percolating 
+-- from the Drawing monad. It Text were built over the Drawing
+-- monad what would it do on a font change, a colour change...
+-- 
+-- That say Text must still be run /within/ the Drawing so it 
+-- can take the initial font size, stroke colour etc.
+--
+
+newtype TextM u a = TextM { getTextM :: Env u -> St u -> (a, St u) }
+
+type instance MonUnit (TextM u) = u
+
+instance Functor (TextM u) where
+  fmap f mf = TextM $ \r s -> let (a,s') = getTextM mf r s in (f a,s')
+
+
+instance Applicative (TextM u) where
+  pure a    = TextM $ \_ s -> (a,s)
+  mf <*> ma = TextM $ \r s -> let (f,s')  = getTextM mf r s
+                                  (a,s'') = getTextM ma r s'
+                              in (f a,s'')
+
+instance Monad (TextM u) where
+  return a  = TextM $ \_ s -> (a,s)
+  m >>= k   = TextM $ \r s -> let (a,s')  = getTextM m r s 
+                              in (getTextM . k) a r s'
+
+                              
+-- Note - post has to displace in the vertical to get the bottom 
+-- line at the base line...
+
+runTextM :: (Num u, FromPtSize u, DrawingCtxM m, u ~ MonUnit m) 
+         => TextM u a -> m (a, LocGraphic u)
+runTextM ma = askCtx >>= \ctx -> 
+    let e = runDF ctx envZero in post $ getTextM ma e stZero
+  where
+    post (a,st)  = let sG = updCtxSym $ mkHKern $ toListH $ acc_sym st
+                       cG = mkHKern $ toListH $ acc_chr st
+                   in return (a, sG `lgappend` cG)
+
+    mkHKern []   = const mempty
+    mkHKern xs   = hkernline xs
+
+    updCtxSym lg = localLG (fontface symbol) lg
+
+
+execTextM :: (Num u, FromPtSize u, DrawingCtxM m, u ~ MonUnit m) 
+          => TextM u a -> m (LocGraphic u)
+execTextM ma = liftM snd $ runTextM ma  
+
+
+stZero :: Num u => St u
+stZero = St { delta_chr       = 0
+            , delta_sym       = 0
+            , acc_chr         = emptyH
+            , acc_sym         = emptyH }
+
+envZero :: FromPtSize u => DrawingF (Env u)
+envZero = (\sz -> Env { char_width   = fromPtSize $ charWidth sz
+                      , spacer_width = fromPtSize $ spacerWidth sz })
+            <$> asksDF (font_size . font_props)
+
+
+gets :: (St u -> a) -> TextM u a
+gets fn = TextM $ \_ s -> (fn s, s)
+
+charMove :: Num u => TextM u ()
+charMove = TextM $ \(Env {char_width=cw, spacer_width=sw}) s -> 
+             let step_width = cw + sw    
+                 d_sym      = (delta_sym s) + step_width
+             in ((), s { delta_chr = step_width, delta_sym = d_sym }) 
+
+symbMove :: Num u => TextM u ()
+symbMove = TextM $ \(Env {char_width=cw, spacer_width=sw}) s -> 
+             let step_width = cw + sw
+                 d_chr      = (delta_chr s) + step_width
+             in ((), s { delta_chr = d_chr, delta_sym = step_width }) 
+
+snocSymb :: KerningChar u -> TextM u ()
+snocSymb kc = TextM $ \_ s -> ((), upd s)
+  where
+    upd = (\s a -> s { acc_sym = a `snocH` kc}) <*> acc_sym
+
+snocChar :: KerningChar u -> TextM u ()
+snocChar kc = TextM $ \_ s -> ((), upd s)
+  where
+    upd = (\s a -> s { acc_chr = a `snocH` kc}) <*> acc_chr
+
+kern :: Num u => u -> TextM u ()
+kern dx = TextM $ \_ s -> ((), upd s)
+  where
+    upd = (\s a b -> s { delta_chr = a+dx, delta_sym = b+dx}) 
+            <*> delta_chr <*> delta_sym
+
+char :: Num u => Char -> TextM u ()
+char ch = gets delta_chr           >>= \u -> 
+          snocChar (kernchar u ch) >> charMove
+
+symb :: Num u => Char -> TextM u ()
+symb sy = gets delta_sym           >>= \u -> 
+          snocSymb (kernchar u sy) >> symbMove
+
+
+symbi :: Num u => Int -> TextM u ()
+symbi i = symb (chr i) 
+
+
+symbEscInt :: Num u => Int -> TextM u ()
+symbEscInt i = gets delta_sym            >>= \u -> 
+               snocSymb (kernEscInt u i) >> symbMove
+
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,7,0)
+-- > (0,8,0)
 --
 wumpus_basic_version :: (Int,Int,Int)
-wumpus_basic_version = (0,7,0)
+wumpus_basic_version = (0,8,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.7.0
+version:          0.8.0
 license:          BSD3
 license-file:     LICENSE
 copyright:        Stephen Tetley <stephen.tetley@gmail.com>
@@ -21,41 +21,28 @@
   .
   Changelog:
   .
-  0.6.0 to 0.7.0:
-  .
-  * Major rework of Graphic types, the old types (AGraphic, 
-    GraphicF etc.) and the old drawing monads have been removed. 
-    The new types are based on the AGraphic and related types but 
-    their implementation is different. The new types track the 
-    /graphics state/ within the type (the DrawingContext) plus 
-    how to draw themselves. For real drawings, graphics are 
-    collected with a Writer-like monad the @Basic.Graphic.Drawing@ 
-    monad which replaces the DrawingCtx and Trace monads. The 
-    Turtle monad remains and has been updated to work with the new
-    drawing monads.
-  .
-  * LRText and LRSymbol modules temporarily removed as they 
-    contradict the new, optimized kerning functionality in 
-    @Wumpus.Core@.
-  .
-  0.5.0 to 0.6.0:
-  .
-  * Updates to work with wumpus-core-0.30.0.
-  .
-  * The code from @Basic.Graphic@ has been moved in to 
-    @Basic.Graphic.Primitive@ - this module is due a major 
-    overhaul. @Basic.Graphic@ is now an /import/ shim for
-    @Basic.Graphic.Primitive@.
+  0.7.0 to 0.8.0:
   .
-  0.4.0 to 0.5.0:
+  * Re-introduced LRText and LRSymbol - they now work with 
+    Wumpus-Core\'s kerning support.
+  . 
+  * Changes to @Graphic.Basic.BaseTypes@ - @DrawingObject@ 
+    renamed to @DrawingF@. @HPrim@ wrapped as a newtype to 
+    support a Monoid instance. Removed @appendGraphic@ and @gcat@ 
+    as they can be achieved with @mappend@ and @mconcat@. 
+    @appendAt@ renamed to @lgappend@. @PointT@ remaned to 
+    @PointF@.
   .
-  * Re-worked the PictureLanguage module.
+  * Changes to @Graphic.Basic.Drawing@ - @drawAt@, @drawAtImg@, 
+    @drawConn@, @drawConnImg@ all removed. They are replaced 
+    by @draw@ and @drawi@ together with then new @at@ and @conn@
+    combinators.
   .
-  * SVGColours and X11Colours moved into @Wumpus.Basic.Colour@.
-    Naming scheme for colours changed to use underscore between 
-    words rather than camelCase.
+  * Changes to @Basic.Graphic.PrimGraphic@ - @localDrawingContext@
+    renamed to @localLG@ and moved to @Basic.Graphic.BaseTypes@.
   .
-  * Updates to work with wumpus-core-0.30.0.
+  * Updates to @Basic.SafeFonts@ to work with changes to 
+    @Wumpus.Core@.
   .
   .
 build-type:         Simple
@@ -76,7 +63,7 @@
   build-depends:      base            <  5, 
                       containers      >= 0.3     && <= 0.4, 
                       vector-space    >= 0.6,
-                      wumpus-core     == 0.32.0
+                      wumpus-core     == 0.33.0
 
   
   exposed-modules:
@@ -100,6 +87,8 @@
     Wumpus.Basic.Paths.Base,
     Wumpus.Basic.Paths.Construction,
     Wumpus.Basic.SafeFonts,
+    Wumpus.Basic.Text.LRSymbol,
+    Wumpus.Basic.Text.LRText,
     Wumpus.Basic.Utils.HList,
     Wumpus.Basic.Utils.Intersection,
     Wumpus.Basic.VersionNumber,