Circular.hs

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