module Music.Graphics.Diagrams (
draw,
writeGraphic,
openGraphic
) where
import Music.Score
import Music.Pitch
import Diagrams.Prelude hiding (Time, Duration)
import qualified Diagrams.Backend.SVG as SVG
import Music.Prelude.Basic
import Control.Lens
import System.Process
import Text.Blaze.Svg.Renderer.Utf8 (renderSvg)
import qualified Data.ByteString.Lazy as ByteString
timeToDouble :: Time -> Double
timeToDouble = realToFrac . (.-. origin)
durationToDouble :: Duration -> Double
durationToDouble = realToFrac
pitchToDouble :: Music.Pitch.Pitch -> Double
pitchToDouble = realToFrac . semitones . (.-. c)
draw :: (Renderable (Path R2) b, Real a) => Score a -> Diagram b R2
draw = bg whitesmoke . scaleX 20 . mconcat . fmap drawNote . fmap (map1 timeToDouble . map2 durationToDouble . map3 realToFrac) . (^. events)
where
map1 f (a,b,c) = (f a,b,c)
map2 f (a,b,c) = (a,f b,c)
map3 f (a,b,c) = (a,b,f c)
drawNote (t,d,x) = translateY x $ translateX (t.+^(d^/2)) $ scaleX d $ noteShape
noteShape = lcA transparent $ fcA (blue `withOpacity` 0.5) $ square 1
writeGraphic :: FilePath -> Score Double -> IO ()
writeGraphic path x = do
let dia = draw x
let svg = renderDia SVG.SVG (SVG.SVGOptions (Dims 1800 (1800/20)) Nothing) dia
let bs = renderSvg svg
ByteString.writeFile path bs
openGraphic :: Score Double -> IO ()
openGraphic x = do
writeGraphic "test.svg" x
system "open -a Firefox test.svg"
return ()