packages feed

tidal-vis-1.0.14: src/VisCycle.hs

module VisCycle
       ( renderCyclePDF
       , renderCycleSVG
       ) where

import Data.Colour.SRGB
import Sound.Tidal.Context
import Sound.Tidal.Utils

import Common

import qualified Graphics.Rendering.Cairo as C


-- | Constants.
totalWidth :: Double
totalWidth = 500

border :: Double
border = 5

v :: (String -> Double -> Double -> (C.Surface -> IO ()) -> IO ())
  -> String             -- ^ filePath
  -> (Double, Double)   -- ^ size
  -> [[Event ColourD]]
  -> String             -- ^ label
  -> IO ()
v sf fn (x,y) colorEvents label =
    sf fn x y $ \surf -> C.renderWith surf $ do
        C.setAntialias C.AntialiasBest
        C.save
        C.translate border border
        C.scale (totalWidth-(border*2)) (totalWidth-(border*2))
        C.setOperator C.OperatorOver
        C.selectFontFace ("Inconsolata" :: String) C.FontSlantNormal C.FontWeightNormal
        C.setFontSize 0.2
        (C.TextExtents _ _ _ textH _ _) <- C.textExtents (label :: String)
        C.moveTo 0 textH
        C.textPath (label :: String)
        C.setSourceRGB 0 0 0
        C.fill
        -- C.setSourceRGB 0 0 0
        -- C.rectangle 0 0 1 1
        -- C.fill
        mapM_ (renderLevel (length colorEvents)) $ enumerate colorEvents
        C.restore

renderLevel :: Int -> (Int, [Event ColourD]) -> C.Render ()
renderLevel total (num, level) = do
    C.save
    mapM_ drawEvent level
    C.restore
  where
    drawEvent :: Event ColourD -> C.Render ()
    drawEvent (Event _ Arc{..} c) = do
        let (RGB r g b) = toSRGB c
        let levelHeight = (1 / fi (total+1))/2
        let h = levelHeight * fi (num + 1)
        let hPi = pi / 2
        let dPi = pi * 2
        C.save
        C.setSourceRGBA r g b 1
        C.arc 0.5 0.5 (h+levelHeight) (fromRational start * dPi - hPi) (fromRational stop * dPi - hPi)
        C.arcNegative 0.5 0.5 h  (fromRational stop * dPi - hPi) (fromRational start * dPi - hPi)
        C.fill
        C.setSourceRGBA 0.5 0.5 0.5 1
        C.setLineWidth 0.005
        C.arc 0.5 0.5 (h+levelHeight) (fromRational start * dPi - hPi) (fromRational stop * dPi - hPi)
        C.arcNegative 0.5 0.5 h  (fromRational stop * dPi - hPi) (fromRational start * dPi - hPi)
        C.stroke
        C.restore

-- | Render a cycle pattern to pdf file.
renderCyclePDF
  :: String -- ^ File name (and path)
  -> String -- ^ Background text
  -> Pattern ColourD
  -> IO ()
renderCyclePDF name label pat = do
    v C.withPDFSurface (name ++ ".pdf") (totalWidth, totalWidth) (levels pat) label
    return ()

    -- | Render a cycle pattern to pdf file.
renderCycleSVG
  :: String -- ^ File name (and path)
  -> String -- ^ Background text
  -> Pattern ColourD
  -> IO ()
renderCycleSVG name label pat = do
    v C.withSVGSurface (name ++ ".svg") (totalWidth, totalWidth) (levels pat) label
    return ()