diff --git a/Music/Theory/Diagram/Grid.hs b/Music/Theory/Diagram/Grid.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Diagram/Grid.hs
@@ -0,0 +1,123 @@
+-- | Functions for drawing grid and table structure common in music
+-- theory and in compositions such as Morton Feldman's durational
+-- /grid/ music of the 1950's.
+module Music.Theory.Diagram.Grid where
+
+import Data.Maybe
+import qualified Text.HTML.Light as H {- html-minimalist -}
+import qualified Text.HTML.Light.Composite as H
+import qualified Text.XML.Light as X {- xml -}
+
+-- * Grid
+
+-- | Real number, synonym for 'Double'.
+type R = Double
+
+-- | Point given as pair of 'R'.
+type P = (R,R)
+
+-- | Red, green and blue colour triple.
+type C = (R,R,R)
+
+-- | Cell location as row and column indices.
+type L = (Int,Int)
+
+-- | Cell
+type Cell = (L,C,String)
+
+-- | Grid
+type Grid = [Cell]
+
+-- | Given /(x,y)/ upper-left co-ordinate of grid, /(w,h)/ cell
+-- dimensions, and /(r,c)/ grid dimensions, make list of upper-left
+-- co-ordinates of cells.
+--
+-- > grid (10,10) (50,10) (2,2) == [(10,10),(60,10),(10,20),(60,20)]
+grid :: P -> (R,R) -> (Int,Int) -> [P]
+grid (x,y) (w,h) (r,c) =
+    let xs = take c [x, x + w ..]
+        ys = take r [y, y + h ..]
+    in concatMap (zip xs . repeat) ys
+
+-- | Variant on 'grid' that constructs a single point.
+--
+-- > map (grid_pt (10,10) (50,10)) [(0,0),(1,1)] == [(10,10),(60,20)]
+grid_pt :: (R,R) -> (R,R) -> L -> P
+grid_pt (x,y) (w,h) (r,c) =
+    let r' = fromIntegral r
+        c' = fromIntegral c
+    in (x + c' * w,y + r' * h)
+
+-- | Displace 'P' (pointwise addition).
+--
+-- > displace (2,3) (1,1) == (3,4)
+displace :: (R,R) -> P -> P
+displace (dx,dy) (x,y) = (x+dx,y+dy)
+
+-- | Make a bounding box from /row/ and /column/ dimensions.
+mk_bbox :: (Int,Int) -> (R,R)
+mk_bbox (r,c) =
+    let f n = (fromIntegral n + 2) * 10
+    in (f c,f r)
+
+-- * Table
+
+-- | A table cell is an 'X.Attr' and 'X.Content' duple.
+type Table_Cell = ([X.Attr],[X.Content])
+
+type Caption = [X.Content]
+
+-- | Table of row order 'Table_Cell's.
+type Table = (Caption,[[Table_Cell]])
+
+-- | Construct a 'Table' with one 'X.Content' per cell.
+simple_table :: Caption -> [[X.Content]] -> Table
+simple_table c z = (c,map (map (\x -> ([],[x]))) z)
+
+-- | Construct a 'Table' with one 'X.Content' per cell, and an
+-- associated class.
+simple_table_class :: Caption -> [[(String,X.Content)]] -> Table
+simple_table_class c z = (c,map (map (\(nm,x) -> ([H.class' nm],[x]))) z)
+
+type Build_F = ((Int,Int) -> Maybe Table_Cell)
+
+-- | Build a table of @(rows,columns)@ dimensions given a function
+-- from @(row,column)@ to 'Maybe' 'Table_Cell'.  If the function is
+-- 'Nothing' the cell is skipped, becase another cell has claimed it's
+-- locations with 'H.colspan' or 'H.rowspan'.
+build_table_m :: Caption -> (Int,Int) -> Build_F -> Table
+build_table_m c (m,n) f =
+    let mk_row i = mapMaybe (\j -> f (i,j)) [0 .. n - 1]
+    in (c,map mk_row [0 .. m - 1])
+
+-- | Build a table of @(rows,columns)@ dimensions given a function
+-- from @(row,column)@ to 'Table_Cell'.
+build_table :: Caption -> (Int,Int) -> ((Int,Int) -> Table_Cell) -> Table
+build_table c (m,n) f = build_table_m c (m,n) (Just . f)
+
+-- | Render 'Table' as @HTML@ table.
+table :: Table -> X.Content
+table (c,z) =
+    let mk_r = H.tr [] . map (uncurry H.td)
+    in H.table [] (H.caption [] c : map mk_r z)
+
+-- | A set of related tables.
+type Table_Set = [Table]
+
+-- | Render a 'Table_Set's in a @div@ with class @table-set@.
+table_set :: Table_Set -> X.Content
+table_set = H.div [H.class' "table-set"] . map table
+
+-- | Render set of 'Table_Set's as @HTML@.
+page :: Maybe FilePath -> [Table_Set] -> String
+page css xs = do
+    let tb = map table_set xs
+        bd = H.body [H.class' "table-page"] tb
+        css' = H.link_css "all" (fromMaybe "css/grid.css" css)
+        hd = H.head [] [css']
+        e = H.html [H.lang "en"] [hd, bd]
+    H.renderHTML5 e
+
+-- | Write set of 'Table_Set's to @HTML@ file.
+to_html :: FilePath -> Maybe FilePath -> [Table_Set] -> IO ()
+to_html o_fn css = writeFile o_fn . page css
diff --git a/Music/Theory/Diagram/Path.hs b/Music/Theory/Diagram/Path.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Diagram/Path.hs
@@ -0,0 +1,193 @@
+-- | Functions to make /path diagrams/ such as those in Fig. VIII-11
+-- on I.Xenakis /Formalized Music/.
+module Music.Theory.Diagram.Path where
+
+import Data.CG.Minus {- hcg-minus -}
+import Data.Function
+import Data.List
+import Data.Maybe
+
+-- * Genera
+
+-- | Set of all /(pre,element,post)/ triples of a sequence.
+--
+-- > parts "abc" == [("",'a',"bc"),("a",'b',"c"),("ab",'c',"")]
+parts :: [a] -> [([a],a,[a])]
+parts inp =
+    let f p i q = let r = (p,i,q)
+                  in case q of
+                       [] -> [r]
+                       (q':q'') -> r : f (p ++ [i]) q' q''
+    in case inp of
+         (x:xs) -> f [] x xs
+         [] -> []
+
+-- | All /(element,remainder)/ pairs for a sequence.
+--
+-- > parts' "abc" == [('a',"bc"),('b',"ac"),('c',"ab")]
+parts' :: [a] -> [(a,[a])]
+parts' = let f (p,i,q) = (i,p++q) in map f . parts
+
+-- | Gather elements with equal keys.
+--
+-- > gather (zip "abcba" [0..]) == [('a',[0,4]),('b',[1,3]),('c',[2])]
+gather :: (Ord a) => [(a,i)] -> [(a,[i])]
+gather =
+    let f xs = (fst (head xs),map snd xs)
+    in map f . groupBy ((==) `on` fst) . sortBy (compare `on` fst)
+
+-- * Geometry
+
+-- | Does either endpoint of the /lhs/ 'Ln' lie on the /rhs/ 'Ln'.
+--
+-- > ln_on (ln' (1/2,1/2) (1/2,1)) (ln' (0,0) (1,1)) == True
+-- > ln_on (ln' (1/2,0) (1/2,1)) (ln' (0,0) (1,1)) == False
+ln_on :: Ln R -> Ln R -> Bool
+ln_on (Ln p q) l = pt_on_line l p || pt_on_line l q
+
+-- | Do 'Ln's overlap in the particular sense of being 'ln_parallel'
+-- and at least one endpoint of one line lying on the other.
+overlap :: Ln R -> Ln R -> Bool
+overlap p q = ln_parallel p q && (ln_on p q || ln_on q p)
+
+-- | Do both points of the /rhs/ 'Ln' lie on the /lhs/ 'Ln'.
+includes :: Ln R -> Ln R -> Bool
+includes l (Ln p q) =
+    let f = pt_on_line l
+    in f p && f q
+
+-- | 'flip' 'includes'.
+is_included :: Ln R -> Ln R -> Bool
+is_included = flip includes
+
+-- | Apply /f/ to /x/ and /y/ duple of 'Pt'.
+pt_fn :: ((a,a) -> b) -> Pt a -> b
+pt_fn f (Pt x y) = f (x,y)
+
+-- | Apply /f/ to /start/ and /end/ 'Pt' duple of 'Ln'.
+ln_fn :: (Num a,Eq a) => ((Pt a,Pt a) -> b) -> Ln a -> b
+ln_fn f (Ln p q) = f (p,q)
+
+-- | Apply /f/ to /start/ and /end/ 'Pt's of 'Ln' and construct 'Ln'.
+ln_pt_fn :: (Num a,Eq a,Num b,Eq b) => (Pt a -> Pt b) -> Ln a -> Ln b
+ln_pt_fn f = ln_fn (\(p,q) -> Ln (f p) (f q))
+
+-- | Scale set of 'Ln' to lie in area given by /(0,n)/.
+to_unit :: R -> [Ln R] -> [Ln R]
+to_unit m p =
+    let p' = concatMap (ln_fn (\(i,j) -> [i,j])) p
+        x = maximum (map pt_x p')
+        y = maximum (map pt_y p')
+        f n = pt_fn (\(i,j) -> Pt (i*m/n) (m - (j*m/n)))
+        g n = ln_pt_fn (f n)
+    in map (g (max x y)) p
+
+-- * Orientation
+
+-- | Enumeration of 'Vertical', 'Horizontal' and 'Diagonal'.
+data Orientation a = Vertical | Horizontal | Diagonal a
+                     deriving (Eq,Show)
+
+-- | Calculate 'Orientation' of 'Ln'.
+--
+-- > orientation (ln' (0,0) (0,1)) == Vertical
+-- > orientation (ln' (0,0) (1,0)) == Horizontal
+-- > orientation (ln' (0,0) (1,1)) == Diagonal 1
+orientation :: (Fractional a,Eq a) => Ln a -> Orientation a
+orientation l =
+    case ln_slope l of
+      Nothing -> Vertical
+      Just m -> if m == 0 then Horizontal else Diagonal m
+
+-- * Shift Map
+
+-- | A table 'Pt' and 'Orientation' set pairs.
+type Shift_Map a = [(Pt a,[Orientation a])]
+
+-- | Construct a 'Shift_Map' from a set of 'Ln's.
+mk_shift_map :: [Ln R] -> Shift_Map R
+mk_shift_map =
+    let f i l = if overlap i l then Just (i,orientation l) else Nothing
+        g (x,i,_) = mapMaybe (f i) x
+        h (l0,o) = let (p,q) = ln_pt l0 in [(p,o),(q,o)]
+    in gather . concatMap h . concatMap g . parts
+
+-- | Apply 'Shift_Map' to a 'Pt'.
+shift_map_pt :: Shift_Map R -> Pt R -> Pt R
+shift_map_pt tbl i =
+    let n = 0.1
+        Pt x y = i
+        g o = let x' = if Vertical `elem` o then x+n else x
+                  y' = if Horizontal `elem` o then y+n else y
+              in Pt x' y'
+    in maybe i g (lookup i tbl)
+
+-- | Apply 'Shift_Map' to a 'Ln'.
+shift_map_ln :: Shift_Map R -> Ln R -> Ln R
+shift_map_ln tbl = ln_pt_fn (shift_map_pt tbl)
+
+-- * Shift table
+
+-- | A table of 'Pt' pairs.
+type Shift_Table a = [(Pt a,Pt a)]
+
+-- | Make element of 'Shift_Table'.
+mk_shift_tbl_m :: (Ln R,Bool) -> Maybe (Shift_Table R)
+mk_shift_tbl_m (Ln p1 p2,occ) =
+    if occ
+    then let Pt x1 y1 = p1
+             Pt x2 y2 = p2
+             n = 0.1
+         in if x1 == x2
+            then let x = x1 + n in Just [(p1,Pt x y1),(p2,Pt x y2)]
+            else let y = y1 + n in Just [(p1,Pt x1 y),(p2,Pt x2 y)]
+    else Nothing
+
+-- | Make complete 'Shift_Table'.
+mk_shift_tbl :: Collision_Table -> Shift_Table R
+mk_shift_tbl = concat . mapMaybe mk_shift_tbl_m
+
+-- | Apply 'Shift_Table' to 'Ln'.
+shift_table_ln :: Shift_Table R -> Ln R -> Ln R
+shift_table_ln tbl =
+    let f i = fromMaybe i (lookup i tbl)
+    in ln_fn (\(p,q) -> Ln (f p) (f q))
+
+-- * Collision table
+
+-- | Table of 'Ln's indicating collisions.
+type Collision_Table = [(Ln R,Bool)]
+
+-- | Construct 'Collision_Table' for a set of 'Ln'.
+mk_collision_table :: [Ln R] -> Collision_Table
+mk_collision_table =
+    let f (x,xs) = (x,any (is_included x) xs)
+    in map f . parts'
+
+-- | Construct 'Shift_Table' from 'Collision_Table' and shift all 'Ln'.
+collision_table_rewrite :: Collision_Table -> [Ln R]
+collision_table_rewrite xs =
+    let tbl = mk_shift_tbl xs
+    in map (shift_table_ln tbl . fst) xs
+
+-- * Path diagram
+
+-- | A diagram given as a set of 'Int' pairs.
+type Path_Diagram = [(Int,Int)]
+
+-- | Construct set of 'Ln' from 'Path_Diagram'.
+path_diagram_ln :: Path_Diagram -> [Ln R]
+path_diagram_ln xs =
+    let xs' = map (pt_from_i . uncurry Pt) xs
+    in zipWith Ln xs' (tail xs')
+
+-- | 'Collision_Table' based resolution of 'Path_Diagram'.
+mk_path_ct :: Path_Diagram -> [Ln R]
+mk_path_ct = collision_table_rewrite . mk_collision_table . path_diagram_ln
+
+-- | 'Shift_Map' variant of 'mk_path_ct'.
+mk_path_sm :: Path_Diagram -> [Ln R]
+mk_path_sm p =
+    let p' = path_diagram_ln p
+    in map (shift_map_ln (mk_shift_map p')) p'
+
diff --git a/Music/Theory/Diagram/Render/Circular.hs b/Music/Theory/Diagram/Render/Circular.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Diagram/Render/Circular.hs
@@ -0,0 +1,90 @@
+-- | Functions for circular representations of Zn structures.
+module Music.Theory.Diagram.Render.Circular where
+
+import Data.CG.Minus {- hcg-minus -}
+import Data.CG.Minus.Colour
+import Data.Colour {- colour -}
+import qualified Graphics.Rendering.Cairo as C {- cairo -}
+import Render.CG.Minus {- hcg-minus-cairo -}
+
+type P = Pt R
+
+lw :: R
+lw = 0.25
+
+circle_s :: Ca -> P -> R -> C.Render ()
+circle_s c i j = circle i j >> pen lw c >> C.stroke
+
+-- > marks (2 * pi) 12
+marks :: R -> Int -> [R]
+marks m n =
+    let i = m / fromIntegral n
+    in [0,i .. m - i]
+
+-- > marks_p 100 (2 * pi) 12
+marks_p :: R -> R -> Int -> [P]
+marks_p r m n =
+    let f i = pt_from_polar (Pt r (i - (pi/2)))
+    in map f (marks m n)
+
+type Text_F = Maybe (Int -> String)
+
+-- | Frame, circle at @(0,0)@ with radius /r/ and /n/ marks.
+frame :: R -> Int -> Text_F -> C.Render ()
+frame r n t_fn = do
+  let g = 0.15
+      c = toCa (g,g,g,1)
+      p = marks_p r (2 * pi) n
+      p' = marks_p (r * 1.1) (2 * pi) n
+      t_fn' = maybe (const "") id t_fn
+  circle_s c (Pt 0 0) r
+  mapM_ (\i -> circle_s c i 1) p
+  mapM_ (\(i,j) -> text c i 4 j) (zip p' (map t_fn' [0..n-1]))
+  text c (Pt 0 0) 4 (show n)
+
+circle_polygon :: R -> Int -> Ca -> [Int] -> C.Render ()
+circle_polygon r n c x = do
+  let p = marks_p r (2 * pi) n
+      p' = map (p !!) x
+  polygon p'
+  pen lw c
+  C.stroke
+
+circle_marks :: R -> Int -> Ca -> [Int] -> C.Render ()
+circle_marks r n c x = do
+  let p = marks_p r (2 * pi) n
+      p' = map (p !!) x
+  mapM_ (\i -> circle_s c i 2) p'
+
+circle_diagram_set :: Int -> Text_F -> [[Int]] -> C.Render ()
+circle_diagram_set n t pp = do
+  frame 100 n t
+  let cc = [venetianRed
+           ,swedishAzureBlue
+           ,candlelightYellow
+           ,fernGreen
+           ,sepiaBrown]
+      f (p,c) = do circle_polygon 100 n c p
+                   circle_marks 100 n c p
+  mapM_ f (zip pp (cycle (map opaque cc)))
+
+circle_diagram :: Int -> Text_F -> [Int] -> C.Render ()
+circle_diagram n t p = circle_diagram_set n t [p]
+
+-- | Variant of 'render_to_file'.
+--
+-- > let s = [[0..11],[0,2..10],[0,3..9],[0,4,8]
+-- >         ,[0,5,10,3,8,1,6,11,4,9,2,7]]
+-- > in to_file F_SVG "/tmp/circular" (circle_diagram_set 12 (Just show) s)
+--
+-- > let s = [[0,5,6,7],[1,2,3,8],[4,9,10,11]]
+-- > in to_file F_SVG "/tmp/circular" (circle_diagram_set 12 (Just show) s)
+--
+-- > let {s = [0,1,5,6,12,25,29,36,42,48,49,53]
+-- >     ;t = [0,8,16,18,26,34]
+-- >     ;z = map (\i -> map ((`mod` 72) . (+ i)) s) t}
+-- > in to_file F_SVG "/tmp/circular" (circle_diagram_set 72 (Just show) z)
+to_file :: File_Type -> FilePath -> C.Render () -> IO ()
+to_file ty nm f =
+  let f' = C.translate 125 125 >> f
+  in render_to_file ty (250,250) nm f'
diff --git a/Music/Theory/Diagram/Render/Contour/WT.hs b/Music/Theory/Diagram/Render/Contour/WT.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Diagram/Render/Contour/WT.hs
@@ -0,0 +1,94 @@
+-- | Contour contact sheets.
+module Music.Theory.Diagram.Render.Contour.WT where
+
+import Control.Monad {- base -}
+import Data.CG.Minus {- hcg-minus -}
+import qualified Graphics.Rendering.Cairo as C {- cairo -}
+import Render.CG.Minus {- hcg-minus-cairo -}
+import System.FilePath {- filepath -}
+
+data Setup = Setup {wt_nc :: Int
+                   ,wt_dimensions :: (Int,Int)
+                   ,wt_spacers :: (R,R)
+                   ,wt_scalar :: R}
+
+type CN = [(Bool,[Int])]
+type PP = [CN]
+
+fi :: Integral a => a -> R
+fi = fromIntegral
+
+ipt :: Integral a => a -> a -> Pt R
+ipt x y = Pt (fi x) (fi y)
+
+-- | Generate grid points.
+-- l=left, u=upper, r=rows, c=columns, w=width, h=height
+grid :: (R,R) -> (Int,Int) -> (R,R) -> (R,R) -> [Pt R]
+grid (l,u) (r,c) (w,h) (dx,dy) =
+    let xs = take r [l,l + w + dx ..]
+        ys = take c [u,u + h + dy ..]
+    in concatMap (\y -> zipWith Pt xs (repeat y)) ys
+
+-- | Calculate number of rows (nr) given number of columns (nc) and
+-- number of entries (ne).
+calc_nr :: Integral t => t -> t -> t
+calc_nr nc ne =
+    let (a,b) = ne `divMod` nc
+    in a + if b == 0 then 0 else 1
+
+-- | Cairo co-ordinates are /y/ descending.
+invert :: (Num a) => a -> [a] -> [a]
+invert n = map (\x -> n - x)
+
+draw_contour :: Pt R -> Bool -> [Int] -> C.Render ()
+draw_contour (Pt x y) c ys = do
+  let (r,g,b) = if c then (1,0,0) else (0,0,0)
+      p = zipWith ipt [0..] ys
+  C.save
+  C.setSourceRGBA r g b 0.75
+  C.setLineWidth 0.05
+  C.translate x y
+  line p
+  C.stroke
+  C.restore
+
+draw_border :: Pt R -> (Int,Int) -> C.Render ()
+draw_border (Pt x y) (w,h) = do
+  let g = 0.75
+  C.save
+  C.setSourceRGBA g g g 0.75
+  C.setLineWidth 0.05
+  C.translate x y
+  C.rectangle 0 0 (fi w) (fi h)
+  C.stroke
+  C.restore
+
+draw_img :: Pt R -> (Int,Int) -> CN -> C.Render ()
+draw_img p (w,h) xs = do
+  draw_border p (w,h)
+  mapM_ (\(c,ys) -> draw_contour p c (invert h ys)) xs
+
+draw_wt :: Setup -> PP -> C.Render ()
+draw_wt (Setup nc (w,h) sp sc) dd = do
+  let nr = calc_nr nc (length dd)
+      g = grid (1,1) (nc,nr) (fi w,fi h) sp
+  C.save
+  C.scale sc sc
+  zipWithM_ (\d p -> draw_img p (w,h) d) dd g
+  C.showPage
+  C.restore
+
+-- | Select format from extension (ie. @.pdf@ or @.svg@).
+draw :: FilePath -> Setup -> [PP] -> IO ()
+draw o_fn wt_f ddd = do
+  let (Setup nc (w,h) (dx,dy) sc) = wt_f
+      nr = calc_nr nc (maximum (map length ddd))
+      w' = fi nc * (fi w + dx) + dx
+      h' = fi nr * (fi h + dy) + dy
+      f s = C.renderWith s (mapM_ (draw_wt wt_f) ddd)
+      wr = case takeExtension o_fn of
+             ".pdf" -> C.withPDFSurface
+             ".svg" -> C.withSVGSurface
+             _ -> undefined
+  wr o_fn (w' * sc) (h' * sc) f
+
diff --git a/Music/Theory/Diagram/Render/Grid.hs b/Music/Theory/Diagram/Render/Grid.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Diagram/Render/Grid.hs
@@ -0,0 +1,30 @@
+-- | Functions for drawing grid and table structure common in music
+-- theory and in compositions such as Morton Feldman's durational
+-- /grid/ music of the 1950's.
+module Music.Theory.Diagram.Render.Grid where
+
+import Data.CG.Minus
+import Data.CG.Minus.Colour
+import Data.Colour {- colour -}
+import qualified Graphics.Rendering.Cairo as C {- cairo -}
+import qualified Music.Theory.Diagram.Grid as T {- hmt -}
+import Render.CG.Minus
+
+-- | Render 'Grid' of /(rows,columns)/ with displacement /(dx,dy)/ in
+-- indicated font size.
+mk_grid :: (Int,Int) -> (R,R) -> R -> T.Grid -> C.Render ()
+mk_grid (r,c) (dx,dy) fs xs = do
+  let g = T.grid (10,10) (10,10) (r,c)
+      grid_pt' = uncurry Pt . T.displace (dx,dy) . T.grid_pt (10,10) (10,10)
+  mapM_ (\(x,y) -> rect (opaque black) (Pt x y) (10,10)) g
+  mapM_ (\(l,clr,i) -> text (opaque (toC clr)) (grid_pt' l) fs i) xs
+  C.showPage
+
+-- | Run render to @PDF@ file.
+--
+-- > let g = [((0,0),(1,0,0),"a"),((2,2),(0,0,1),"b")]
+-- > in to_pdf "/tmp/grid.pdf" (60,60) (mk_grid (4,4) (2,8) 9 g)
+to_pdf :: FilePath -> (R,R) -> C.Render () -> IO ()
+to_pdf nm (w,h) f = do
+  let g s = C.renderWith s f
+  C.withPDFSurface nm w h g
diff --git a/Music/Theory/Diagram/Render/Path.hs b/Music/Theory/Diagram/Render/Path.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Diagram/Render/Path.hs
@@ -0,0 +1,41 @@
+-- | Functions to make /path diagrams/ such as those in Fig. VIII-11
+-- on I.Xenakis /Formalized Music/.
+module Music.Theory.Diagram.Render.Path where
+
+import Data.CG.Minus {- hcg-minus -}
+import Data.CG.Minus.Colour
+import Data.Colour {- colour -}
+import qualified Graphics.Rendering.Cairo as C {- cairo -}
+import Music.Theory.Diagram.Path
+import Render.CG.Minus.Arrow
+
+-- * Drawing
+
+-- | A set of 'Ca' and 'Ls' pairs.
+type Path = [(Ca,Ls R)]
+
+-- | Draw 'Path' with mid-point arrows.
+draw_path :: Path -> C.Render ()
+draw_path xs = do
+  mapM_ (uncurry (arrows_mp 0.1 (pi/9))) xs
+  C.showPage
+
+-- | 'mapM_' 'draw_path'.
+draw_paths :: [Path] -> C.Render ()
+draw_paths = mapM_ draw_path
+
+-- | 'draw_paths' to named @PDF@ file.
+write_pdf :: FilePath -> [Path] -> IO ()
+write_pdf fn xs = do
+  let f s = C.renderWith s (C.translate 10 100 >>
+                            C.scale 100 100 >>
+                            draw_paths xs)
+  C.withPDFSurface fn 500 500 f
+
+-- * Path diagram
+
+-- | Write @PDF@ of a set of 'Path_Diagram's to named file.
+path_diagram :: FilePath -> [Path_Diagram] -> IO ()
+path_diagram fn =
+    let f (i,j) = (opaque black,[i,j])
+    in write_pdf fn . map (map (ln_fn f) . to_unit 4 . mk_path_sm)
diff --git a/Music/Theory/Tuning/Table.hs b/Music/Theory/Tuning/Table.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Table.hs
@@ -0,0 +1,103 @@
+-- | Tuning tables
+module Music.Theory.Tuning.Table where
+
+import qualified Music.Theory.Diagram.Grid as G
+import Music.Theory.List
+import Music.Theory.Pitch
+import Music.Theory.Pitch.Spelling
+import Music.Theory.Tuning
+import qualified Text.HTML.Light as H {- html-minimalist -}
+import Text.Printf
+
+-- * Equal temperament
+
+-- | 'octpc_to_pitch' and 'octpc_to_cps'.
+octpc_to_pitch_cps :: (Floating n) => OctPC -> (Pitch,n)
+octpc_to_pitch_cps x = (octpc_to_pitch pc_spell_ks x,octpc_to_cps x)
+
+-- | 12-tone equal temperament table equating 'Pitch' and frequency
+-- over range of human hearing, where @A4@ = @440@hz.
+--
+-- > length tbl_12et == 132
+-- > min_max (map (round . snd) tbl_12et) == (16,31609)
+tbl_12et :: [(Pitch,Double)]
+tbl_12et =
+    let z = [(o,pc) | o <- [0..10], pc <- [0..11]]
+    in map octpc_to_pitch_cps z
+
+-- | 24-tone equal temperament variant of 'tbl_12et'.
+--
+-- > length tbl_24et == 264
+-- > min_max (map (round . snd) tbl_24et) == (16,32535)
+tbl_24et :: [(Pitch, Double)]
+tbl_24et =
+    let f x = let p = fmidi_to_pitch pc_spell_ks x
+                  p' = pitch_rewrite_threequarter_alteration p
+              in (p',fmidi_to_cps x)
+    in map f [12,12.5 .. 143.5]
+
+-- | Given an @ET@ table (or like) find bounds of frequency.
+--
+-- > let r = Just (at_pair octpc_to_pitch_cps ((3,11),(4,0)))
+-- > in bounds_et_table tbl_12et 256 == r
+bounds_et_table :: Ord s => [(t,s)] -> s -> Maybe ((t,s),(t,s))
+bounds_et_table tbl =
+    let f (_,p) = compare p
+    in find_bounds f (adj2 1 tbl)
+
+-- | 'bounds_et_table' of 'tbl_12et'.
+--
+-- > map bounds_12et_tone (hsn 17 55)
+bounds_12et_tone :: Double -> Maybe ((Pitch,Double),(Pitch,Double))
+bounds_12et_tone = bounds_et_table tbl_12et
+
+-- | Tuple indicating nearest 'Pitch' to /frequency/ with @ET@
+-- frequency, and deviation in hertz and 'Cents'.
+type HS_R = (Double,Pitch,Double,Double,Cents)
+
+-- | Form 'HS_R' for /frequency/ by consulting table.
+--
+-- > let {f = 256
+-- >     ;f' = octpc_to_cps (4,0)
+-- >     ;r = (f,Pitch C Natural 4,f',f-f',to_cents (f/f'))}
+-- > in nearest_et_table_tone tbl_12et 256 == r
+nearest_et_table_tone :: [(Pitch,Double)] -> Double -> HS_R
+nearest_et_table_tone tbl f =
+    case bounds_et_table tbl f of
+      Nothing -> undefined
+      Just ((lp,lf),(rp,rf)) ->
+          let ld = f - lf
+              rd = f - rf
+          in if abs ld < abs rd
+             then (f,lp,lf,ld,to_cents (f/lf))
+             else (f,rp,rf,rd,to_cents (f/rf))
+
+nearest_12et_tone :: Double -> HS_R
+nearest_12et_tone = nearest_et_table_tone tbl_12et
+
+nearest_24et_tone :: Double -> HS_R
+nearest_24et_tone = nearest_et_table_tone tbl_24et
+
+-- * Cell
+
+-- | /n/-decimal places.
+--
+-- > ndp 3 (1/3) == "0.333"
+ndp :: Int -> Double -> String
+ndp = printf "%.*f"
+
+-- | 'G.Table_Cell' from set of 'HS_R'.
+hs_r_cell :: Int -> (Int -> String) -> [HS_R] -> (Int,Int) -> G.Table_Cell
+hs_r_cell n nm_f t (i,j) =
+    let dp = ndp n
+        (f,p,pf,fd,c) = t !! i
+        e = case j of
+              0 -> nm_f i
+              1 -> dp f
+              2 -> pitch_pp p
+              3 -> dp pf
+              4 -> dp fd
+              5 -> dp c
+              _ -> undefined
+    in ([],[H.cdata e])
+
diff --git a/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -0,0 +1,13 @@
+hmt-diagrams
+------------
+
+[cairo][cairo] & [html][html5] rendering of [hmt][hmt] related diagrams.
+
+[cairo]: http://cairographics.org/
+[html5]: http://www.w3.org/html5
+[hmt]: http://rd.slavepianos.org/?t=hmt
+
+© [rohan drape][rd], 2006-2013, [gpl]
+
+[rd]: http://rd.slavepianos.org/
+[gpl]: http://gnu.org/copyleft/
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/hmt-diagrams.cabal b/hmt-diagrams.cabal
new file mode 100644
--- /dev/null
+++ b/hmt-diagrams.cabal
@@ -0,0 +1,39 @@
+Name:              hmt-diagrams
+Version:           0.14
+Synopsis:          Haskell Music Theory Diagrams
+Description:       Haskell Music Theory Diagrams
+License:           GPL
+Category:          Music
+Copyright:         Rohan Drape, 2006-2013
+Author:            Rohan Drape
+Maintainer:        rd@slavepianos.org
+Stability:         Experimental
+Homepage:          http://rd.slavepianos.org/?t=hmt-diagrams
+Tested-With:       GHC == 7.0.4
+Build-Type:        Simple
+Cabal-Version:     >= 1.8
+
+Data-files:        README
+
+Library
+  Build-Depends:   base==4.*,
+                   cairo,
+                   colour,
+                   hcg-minus==0.14.*,
+                   hcg-minus-cairo==0.14.*,
+                   hmt==0.14.*,
+                   html-minimalist==0.14.*,
+                   filepath,
+                   xml
+  GHC-Options:     -Wall -fwarn-tabs
+  Exposed-modules: Music.Theory.Diagram.Grid
+                   Music.Theory.Diagram.Path
+                   Music.Theory.Diagram.Render.Circular
+                   Music.Theory.Diagram.Render.Contour.WT
+                   Music.Theory.Diagram.Render.Grid
+                   Music.Theory.Diagram.Render.Path
+                   Music.Theory.Tuning.Table
+
+Source-Repository  head
+  Type:            darcs
+  Location:        http://rd.slavepianos.org/sw/hmt-diagrams
