diff --git a/Graphics/PS.hs b/Graphics/PS.hs
--- a/Graphics/PS.hs
+++ b/Graphics/PS.hs
@@ -1,3 +1,4 @@
+-- | Top-level module for @hps@.
 module Graphics.PS (module Graphics.PS.Pt,
                     module Graphics.PS.Bezier,
                     module Graphics.PS.Path,
diff --git a/Graphics/PS/Bezier.hs b/Graphics/PS/Bezier.hs
--- a/Graphics/PS/Bezier.hs
+++ b/Graphics/PS/Bezier.hs
@@ -1,3 +1,4 @@
+-- | Bezier functions.
 module Graphics.PS.Bezier (bezier4) where
 
 import Graphics.PS.Pt
@@ -5,14 +6,14 @@
 {--
 bezier3 :: Pt -> Pt -> Pt -> Double -> Pt
 bezier3 (Pt x1 y1) (Pt x2 y2) (Pt x3 y3) mu = (Pt x y)
-    where a = mu * mu
+    where a = mu*mu
           b = 1 - mu
-          c = b * b
-          x = x1 * c + 2 * x2 * b * mu + x3 * a
-          y = y1 * c + 2 * y2 * b * mu + y3 * a
+          c = b*b
+          x = x1*c + 2*x2*b*mu + x3*a
+          y = y1*c + 2*y2*b*mu + y3*a
 --}
 
--- | Four-point bezier curve interpolation.  The index (mu) is
+-- | Four-point bezier curve interpolation.  The index /mu/ is
 --   in the range zero to one.
 bezier4 :: Pt -> Pt -> Pt -> Pt -> Double -> Pt
 bezier4 (Pt x1 y1) (Pt x2 y2) (Pt x3 y3) (Pt x4 y4) mu =
diff --git a/Graphics/PS/Font.hs b/Graphics/PS/Font.hs
--- a/Graphics/PS/Font.hs
+++ b/Graphics/PS/Font.hs
@@ -1,6 +1,7 @@
+-- | Font type and functions.
 module Graphics.PS.Font (Font(..)) where
 
 -- | Font data type.
-data Font = Font { fontName :: String
-                 , fontSize :: Double }
-            deriving (Eq, Show)
+data Font = Font {fontName :: String
+                 ,fontSize :: Double}
+            deriving (Eq,Show)
diff --git a/Graphics/PS/GS.hs b/Graphics/PS/GS.hs
--- a/Graphics/PS/GS.hs
+++ b/Graphics/PS/GS.hs
@@ -1,32 +1,39 @@
-module Graphics.PS.GS ( GS(..)
-                      , LineCap(..)
-                      , LineJoin(..)
-                      , Color(..)
-                      , defaultGS, greyGS ) where
+-- | PS graphics state.
+module Graphics.PS.GS (GS(..)
+                      ,LineCap(..)
+                      ,LineJoin(..)
+                      ,LineWidth
+                      ,Color(..)
+                      ,defaultGS, greyGS) where
 
-data LineCap = ButtCap 
-             | RoundCap 
+-- | Line cap enumeration.
+data LineCap = ButtCap
+             | RoundCap
              | ProjectingSquareCap
                deriving (Eq, Show, Enum)
 
+-- | Line width (real).
 type LineWidth = Double
 
-data LineJoin = MiterJoin 
-              | RoundJoin 
+-- | Line join enumeration.
+data LineJoin = MiterJoin
+              | RoundJoin
               | BevelJoin
                 deriving (Eq, Show, Enum)
 
+-- | Colour model.
 data Color = RGB Double Double Double
              deriving (Eq, Show)
 
+-- | Graphics state.
 data GS = GS Color LineWidth LineCap LineJoin ([Int], Int) Double
           deriving (Eq, Show)
 
--- | Default GS of indicated color.
+-- | Default 'GS' of indicated 'Color'.
 defaultGS :: Color -> GS
 defaultGS c = GS c 1.0 ButtCap MiterJoin ([], 0) 10.0
 
--- | Default GS of indicated shade of grey.
+-- | Default 'GS' of indicated shade of grey.
 greyGS :: Double -> GS
 greyGS g = defaultGS (RGB g g g)
 
diff --git a/Graphics/PS/Glyph.hs b/Graphics/PS/Glyph.hs
--- a/Graphics/PS/Glyph.hs
+++ b/Graphics/PS/Glyph.hs
@@ -1,3 +1,4 @@
+-- | Glyph data type.
 module Graphics.PS.Glyph (Glyph) where
 
 -- | Character data type.
diff --git a/Graphics/PS/Image.hs b/Graphics/PS/Image.hs
--- a/Graphics/PS/Image.hs
+++ b/Graphics/PS/Image.hs
@@ -1,17 +1,34 @@
-module Graphics.PS.Image (Image(..), over) where
+-- | Image type and functions.
+module Graphics.PS.Image (Image(..),over) where
 
-import qualified Graphics.PS.Matrix as M
-import qualified Graphics.PS.Path as P
-import qualified Graphics.PS.GS as G
+import Graphics.PS.Matrix
+import Graphics.PS.Path
+import Graphics.PS.GS
 
--- | Image data type.
-data Image = Stroke G.GS P.Path
-           | Fill G.GS P.Path
-           | ITransform M.Matrix Image
+-- | An image is a rendering of a graph of 'Path's.
+data Image = Stroke GS Path
+           | Fill GS Path
+           | ITransform Matrix Image
            | Over Image Image
            | Empty
              deriving (Eq, Show)
 
--- | Layer one image over another.
+-- | Layer one 'Image' over another.
 over :: Image -> Image -> Image
 over = Over
+
+{-
+-- | Apply a function to leaf nodes.
+i_apply :: (Image -> Image) -> Image -> Image
+i_apply f (ITransform m i) = ITransform m (i_apply f i)
+i_apply f (Over i j) = Over (i_apply f i) (i_apply f j)
+i_apply f i = f i
+
+-- | Apply a path function to leaf nodes.
+i_p_apply :: (P.Path -> P.Path) -> Image -> Image
+i_p_apply f (Stroke g p) = Stroke g (P.p_apply f p)
+i_p_apply f (Fill g p) = Fill g (P.p_apply f p)
+i_p_apply f (ITransform m i) = ITransform m (i_p_apply f i)
+i_p_apply f (Over i j) = Over (i_p_apply f i) (i_p_apply f j)
+i_p_apply _ Empty = Empty
+-}
diff --git a/Graphics/PS/Matrix.hs b/Graphics/PS/Matrix.hs
--- a/Graphics/PS/Matrix.hs
+++ b/Graphics/PS/Matrix.hs
@@ -1,43 +1,40 @@
-module Graphics.PS.Matrix ( Matrix(Matrix)
-                          , identity
-                          , translation, scaling, rotation ) where
+-- | Matrix type and functions.
+module Graphics.PS.Matrix (R,Matrix(Matrix)
+                          ,identity
+                          ,translation,scaling,rotation) where
 
+-- | Synonym for 'Double'.
 type R = Double
 
 -- | Transformation matrix data type.
-data Matrix = Matrix R R R R R R
-              deriving (Eq, Show)
-
-type M = Matrix
+data Matrix = Matrix R R R R R R deriving (Eq,Show)
 
-data MIx = I0 
-            | I1 
-            | I2 
-              deriving (Eq, Show, Enum)
+-- | Enumeration of 'Matrix' indices.
+data Matrix_Index = I0 | I1 | I2
 
-row :: M -> MIx -> (R, R, R)
-row (Matrix a b _ _ _ _) I0 = (a, b, 0)
-row (Matrix _ _ c d _ _) I1 = (c, d, 0)
-row (Matrix _ _ _ _ e f) I2 = (e, f, 1)
+row :: Matrix -> Matrix_Index -> (R,R,R)
+row (Matrix a b _ _ _ _) I0 = (a,b,0)
+row (Matrix _ _ c d _ _) I1 = (c,d,0)
+row (Matrix _ _ _ _ e f) I2 = (e,f,1)
 
-col :: M -> MIx -> (R, R, R)
-col (Matrix a _ c _ e _) I0 = (a, c, e)
-col (Matrix _ b _ d _ f) I1 = (b, d, f)
-col (Matrix _ _ _ _ _ _) I2 = (0, 0, 1)
+col :: Matrix -> Matrix_Index -> (R,R,R)
+col (Matrix a _ c _ e _) I0 = (a,c,e)
+col (Matrix _ b _ d _ f) I1 = (b,d,f)
+col (Matrix _ _ _ _ _ _) I2 = (0,0,1)
 
-multiply :: M -> M -> M
+multiply :: Matrix -> Matrix -> Matrix
 multiply a b =
-    let f i j = let (r1, r2, r3) = row a i
-                    (c1, c2, c3) = col b j
+    let f i j = let (r1,r2,r3) = row a i
+                    (c1,c2,c3) = col b j
                 in r1 * c1 + r2 * c2 + r3 * c3
         m = Matrix
     in m (f I0 I0) (f I0 I1) (f I1 I0) (f I1 I1) (f I2 I0) (f I2 I1)
 
-pointwise :: (R -> R) -> M -> M 
+pointwise :: (R -> R) -> Matrix -> Matrix
 pointwise g (Matrix a b c d e f) =
     Matrix (g a) (g b) (g c) (g d) (g e) (g f)
 
-pointwise2 :: (R -> R -> R) -> M -> M -> M
+pointwise2 :: (R -> R -> R) -> Matrix -> Matrix -> Matrix
 pointwise2 g (Matrix a b c d e f) (Matrix a' b' c' d' e' f') =
     Matrix (g a a') (g b b') (g c c') (g d d') (g e e') (g f f')
 
@@ -48,18 +45,18 @@
     abs = pointwise abs
     signum = pointwise signum
     fromInteger n = let n' = fromInteger n
-                    in Matrix n' 0 0 n' 0 0 
+                    in Matrix n' 0 0 n' 0 0
 
 -- | A translation matrix with independent x and y offsets.
-translation :: R -> R -> M
+translation :: R -> R -> Matrix
 translation = Matrix 1 0 0 1
 
 -- | A scaling matrix with independent x and y scalars.
-scaling :: R -> R -> M
+scaling :: R -> R -> Matrix
 scaling x y = Matrix x 0 0 y 0 0
 
 -- | A rotation matrix through the indicated angle (in radians).
-rotation :: R -> M
+rotation :: R -> Matrix
 rotation a =
     let c = cos a
         s = sin a
@@ -67,7 +64,7 @@
     in Matrix c s t c 0 0
 
 -- | The identity matrix.
-identity :: M
+identity :: Matrix
 identity = Matrix 1 0 0 1 0 0
 
 {--
diff --git a/Graphics/PS/PS.hs b/Graphics/PS/PS.hs
--- a/Graphics/PS/PS.hs
+++ b/Graphics/PS/PS.hs
@@ -1,4 +1,5 @@
-module Graphics.PS.PS (ps) where
+-- | Postscript generator.
+module Graphics.PS.PS (ps,eps,stringFromPS) where
 
 import Graphics.PS.Pt
 import qualified Graphics.PS.Matrix as M
@@ -10,26 +11,29 @@
 import qualified Graphics.PS.Image as I
 import Data.List
 import System.IO
+import Data.Monoid (Monoid, mappend, mempty, mconcat, Endo(Endo,appEndo), )
 
-data PS = Name    String
-        | LName   String
-        | Op      String
+
+data PS = Name String
+        | LName String
+        | Op String
         | Comment String
-        | Int     Int
-        | Double  Double
-        | String  String
-        | Matrix  M.Matrix
-        | Array   [PS]
-        | Proc    [PS]
-        | Dict    [(PS,PS)]
-        | Seq     [PS]
+        | Int Int
+        | Double Double
+        | String String
+        | Matrix M.Matrix
+        | Array [PS]
+        | Proc [PS]
+        | Dict [(PS,PS)]
+        | Seq [PS]
 
 dsc :: String -> [String] -> PS
 dsc k [] = Comment ('%' : k)
 dsc k v = Comment (concat ("%" : k : ": " : intersperse " " v))
 
-header :: PS
+header,headerEps :: PS
 header = Comment "!PS-Adobe-3.0"
+headerEps = Comment "!PS-Adobe-3.0 EPSF-3.0"
 
 title :: String -> PS
 title t = dsc "Title" [t]
@@ -43,6 +47,12 @@
 pages :: Int -> PS
 pages n = dsc "Pages" [show n]
 
+bbox :: P.BBox -> PS
+bbox (P.BBox i j k l) = dsc "BoundingBox" [show i,show j,show k,show l]
+bbox (P.HRBBox i j k l i' j' k' l') =
+    Seq [dsc "BoundingBox" [show i,show j,show k,show l],
+         dsc "HiResBoundingBox" [show i',show j',show k',show l']]
+
 endComments :: PS
 endComments = dsc "EndComments" []
 
@@ -96,10 +106,10 @@
 false = Name "false"
 
 save :: PS
-save = Seq [Op "matrix", Op "currentmatrix"]
+save = Op "q"
 
 restore :: PS
-restore = Op "setmatrix"
+restore = Op "Q"
 
 showPage :: PS
 showPage = Op "showpage"
@@ -134,6 +144,9 @@
 curveTo :: Pt -> Pt -> Pt -> PS
 curveTo a b c = Seq (map Double (ptXYs [a,b,c]) ++ [Op "c"])
 
+closePath :: Pt -> PS
+closePath (Pt x y) = Seq [Double x, Double y, Op "h"]
+
 selectFont :: Font -> PS
 selectFont (Font f n) = Seq [LName f, Double n, Op "Tf"]
 
@@ -141,60 +154,65 @@
 charPath g = Seq [String g, false, Op "charpath"]
 
 gs :: GS -> PS
-gs (GS c w k j (d, o) m) = Seq [ rgb c
-                               , lineWidth w
-                               , lineCap k
-                               , lineJoin j
-                               , dash d o
-                               , miterLimit m ]
+gs (GS c w k j (d, o) m) =
+    Seq [rgb c
+        ,lineWidth w
+        ,lineCap k
+        ,lineJoin j
+        ,dash d o
+        ,miterLimit m]
 
 path :: Path -> PS
-path (MoveTo p)        = moveTo p
-path (LineTo p)        = lineTo p
-path (Text f g)        = Seq [selectFont f, charPath g]
+path (MoveTo p) = moveTo p
+path (LineTo p) = lineTo p
+path (Text f g) = Seq [selectFont f, charPath g]
 path (CurveTo c1 c2 p) = curveTo c1 c2 p
-path (PTransform m p)   = Seq [ save
-                              , transform m
-                              , path p
-                              , restore ]
-path (Join a b)        = Seq [path a, path b]
+path (ClosePath p) = closePath p
+path (PTransform m p) = Seq [transform m, path p]
+path (Join a b) = Seq [path a, path b]
 
 image :: I.Image -> PS
 image I.Empty = Comment "Empty"
 image (I.Stroke g p) = Seq [path p, gs g, stroke]
 image (I.Fill g p) = Seq [path p, gs g, fill]
-image (I.ITransform m i) = Seq [ save
-                               , transform m
-                               , image i
-                               , restore ]
-image (I.Over a b) = Seq [image b, image a]
+image (I.ITransform m i) = Seq [transform m, image i]
+image (I.Over a b) = Seq [save
+                         ,image b
+                         ,restore
+                         ,image a]
 
 mlist :: M.Matrix -> [Double]
 mlist (M.Matrix a b c d e f) = [a,b,c,d,e,f]
 
-bracket :: (String -> IO ()) -> String -> String -> [a] -> (a -> IO ()) -> IO ()
-bracket f o c p g = 
-    let h a = f a >> f " "
-    in h o >> mapM_ g p >> h c 
+infixl 1 >+>
 
+(>+>) :: Monoid m => m -> m -> m
+(>+>) = mappend
+
+bracket :: (Monoid m) =>
+    (String -> m) -> String -> String -> [a] -> (a -> m) -> m
+bracket f o c p g =
+    let h a = f a >+> f " "
+    in h o >+> mconcat (map g p) >+> h c
+
 escape :: String -> String
 escape = concatMap (\c -> if elem c "()" then ['\\', c] else [c])
 
-put :: (String -> IO ()) -> PS -> IO ()
-put f (Name n)    = f n >> f " "
-put f (LName n)   = f "/" >> f n >> f " "
-put f (Op o)      = f o >> f "\n"
-put f (Comment o) = f "%" >> f o >> f "\n"
-put f (Int n)     = f (show n) >> f " "
-put f (Double n)  = f (show n) >> f " "
-put f (String s)  = f "(" >> f (escape s) >> f ") "
-put f (Array a)   = bracket f "[" "]" a (put f)
-put f (Proc p)    = bracket f "{" "}" p (put f)
-put f (Matrix m)  = put f (Array (map Double (mlist m)))
-put f (Dict d)    = 
+put :: (Monoid m) => (String -> m) -> PS -> m
+put f (Name n) = f n >+> f " "
+put f (LName n) = f "/" >+> f n >+> f " "
+put f (Op o) = f o >+> f "\n"
+put f (Comment o) = f "%" >+> f o >+> f "\n"
+put f (Int n) = f (show n) >+> f " "
+put f (Double n) = f (show n) >+> f " "
+put f (String s) = f "(" >+> f (escape s) >+> f ") "
+put f (Array a) = bracket f "[" "]" a (put f)
+put f (Proc p) = bracket f "{" "}" p (put f)
+put f (Matrix m) = put f (Array (map Double (mlist m)))
+put f (Dict d) =
     let g = concatMap (\(a,b) -> [a,b])
-    in bracket f "<<" ">>" (g d) (put f) 
-put f (Seq a)     = mapM_ (put f) a
+    in bracket f "<<" ">>" (g d) (put f)
+put f (Seq a) = mconcat (map (put f) a)
 
 ps' :: (I.Image, Int) -> PS
 ps' (p, n) = Seq [page "Graphics.PS" n,  image p, showPage]
@@ -206,23 +224,53 @@
 
 -- | Write a postscript file.  The list of images are written
 --   one per page.
-ps :: String -> P.Paper -> [I.Image] -> IO ()
-ps f d p = do 
-  h <- openFile f WriteMode
-  let g = put (hPutStr h)
+ps :: FilePath -> P.Paper -> [I.Image] -> IO ()
+ps f d p =
+  writeFile f (stringFromPS f d p)
+
+-- | Generate postscript data given /title/, page size, and a set of
+-- page 'I.Images'.
+stringFromPS :: String -> P.Paper -> [I.Image] -> String
+stringFromPS t d p =
+  let g = put (\s -> Endo (s++))
       (P.Paper width height) = paper_ps d
-  mapM_ g [ header
-          , title ("Graphics.PS: " ++ f)
-          , creator "Graphics.PS"
-          , languageLevel 2
-          , pages (length p)
-          , documentMedia "Default" width height
-          , endComments
-          , prolog ]
-  mapM_ g (map ps' (zip p [1..]))
-  mapM_ g [ trailer
-          , eof]
-  hClose h
+  in  flip appEndo "" $
+      g header >+>
+      g (title t) >+>
+      g (creator "Graphics.PS") >+>
+      g (languageLevel 2) >+>
+      g (pages (length p)) >+>
+      g (documentMedia "Default" width height) >+>
+      g endComments >+>
+      g prolog >+>
+      mconcat (map (g . ps') (zip p [1..])) >+>
+      g trailer >+>
+      g eof
+
+
+newtype MonadMonoid m = MonadMonoid {appMonadMonoid :: m ()}
+
+instance Monad m => Monoid (MonadMonoid m) where
+   mempty = MonadMonoid (return ())
+   mappend (MonadMonoid a) (MonadMonoid b) =
+      MonadMonoid (a >> b)
+   mconcat = MonadMonoid . mapM_ appMonadMonoid
+
+-- | Write an encapsulated postscript file.  The single image
+--   is written.
+eps :: String -> P.BBox -> I.Image -> IO ()
+eps f d p =
+  withFile f WriteMode $ \h ->
+     let g = put (MonadMonoid . hPutStr h)
+     in  mapM_ (appMonadMonoid . g) $
+            [headerEps
+            ,title ("Graphics.PS: " ++ f)
+            ,creator "Graphics.PS"
+            ,languageLevel 2
+            ,bbox d
+            ,endComments
+            ,prolog
+            ,image p]
 
 {--
 
diff --git a/Graphics/PS/Paper.hs b/Graphics/PS/Paper.hs
--- a/Graphics/PS/Paper.hs
+++ b/Graphics/PS/Paper.hs
@@ -1,29 +1,53 @@
+-- | Paper sizes.
+-- For ISO sizes see <http://www.cl.cam.ac.uk/~mgk25/iso-paper.html>.
 module Graphics.PS.Paper where
 
--- http://www.cl.cam.ac.uk/~mgk25/iso-paper.html
-
 -- | Paper size data type.
-data Paper = Paper { width :: Int
-                   , height :: Int } 
-             deriving (Eq, Show)
+data Paper = Paper {width :: Int
+                   ,height :: Int}
+             deriving (Eq,Show)
 
--- | Swap width and height.
+-- | BoundingBox for an EPSF file with an optional HiResBoundingBox
+data BBox = BBox {llx :: Int -- ^ lower left x (x-min)
+                 ,lly :: Int -- ^ lower left y (y-min)
+                 ,urx :: Int -- ^ upper right x (x-max)
+                 ,ury :: Int -- ^ upper right y (y-max)
+                 }
+          | HRBBox {llx :: Int
+                   ,lly :: Int
+                   ,urx :: Int
+                   ,ury :: Int
+                   ,hrllx :: Double -- ^ high resolution 'llx'
+                   ,hrlly :: Double -- ^ high resolution 'lly'
+                   ,hrurx :: Double -- ^ high resolution 'urx'
+                   ,hrury :: Double -- ^ high resolution 'ury'
+                   }
+            deriving (Eq,Show)
+
+-- | Swap width and height of 'Paper'.
 landscape :: Paper -> Paper
 landscape (Paper w h) = Paper h w
 
--- | A div variant that rounds rather than truncates.
+-- | A 'div' variant that rounds rather than truncates.
+--
+-- > let f (Paper _ h) = h `div` 2 == h `divRound` 2
+-- > in all id (map f [b0,b1,b2,b3,b4,b5,b6,b7,b8,b9]) == False
 divRound :: Int -> Int -> Int
-divRound x y = 
+divRound x y =
     let x' = (fromIntegral x)::Double
         y' = (fromIntegral y)::Double
     in round (x' / y')
 
--- | ISO size downscaling.
+-- | ISO size downscaling, ie. from @A0@ to @A1@.
+--
+-- > iso_down_scale a4 == a5
 iso_down_scale :: Paper -> Paper
 iso_down_scale (Paper w h) = Paper (h `divRound` 2) w
 
 -- | ISO A sizes in millimeters.
-a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10 :: Paper
+--
+-- > a4 == Paper 210 297
+a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10 :: Paper
 a0 = Paper 841 1189
 a1 = iso_down_scale a0
 a2 = iso_down_scale a1
@@ -37,7 +61,9 @@
 a10 = iso_down_scale a9
 
 -- | ISO B sizes in millimeters.
-b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, b10 :: Paper
+--
+-- > b4 == Paper 250 354
+b0,b1,b2,b3,b4,b5,b6,b7,b8,b9,b10 :: Paper
 b0 = Paper 1000 1414
 b1 = iso_down_scale b0
 b2 = iso_down_scale b1
@@ -51,7 +77,9 @@
 b10 = iso_down_scale b9
 
 -- | ISO C sizes in millimeters.
-c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10 :: Paper
+--
+-- > c4 == Paper 229 324
+c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10 :: Paper
 c0 = Paper 917 1297
 c1 = iso_down_scale c0
 c2 = iso_down_scale c1
@@ -64,6 +92,23 @@
 c9 = iso_down_scale c8
 c10 = iso_down_scale c9
 
--- | US Letter size in millimeters.
+-- | US Letter size in millimeters (ie 'Paper' @216 279@).
 usLetter :: Paper
 usLetter = Paper 216 279
+
+-- | Newspaper sizes in millimeters.
+-- See <http://www.papersizes.org/newspaper-sizes.htm>.
+broadsheet,berliner,tabloid :: Paper
+broadsheet = Paper 600 750
+berliner = Paper 315 470
+tabloid = Paper 280 430
+
+-- | Proportion of 'Paper'.
+--
+-- > proportion broadsheet == 1.25
+-- > map (round . (* 1e3) . proportion) [a0,b0,c0] == [1414,1414,1414]
+-- > map proportion [usLetter,berliner,tabloid]
+proportion :: Paper -> Double
+proportion p =
+    let f = fromIntegral
+    in f (height p) / f (width p)
diff --git a/Graphics/PS/Path.hs b/Graphics/PS/Path.hs
--- a/Graphics/PS/Path.hs
+++ b/Graphics/PS/Path.hs
@@ -1,54 +1,63 @@
-module Graphics.PS.Path ( Path(..), (+++)
-                        , line, polygon, rectangle
-                        , arc, arcNegative, annular
-                        , flatten ) where
+-- | Path type and functions.
+module Graphics.PS.Path (Path(..),(+++)
+                        ,line,polygon,rectangle
+                        ,arc,arcNegative,annular
+                        ,flatten
+                        ,renderLines,renderLines') where
 
+import Data.List
 import Graphics.PS.Pt
 import Graphics.PS.Matrix
 import Graphics.PS.Glyph
 import Graphics.PS.Font
 
--- | Path data type, in cartesian space.
+-- | Path data type,in cartesian space.
 data Path = MoveTo Pt
           | LineTo Pt
           | CurveTo Pt Pt Pt
+          | ClosePath Pt
           | Text Font [Glyph]
           | PTransform Matrix Path
           | Join Path Path
-            deriving (Eq, Show)
+            deriving (Eq,Show)
 
--- | Infix notation for path join.
+-- | Infix notation for 'Join'.
 (+++) :: Path -> Path -> Path
 (+++) = Join
 
--- | Combine multiple paths.
+-- | Left fold of 'Join'.
 combine :: [Path] -> Path
 combine = foldl1 Join
 
--- | Line segments though list of points.
+-- | Line segments though list of 'Pt'.
 line :: [Pt] -> Path
-line (p:ps) = combine (MoveTo p : map LineTo ps)
-line _ = error "line: illegal data"
+line x =
+    case x of
+      [] -> error "line: illegal data"
+      (p:ps) -> combine (MoveTo p : map LineTo ps)
 
--- | Line variant connecting last point to first point.
+-- | Variant of 'line' connecting the last 'Pt' to the first.
 polygon :: [Pt] -> Path
-polygon (p:ps) = line (p:ps) `Join` LineTo p
-polygon _ = error "polygon: illegal data"
+polygon x =
+    case x of
+      [] -> error "polygon: illegal data"
+      (p:ps) -> line (p:ps) +++ ClosePath p
 
--- | Rectangle of specified dimensions anticlockwise from lower left.
+-- | Rectangle with lower left at 'Pt' and of specified width and
+-- height.  Polygon is oredered anticlockwise from lower left.
 rectangle :: Pt -> Double -> Double -> Path
 rectangle (Pt x y) w h =
     let ll = Pt x y
         lr = Pt (x + w) y
         ur = Pt (x + w) (y + h)
         ul = Pt x (y + h)
-    in polygon [ll, lr, ur, ul]
+    in polygon [ll,lr,ur,ul]
 
-type ArcP = (Pt, Pt, Pt, Pt)
-data Arc  = Arc1 ArcP 
-          | Arc2 ArcP ArcP
+type ArcP = (Pt,Pt,Pt,Pt)
+data Arc = Arc1 ArcP
+         | Arc2 ArcP ArcP
 
--- (x,y) = center, r = radius, a = start angle, b = end angle
+-- (x,y) = center,r = radius,a = start angle,b = end angle
 arcp :: Pt -> Double -> Double -> Double -> ArcP
 arcp (Pt x y) r a b =
     let ca = cos a
@@ -60,31 +69,31 @@
         p1 = Pt (x + r * (ca - bcp * sa)) (y + r * (sa + bcp * ca))
         p2 = Pt (x + r * (cb + bcp * sb)) (y + r * (sb - bcp * cb))
         p3 = Pt (x + r * cb) (y + r * sb)
-    in (p0, p1, p2, p3)
+    in (p0,p1,p2,p3)
 
--- c = center, r = radius, a = start angle, b = end angle
+-- c = center,r = radius,a = start angle,b = end angle
 -- if the arc angle is greater than pi the arc must be drawn in two
 arca :: Pt -> Double -> Double -> Double -> Arc
 arca c r a b =
     let d = abs (b - a)
         b' = b - (d / 2)
-    in if d > pi 
+    in if d > pi
        then Arc2 (arcp c r a b') (arcp c r b' b)
        else Arc1 (arcp c r a b)
 
 --
 arc' :: Arc -> Path
-arc' (Arc1 (p0, p1, p2, p3)) =
+arc' (Arc1 (p0,p1,p2,p3)) =
     let m = MoveTo p0
         c = CurveTo p1 p2 p3
-    in m `Join` c
-arc' (Arc2 (p0, p1, p2, p3) (_, p5, p6, p7)) =
+    in m +++ c
+arc' (Arc2 (p0,p1,p2,p3) (_,p5,p6,p7)) =
     let m = MoveTo p0
         c1 = CurveTo p1 p2 p3
         c2 = CurveTo p5 p6 p7
-    in m `Join` c1 `Join` c2
+    in m +++ c1 +++ c2
 
--- | Arc given by a central point, a radius, and start and end angles.
+-- | Arc given by a central point,a radius,and start and end angles.
 arc :: Pt -> Double -> Double -> Double -> Path
 arc c r a b =
     let f n = if n < a then f (n + 2 * pi) else n
@@ -92,16 +101,16 @@
 
 -- | Negative arc.
 arcNegative :: Pt -> Double -> Double -> Double -> Path
-arcNegative c r a b = 
+arcNegative c r a b =
     let f n = if n > a then f (n - 2 * pi) else n
     in arc' (arca c r (f b) a)
 
--- (x,y) = center, ir = inner radius, xr = outer radius, sa = start
--- angle, a = angle, ea = end angle
+-- (x,y) = center,ir = inner radius,xr = outer radius,sa = start
+-- angle,a = angle,ea = end angle
 
 -- | Annular segment.
 annular :: Pt -> Double -> Double -> Double -> Double -> Path
-annular (Pt x y) ir xr sa a = 
+annular (Pt x y) ir xr sa a =
     let ea = sa + a
         x2 = x + ir * cos sa -- ll
         y2 = y + ir * sin sa
@@ -116,20 +125,39 @@
                ,arcNegative (Pt x y) ir ea sa]
 
 flatten' :: Matrix -> Path -> Path
-flatten' m (MoveTo p) = MoveTo (ptTransform m p)
-flatten' m (LineTo p) = LineTo (ptTransform m p)
-flatten' m (PTransform m' p) = flatten' (m' * m) p
-flatten' m (Join a b) = Join (flatten' m a) (flatten' m b)
-flatten' m (CurveTo p q r) =
-    let f = ptTransform m
-    in CurveTo (f p) (f q) (f r)
-flatten' _ (Text _ _) = error "cannot flatten text"
+flatten' m path =
+    case path of
+      MoveTo p -> MoveTo (ptTransform m p)
+      LineTo p -> LineTo (ptTransform m p)
+      ClosePath p -> ClosePath (ptTransform m p)
+      PTransform m' p -> flatten' (m' * m) p
+      Join a b -> Join (flatten' m a) (flatten' m b)
+      CurveTo p q r -> let f = ptTransform m
+                       in CurveTo (f p) (f q) (f r)
+      Text _ _ -> error "cannot flatten text"
 
 -- | Apply any transformations at path.  The resulting path will not
---   have any transformation nodes.
+--   have any 'PTransform' nodes.
 flatten :: Path -> Path
 flatten = flatten' identity
 
+-- | Render each (p1,p2) as a distinct line.
+renderLines :: [(Pt,Pt)] -> Path
+renderLines =
+    let f pth (p1,p2) = pth +++ MoveTo p1 +++ LineTo p2
+    in foldl f (MoveTo origin)
+
+-- | Collapse line sequences into a single line.
+renderLines' :: [(Pt,Pt)] -> Path
+renderLines' =
+    let g p (a,b) = if p == a
+                    then (b,Right b)
+                    else (b,Left (a,b))
+        f path e = case e of
+                     Left (p1,p2) -> path +++ MoveTo p1 +++ LineTo p2
+                     Right p2 -> path +++ LineTo p2
+    in foldl f (MoveTo origin) . snd . mapAccumL g origin
+
 {--
 
 curve :: Pt -> Pt -> Pt -> Pt -> Path
@@ -142,5 +170,11 @@
 -- | Polar variant.
 pLineTo :: Pt -> Path
 pLineTo p = LineTo (polarToRectangular p)
+
+-- | Apply a funtion to leaf nodes.
+p_apply :: (Path -> Path) -> Path -> Path
+p_apply f (Join p q) = Join (f p) (f q)
+p_apply f (PTransform m p) = PTransform m (f p)
+p_apply f p = f p
 
 --}
diff --git a/Graphics/PS/Path/Graphs.hs b/Graphics/PS/Path/Graphs.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/PS/Path/Graphs.hs
@@ -0,0 +1,66 @@
+-- | Set of predefined 'Path's.
+module Graphics.PS.Path.Graphs where
+
+import Graphics.PS.Path
+import Graphics.PS.Pt
+import Graphics.PS.Transform
+import Graphics.PS.Unit
+
+-- | See <ftp.scsh.net/pub/scsh/contrib/fps/doc/examples/fractal-sqr.html>
+fractal_sqr_pt :: Pt -> Pt -> Int -> [(Pt,Pt)]
+fractal_sqr_pt p1 p2 d =
+    case d of
+      0 -> [(p1,p2)]
+      _ -> let (Pt x1 y1) = p1
+               (Pt x2 y2) = p2
+               x3 = ((x1 + x2) / 2) + ((y2 - y1) / 2)
+               y3 = ((y1 + y2) / 2) - ((x2 - x1) / 2)
+               p3 = Pt x3 y3
+           in fractal_sqr_pt p1 p3 (d - 1) ++ fractal_sqr_pt p3 p2 (d - 1)
+
+-- | 'Path' of 'fractal_sqr_pt' with inputs @(250,250)@, @(175,175)@, @12@.
+fractal_sqr :: Path
+fractal_sqr = renderLines (fractal_sqr_pt (Pt 250 250) (Pt 175 175) 12)
+
+-- | 'renderLines'' variant of 'fractal_sqr'.
+fractal_sqr' :: Path
+fractal_sqr' = renderLines' (fractal_sqr_pt (Pt 250 250) (Pt 175 175) 12)
+
+-- | A /unit/ arrow.
+unitArrow :: Int -> Path
+unitArrow d =
+    case d of
+      1 -> MoveTo (Pt 0 0) +++ LineTo (Pt 0 1)
+      _ -> let s = 0.6
+               sa = scale s s (unitArrow (d - 1))
+               cw = negate (radians 135)
+               ccw = negate cw
+           in unitArrow 1 +++
+              (translate 0 1 . rotate cw) sa +++
+              (translate 0 1 . rotate ccw) sa
+
+-- | See <ftp.scsh.net/pub/scsh/contrib/fps/doc/examples/fractal-arrow.html>
+fractalArrow :: Double -> Int -> Path
+fractalArrow h d =
+    let x = (576 - h) / 2 + h / 2
+        y = (720 - h) / 2
+        a = unitArrow d
+    in (translate x y . scale h h) a
+
+-- | Isosceles right angled triangle
+erat :: Pt -> Double -> Path
+erat (Pt x y) n = polygon [Pt x y,Pt (x+n) y,Pt x (y+n)]
+
+-- | Sierpinski triangle.
+sierpinski :: Pt -> Double -> Double -> Path
+sierpinski p n limit =
+    let m = n / 2
+        (Pt x y) = p
+        s q = sierpinski q m limit
+        t1 = s p
+        t2 = s (Pt x (y + m))
+        t3 = s (Pt (x + m) y)
+    in if n <= limit
+       then erat p n
+       else t1 +++ t2 +++ t3
+
diff --git a/Graphics/PS/Pt.hs b/Graphics/PS/Pt.hs
--- a/Graphics/PS/Pt.hs
+++ b/Graphics/PS/Pt.hs
@@ -1,23 +1,24 @@
-module Graphics.PS.Pt ( Pt(Pt), 
-                        polarToRectangular, 
-                        ptMin, ptMax, ptXYs, origin, 
-                        ptTransform ) where
+-- | Point type and associated functions.
+module Graphics.PS.Pt (Pt(Pt)
+                      ,polarToRectangular
+                      ,ptMin, ptMax, ptXYs, origin
+                      ,ptTransform) where
 
 import Graphics.PS.Matrix
 
--- | Point data type, component values are real.
+-- | Cartesian co-ordinate with real valued /x/ and /y/ fields.
 data Pt = Pt Double Double
           deriving (Eq, Show)
 
 instance Num Pt where
-    negate (Pt x y)     = Pt (- x) (- y)
+    negate (Pt x y) = Pt (- x) (- y)
     Pt x0 y0 + Pt x1 y1 = Pt (x0 + x1) (y0 + y1)
     Pt x0 y0 - Pt x1 y1 = Pt (x0 - x1) (y0 - y1)
     Pt x0 y0 * Pt x1 y1 = Pt (x0 * x1) (y0 * y1)
-    abs (Pt x y)        = Pt (abs x) (abs y)
-    signum _            = 0
-    fromInteger a       = let a' = fromInteger a
-                          in Pt a' a'
+    abs (Pt x y) = Pt (abs x) (abs y)
+    signum _ = 0
+    fromInteger a = let a' = fromInteger a
+                    in Pt a' a'
 
 instance Ord Pt where
     (Pt x0 y0) <= (Pt x1 y1) = x0 <= x1 && y0 <= y1
@@ -26,6 +27,7 @@
 origin :: Pt
 origin = Pt 0 0
 
+-- | /x/ and /y/ elements of a set of 'Pt's.
 ptXYs :: [Pt] -> [Double]
 ptXYs [] = []
 ptXYs (Pt x y : ps) = x : y : ptXYs ps
@@ -33,9 +35,11 @@
 ptOp :: (Double -> Double -> Double) -> Pt -> Pt -> Pt
 ptOp op (Pt x1 y1) (Pt x2 y2) = Pt (op x1 x2) (op y1 y2)
 
+-- | 'Pt' at /x/ and /y/ minima of inputs.
 ptMin :: Pt -> Pt -> Pt
 ptMin = ptOp min
 
+-- | 'Pt' at /x/ and /y/ maxima of inputs.
 ptMax :: Pt -> Pt -> Pt
 ptMax = ptOp max
 
@@ -70,7 +74,7 @@
 rectangularToPolar :: Pt -> Pt
 rectangularToPolar (Pt x y)
     | (x == 0) && (y == 0) = Pt 0 t
-    | otherwise            = Pt (atan2 y x) t
+    | otherwise = Pt (atan2 y x) t
     where t = hypot x y
 
 --}
diff --git a/Graphics/PS/Query.hs b/Graphics/PS/Query.hs
--- a/Graphics/PS/Query.hs
+++ b/Graphics/PS/Query.hs
@@ -1,52 +1,69 @@
-module Graphics.PS.Query ( startPt, endPt
-                         , mkValid
-                         , approx, close ) where
+-- | 'Path' query functions and related operations.
+module Graphics.PS.Query (startPt, endPt
+                         ,mkValid
+                         ,approx, close) where
 
 import Graphics.PS.Pt
 import Graphics.PS.Bezier
 import Graphics.PS.Path
 
--- | Locate the starting point of the path.
+-- | Locate the starting point of the path, which must begin with a
+-- 'MoveTo' node.
 startPt :: Path -> Maybe Pt
-startPt (MoveTo p) = Just p
-startPt (Join p _) = startPt p
-startPt _ = Nothing
+startPt path =
+    case path of
+      MoveTo p -> Just p
+      Join p _ -> startPt p
+      _ -> Nothing
 
+-- | Variant that allows the initial node to be a 'LineTo' or
+-- 'CurveTo' node.
 startPt' :: Path -> Maybe Pt
-startPt' (MoveTo p) = Just p
-startPt' (LineTo p) = Just p
-startPt' (CurveTo p _ _) = Just p
-startPt' (Join p _) = startPt' p
-startPt' _ = Nothing
+startPt' path =
+    case path of
+      MoveTo p -> Just p
+      LineTo p -> Just p
+      CurveTo p _ _ -> Just p
+      Join p _ -> startPt' p
+      _ -> Nothing
 
--- | Ensure path begins with a MoveTo.
+-- | Ensure path begins with a 'MoveTo' node.
 mkValid :: Path -> Path
-mkValid p = f (startPt' p)
-    where f (Just q) = MoveTo q +++ p
-          f Nothing = p
+mkValid path =
+    case startPt' path of
+      Just p -> MoveTo p +++ path
+      Nothing -> path
 
 -- | Locate the end point of the path.
 endPt :: Path -> Maybe Pt
-endPt (MoveTo p) = Just p
-endPt (LineTo p) = Just p
-endPt (CurveTo _ _ p) = Just p
-endPt (Join _ p) = endPt p
-endPt _ = Nothing
+endPt path =
+    case path of
+      MoveTo p -> Just p
+      LineTo p -> Just p
+      CurveTo _ _ p -> Just p
+      Join _ p -> endPt p
+      _ -> Nothing
 
--- | Add a LineTo the start point of path.
+-- | Append a 'LineTo' the start point of 'Path'.
 close :: Path -> Path
-close p = f (startPt p)
-    where f (Just q) = p +++ LineTo q
-          f Nothing = p
+close path =
+    case startPt path of
+      Just p -> path +++ ClosePath p
+      Nothing -> path
 
--- | Approximate curves as straight lines.
+-- | Approximate curves as /n/ straight line segments.  That is
+-- replace 'CurveTo' nodes with /n/ 'LineTo' nodes calculated using
+-- 'bezier4'.
 approx :: Double -> Path -> Path
-approx n (Join a (CurveTo p q r)) = 
-    let is = [0, (1.0/n) .. 1.0]
-        f (Just p1) p2 p3 p4 = map (bezier4 p1 p2 p3 p4) is
-        f Nothing _ _ _ = []
-    in a +++ line (f (endPt a) p q r)
-approx _ p = p
+approx n path =
+    case path of
+      Join a (CurveTo p2 p3 p4) ->
+          let is = [0, (1.0/n) .. 1.0]
+              l = case endPt a of
+                    Just p1 -> map (bezier4 p1 p2 p3 p4) is
+                    Nothing -> []
+          in a +++ line l
+      _ -> path
 
 {--
 
@@ -59,10 +76,10 @@
 bboxSum (BBox a b) (BBox c d) = BBox (ptMin a c) (ptMax b d)
 
 bbox :: Path -> BBox
-bbox (MoveTo p)     = BBox p p
-bbox (LineTo p)     = BBox p p
-bbox (Join a b)     = bbox a `bboxSum` bbox b
-bbox _              = error "illegal Query"
+bbox (MoveTo p) = BBox p p
+bbox (LineTo p) = BBox p p
+bbox (Join a b) = bbox a `bboxSum` bbox b
+bbox _ = error "illegal Query"
 
 join :: Path -> Path -> Path
 join a b = a +++ translate x y b
diff --git a/Graphics/PS/Statistics.hs b/Graphics/PS/Statistics.hs
--- a/Graphics/PS/Statistics.hs
+++ b/Graphics/PS/Statistics.hs
@@ -1,30 +1,32 @@
-module Graphics.PS.Statistics ( Statistics(..)
-                              , pathStatistics ) where
+-- | 'Path' statistics.
+module Graphics.PS.Statistics (Statistics(..)
+                              ,pathStatistics) where
 
 import Graphics.PS.Path
 
 -- | Path statistics data type.
-data Statistics = Statistics {
-      nMoveTo :: Integer
-    , nLineTo :: Integer
-    , nCurveTo :: Integer
-    , nGlyph :: Integer
-    , nTransform :: Integer }
+data Statistics = Statistics {nMoveTo :: Integer
+                             ,nLineTo :: Integer
+                             ,nCurveTo :: Integer
+                             ,nClosePath :: Integer
+                             ,nGlyph :: Integer
+                             ,nTransform :: Integer}
 
 plus :: Statistics -> Statistics -> Statistics
 plus p q =
-    let (Statistics m1 l1 c1 g1 t1) = p
-        (Statistics m2 l2 c2 g2 t2) = q
-    in Statistics (m1 + m2) (l1 + l2) (c1 + c2) (g1 + g2) (t1 + t2)
-
-st :: Path -> Statistics
-st (MoveTo _) = Statistics 1 0 0 0 0
-st (LineTo _) = Statistics 0 1 0 0 0
-st (CurveTo _ _ _) = Statistics 0 0 1 0 0
-st (Text _ s) = Statistics 0 0 0 (fromIntegral (length s)) 0
-st (PTransform _ p) = Statistics 0 0 0 0 1 `plus` st p
-st (Join p1 p2) = st p1 `plus` st p2
+    let (Statistics m1 l1 c1 f1 g1 t1) = p
+        (Statistics m2 l2 c2 f2 g2 t2) = q
+    in Statistics (m1+m2) (l1+l2) (c1+c2) (f1+f2) (g1+g2) (t1+t2)
 
 -- | Determine number of path components of each type.
 pathStatistics :: Path -> Statistics
-pathStatistics = st
+pathStatistics path =
+    case path of
+      MoveTo _ -> Statistics 1 0 0 0 0 0
+      LineTo _ -> Statistics 0 1 0 0 0 0
+      CurveTo _ _ _ -> Statistics 0 0 1 0 0 0
+      ClosePath _ -> Statistics 0 0 0 1 0 0
+      Text _ s -> Statistics 0 0 0 0 (fromIntegral (length s)) 0
+      PTransform _ p -> Statistics 0 0 0 0 0 1 `plus` pathStatistics p
+      Join p1 p2 -> pathStatistics p1 `plus` pathStatistics p2
+
diff --git a/Graphics/PS/Transform.hs b/Graphics/PS/Transform.hs
--- a/Graphics/PS/Transform.hs
+++ b/Graphics/PS/Transform.hs
@@ -1,19 +1,25 @@
-module Graphics.PS.Transform (translate, scale, rotate) where
+-- | Class and associated functions for 'Matrix' transformations.
+module Graphics.PS.Transform (Transformable
+                             ,translate, scale, rotate) where
 
 import Graphics.PS.Matrix
 import Graphics.PS.Pt
 import qualified Graphics.PS.Path as P
 import qualified Graphics.PS.Image as I
 
+-- | Values that can be transformed in relation to a 'Matrix'.
 class Transformable a where
     transform :: Matrix -> a -> a
 
+-- | Translation in /x/ and /y/.
 translate :: (Transformable a) => Double -> Double -> a -> a
 translate x = transform . translation x
 
+-- | Scaling in /x/ and /y/.
 scale :: (Transformable a) => Double -> Double -> a -> a
 scale x = transform . scaling x
 
+-- | Rotation, in radians.
 rotate :: (Transformable a) => Double -> a -> a
 rotate = transform . rotation
 
diff --git a/Graphics/PS/Unit.hs b/Graphics/PS/Unit.hs
--- a/Graphics/PS/Unit.hs
+++ b/Graphics/PS/Unit.hs
@@ -1,3 +1,4 @@
+-- | Unit definitions and conversions.
 module Graphics.PS.Unit (radians, mm_pt) where
 
 -- | Convert degrees to radians.
diff --git a/Help/Animation.hs b/Help/Animation.hs
deleted file mode 100644
--- a/Help/Animation.hs
+++ /dev/null
@@ -1,75 +0,0 @@
-module Animation where
-
-import System.Random
-import Graphics.PS
-import Graphics.PS.Cairo
-import qualified Graphics.UI.Gtk as G
-import Data.IORef
-
-data A = A Double Double Double Double
-
-semiann :: A -> Double -> Image
-semiann (A gs ir xr a) sa =
-    let  x = 250
-         y = 250
-         z = 250
-         sa' = sa * 2.0 * pi
-         a' = a * pi
-         ir' = min ir xr
-         xr' = max ir xr
-         shift = translate x y . scale z z
-    in Fill (greyGS gs) (shift (annular origin ir' xr' sa' a'))
-
--- | Group a list into a list of n element lists.
-clump :: Int -> [a] -> [[a]]
-clump _ [] = []
-clump n l =
-    let (i,j) = splitAt n l
-    in i : clump n j
-
--- | Generate a list of n random numbers in the range [l,r].
-randn :: Int -> Int -> Double -> Double -> [Double]
-randn s n l r =
-    let f i = i * (r - l) + l
-    in (map f . take n . randoms . mkStdGen) s
-
---
-settings :: [(A, Double, Double)]
-settings =
-    let g [a,b,c,d,e,f] = (A a b c d, e, f)
-        g _ = undefined
-    in map g (clump 6 (randn 0 66 0 1))
-
-as :: [A]
-as = map (\(a,_,_) -> a) settings
-
-ns :: [Double]
-ns = map (\(_,n,_) -> n/100) settings
-
-is :: [Double]
-is = map (\(_,_,i) -> i) settings
-
-main :: IO ()
-main = do
-  G.initGUI
-  window <- G.windowNew
-  canvas <- G.drawingAreaNew
-  ss <- newIORef is
-  G.windowSetResizable window False
-  G.widgetSetSizeRequest window 500 500
-  G.onKeyPress window (const (G.widgetDestroy window >> return True))
-  G.onDestroy window G.mainQuit
-  G.onExpose canvas (const (updateCanvas canvas ss))
-  G.timeoutAdd (G.widgetQueueDraw window >> return True) 42
-  G.set window [G.containerChild G.:= canvas]
-  G.widgetShowAll window
-  G.mainGUI
-
-updateCanvas :: G.DrawingArea -> IORef [Double] -> IO Bool
-updateCanvas canvas ss = do
-  window <- G.widgetGetDrawWindow canvas
-  modifyIORef ss (zipWith (+) ns)
-  aa <- readIORef ss
-  let i = foldl1 over (zipWith semiann as aa)
-  G.renderWithDrawable window (renderImage i)
-  return True
diff --git a/Help/Fractal.hs b/Help/Fractal.hs
deleted file mode 100644
--- a/Help/Fractal.hs
+++ /dev/null
@@ -1,45 +0,0 @@
-module Fractal (fractal, fractalArrow, sierpinski) where
-
-import Graphics.PS
-
--- | ftp://ftp.scsh.net/pub/scsh/contrib/fps/doc/examples/fractal-sqr.html
-fractal :: Pt -> Pt -> Int -> [(Pt, Pt)]
-fractal p1 p2 0 = [(p1, p2)]
-fractal p1 p2 d = fractal p1 p3 (d - 1) ++ fractal p3 p2 (d - 1)
-    where (Pt x1 y1) = p1
-          (Pt x2 y2) = p2
-          x3         = ((x1 + x2) / 2) + ((y2 - y1) / 2)
-          y3         = ((y1 + y2) / 2) - ((x2 - x1) / 2)
-          p3         = Pt x3 y3
-
--- | ftp://ftp.scsh.net/pub/scsh/contrib/fps/doc/examples/fractal-arrow.html
-fractalArrow :: Double -> Int -> Path
-fractalArrow h d = (translate x y . scale h h) a
-    where x = (576 - h) / 2 + h / 2
-          y = (720 - h) / 2
-          a = unitArrow d
-
-unitArrow :: Int -> Path
-unitArrow 1 = MoveTo (Pt 0 0) +++ LineTo (Pt 0 1)
-unitArrow d = unitArrow 1
-              +++ (translate 0 1 . rotate cw)  sa
-              +++ (translate 0 1 . rotate ccw) sa
-    where s   = 0.6
-          sa  = scale s s (unitArrow (d - 1))
-          cw  = - (radians 135)
-          ccw = - cw
-
--- | Equilateral right angled triangle
-erat :: Pt -> Double -> Path
-erat (Pt x y) n = polygon [Pt x y, Pt (x+n) y, Pt x (y+n)]
-
--- | Sierpinski triangle.
-sierpinski :: Pt -> Double -> Double -> Path
-sierpinski p n limit | n <= limit = erat p n
-                     | otherwise  = t1 +++ t2 +++ t3
-    where m        = n / 2
-          (Pt x y) = p
-          s q      = sierpinski q m limit
-          t1       = s p
-          t2       = s (Pt x (y + m))
-          t3       = s (Pt (x + m) y)
diff --git a/Help/HaskellPostScript.hs b/Help/HaskellPostScript.hs
deleted file mode 100644
--- a/Help/HaskellPostScript.hs
+++ /dev/null
@@ -1,165 +0,0 @@
-import Fractal
-import Graphics.PS hiding (a0, a1)
-import Graphics.PS.Cairo
-import System.Random
-import Data.Maybe
-import Data.List
-
--- | Group a list into a list of n element lists.
-clump :: Int -> [a] -> [[a]]
-clump _ [] = []
-clump n l = i : clump n j where (i,j) = splitAt n l
-
--- | Generate a list of n random numbers in the range [l,r].
-randn :: Int -> Int -> Double -> Double -> [Double]
-randn s n l r = (map f . take n . randoms . mkStdGen) s
-    where f i = i * (r - l) + l
-
--- | Grey fill operator.
-gfill :: Double -> Path -> Image
-gfill g = Fill (greyGS g)
-
--- | Grey stroke operator.
-gstroke :: Double -> Path -> Image
-gstroke g = Stroke (greyGS g)
-
--- | Crappy normalizer, ought to do bounds checks and take paper size.
-normalize :: Path -> Path
-normalize p = (translate s s . scale z z) p
-    where s = 250
-          z = 250
-
--- Text is a path constructor.  The first argument is a Font, the
--- second a list of Glyphs.  Ordinarly a Text path is filled, however
--- it can be stroked as below.
-
-simpleText :: Image
-simpleText = gstroke 0.25 t
-    where t = MoveTo (Pt 100 400) +++ Text (Font "Times" 72) "SimpleText"
-
--- A random scattering of filled grey rectangles.
-
-rectangle_ :: [Double] -> Image
-rectangle_ [g,x,y,z] = gfill g (shift (rectangle origin 1 1))
-    where  x'     = x * 500
-           y'     = y * 500
-           z'     = z * 64
-           shift  = translate x' y' . scale z' z'
-rectangle_ _ = error "illegal rectangle_"
-
--- Angles in Hps are in radians and counter-clockwise.
-
--- A Path must begin with a MoveTo operator.
-
--- A random scattering of stroked arcs.  arc makes a path composed of
--- bezier curves.
-
-semiarc :: [Double] -> Image
-semiarc [g,x,y,z] = (gstroke g . shift . mkValid) (arc origin 1 0 (1.5 * pi))
-    where  x'    = x * 500
-           y'    = y * 500
-           z'    = z * 64
-           shift = translate x' y' . scale z' z'
-semiarc _ = error "illegal semiarc"
-
--- A random set of annular sections.  annular makes a path composed of
--- arcs and lines.  g = grey, ir = inner radius, xr = outer radius, sa
--- = start angle, a = angle.
-
-semiann :: (Double -> Path -> Image) -> [Double] -> Image
-semiann f [g,ir,xr,sa,a] = f g $ shift $ mkValid $ annular origin ir' xr' sa' a'
-    where  x      = 250
-           y      = 250
-           z      = 250
-           sa'    = sa * 2.0 * pi
-           a'     = a * pi
-           ir'    = min ir xr
-           xr'    = max ir xr
-           shift  = translate x y . scale z z
-semiann _ _ = error "illegal semiann"
-
--- |flatten| applies all tranformations on a path generating a new
--- path.
-
-curve_ex :: Image
-curve_ex = s 0 c `over` s 0.5 l
-    where p0 = Pt 0.1 0.5
-          p1 = Pt 0.4 0.9
-          p2 = Pt 0.6 0.1
-          p3 = Pt 0.9 0.5
-          c  = MoveTo p0 +++ CurveTo p1 p2 p3
-          l  = MoveTo p0 +++ LineTo p1 +++ MoveTo p2 +++ LineTo p3
-          s n = gstroke n . normalize
-
-startPt_ :: Path -> Pt
-startPt_  = fromJust . startPt
-
-endPt_ :: Path -> Pt
-endPt_  = fromJust . endPt
-
---arcd_ex :: Image
-arcd_ex :: (Pt -> Double -> Double -> Double -> Path) -> Image
-arcd_ex arcd = s 0 e0 `over` f 0.9 e1 `over` s 0.5 e2
-    where c  = Pt 0.5 0.5
-          r  = 0.4
-          a0 = radians 45
-          a1 = radians 180
-          e0 = mkValid $ arcd c r a0 a1
-          e1 = mkValid $ arc c 0.05 0 (2 * pi)
-          e2 = MoveTo c +++ LineTo (startPt_ e0) +++ MoveTo c +++ LineTo (endPt_ e0)
-          s n = gstroke n . normalize
-          f n = gfill n . normalize
-
-path_ex' :: Path
-path_ex' = MoveTo (Pt 0.5 0.1)
-           +++ LineTo (Pt 0.9 0.9)
-           +++ LineTo (Pt 0.5 0.9)
-           +++ CurveTo (Pt 0.2 0.9) (Pt 0.2 0.5) (Pt 0.5 0.5)
-
-
--- | Render each (p1, p2) as a distinct line.
-renderLines :: [(Pt, Pt)] -> Path
-renderLines = foldl f (MoveTo origin)
-    where f pth (p1, p2) = pth +++ MoveTo p1 +++ LineTo p2
-
--- | Collapse line sequences into a single line.
-renderLinesO :: [(Pt, Pt)] -> Path
-renderLinesO = foldl f (MoveTo origin) . snd . mapAccumL g origin
-    where g p (a,b) | p == a = (b, Right b)
-                    | otherwise = (b, Left (a,b))
-          f pth (Left (p1, p2)) = pth +++ MoveTo p1 +++ LineTo p2
-          f pth (Right p2) = pth +++ LineTo p2
-
-main :: IO ()
-main = 
-    let  rightAngles = renderLines (fractal (Pt 250 250) (Pt 175 175) 12)
-         rightAnglesO = renderLinesO (fractal (Pt 250 250) (Pt 175 175) 12)
-         arrows = fractalArrow 200 9
-         rectangles = (foldl1 over . map rectangle_ . clump 4) (randn 1 240 0 1)
-         semiarcs = (foldl1 over . map semiarc . clump 4) (randn 1 120 0 1)
-         semiannsS = foldl1 over $ map (semiann gstroke) $ clump 5 $ randn 1 50 0 1
-         semiannsF = foldl1 over $ map (semiann gfill) $ clump 5 $ randn 1 50 0 1
-         arc_ex  = arcd_ex arc
-         arcNegative_ex = arcd_ex arcNegative
-         path_ex = s 0 path_ex'
-         approx_ex n = s 0 (approx n path_ex')
-         fs_ex = s 0 e `over` f 0.9 e where e = close path_ex'
-         s n = gstroke n . normalize
-         f n = gfill n . normalize
-    in cg "test.ps" (Paper 900 600) [ gstroke 0 rightAngles
-                                    , gstroke 0 rightAnglesO
-                                    , gstroke 0 arrows
-                                    , gstroke 0 (flatten arrows)
-                                    , f 0 (sierpinski origin 0.5 0.01)
-                                    , simpleText
-                                    , rectangles
-                                    , semiarcs
-                                    , semiannsS
-                                    , semiannsF
-                                    , curve_ex
-                                    , arc_ex
-                                    , arcNegative_ex
-                                    , path_ex
-                                    , approx_ex 100
-                                    , approx_ex 10 
-                                    , fs_ex ]
diff --git a/Help/Screen.hs b/Help/Screen.hs
deleted file mode 100644
--- a/Help/Screen.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-module Screen where
-
-import Graphics.PS
-import Graphics.PS.Cairo
-
-drawPath :: (GS -> a -> b) -> Double -> a -> b
-drawPath m g p = m (greyGS g) p
-
-drawCircle :: Pt -> Double -> Image
-drawCircle p r =
-    let c = arc p r 0 (2 * pi)
-    in drawPath Stroke 0.2 c
-
-drawRectangle :: Pt -> Double -> Double -> Double -> Image
-drawRectangle p w h a =
-    let r = rectangle p w h
-    in drawPath Fill 0.4 (rotate a r)
-
-drawText :: Pt -> [Glyph] -> Double -> Image
-drawText p t n =
-    let t' = Text (Font "Times" n) t
-    in drawPath Stroke 0.2 (MoveTo p +++ t')
-
-scena :: Double -> [Image]
-scena n = 
-  let p = Pt 250 250
-      r = map (\a -> drawRectangle p 25 35 (pi/12*n*a)) [0..4]
-  in [ drawCircle p (25 * n)
-     , drawCircle p (65 * n)
-     , drawText p "Some text" (24 * n) ] ++ r
-
-main :: IO ()
-main = cg "test.ps" (Paper 900 600) (scena 1.0)
diff --git a/Help/fractals.hs b/Help/fractals.hs
new file mode 100644
--- /dev/null
+++ b/Help/fractals.hs
@@ -0,0 +1,204 @@
+module Main where
+
+import Data.Maybe
+import Graphics.PS hiding (a0, a1)
+import Graphics.PS.Path.Graphs
+import System.Directory
+import System.Environment
+import System.FilePath.Posix
+import System.Random
+
+-- | Group a list into a list of /n/ element lists.
+clump :: Int -> [a] -> [[a]]
+clump n l =
+    case l of
+      [] -> []
+      _ -> let (i,j) = splitAt n l
+           in i : clump n j
+
+-- | Given seed /s/ generate a list of /n/ random numbers in the range
+-- [/l,r/].
+randn :: Int -> Int -> Double -> Double -> [Double]
+randn s n l r =
+    let f i = i * (r - l) + l
+    in (map f . take n . randoms . mkStdGen) s
+
+-- | Grey fill operator.
+gfill :: Double -> Path -> Image
+gfill g = Fill (greyGS g)
+
+-- | Grey stroke operator.
+gstroke :: Double -> Path -> Image
+gstroke g = Stroke (greyGS g)
+
+-- | Thin grey stroke operator.
+gstroke' :: Double -> Path -> Image
+gstroke' g = Stroke (GS (RGB g g g) 0.01 RoundCap RoundJoin ([],0) 10.0)
+
+-- | Bold blue stroke operator.
+bstroke :: Path -> Image
+bstroke = Stroke (GS (RGB 0.0 0.0 1.0) 16.0 RoundCap RoundJoin ([],0) 10.0)
+
+-- | Crappy normalizer, ought to do bounds checks and take paper size.
+normalize :: Path -> Path
+normalize p =
+    let s = 250
+        z = 250
+    in (translate s s . scale z z) p
+
+-- | Text is a path constructor.  The first argument is a Font, the
+--   second a list of Glyphs.  Ordinarly a Text path is filled, however
+--   it can be stroked as below.
+simpleText :: Image
+simpleText =
+    let t = Text (Font "Times" 72) "SimpleText"
+    in gstroke 0.25 (MoveTo (Pt 100 400) +++ t)
+
+rectangle_ :: [Double] -> Image
+rectangle_ [g,x,y,z] =
+    let x' = x * 500
+        y' = y * 500
+        z' = z * 64
+        shift = translate x' y' . scale z' z'
+    in gfill g (shift (rectangle origin 1 1))
+rectangle_ _ = error "illegal rectangle_"
+
+-- | A random scattering of filled grey rectangles.
+rectangles :: Image
+rectangles = (foldl1 over . map rectangle_ . clump 4) (randn 1 240 0 1)
+
+-- Angles in Hps are in radians and counter-clockwise.
+
+-- A Path must begin with a MoveTo operator.
+
+-- | 'arc' makes a path composed of bezier curves.
+semiarc :: [Double] -> Image
+semiarc [g,x,y,z] =
+    let x' = x * 500
+        y' = y * 500
+        z' = z * 64
+        shift = translate x' y' . scale z' z'
+    in (gstroke' g . shift . mkValid) (arc origin 1 0 (1.5 * pi))
+semiarc _ = error "illegal semiarc"
+
+-- | A random scattering of stroked arcs.
+semiarcs :: Image
+semiarcs = (foldl1 over . map semiarc . clump 4) (randn 1 120 0 1)
+
+-- | 'annular' makes a path composed of arcs and lines.  g = grey, ir =
+-- inner radius, xr = outer radius, sa = start angle, a = angle.
+semiann :: (Double -> Path -> Image) -> [Double] -> Image
+semiann f [g,ir,xr,sa,a] =
+    let x = 250
+        y = 250
+        z = 250
+        sa' = sa * 2.0 * pi
+        a' = a * pi
+        ir' = min ir xr
+        xr' = max ir xr
+        shift = translate x y . scale z z
+    in f g $ shift $ mkValid $ annular origin ir' xr' sa' a'
+semiann _ _ = error "illegal semiann"
+
+-- | A random set of annular sections.
+semiannsS :: Image
+semiannsS = foldl1 over $ map (semiann gstroke') $ clump 5 $ randn 1 50 0 1
+
+semiannsF :: Image
+semiannsF = foldl1 over $ map (semiann gfill) $ clump 5 $ randn 1 50 0 1
+
+-- |flatten| applies all tranformations on a path generating a new
+-- path.
+
+curve_ex :: Image
+curve_ex =
+    let p0 = Pt 0.1 0.5
+        p1 = Pt 0.4 0.9
+        p2 = Pt 0.6 0.1
+        p3 = Pt 0.9 0.5
+        c = MoveTo p0 +++ CurveTo p1 p2 p3
+        l = MoveTo p0 +++ LineTo p1 +++ MoveTo p2 +++ LineTo p3
+        s n = gstroke' n . normalize
+    in s 0 c `over` s 0.5 l
+
+startPt_ :: Path -> Pt
+startPt_ = fromJust . startPt
+
+endPt_ :: Path -> Pt
+endPt_ = fromJust . endPt
+
+--arcd_ex :: Image
+arcd_ex :: (Pt -> Double -> Double -> Double -> Path) -> Image
+arcd_ex arcd =
+    let c = Pt 0.5 0.5
+        r = 0.4
+        a0 = radians 45
+        a1 = radians 180
+        e0 = mkValid $ arcd c r a0 a1
+        e1 = mkValid $ arc c 0.05 0 (2 * pi)
+        e2 = MoveTo c +++ LineTo (startPt_ e0) +++ MoveTo c +++ LineTo (endPt_ e0)
+        s n = gstroke' n . normalize
+        f n = gfill n . normalize
+    in s 0 e0 `over` f 0.9 e1 `over` s 0.5 e2
+
+path_ex' :: Path
+path_ex' = MoveTo (Pt 0.5 0.1)
+           +++ LineTo (Pt 0.9 0.9)
+           +++ LineTo (Pt 0.5 0.9)
+           +++ CurveTo (Pt 0.2 0.9) (Pt 0.2 0.5) (Pt 0.5 0.5)
+
+hps :: [Image]
+hps =
+    let arrows = fractalArrow 200 9
+        arc_ex = arcd_ex arc
+        arcNegative_ex = arcd_ex arcNegative
+        path_ex = s 0 path_ex'
+        approx_ex n = s 0 (approx n path_ex')
+        fs_ex = let e = close path_ex'
+                in s 0 e `over` f 0.9 e
+        s n = gstroke' n . normalize
+        f n = gfill n . normalize
+    in [ gstroke 0 fractal_sqr
+       , gstroke 0 fractal_sqr'
+       , gstroke 0 arrows
+       , gstroke 0 (flatten arrows)
+       , f 0 (sierpinski origin 0.5 0.01)
+       , simpleText
+       , rectangles
+       , semiarcs
+       , semiannsS
+       , semiannsF
+       , curve_ex
+       , arc_ex
+       , arcNegative_ex
+       , path_ex
+       , approx_ex 100
+       , approx_ex 10
+       , fs_ex
+       ]
+
+heps :: Image
+heps = bstroke (erat (Pt 48 32) 120)
+
+bb :: BBox
+bb = HRBBox 35 19 180 164 40.0 24.0 176.0 160.0
+
+writing :: String -> IO ()
+writing fn = print ("writing output to: " ++ fn)
+
+-- | Usage: main [ps_file_path] [eps_file_path]
+--   Defaults are used for unsupplied args
+main :: IO ()
+main = do
+  a <- getArgs
+  u <- getUserDocumentsDirectory
+  let ofn = case a of
+              x:_ -> x
+              _ -> u </> "hps.ps"
+      epsfn = case a of
+                [_,x] -> x
+                _ -> u </> "heps.eps"
+  writing ofn
+  ps ofn a4 hps
+  writing epsfn
+  eps epsfn bb heps
diff --git a/README b/README
--- a/README
+++ b/README
@@ -2,5 +2,7 @@
 
 partial and trivial postcript rendering
 
-(c) rohan drape 2006-2010
+(c) rohan drape and others, 2006-2011
     gpl.2, http://gnu.org/copyleft/
+    with contributions by declan murphy & henning thielemann
+    see darcs history for details
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+import Distribution.Simple
+main = defaultMain
diff --git a/Setup.lhs b/Setup.lhs
deleted file mode 100644
--- a/Setup.lhs
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/usr/bin/env runhaskell
-> import Distribution.Simple
-> main = defaultMain
diff --git a/hps.cabal b/hps.cabal
--- a/hps.cabal
+++ b/hps.cabal
@@ -1,24 +1,20 @@
 Name:              hps
-Version:           0.2
+Version:           0.11
 Synopsis:          Haskell Postscript
 Description:       Haskell library partially implementing the
                    postscript drawing model.
 License:           GPL
 Category:          Graphics
-Copyright:         Rohan Drape, 2006-2010
-Author:            Rohan Drape
+Copyright:         Rohan Drape, 2006-2011
+Author:            Rohan Drape and others
 Maintainer:        rd@slavepianos.org
 Stability:         Experimental
 Homepage:          http://slavepianos.org/rd/?t=hps
-Tested-With:       GHC == 6.10.3
+Tested-With:       GHC == 7.2.2
 Build-Type:	   Simple
-Cabal-Version:     >= 1.6
+Cabal-Version:     >= 1.8
 
 Data-files:        README
-                   Help/Animation.hs
-                   Help/Fractal.hs
-                   Help/HaskellPostScript.hs
-                   Help/Screen.hs
 
 Library
   Build-Depends:   base == 4.*
@@ -28,6 +24,7 @@
                    Graphics.PS.Matrix
                    Graphics.PS.Bezier
                    Graphics.PS.Path
+                   Graphics.PS.Path.Graphs
                    Graphics.PS.Glyph
                    Graphics.PS.Font
                    Graphics.PS.Image
@@ -38,6 +35,16 @@
                    Graphics.PS.Paper
                    Graphics.PS.PS
                    Graphics.PS.Unit
+
+Executable hps-fractals
+  hs-source-dirs:  . Help
+  Build-Depends:   base == 4.*,
+                   directory,
+                   filepath,
+                   random
+  Main-Is:         fractals.hs
+  Ghc-Options:     -Wall -fwarn-tabs
+  Other-Modules:   Graphics.PS
 
 Source-Repository  head
   Type:            darcs