-- | 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