module Music.Theory.Diagram.Render.Hinton where
import Data.Colour
import Data.CG.Minus
import Data.CG.Minus.Colour
import qualified Graphics.Rendering.Cairo as C
import Render.CG.Minus
import qualified Music.Theory.Diagram.Grid as T
type Arr t = [[t]]
a_dimensions :: Arr t -> (Int,Int)
a_dimensions m =
let r = length m
m0:_ = m
c = length m0
in (r,c)
a_normalise :: (Fractional t,Ord t) => Arr t -> Arr t
a_normalise a = let m = maximum (map maximum a) in map (map (/ m)) a
a_scale :: Num t => t -> Arr t -> Arr t
a_scale k = map (map (* k))
draw_hinton_cell :: (C,C) -> ((R,R),R) -> C.Render ()
draw_hinton_cell (n,p) ((x,y),k) =
let (d,z) = let e = sqrt (abs k) in (e,(1 e) / 2)
(d',z') = (d * 10,z * 10)
fg = if k > 0 then p else n
in rect_fill (opaque fg) (Pt (x + z') (y + z')) (d',d')
draw_hinton1 :: (C,C,C) -> (Int, Int) -> Arr R -> C.Render ()
draw_hinton1 (bg,n,p) (r,c) xs = do
let g = T.grid (10,10) (10,10) (r,c)
rect_fill (opaque bg) (Pt 10 10) (fromIntegral c * 10,fromIntegral r * 10)
mapM_ (draw_hinton_cell (n,p)) (zip (concat g) (concat xs))
C.showPage
hinton_diagrams :: (C,C,C) -> R -> FilePath -> [Arr R] -> IO ()
hinton_diagrams (bg,n,p) s fn m =
let m0:_ = m
(r,c) = a_dimensions m0
(w,h) = (c * 10 + 20,r * 10 + 20)
(w',h') = (fromIntegral w,fromIntegral h)
m' = map (a_scale s . a_normalise) m
g sf = C.renderWith sf (mapM_ (draw_hinton1 (bg,n,p) (r,c)) m')
in C.withPDFSurface fn w' h' g