music-graphics (empty) → 1.6
raw patch · 5 files changed
+156/−0 lines, 5 filesdep +basedep +blaze-svgdep +bytestringsetup-changed
Dependencies added: base, blaze-svg, bytestring, diagrams-core, diagrams-lib, diagrams-svg, lens, music-pitch, music-preludes, music-score, process
Files
- COPYING +26/−0
- Setup.lhs +4/−0
- music-graphics.cabal +41/−0
- src/Music/Graphics.hs +6/−0
- src/Music/Graphics/Diagrams.hs +79/−0
+ COPYING view
@@ -0,0 +1,26 @@++Copyright (c) 2013, Hans Höglund+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * Neither the name of the <organization> nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ music-graphics.cabal view
@@ -0,0 +1,41 @@++name: music-graphics+version: 1.6+cabal-version: >= 1.10+author: Hans Hoglund+maintainer: Hans Hoglund <hans@hanshoglund.se>+license: BSD3+license-file: COPYING+synopsis: Diagrams-based visualization of musical data structures.+category: +tested-with: GHC+build-type: Simple++description:+ To be written.++source-repository head+ type: git+ location: git://github.com/music-suite/music-graphics.git++library+ build-depends:+ base >= 4 && < 5,+ music-score == 1.6,+ music-pitch == 1.6,+ diagrams-core >= 0.6,+ diagrams-svg >= 0.6,+ bytestring,+ blaze-svg,+ process,+ lens,++ -- DEBUG+ music-preludes == 1.6,++ diagrams-lib >= 0.6+ hs-source-dirs: src+ default-language: Haskell2010+ exposed-modules:+ Music.Graphics+ Music.Graphics.Diagrams
+ src/Music/Graphics.hs view
@@ -0,0 +1,6 @@++module Music.Graphics (+ module Music.Graphics.Diagrams+) where++import Music.Graphics.Diagrams
+ src/Music/Graphics/Diagrams.hs view
@@ -0,0 +1,79 @@++{-# LANGUAGE NoMonomorphismRestriction, TypeFamilies, FlexibleContexts #-}++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++-- test +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{-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)+-- => Score b -> Score c -> Diagram SVG R2+-- drawScores notes cmds = notes1D <> notes2D <> cmdsD <> middleLines <> crossLines+-- where+-- notes1 = mfilter (\x -> getPartGroup (getVoice x) == 1) notes+-- notes2 = mfilter (\x -> getPartGroup (getVoice x) == 2) notes+-- +-- notes1D = mconcat $ fmap (drawNote 1) $ perform notes1+-- notes2D = mconcat $ fmap (drawNote 2) $ perform notes2+-- cmdsD = mconcat $ fmap drawCmd $ perform cmds+-- middleLines = translateX ((/ 2) $ totalDur) (hrule $ totalDur)+-- crossLines = mconcat $ fmap (\n -> translateX ((totalDur/5) * n) (vrule 100)) $ [0..5]+-- +-- drawNote n (t,d,x) = translateY (getP x + off n) $ translateX (getT (t.+^(d^/2))) $ scaleX (getD d) $ noteShape n+-- off 1 = 50+-- off 2 = (-50)+-- drawCmd (t,d,x) = translateY 0 $ translateX (getT t) $ cmdShape+-- +-- noteShape 1 = lcA transparent $ fcA (blue `withOpacity` 0.3) $ square 1+-- noteShape 2 = lcA transparent $ fcA (green `withOpacity` 0.3) $ square 1+-- cmdShape = lcA (red `withOpacity` 0.3) $ vrule (200)+-- +-- totalDur = getD $ duration notes+-- getT = fromRational . toRational+-- getD = fromRational . toRational+-- getP = (subtract 60) . fromIntegral . getPitch