module Music.Theory.Diagram.Grid where
import Data.Maybe
import qualified Text.HTML.Light as H
import qualified Text.HTML.Light.Composite as H
import qualified Text.XML.Light as X
type R = Double
type P = (R,R)
type C = (R,R,R)
type L = (Int,Int)
type Cell = (L,C,String)
type Grid = [Cell]
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
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 :: (R,R) -> P -> P
displace (dx,dy) (x,y) = (x+dx,y+dy)
mk_bbox :: (Int,Int) -> (R,R)
mk_bbox (r,c) =
let f n = (fromIntegral n + 2) * 10
in (f c,f r)
type Table_Cell = ([X.Attr],[X.Content])
type Caption = [X.Content]
type Table = (Caption,[[Table_Cell]])
simple_table :: Caption -> [[X.Content]] -> Table
simple_table c z = (c,map (map (\x -> ([],[x]))) z)
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_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_table :: Caption -> (Int,Int) -> ((Int,Int) -> Table_Cell) -> Table
build_table c (m,n) f = build_table_m c (m,n) (Just . f)
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)
type Table_Set = [Table]
table_set :: Table_Set -> X.Content
table_set = H.div [H.class' "table-set"] . map table
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
to_html :: FilePath -> Maybe FilePath -> [Table_Set] -> IO ()
to_html o_fn css = writeFile o_fn . page css