module Music.Theory.Diagram.Render.Contour.WT where
import Control.Monad
import Data.CG.Minus
import qualified Graphics.Rendering.Cairo as C
import Render.CG.Minus
import System.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)
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
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
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
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