diff --git a/Graphics/PS/Font.hs b/Graphics/PS/Font.hs
--- a/Graphics/PS/Font.hs
+++ b/Graphics/PS/Font.hs
@@ -1,5 +1,5 @@
 -- | Font type and functions.
-module Graphics.PS.Font (Font(..)) where
+module Graphics.PS.Font where
 
 -- | Font data type.
 data Font = Font {fontName :: String
diff --git a/Graphics/PS/GS.hs b/Graphics/PS/GS.hs
--- a/Graphics/PS/GS.hs
+++ b/Graphics/PS/GS.hs
@@ -1,10 +1,5 @@
 -- | PS graphics state.
-module Graphics.PS.GS (GS(..)
-                      ,LineCap(..)
-                      ,LineJoin(..)
-                      ,LineWidth
-                      ,Color(..)
-                      ,defaultGS, greyGS) where
+module Graphics.PS.GS where
 
 -- | Line cap enumeration.
 data LineCap = ButtCap
@@ -21,12 +16,17 @@
               | BevelJoin
                 deriving (Eq, Show, Enum)
 
--- | Colour model.
-data Color = RGB Double Double Double
+-- | Colour model.  Postscript doesn't support alpha, but store it for PDF rendering etc.
+data Color = RGBA Double Double Double Double
              deriving (Eq, Show)
 
 -- | Graphics state.
-data GS = GS Color LineWidth LineCap LineJoin ([Int], Int) Double
+data GS = GS {gs_color :: Color
+             ,gs_line_width :: LineWidth
+             ,gs_line_cap :: LineCap
+             ,gs_line_join :: LineJoin
+             ,gs_dash :: ([Int], Int)
+             ,gs_miter_limit :: Double}
           deriving (Eq, Show)
 
 -- | Default 'GS' of indicated 'Color'.
@@ -35,7 +35,7 @@
 
 -- | Default 'GS' of indicated shade of grey.
 greyGS :: Double -> GS
-greyGS g = defaultGS (RGB g g g)
+greyGS g = defaultGS (RGBA g g g 1)
 
 {--
 blackGS :: GS
diff --git a/Graphics/PS/Glyph.hs b/Graphics/PS/Glyph.hs
--- a/Graphics/PS/Glyph.hs
+++ b/Graphics/PS/Glyph.hs
@@ -1,5 +1,5 @@
 -- | Glyph data type.
-module Graphics.PS.Glyph (Glyph) where
+module Graphics.PS.Glyph where
 
 -- | Character data type.
 type Glyph = Char
diff --git a/Graphics/PS/Image.hs b/Graphics/PS/Image.hs
--- a/Graphics/PS/Image.hs
+++ b/Graphics/PS/Image.hs
@@ -1,7 +1,10 @@
 -- | Image type and functions.
 module Graphics.PS.Image where
 
-import Data.CG.Minus {- hcg-minus -}
+import Data.Monoid (Monoid, mappend, mconcat, mempty) {- base (obsolete) -}
+
+import Data.CG.Minus.Types {- hcg-minus -}
+
 import Graphics.PS.Path
 import Graphics.PS.GS
 
@@ -12,6 +15,11 @@
            | Over Image Image
            | Empty
              deriving (Eq, Show)
+
+instance Monoid Image where
+    mempty = Empty
+    mappend = Over
+    mconcat = foldr Over Empty
 
 -- | Layer one 'Image' over another.
 over :: Image -> Image -> Image
diff --git a/Graphics/PS/PS.hs b/Graphics/PS/PS.hs
--- a/Graphics/PS/PS.hs
+++ b/Graphics/PS/PS.hs
@@ -1,14 +1,13 @@
 -- | Postscript generator.
-module Graphics.PS.PS (ps,eps,stringFromPS) where
+module Graphics.PS.PS where
 
 import Data.CG.Minus {- hcg-minus -}
-import Data.List
-import Data.Monoid (Monoid, mappend, mempty, mconcat, Endo(Endo,appEndo), )
-import System.IO
+import Data.List {- base -}
+import Data.Monoid {- base -}
+import System.IO {- base -}
 
 import Graphics.PS.Path
 import Graphics.PS.Font
-import Graphics.PS.Unit
 import Graphics.PS.GS
 import qualified Graphics.PS.Paper as P
 import qualified Graphics.PS.Image as I
@@ -26,50 +25,56 @@
         | Dict [(PS,PS)]
         | Seq [PS]
 
-dsc :: String -> [String] -> PS
-dsc k [] = Comment ('%' : k)
-dsc k v = Comment (concat ("%" : k : ": " : intersperse " " v))
+dscPS :: String -> [String] -> PS
+dscPS k v =
+    case v of
+      [] -> Comment ('%' : k)
+      _ ->Comment (concat ("%" : k : ": " : intersperse " " v))
 
-header,headerEps :: PS
-header = Comment "!PS-Adobe-3.0"
-headerEps = Comment "!PS-Adobe-3.0 EPSF-3.0"
+headerPS :: PS
+headerPS = Comment "!PS-Adobe-3.0"
 
-title :: String -> PS
-title t = dsc "Title" [t]
+headerEPS :: PS
+headerEPS = Comment "!PS-Adobe-3.0 EPSF-3.0"
 
-creator :: String -> PS
-creator t = dsc "Creator" [t]
+titlePS :: String -> PS
+titlePS t = dscPS "Title" [t]
 
-languageLevel :: Int -> PS
-languageLevel n = dsc "LanguageLevel" [show n]
+creatorPS :: String -> PS
+creatorPS t = dscPS "Creator" [t]
 
-pages :: Int -> PS
-pages n = dsc "Pages" [show n]
+languageLevelPS :: Int -> PS
+languageLevelPS n = dscPS "LanguageLevel" [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']]
+pagesPS :: Int -> PS
+pagesPS n = dscPS "Pages" [show n]
 
-endComments :: PS
-endComments = dsc "EndComments" []
+bboxPS :: P.BBox -> PS
+bboxPS b =
+    case b of
+      P.BBox i j k l -> dscPS "BoundingBox" [show i,show j,show k,show l]
+      P.HRBBox i j k l i' j' k' l' ->
+          Seq [dscPS "BoundingBox" [show i,show j,show k,show l],
+               dscPS "HiResBoundingBox" [show i',show j',show k',show l']]
 
-page :: (Show a) => String -> a -> PS
-page t n = dsc "Page" [t, show n]
+endCommentsPS :: PS
+endCommentsPS = dscPS "EndComments" []
 
-trailer :: PS
-trailer = dsc "Trailer" []
+pagePS :: (Show a) => String -> a -> PS
+pagePS t n = dscPS "Page" [t, show n]
 
-eof :: PS
-eof = dsc "EOF" []
+trailerPS :: PS
+trailerPS = dscPS "Trailer" []
 
-documentMedia :: String -> Int -> Int -> PS
-documentMedia tag w h = dsc "DocumentMedia" [tag, show w, show h, "0", "()", "()"]
+eofPS :: PS
+eofPS = dscPS "EOF" []
 
-alias :: String -> String -> PS
-alias o a = Seq [LName a, Proc [Name o], Op "def"]
+documentMediaPS :: String -> Int -> Int -> PS
+documentMediaPS tag w h = dscPS "DocumentMedia" [tag, show w, show h, "0", "()", "()"]
 
+aliasPS :: String -> String -> PS
+aliasPS o a = Seq [LName a, Proc [Name o], Op "def"]
+
 pdfCompat :: [(String, String)]
 pdfCompat = [("gsave",                "q"),
              ("grestore",             "Q"),
@@ -90,159 +95,157 @@
              ("selectfont",           "Tf"),
              ("clip",                 "W")]
 
-prolog :: PS
-prolog =
-    let f (a,b) = alias a b
+prologPS :: PS
+prologPS =
+    let f (a,b) = aliasPS a b
     in Seq (map f pdfCompat)
 
-stroke :: PS
-stroke = Op "S"
+strokePS :: PS
+strokePS = Op "S"
 
-fill :: PS
-fill = Op "f"
+fillPS :: PS
+fillPS = Op "f"
 
-false :: PS
-false = Name "false"
+falsePS :: PS
+falsePS = Name "false"
 
-save :: PS
-save = Op "q"
+savePS :: PS
+savePS = Op "q"
 
-restore :: PS
-restore = Op "Q"
+restorePS :: PS
+restorePS = Op "Q"
 
-showPage :: PS
-showPage = Op "showpage"
+showPagePS :: PS
+showPagePS = Op "showpage"
 
-rgb :: Color -> PS
-rgb (RGB r g b) = Seq [Double r, Double g, Double b, Op "RG"]
+rgbaPS :: Color -> PS
+rgbaPS (RGBA r g b _) = Seq [Double r, Double g, Double b, Op "RG"]
 
-lineWidth :: Double -> PS
-lineWidth w = Seq [Double w, Op "w"]
+lineWidthPS :: Double -> PS
+lineWidthPS w = Seq [Double w, Op "w"]
 
-lineCap :: (Enum a) => a -> PS
-lineCap c = Seq [Int (fromEnum c), Op "j"]
+lineCapPS :: (Enum a) => a -> PS
+lineCapPS c = Seq [Int (fromEnum c), Op "j"]
 
-lineJoin :: (Enum a) => a -> PS
-lineJoin j = Seq [Int (fromEnum j), Op "J"]
+lineJoinPS :: (Enum a) => a -> PS
+lineJoinPS j = Seq [Int (fromEnum j), Op "J"]
 
-dash :: [Int] -> Int -> PS
-dash d o = Seq [Array (map Int d), Int o, Op "d"]
+dashPS :: [Int] -> Int -> PS
+dashPS d o = Seq [Array (map Int d), Int o, Op "d"]
 
-miterLimit :: Double -> PS
-miterLimit m = Seq [Double m, Op "M"]
+miterLimitPS :: Double -> PS
+miterLimitPS m = Seq [Double m, Op "M"]
 
-moveTo :: Pt Double -> PS
-moveTo (Pt x y) = Seq [Double x, Double y, Op "m"]
+moveToPS :: Pt Double -> PS
+moveToPS (Pt x y) = Seq [Double x, Double y, Op "m"]
 
-lineTo :: Pt Double -> PS
-lineTo (Pt x y) = Seq [Double x, Double y, Op "l"]
+lineToPS :: Pt Double -> PS
+lineToPS (Pt x y) = Seq [Double x, Double y, Op "l"]
 
-transform :: Matrix Double -> PS
-transform m = Seq [Transform m, Op "cm"]
+transformPS :: Matrix Double -> PS
+transformPS m = Seq [Transform m, Op "cm"]
 
-curveTo :: Pt Double -> Pt Double -> Pt Double -> PS
-curveTo a b c = Seq (map Double (ls_xy [a,b,c]) ++ [Op "c"])
+curveToPS :: Pt Double -> Pt Double -> Pt Double -> PS
+curveToPS a b c = Seq (map Double (ls_xy (Ls [a,b,c])) ++ [Op "c"])
 
-closePath :: Pt Double -> PS
-closePath (Pt x y) = Seq [Double x, Double y, Op "h"]
+closePathPS :: Pt Double -> PS
+closePathPS (Pt x y) = Seq [Double x, Double y, Op "h"]
 
-selectFont :: Font -> PS
-selectFont (Font f n) = Seq [LName f, Double n, Op "Tf"]
+selectFontPS :: Font -> PS
+selectFontPS (Font f n) = Seq [LName f, Double n, Op "Tf"]
 
-charPath :: String -> PS
-charPath g = Seq [String g, false, Op "charpath"]
+charPathPS :: String -> PS
+charPathPS g = Seq [String g, falsePS, 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]
+gsPS :: GS -> PS
+gsPS (GS c w k j (d, o) m) =
+    Seq [rgbaPS c
+        ,lineWidthPS w
+        ,lineCapPS k
+        ,lineJoinPS j
+        ,dashPS d o
+        ,miterLimitPS m]
 
-path :: Path -> PS
-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 (ClosePath p) = closePath p
-path (PTransform m p) = Seq [transform m, path p]
-path (Join a b) = Seq [path a, path b]
+pathPS :: Path -> PS
+pathPS path =
+    case path of
+      MoveTo p -> moveToPS p
+      LineTo p -> lineToPS p
+      Text f g -> Seq [selectFontPS f, charPathPS g]
+      CurveTo c1 c2 p -> curveToPS c1 c2 p
+      ClosePath p -> closePathPS p
+      PTransform m p -> Seq [transformPS m, pathPS p]
+      Join a b -> Seq [pathPS a, pathPS 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 [transform m, image i]
-image (I.Over a b) = Seq [save
-                         ,image b
-                         ,restore
-                         ,image a]
+imagePS :: I.Image -> PS
+imagePS img =
+    case img of
+      I.Empty -> Comment "Empty"
+      I.Stroke g p -> Seq [pathPS p, gsPS g, strokePS]
+      I.Fill g p -> Seq [pathPS p, gsPS g, fillPS]
+      I.ITransform m i -> Seq [transformPS m, imagePS i]
+      I.Over a b -> Seq [savePS
+                        ,imagePS b
+                        ,restorePS
+                        ,imagePS a]
 
 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 =
+ps_bracket :: (Monoid m) => (String -> m) -> String -> String -> [a] -> (a -> m) -> m
+ps_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 :: (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 (Transform m) = put f (Array (map Double (mx_list m)))
-put f (Dict d) =
-    let g = concatMap (\(a,b) -> [a,b])
-    in bracket f "<<" ">>" (g d) (put f)
-put f (Seq a) = mconcat (map (put f) a)
+ps_escape :: String -> String
+ps_escape = concatMap (\c -> if elem c "()" then ['\\', c] else [c])
 
-ps' :: (I.Image, Int) -> PS
-ps' (p, n) = Seq [page "Graphics.PS" n,  image p, showPage]
+ps_put :: (Monoid m) => (String -> m) -> PS -> m
+ps_put f x =
+    case x of
+      Name n -> f n >+> f " "
+      LName n -> f "/" >+> f n >+> f " "
+      Op o -> f o >+> f "\n"
+      Comment o -> f "%" >+> f o >+> f "\n"
+      Int n -> f (show n) >+> f " "
+      Double n -> f (show n) >+> f " "
+      String s -> f "(" >+> f (ps_escape s) >+> f ") "
+      Array a -> ps_bracket f "[" "]" a (ps_put f)
+      Proc p -> ps_bracket f "{" "}" p (ps_put f)
+      Transform m -> ps_put f (Array (map Double (mx_list m)))
+      Dict d -> let g = concatMap (\(a,b) -> [a,b]) in ps_bracket f "<<" ">>" (g d) (ps_put f)
+      Seq a -> mconcat (map (ps_put f) a)
 
-paper_ps :: P.Paper -> P.Paper
-paper_ps (P.Paper w h) =
-    let f n = floor (mm_pt (fromIntegral n)::Double)
-    in P.Paper (f w) (f h)
+to_page_seq :: (I.Image, Int) -> PS
+to_page_seq (p, n) = Seq [pagePS "Graphics.PS" n, imagePS p, showPagePS]
 
--- | Write a postscript file.  The list of images are written
---   one per page.
+-- | Write a postscript file.  The list of images are written one per page.
 ps :: FilePath -> P.Paper -> [I.Image] -> IO ()
-ps f d p =
-  writeFile f (stringFromPS f d p)
+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
-  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
+-- | Variant with page (paper) size in points.
+stringFromPS_pt :: String -> (Int,Int) -> [I.Image] -> String
+stringFromPS_pt t (width,height) p =
+  let g = ps_put (\s -> Endo (s++))
+  in flip appEndo "" $
+     g headerPS >+>
+     g (titlePS t) >+>
+     g (creatorPS "Graphics.PS") >+>
+     g (languageLevelPS 2) >+>
+     g (pagesPS (length p)) >+>
+     g (documentMediaPS "Default" width height) >+>
+     g endCommentsPS >+>
+     g prologPS >+>
+     mconcat (map (g . to_page_seq) (zip p [1..])) >+>
+     g trailerPS >+>
+     g eofPS
 
+-- | Generate postscript data given /title/, page size, and a
+-- set of page 'I.Images'.
+stringFromPS :: String -> P.Paper -> [I.Image] -> String
+stringFromPS t p = stringFromPS_pt t (P.paper_size_pt p)
 
 newtype MonadMonoid m = MonadMonoid {appMonadMonoid :: m ()}
 
@@ -252,21 +255,21 @@
       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]
+-- | Write an encapsulated postscript file.  The 'P.BBox' is in
+-- points.  The single image is written.
+eps :: FilePath -> P.BBox -> I.Image -> IO ()
+eps fn d p =
+  withFile fn WriteMode $ \h ->
+     let g = ps_put (MonadMonoid . hPutStr h)
+     in mapM_ (appMonadMonoid . g) $
+            [headerEPS
+            ,titlePS ("Graphics.PS: " ++ fn)
+            ,creatorPS "Graphics.PS"
+            ,languageLevelPS 2
+            ,bboxPS d
+            ,endCommentsPS
+            ,prologPS
+            ,imagePS p]
 
 {--
 
diff --git a/Graphics/PS/Paper.hs b/Graphics/PS/Paper.hs
--- a/Graphics/PS/Paper.hs
+++ b/Graphics/PS/Paper.hs
@@ -1,12 +1,28 @@
--- | Paper sizes.
--- For ISO sizes see <http://www.cl.cam.ac.uk/~mgk25/iso-paper.html>.
+-- | Paper and BBox.
 module Graphics.PS.Paper where
 
--- | Paper size data type.
-data Paper = Paper {width :: Int
+import Graphics.PS.Unit
+
+-- | Enumeration type for Units.
+data Units = MM | PT deriving (Eq,Show)
+
+-- | Paper size data type, the units are specified in the type.
+-- The units in postscript are points, we often work in millimeters.
+data Paper = Paper {units :: Units
+                   ,width :: Int
                    ,height :: Int}
              deriving (Eq,Show)
 
+-- | Translate 'Paper' from mm to points.
+--
+-- > let a4 = Paper MM 210 297
+-- > paper_size_pt a4 == (595,841)
+paper_size_pt :: Paper -> (Int,Int)
+paper_size_pt (Paper unit w h) =
+    case unit of
+      MM -> (mm_pt_int w,mm_pt_int h)
+      PT -> (w,h)
+
 -- | 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)
@@ -26,89 +42,54 @@
 
 -- | Swap width and height of 'Paper'.
 landscape :: Paper -> Paper
-landscape (Paper w h) = Paper h w
+landscape (Paper u w h) = Paper u h w
 
--- | A 'div' variant that rounds rather than truncates.
+-- | Proportion of 'Paper'.
 --
--- > 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 =
-    let x' = (fromIntegral x)::Double
-        y' = (fromIntegral y)::Double
-    in round (x' / y')
+-- > import Graphics.PS.Paper.Names
+-- > proportion broadsheet == 1.25
+-- > map (round . (* 1e3) . proportion) [a0,b0,c0] == [1414,1414,1414]
+-- > map proportion [usLetter,berliner,tabloid]
+proportion :: Paper -> Double
+proportion (Paper _ w h) = i_to_d h / i_to_d w
 
--- | 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
+-- | The margin given by placing paper size /p/ within /q/.
+inset_margin :: Paper -> Paper -> (Units,Int,Int)
+inset_margin (Paper u1 w1 h1) (Paper u2 w2 h2) =
+    if u1 /= u2
+    then error "inset_margin: unequal units"
+    else (u2,(w2 - w1) `div` 2,(h2 - h1) `div` 2)
 
--- | ISO A sizes in millimeters.
---
--- > 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
-a3 = iso_down_scale a2
-a4 = iso_down_scale a3
-a5 = iso_down_scale a4
-a6 = iso_down_scale a5
-a7 = iso_down_scale a6
-a8 = iso_down_scale a7
-a9 = iso_down_scale a8
-a10 = iso_down_scale a9
+-- * BBox
 
--- | ISO B sizes in millimeters.
+-- | Sum of 'BBox'.
 --
--- > 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
-b3 = iso_down_scale b2
-b4 = iso_down_scale b3
-b5 = iso_down_scale b4
-b6 = iso_down_scale b5
-b7 = iso_down_scale b6
-b8 = iso_down_scale b7
-b9 = iso_down_scale b8
-b10 = iso_down_scale b9
+-- > bbox_sum (BBox 5 5 10 10) (BBox 0 0 2 20) == BBox 0 0 10 20
+bbox_sum :: BBox -> BBox -> BBox
+bbox_sum p q =
+    case (p,q) of
+      (BBox x0 y0 x1 y1,BBox x2 y2 x3 y3) ->
+          BBox (min x0 x2) (min y0 y2) (max x1 x3) (max y1 y3)
+      _ -> error "bbox_sum: HR not handled"
 
--- | ISO C sizes in millimeters.
---
--- > 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
-c3 = iso_down_scale c2
-c4 = iso_down_scale c3
-c5 = iso_down_scale c4
-c6 = iso_down_scale c5
-c7 = iso_down_scale c6
-c8 = iso_down_scale c7
-c9 = iso_down_scale c8
-c10 = iso_down_scale c9
+-- | Translate 'BBox' from mm to points.
+bbox_mm_to_pt :: BBox -> BBox
+bbox_mm_to_pt bb =
+    case bb of
+      BBox x y x' y' ->
+          BBox (mm_pt_int x) (mm_pt_int y) (mm_pt_int x') (mm_pt_int y')
+      HRBBox x y x' y' hx hy hx' hy' ->
+          HRBBox (mm_pt_int x) (mm_pt_int y) (mm_pt_int x') (mm_pt_int y')
+                 (mm_pt hx) (mm_pt hy) (mm_pt hx') (mm_pt hy')
 
--- | US Letter size in millimeters (ie 'Paper' @216 279@).
-usLetter :: Paper
-usLetter = Paper 216 279
+{- | A 'div' variant that rounds rather than truncates.
 
--- | 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
+> 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
 
--- | 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)
+-}
+divRound :: Int -> Int -> Int
+divRound x y =
+    let x' = (fromIntegral x)::Double
+        y' = (fromIntegral y)::Double
+    in round (x' / y')
diff --git a/Graphics/PS/Paper/Names.hs b/Graphics/PS/Paper/Names.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/PS/Paper/Names.hs
@@ -0,0 +1,94 @@
+-- | Names of paper sizes.
+-- For ISO sizes see <http://www.cl.cam.ac.uk/~mgk25/iso-paper.html>.
+module Graphics.PS.Paper.Names where
+
+import Graphics.PS.Paper
+
+-- | ISO size downscaling, ie. from @A0@ to @A1@.
+--
+-- > iso_down_scale a4 == a5
+iso_down_scale :: Paper -> Paper
+iso_down_scale (Paper u w h) = Paper u (h `divRound` 2) w
+
+-- | JIS size downscaling, truncates instead of rounding.
+jis_down_scale :: Paper -> Paper
+jis_down_scale (Paper u w h) = Paper u (h `div` 2) w
+
+-- | ISO A sizes in millimeters.
+--
+-- > a4 == Paper 210 297
+a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10 :: Paper
+a0 = Paper MM 841 1189
+a1 = iso_down_scale a0
+a2 = iso_down_scale a1
+a3 = iso_down_scale a2
+a4 = iso_down_scale a3
+a5 = iso_down_scale a4
+a6 = iso_down_scale a5
+a7 = iso_down_scale a6
+a8 = iso_down_scale a7
+a9 = iso_down_scale a8
+a10 = iso_down_scale a9
+
+-- | ISO B sizes in millimeters.
+--
+-- > b4 == Paper 250 354
+-- > inset_margin b4 a3 == (23,33)
+b0,b1,b2,b3,b4,b5,b6,b7,b8,b9,b10 :: Paper
+b0 = Paper MM 1000 1414
+b1 = iso_down_scale b0
+b2 = iso_down_scale b1
+b3 = iso_down_scale b2
+b4 = iso_down_scale b3
+b5 = iso_down_scale b4
+b6 = iso_down_scale b5
+b7 = iso_down_scale b6
+b8 = iso_down_scale b7
+b9 = iso_down_scale b8
+b10 = iso_down_scale b9
+
+-- | JIS B sizes
+--
+-- > jis_b4 == Paper 257 364
+-- > (proportion b0,proportion jis_b0) == (1.414,1.4135922330097088)
+--
+-- > inset_margin jis_b4 a3 == (20,28)
+jis_b0,jis_b1,jis_b2,jis_b3,jis_b4,jis_b5,jis_b6,jis_b7,jis_b8,jis_b9,jis_b10 :: Paper
+jis_b0 = Paper MM 1030 1456
+jis_b1 = jis_down_scale jis_b0
+jis_b2 = jis_down_scale jis_b1
+jis_b3 = jis_down_scale jis_b2
+jis_b4 = jis_down_scale jis_b3
+jis_b5 = jis_down_scale jis_b4
+jis_b6 = jis_down_scale jis_b5
+jis_b7 = jis_down_scale jis_b6
+jis_b8 = jis_down_scale jis_b7
+jis_b9 = jis_down_scale jis_b8
+jis_b10 = jis_down_scale jis_b9
+
+-- | ISO C sizes in millimeters.
+--
+-- > c4 == Paper 229 324
+c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10 :: Paper
+c0 = Paper MM 917 1297
+c1 = iso_down_scale c0
+c2 = iso_down_scale c1
+c3 = iso_down_scale c2
+c4 = iso_down_scale c3
+c5 = iso_down_scale c4
+c6 = iso_down_scale c5
+c7 = iso_down_scale c6
+c8 = iso_down_scale c7
+c9 = iso_down_scale c8
+c10 = iso_down_scale c9
+
+-- | US Letter size in millimeters (ie 'Paper' @216 279@).
+usLetter :: Paper
+usLetter = Paper MM 216 279
+
+-- | Newspaper sizes in millimeters.
+-- See <http://www.papersizes.org/newspaper-sizes.htm>.
+broadsheet,berliner,tabloid :: Paper
+broadsheet = Paper MM 600 750
+berliner = Paper MM 315 470
+tabloid = Paper MM 280 430
diff --git a/Graphics/PS/Path.hs b/Graphics/PS/Path.hs
--- a/Graphics/PS/Path.hs
+++ b/Graphics/PS/Path.hs
@@ -1,12 +1,11 @@
 -- | Path type and functions.
-module Graphics.PS.Path (Path(..),(+++)
-                        ,line,polygon,rectangle
-                        ,arc,arcNegative,annular
-                        ,flatten
-                        ,renderLines,renderLines') where
+module Graphics.PS.Path where
 
 import Data.List {- base -}
+import Data.Monoid (Monoid, mappend, mconcat, mempty) {- base (obsolete) -}
+
 import Data.CG.Minus {- hcg-minus -}
+
 import Graphics.PS.Glyph
 import Graphics.PS.Font
 
@@ -20,6 +19,12 @@
           | Join Path Path
             deriving (Eq,Show)
 
+instance Monoid Path where
+    mempty = MoveTo (Pt 0 0)
+    mappend = Join
+    mconcat [] = mempty
+    mconcat paths = combine paths
+
 -- | Infix notation for 'Join'.
 (+++) :: Path -> Path -> Path
 (+++) = Join
@@ -52,12 +57,15 @@
         ul = Pt x (y + h)
     in polygon [ll,lr,ur,ul]
 
-type ArcP = (Pt Double,Pt Double,Pt Double,Pt Double)
-data Arc = Arc1 ArcP
-         | Arc2 ArcP ArcP
+-- | An arc segment, as starting point and values for the curveto operator.
+type Arc_Seg n = (Pt n,Pt n,Pt n,Pt n)
 
--- (x,y) = center,r = radius,a = start angle,b = end angle
-arcp :: Pt Double -> Double -> Double -> Double -> ArcP
+-- | An arc, given as either one or two segments.
+data Arc n = Arc1 (Arc_Seg n)
+           | Arc2 (Arc_Seg n) (Arc_Seg n)
+
+-- | Arc segment, (x,y) = center,r = radius,a = start angle,b = end angle.
+arcp :: Pt Double -> Double -> Double -> Double -> Arc_Seg Double
 arcp (Pt x y) r a b =
     let ca = cos a
         sa = sin a
@@ -70,9 +78,10 @@
         p3 = Pt (x + r * cb) (y + r * sb)
     in (p0,p1,p2,p3)
 
--- 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 -> Double -> Arc
+-- | Arc, 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 segments.
+arca :: Pt Double -> Double -> Double -> Double -> Arc Double
 arca c r a b =
     let d = abs (b - a)
         b' = b - (d / 2)
@@ -80,36 +89,39 @@
        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)) =
-    let m = MoveTo p0
-        c = CurveTo p1 p2 p3
-    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 +++ c1 +++ c2
+-- | 'Path' of 'Arc'.
+arc_to_path :: Arc Double -> Path
+arc_to_path a =
+    case a of
+      Arc1 (p0,p1,p2,p3) -> MoveTo p0 +++ CurveTo p1 p2 p3
+      Arc2 (p0,p1,p2,p3) (_,p5,p6,p7) -> MoveTo p0 +++ CurveTo p1 p2 p3 +++ CurveTo p5 p6 p7
 
+-- | Variant of 'arca' allowing b to be less than a.
+arca_udir :: Pt Double -> Double -> Double -> Double -> Arc Double
+arca_udir c r a b =
+    let b' = if b < a then b + 2 * pi else b
+    in arca c r a b'
+
+-- | 'arca_udir' with a and b reversed.
+arcNegative_udir :: Pt Double -> Double -> Double -> Double -> Arc Double
+arcNegative_udir c r a b =
+    let b' = if b > a then b - 2 * pi else b
+    in arca c r b' a
+
 -- | Arc given by a central point,a radius,and start and end angles.
 arc :: Pt Double -> Double -> Double -> Double -> Path
-arc c r a b =
-    let f n = if n < a then f (n + 2 * pi) else n
-    in arc' (arca c r a (f b))
+arc c r a = arc_to_path . arca_udir c r a
 
 -- | Negative arc.
 arcNegative :: Pt Double -> Double -> Double -> Double -> Path
-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)
+arcNegative c r a = arc_to_path . arcNegative_udir c r a
 
--- (x,y) = center,ir = inner radius,xr = outer radius,sa = start
--- angle,a = angle,ea = end angle
+type Annular n = (Pt n,Pt n,Arc n,Pt n,Arc n)
 
--- | Annular segment.
-annular :: Pt Double -> Double -> Double -> Double -> Double -> Path
-annular (Pt x y) ir xr sa a =
+-- | (x,y) = center,ir = inner radius,xr = outer radius,sa = start
+-- angle,a = angle,ea = end angle
+annular_f :: Pt Double -> Double -> Double -> Double -> Double -> Annular Double
+annular_f (Pt x y) ir xr sa a =
     let ea = sa + a
         x2 = x + ir * cos sa -- ll
         y2 = y + ir * sin sa
@@ -117,20 +129,26 @@
         y3 = y + xr * sin sa
         x4 = x + ir * cos ea -- lr
         y4 = y + ir * sin ea
-    in combine [MoveTo (Pt x2 y2)
-               ,LineTo (Pt x3 y3)
-               ,arc (Pt x y) xr sa ea
-               ,LineTo (Pt x4 y4)
-               ,arcNegative (Pt x y) ir ea sa]
+    in (Pt x2 y2
+       ,Pt x3 y3
+       ,arca_udir (Pt x y) xr sa ea
+       ,Pt x4 y4
+       ,arcNegative_udir (Pt x y) ir ea sa)
 
-flatten' :: Matrix Double -> Path -> Path
-flatten' m path =
+-- | Annular segment.
+annular :: Pt Double -> Double -> Double -> Double -> Double -> Path
+annular c ir xr sa a =
+    let (p1,p2,a1,p3,a2) = annular_f c ir xr sa a
+    in combine [MoveTo p1,LineTo p2,arc_to_path a1,LineTo p3,arc_to_path a2]
+
+flatten_f :: Matrix Double -> Path -> Path
+flatten_f m path =
     case path of
       MoveTo p -> MoveTo (pt_transform m p)
       LineTo p -> LineTo (pt_transform m p)
       ClosePath p -> ClosePath (pt_transform m p)
-      PTransform m' p -> flatten' (m' * m) p
-      Join a b -> Join (flatten' m a) (flatten' m b)
+      PTransform m' p -> flatten_f (m' * m) p
+      Join a b -> Join (flatten_f m a) (flatten_f m b)
       CurveTo p q r -> let f = pt_transform m
                        in CurveTo (f p) (f q) (f r)
       Text _ _ -> error "cannot flatten text"
@@ -138,7 +156,7 @@
 -- | Apply any transformations at path.  The resulting path will not
 --   have any 'PTransform' nodes.
 flatten :: Path -> Path
-flatten = flatten' mx_identity
+flatten = flatten_f mx_identity
 
 -- | Render each (p1,p2) as a distinct line.
 renderLines :: [Ln Double] -> Path
@@ -147,8 +165,8 @@
     in foldl f (MoveTo pt_origin)
 
 -- | Collapse line sequences into a single line.
-renderLines' :: [Ln Double] -> Path
-renderLines' =
+renderLines_jn :: [Ln Double] -> Path
+renderLines_jn =
     let g p (Ln a b) = if p == a
                        then (b,Right b)
                        else (b,Left (Ln a b))
diff --git a/Graphics/PS/Path/Graphs.hs b/Graphics/PS/Path/Graphs.hs
--- a/Graphics/PS/Path/Graphs.hs
+++ b/Graphics/PS/Path/Graphs.hs
@@ -22,9 +22,9 @@
 fractal_sqr :: Path
 fractal_sqr = renderLines (fractal_sqr_pt (Pt 250 250) (Pt 175 175) 12)
 
--- | 'renderLines'' variant of 'fractal_sqr'.
+-- | 'renderLines_jn' variant of 'fractal_sqr'.
 fractal_sqr' :: Path
-fractal_sqr' = renderLines' (fractal_sqr_pt (Pt 250 250) (Pt 175 175) 12)
+fractal_sqr' = renderLines_jn (fractal_sqr_pt (Pt 250 250) (Pt 175 175) 12)
 
 -- | A /unit/ arrow.
 unitArrow :: Int -> Path
diff --git a/Graphics/PS/Query.hs b/Graphics/PS/Query.hs
--- a/Graphics/PS/Query.hs
+++ b/Graphics/PS/Query.hs
@@ -1,13 +1,14 @@
 -- | 'Path' query functions and related operations.
-module Graphics.PS.Query (startPt, endPt
-                         ,mkValid
-                         ,approx, close) where
+module Graphics.PS.Query where
 
-import Data.CG.Minus {- hcg-minus -}
+import Data.CG.Minus.Types {- hcg-minus -}
+import qualified Data.CG.Minus as CG {- hcg-minus -}
+import qualified Data.CG.Minus.Bezier as CG {- hcg-minus -}
+
+import Graphics.PS.Paper
 import Graphics.PS.Path
 
--- | Locate the starting point of the path, which must begin with a
--- 'MoveTo' node.
+-- | Locate the starting point of the path, which must begin with a 'MoveTo' node.
 startPt :: Path -> Maybe (Pt Double)
 startPt path =
     case path of
@@ -15,8 +16,7 @@
       Join p _ -> startPt p
       _ -> Nothing
 
--- | Variant that allows the initial node to be a 'LineTo' or
--- 'CurveTo' node.
+-- | Variant that allows the initial node to be a 'LineTo' or 'CurveTo' node.
 startPt' :: Path -> Maybe (Pt Double)
 startPt' path =
     case path of
@@ -59,26 +59,41 @@
       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
+                    Just p1 -> map (CG.bezier4 p1 p2 p3 p4) is
                     Nothing -> []
           in a +++ line l
       _ -> path
 
-{--
+-- | Rectangle, given as lower left and upper right points.
+data Rect a = Rect {rect_ll :: Pt a
+                   ,rect_ur :: Pt a}
+              deriving (Eq,Show)
 
-data BBox = BBox Pt Pt
-            deriving (Eq, Show)
+-- | Sum (join) of two 'Rect'.
+rect_sum :: Ord a => Rect a -> Rect a -> Rect a
+rect_sum (Rect a b) (Rect c d) = Rect (CG.pt_min a c) (CG.pt_max b d)
 
-import Graphics.PS.Transform
+-- | Rectangle bounding a (simple) 'Path'.
+path_rect :: Path -> Rect Double
+path_rect path =
+    case path of
+      MoveTo p -> Rect p p
+      LineTo p -> Rect p p
+      CurveTo c0 c1 p0 -> Rect (foldl1 CG.pt_min [c0,c1,p0]) (foldl1 CG.pt_max [c0,c1,p0])
+      Join p q -> path_rect p `rect_sum` path_rect q
+      _ -> error "path_rect: illegal query"
 
-bboxSum :: BBox -> BBox -> BBox
-bboxSum (BBox a b) (BBox c d) = BBox (ptMin a c) (ptMax b d)
+-- | Translate 'Rect' to 'BBox'.
+rect_to_bbox :: RealFrac a => Rect a -> BBox
+rect_to_bbox (Rect (Pt x0 y0) (Pt x1 y1)) = BBox (floor x0) (floor y0) (ceiling x1) (ceiling y1)
 
-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"
+path_to_bbox :: Path -> BBox
+path_to_bbox = rect_to_bbox . path_rect
+
+{--
+
+
+import Graphics.PS.Transform
 
 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
@@ -2,6 +2,7 @@
 module Graphics.PS.Statistics where
 
 import Data.Monoid {- base -}
+
 import Graphics.PS.Image
 import Graphics.PS.Path
 
diff --git a/Graphics/PS/Transform.hs b/Graphics/PS/Transform.hs
--- a/Graphics/PS/Transform.hs
+++ b/Graphics/PS/Transform.hs
@@ -1,36 +1,36 @@
 {-# Language FlexibleInstances #-}
 -- | Class and associated functions for 'Matrix' transformations.
-module Graphics.PS.Transform (Transformable
-                             ,translate, scale, rotate) where
+module Graphics.PS.Transform where
 
-import Data.CG.Minus {- hcg-minus -}
+import qualified Data.CG.Minus as CG {- hcg-minus -}
+
 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 Double -> a -> a
+class Transformable t where
+    mtransform :: CG.Matrix Double -> t -> t
 
 -- | Translation in /x/ and /y/.
-translate :: (Transformable a) => Double -> Double -> a -> a
-translate x = transform . mx_translation x
+translate :: Transformable t => Double -> Double -> t -> t
+translate x = mtransform . CG.mx_translation x
 
 -- | Scaling in /x/ and /y/.
-scale :: (Transformable a) => Double -> Double -> a -> a
-scale x = transform . mx_scaling x
+scale :: Transformable t => Double -> Double -> t -> t
+scale x = mtransform . CG.mx_scaling x
 
 -- | Rotation, in radians.
-rotate :: (Transformable a) => Double -> a -> a
-rotate = transform . mx_rotation
+rotate :: Transformable t => Double -> t -> t
+rotate = mtransform . CG.mx_rotation
 
 instance Transformable I.Image where
-    transform = I.ITransform
+    mtransform = I.ITransform
 
 instance Transformable P.Path where
-    transform = P.PTransform
+    mtransform = P.PTransform
 
-instance Transformable (Pt Double) where
-    transform = pt_transform
+instance Transformable (CG.Pt Double) where
+    mtransform = CG.pt_transform
 
 {--
 import Graphics.PS.Pt
diff --git a/Graphics/PS/Unit.hs b/Graphics/PS/Unit.hs
--- a/Graphics/PS/Unit.hs
+++ b/Graphics/PS/Unit.hs
@@ -1,17 +1,25 @@
 -- | Unit definitions and conversions.
-module Graphics.PS.Unit (radians, mm_pt) where
+module Graphics.PS.Unit where
 
 -- | Convert degrees to radians.
-radians :: (Floating a) => a -> a
+radians :: Floating a => a -> a
 radians n = n / (360 / (2 * pi))
 
 -- | Convert millimeters to PS points.
-mm_pt :: (Floating a) => a -> a
+mm_pt :: Floating a => a -> a
 mm_pt = (* 2.8346456664)
 
+-- | Type specialised 'fromIntegral'.
+i_to_d :: Int -> Double
+i_to_d = fromIntegral
+
+-- | 'Int' variant of 'mm_pt'.
+mm_pt_int :: Int -> Int
+mm_pt_int = floor . mm_pt . i_to_d
+
 {--
 -- | Convert PS points to millimeters.
-pt_mm :: (Floating a) => a -> a
+pt_mm :: Floating a => a -> a
 pt_mm = (/ 2.8346456664)
 
 -- | Postscript makes a point exactly 1/72 of an inch.
@@ -19,15 +27,15 @@
 inch n = 72 * n
 
 -- | 1 cm = 0.393700787 inches
-cm :: (Floating a) => a -> a
+cm :: Floating a => a -> a
 cm n = 28.346456664 * n
 
-twopi :: (Floating a) => a
+twopi :: Floating a => a
 twopi = 2 * pi
 
-halfpi :: (Floating a) => a
+halfpi :: Floating a => a
 halfpi = pi / 2
 
-degrees :: (Floating a) => a -> a
+degrees :: Floating a => a -> a
 degrees n = n * (360 / twopi)
 --}
diff --git a/Graphics/PS/Util.hs b/Graphics/PS/Util.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/PS/Util.hs
@@ -0,0 +1,19 @@
+module Graphics.PS.Util where
+
+import Control.Monad {- base -}
+import System.FilePath {- filepath -}
+import System.Process {- process -}
+
+type Cmd = (String,[String])
+
+run_cmd :: Cmd -> IO ()
+run_cmd (c,a) = void (rawSystem c a)
+
+eps_to_pdf_cmd :: FilePath -> Cmd
+eps_to_pdf_cmd fn = ("ps2pdf",["-dEPSCrop",fn,replaceExtension fn ".pdf"])
+
+-- | Run ps2pdf to translate an EPS file to a PDF file.
+--
+-- > eps_to_pdf "/tmp/t.0.eps"
+eps_to_pdf :: FilePath -> IO ()
+eps_to_pdf = run_cmd . eps_to_pdf_cmd
diff --git a/Help/fractals.hs b/Help/fractals.hs
deleted file mode 100644
--- a/Help/fractals.hs
+++ /dev/null
@@ -1,205 +0,0 @@
-module Main where
-
-import Data.Maybe {- base -}
-import System.Directory {- directory -}
-import System.Environment {- base -}
-import System.FilePath {- filepath -}
-import System.Random {- random -}
-
-import Graphics.PS hiding (a0, a1)
-import qualified Graphics.PS.Path.Graphs as G
-
--- | 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 pt_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 pt_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 pt_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 Double
-startPt_ = fromJust . startPt
-
-endPt_ :: Path -> Pt Double
-endPt_ = fromJust . endPt
-
---arcd_ex :: Image
-arcd_ex :: (Pt Double -> 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 = G.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 G.fractal_sqr
-       , gstroke 0 G.fractal_sqr'
-       , gstroke 0 arrows
-       , gstroke 0 (flatten arrows)
-       , f 0 (G.sierpinski pt_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_img :: Image
-heps_img = bstroke (G.erat (Pt 48 32) 120)
-
-heps_bb :: BBox
-heps_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 heps_bb heps_img
diff --git a/README b/README
--- a/README
+++ b/README
@@ -1,21 +1,16 @@
 hps
 ---
 
-[haskell][hs] [postscript][ps]
+[haskell](http://haskell.org) [postscript](http://adobe.com/products/postscript/)
 
 partial and trivial rendering of the post script drawing model.
 
-[hs]: http://haskell.org
-[ps]: http://adobe.com/products/postscript/
-
-© [rohan drape][rd] and others, 2006-2014,
-[gpl][gpl]. with contributions by:
+© [rohan drape](http://rd.slavepianos.org/) and others,
+2006-2017,
+[gpl](http://gnu.org/copyleft/).
+with contributions by:
 
 - declan murphy
 - henning thielemann
 
-see the [darcs][darcs] [history](?t=hps&q=history) for details
-
-[rd]:  http://rd.slavepianos.org/
-[gpl]: http://gnu.org/copyleft/
-[darcs]: http://darcs.net/
+see the [darcs](http://darcs.net/) [history](?t=hps&q=history) for details
diff --git a/hps.cabal b/hps.cabal
--- a/hps.cabal
+++ b/hps.cabal
@@ -1,16 +1,16 @@
 Name:              hps
-Version:           0.15
+Version:           0.16
 Synopsis:          Haskell Postscript
 Description:       Haskell library partially implementing the
                    postscript drawing model.
 License:           GPL
 Category:          Graphics
-Copyright:         Rohan Drape, 2006-2014
+Copyright:         Rohan Drape, 2006-2017
 Author:            Rohan Drape and others
 Maintainer:        rd@slavepianos.org
 Stability:         Experimental
-Homepage:          http://rd.slavepianos.org/?t=hps
-Tested-With:       GHC == 7.6.1
+Homepage:          http://rd.slavepianos.org/t/hps
+Tested-With:       GHC == 8.0.1
 Build-Type:	   Simple
 Cabal-Version:     >= 1.8
 
@@ -18,7 +18,9 @@
 
 Library
   Build-Depends:   base == 4.*,
-                   hcg-minus == 0.15.*
+                   hcg-minus == 0.16.*,
+                   filepath,
+                   process
   GHC-Options:     -Wall -fwarn-tabs
   Exposed-modules: Graphics.PS
                    Graphics.PS.Path
@@ -31,24 +33,10 @@
                    Graphics.PS.GS
                    Graphics.PS.Query
                    Graphics.PS.Paper
+                   Graphics.PS.Paper.Names
                    Graphics.PS.PS
                    Graphics.PS.Unit
-
-Flag build-exec
- default:          False
-
-Executable hps-fractals
-  If !flag(build-exec)
-   buildable:      False
-  hs-source-dirs:  . Help
-  Build-Depends:   base == 4.*,
-                   directory,
-                   filepath,
-                   hcg-minus == 0.15.*,
-                   random
-  Main-Is:         fractals.hs
-  Ghc-Options:     -Wall -fwarn-tabs
-  Other-Modules:   Graphics.PS
+                   Graphics.PS.Util
 
 Source-Repository  head
   Type:            darcs