music-graphics 1.6.2 → 1.7
raw patch · 2 files changed
+43/−35 lines, 2 filesdep ~lensdep ~music-pitchdep ~music-preludes
Dependency ranges changed: lens, music-pitch, music-preludes, music-score
Files
- music-graphics.cabal +5/−5
- src/Music/Graphics/Diagrams.hs +38/−30
music-graphics.cabal view
@@ -1,6 +1,6 @@ name: music-graphics-version: 1.6.2+version: 1.7 author: Hans Hoglund maintainer: Hans Hoglund <hans@hanshoglund.se> license: BSD3@@ -26,10 +26,10 @@ bytestring, blaze-svg, process,- lens,- music-preludes == 1.6.2,- music-score == 1.6.2,- music-pitch == 1.6.2,+ lens >= 4.1.2 && < 4.2,+ music-preludes == 1.7,+ music-score == 1.7,+ music-pitch == 1.7, diagrams-lib >= 0.6 exposed-modules: Music.Graphics Music.Graphics.Diagrams
src/Music/Graphics/Diagrams.hs view
@@ -2,9 +2,9 @@ {-# LANGUAGE NoMonomorphismRestriction, TypeFamilies, FlexibleContexts #-} module Music.Graphics.Diagrams (- draw,- writeGraphic,- openGraphic+ -- draw,+ -- writeGraphic,+ -- openGraphic ) where import Music.Score@@ -18,37 +18,45 @@ 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{-TODO-} . 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+-- -- FIXME find best reader+-- system "open -a Firefox test.svg"+-- return () -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{-TODO-} . 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- -- FIXME find best reader- system "open -a Firefox test.svg"- return ()++++ -- drawScores -- :: (Integral p, p ~ Pitch b, HasPitch b, Voice b ~ NotePart, HasVoice b)