music-preludes 1.7.1 → 1.7.2

raw patch · 19 files changed

+279/−138 lines, 19 filesdep +averagedep +music-articulationdep ~lensdep ~lilyponddep ~music-dynamicsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: average, music-articulation

Dependency ranges changed: lens, lilypond, music-dynamics, music-dynamics-literal, music-parts, music-pitch, music-pitch-literal, music-score, musicxml2

API changes (from Hackage documentation)

Files

• examples/analysis.hs +7/−4
• examples/annotatations.hs +2/−2
• examples/bartok.hs +3/−3
• examples/behavior.hs +10/−0
• examples/canon.hs +1/−0
• examples/canon.music +1/−1
• examples/chords.hs +56/−23
• examples/duo.hs +1/−1
• examples/part.hs +14/−13
• examples/scheme.hs +45/−16
• examples/test1.scm +3/−0
• examples/test2.scm +12/−0
• examples/time_signatures.hs +8/−5
• examples/trio.hs +9/−9
• music-preludes.cabal +12/−10
• src/Music/Prelude/Basic.hs +13/−13
• src/Music/Prelude/CmdLine.hs +62/−25
• src/Music/Prelude/Instances.hs +11/−1
• src/Music/Prelude/Standard.hs +9/−12

@@ -17,9 +17,12 @@ markImperfect = text "Imperfect consonances" . markIf isImperfectConsonance markDiss      = text "Dissonances"           . markIf isDissonance +-- Try different subjects+subject = [c..c']+-- subject = [c,d,cs,gs,f,fs,g_,gs_,fs,f,e,ds',c] -main = openLilypond $ asScore $ rcat [-    markPerfect   $ scat [c..c'],-    markImperfect $ scat [c..c'],-    markDiss      $ scat [c..c']    +main = openLilypond $ asScore $ rcat [+    markPerfect   $ scat subject,+    markImperfect $ scat subject,+    markDiss      $ scat subject       ]

@@ -14,13 +14,13 @@      . intervalAnnotations subjectDiff      . scat $ map (fromPitch'.pure) subject -subject :: [BasicPitch]+subject :: [Pitch] subject = [c, d, f, e, f, g, a, g, e, d, c]  subjectDiff :: [Interval] subjectDiff = zipWith (.-.) (tail subject) subject --- reify :: BasicPitch -> Score BasicNote+-- reify :: Pitch -> Score BasicNote -- reify = (`up` c) . pure . (.-. c)  intervalAnnotations :: [Interval] -> (Score BasicNote -> Score BasicNote)

@@ -25,14 +25,14 @@     left = (level pp {-. legato-})           (scat [a,g,f,e] |> d^*2)       |> {-(level ((mp |> mp `cresc` mf |> mf)^*8) . legato)-}id -         (scat [g,f,e,d] |> c |> (d |> e)^/2 |> f |> e |> d^*8)+         (scat [g,f,e,d] |> c |> (d |> e)^/2 |> f |> e |> d^*8)     --      right = up _P4 . delay 2 $           (level pp {-. legato-})           (scat [a,g,f,e] |> d^*2)       |> (level mp {-. legato-}) -         (scat [g,f,e,d] |> c |> (d |> e)^/2 |> f |> e |> d^*8)+         (scat [g,f,e,d] |> c |> (d |> e)^/2 |> f |> e |> d^*8) -  in meta $ compress 8 $ left </> down _P8 right+  in meta $ compress 8 $ left </> down _P8 right  

@@ -0,0 +1,10 @@++import Music.Prelude++toPitch :: Double -> Pitch+toPitch x = c .+^ si x+  where+    si t = spell usingSharps $ (floor t :: Semitones)+    +main = open music+music = set pitches' (stretch 12 $ fmap toPitch $ sine * 7) $ times 24 c

@@ -1,3 +1,4 @@+ {-# LANGUAGE OverloadedStrings #-}  {-

@@ -9,7 +9,7 @@   frere2 = delay 2 frere </> frere   frere4 = delay 4 frere2 </> frere2 -  info = {-title "Frere Jaques" . -}composer "Trad." . tempo (metronome (1/4) 120)+  info = title "Frere Jaques" . composer "Trad." . tempo (metronome (1/4) 120)  in info $ asScore $ frere4 

@@ -7,12 +7,12 @@ import Control.Applicative import System.Process (system) -kStrum = 0.03+-- kStrum = 0.005+kStrum = 0  main   = do-  -- openLilypond (music^/4)+  openLilypond music   -- openMidi music-  openAudacity music  guitar = (tutti $ StdInstrument 26) alto   = (tutti $ StdInstrument 65)@@ -20,40 +20,73 @@   -- Strum a chord-strum :: [Score a] -> Score a-strum = pcat . zipWith (\t x -> delay t . stretchTo (x^.duration ^-^ t) $ x) [0,kStrum..]+-- TODO port this to Chord module+strumUp :: [Score a] -> Score a+strumUp = pcat . zipWith (\t x -> delay t . stretchTo (x^.duration ^-^ t) $ x) [0,kStrum..] +strumDown = strumUp . reverse++data StrumDirection = Up | Down deriving (Eq, Ord, Show, Enum)++nextDirection :: StrumDirection -> StrumDirection+nextDirection Up   = Down+nextDirection Down = Up++-- 21212++strumRhythm+  :: StrumDirection -- ^ Initial direction+  -> [Duration]     -- ^ Duration pattern (repeated if necessary)+  -> [[Score a]]    -- ^ Sequence of chords to strum+  -> Score a+strumRhythm startDirection durations' values = scat chords+  where+    directions = iterate nextDirection startDirection+    durations = cycle durations'+    chords = zipWith3 (\dir dur chord -> case dir of+      Up   -> strumUp (stretch dur chord)+      Down -> strumDown (stretch dur chord)+      ) directions durations values+    +    +strum x = strumRhythm Up (map (/8) [2,1,2,1,2])+  [x,dropLast 1 x,level _p $ drop 1 x,level _p $ dropLast 1 x, level _p $ drop 1 x]+  where+    dropLast n = reverse . drop n . reverse++ counterRh = set parts' rh $ (mcatMaybes $ times 4 $ octavesUp 1 $ scat [rest^*2,g,g,g^*2,g^*2, rest^*2, scat [g,g,g]^*2])^/8 -strings = set parts' (tutti violin) $ octavesAbove 1 $ +strings = set parts' (tutti violin) $ octavesAbove 1 $       (c_<>e_<>g_)^*4    |> (c_<>fs_<>a_)^*4   |> (g__<>c_<>e_)^*4    |> (c_<>f_<>g_)^*4 -melody = octavesDown 1 $ set parts' (tutti horn) $ +melody = octavesDown 1 $ set parts' (tutti horn) $    (scat [c',g'^*2,e',d',c'^*2,b,c'^*2,d'^*2,e',d',c'^*2]^/4)   |>   (scat [c',a'^*2,e',d',c'^*2,b,c'^*2,d'^*2,eb',d',c']^/4)    -music = asScore  $ -  (<> melody) $-  (<> level _p strings) $-  (<> level ff counterRh) $-  -  set parts' (solo clarinet) $ level mf $ -  (pcat $ take 4 $ zipWith delay [0,1..10] $ repeat $ strum [c_,e_,g_,c,e,g])+music = scat [music1, music2]+music1 = asScore $ mempty+  -- <> (level mf $ set parts' guitar $ melody)+  -- <> level _p strings+  <> level mp counterRh+  <> gtr+music2 = asScore $ mempty+  <> (level mf $ melody)+  <> level _p strings+  <> level _p counterRh+  <> gtr++gtr = set parts' guitar $+  (pcat $ take 4 $ zipWith delay [0,1..10] $ repeat $ strum [c_,e_,g_,c,e,g])   |>-  (pcat $ take 4 $ zipWith delay [0,1..10] $ repeat $ strum [c_,fs_,a_,c,fs,a])+  (pcat $ take 4 $ zipWith delay [0,1..10] $ repeat $ strum [c_,fs_,a_,c,fs,a])   |>-  (pcat $ take 4 $ zipWith delay [0,1..10] $ repeat $ strum [c_,e_,g_,c,e,g])+  (pcat $ take 4 $ zipWith delay [0,1..10] $ repeat $ strum [c_,e_,g_,c,e,g])   |>-  (pcat $ take 4 $ zipWith delay [0,1..10] $ repeat $ strum [g_,a_,c,f,a,c'])+  (pcat $ take 4 $ zipWith delay [0,1..10] $ repeat $ strum [g_,a_,c,f,a,c'])   --openAudacity :: Score Note -> IO ()    -openAudacity x = do-    void $ writeMidi "test.mid" $ x-    void $ system "timidity -Ow test.mid"-    void $ system "open -a Audacity test.wav"

@@ -18,7 +18,7 @@     -- playMidiIO "Graphic MIDI" $ music^/10  toLydian :: Score BasicNote -> Score BasicNote-toLydian = pitches' %~ (\p -> if ((p::Behavior BasicPitch) ! 0) == ((c::Behavior BasicPitch) ! 0) then cs else p)+toLydian = pitches' %~ (\p -> if ((p::Behavior Pitch) ! 0) == ((c::Behavior Pitch) ! 0) then cs else p) -- TODO cleanup  subj1 = (^/2) $

@@ -13,13 +13,14 @@     Inspired by the Abjad transcription -} + main :: IO () main = open music  ensemble :: [Part] ensemble = [solo tubularBells] <> (divide 2 (tutti violin)) <> [tutti viola] <> [tutti cello] <> [tutti doubleBass] -music :: Score Note+music :: Score StandardNote music = meta $ stretch (3/2) $ {-before 60-} (mempty <> bell <> delay 6 strings)     where         meta = id@@ -44,19 +45,19 @@ tintin' :: Interval -> Interval tintin' melInterval      | isNegative melInterval = error "tintin: Negative interval"-    | otherwise = last $ takeWhile (< melInterval) $ tintinNotes+    | otherwise = last $ takeWhile (< melInterval) $ tintinStandardNotes     where-        tintinNotes = concat $ iterate (fmap (+ _P8)) minorTriad+        tintinStandardNotes = concat $ iterate (fmap (+ _P8)) minorTriad         minorTriad = [_P1,m3,_P5]  -bell :: Score Note+bell :: Score StandardNote bell = let-    cue :: Score (Maybe Note)+    cue :: Score (Maybe StandardNote)     cue = stretchTo 1 (rest |> a)      in parts' .~ (ensemble !! 0) $ text "l.v." $ mcatMaybes $ times 40 $ scat [times 3 $ scat [cue,rest], rest^*2] -strings :: Score Note+strings :: Score StandardNote strings = strings_vln1 <> strings_vln2 <> strings_vla <> strings_vc <> strings_db  strings_vln1 = clef GClef $ parts' .~ (ensemble !! 1) $ up (_P8^*1)   $ strings_cue@@ -66,13 +67,13 @@ strings_db   = clef FClef $ parts' .~ (ensemble !! 5) $ down (_P8^*3) $ stretch 16 strings_cue strings_cue = delay (1/2) $ withTintin (down (_P8^*4) $ asPitch a) $ mainSubject -fallingScale :: [Score Note]+fallingScale :: [Score StandardNote] fallingScale = [a',g'..a_] -fallingScaleSect :: Int -> [Score Note]+fallingScaleSect :: Int -> [Score StandardNote] fallingScaleSect n = {-fmap (annotate (show n)) $-} take n $ fallingScale -mainSubject :: Score Note+mainSubject :: Score StandardNote mainSubject = stretch (1/6) $ asScore $ scat $ mapEvensOdds (accent . (^*2)) id $ concatMap fallingScaleSect [1..30]  @@ -99,19 +100,19 @@     in take (length xs) $ map f evens `merge` map g odds  -openAudacity :: Score Note -> IO ()    +openAudacity :: Score StandardNote -> IO ()     openAudacity x = do     void $ writeMidi "test.mid" $ x     void $ system "timidity -Ow test.mid"     void $ system "open -a Audacity test.wav" -openAudio :: Score Note -> IO ()    +openAudio :: Score StandardNote -> IO ()     openAudio x = do     -- void $ writeMidi "test.mid" $ x     void $ system "timidity -Ow test.mid"     void $ system "open -a Audacity test.wav" -fixClefs :: Score Note -> Score Note+fixClefs :: Score StandardNote -> Score StandardNote fixClefs = id -- fixClefs = pcat . fmap (uncurry g) . extractParts' --     where@@ -123,7 +124,7 @@ concurrentlyWith :: (a -> b -> c) -> IO a -> IO b -> IO c concurrentlyWith f x y = uncurry f <$> x `concurrently` y -play, open, openAndPlay :: Score Note -> IO ()   +play, open, openAndPlay :: Score StandardNote -> IO ()    tempo_ = 120 play x = openAudio $ stretch ((60*4)/tempo_) $ fixClefs $ x open x = openLilypond' LyScoreFormat $ fixClefs $ x

@@ -8,7 +8,7 @@ {-   Basic Scheme bindings -  For examples, see test1.scm (TODO write more)+  See Scheme files in example directory    Requires husk-scheme to be in your path     http://hackage.haskell.org/package/husk-scheme@@ -20,13 +20,15 @@ import qualified Data.Map                  as Map import           Data.Maybe import           Data.Traversable+import           Data.Colour (Colour(..)) import           Language.Scheme.Core import           Language.Scheme.Parser import           Language.Scheme.Types import           Language.Scheme.Variables import           Music.Prelude import qualified Music.Score               as Score-import           System.IO.Unsafe+import qualified System.Environment+import qualified System.IO.Unsafe -- import qualified Data.List -- import System.Random @@ -36,7 +38,7 @@   (.-.) = (-)   (.+^) = (+) -lispApi = [+musicSuiteApi = [   ("c", toLisp (c :: LispScore)),   ("d", toLisp (d :: LispScore)),   ("e", toLisp (e :: LispScore)),@@ -45,13 +47,13 @@   ("a", toLisp (a :: LispScore)),   ("b", toLisp (b :: LispScore)), -  ("c#", toLisp (cs :: LispScore)),-  ("d#", toLisp (ds :: LispScore)),-  ("e#", toLisp (es :: LispScore)),-  ("f#", toLisp (fs :: LispScore)),-  ("g#", toLisp (gs :: LispScore)),-  ("a#", toLisp (as :: LispScore)),-  ("b#", toLisp (bs :: LispScore)),+  ("cs", toLisp (cs :: LispScore)),+  ("ds", toLisp (ds :: LispScore)),+  ("es", toLisp (es :: LispScore)),+  ("fs", toLisp (fs :: LispScore)),+  ("gs", toLisp (gs :: LispScore)),+  ("as", toLisp (as :: LispScore)),+  ("bs", toLisp (bs :: LispScore)),    ("cb", toLisp (cb :: LispScore)),   ("db", toLisp (db :: LispScore)),@@ -61,9 +63,20 @@   ("ab", toLisp (ab :: LispScore)),   ("bb", toLisp (bb :: LispScore)), +  -- TODO does not work well with Integer+  -- ("red",   toLisp ("red" :: String)),+  -- ("blue",  toLisp ("blue" :: String)),+  -- ("black", toLisp ("black" :: String)),+  -- ("color", CustFunc $ lift2 ((\x -> case x of { "red" -> colorRed ; "black" -> colorBlack }) :: String -> LispScore -> LispScore)),++  -- TODO does not work well with Integer+  -- ("accent", CustFunc $ lift1 (accent :: LispScore -> LispScore)),++   ("m3", toLisp (m3 :: Integer)),   ("M3", toLisp (_M3 :: Integer)),   ("up",       CustFunc $ lift2 (up   :: Integer -> LispScore -> LispScore)),+  ("down",     CustFunc $ lift2 (up   :: Integer -> LispScore -> LispScore)),    -- ("ff", toLisp (fff :: Sum Double)),   -- ("level",    CustFunc $ lift2 (up   :: Sum Double -> LispScore -> LispScore)),@@ -88,18 +101,29 @@   -main = do+main = do +  args <- System.Environment.getArgs+  files <- case args of+    [] -> do+      putStrLn "Usage: runhaskell scheme.hs file..."+      fail mempty+    xs -> return args   stdEnv <- r5rsEnv-  env <- extendEnv stdEnv (map (over _1 (varNamespace,)) $ lispApi)-  code <- readFile "examples/test1.scm"-  res <- evalLisp' env $ fromRight $ readExpr code+  env <- extendEnv stdEnv (map (over _1 (varNamespace,)) $ musicSuiteApi)+  code <- readFile (head files)+  -- TODO handle error here+  res <- evalLisp' env $ readExprErrorFail $ readExpr code   let sc = (\x -> x :: LispScore) $ fromJust $ fromRight $ fmap fromLisp $ res   -- printScore sc-  openLilypond $ fmap (\x -> PartT(mempty::Part,TieT(mempty,ArticulationT(mempty::(Sum Double,Sum Double),DynamicT(mempty::Sum Double,[x]))))) $ sc+  openLilypond $ fmap (\x -> PartT(mempty::Part,TieT(mempty,ArticulationT(mempty::Articulation,DynamicT(mempty::Sum Double,[x]))))) $ sc   return ()  printScore = mapM_ print . view notes+readExprErrorFail (Right x) = x+readExprErrorFail _         = error "Could not read scheme expression"+ fromRight (Right x) = x  +fromRight _         = error "Unknown error"   class HasLisp a where@@ -116,6 +140,11 @@     Bool x -> Just x     _      -> Nothing +instance HasLisp Char where+  _unlisp = prism' (Char) $ \x -> case x of+    Char x -> Just x+    _      -> Nothing+ instance HasLisp Int where   _unlisp = prism' (Number . toInteger) $ \x -> case x of     Number x -> Just (fromInteger x)@@ -209,7 +238,7 @@     toMap k v = Map.insert k v mempty            retR :: a -> IORef a-    retR = unsafePerformIO . newIORef+    retR = System.IO.Unsafe.unsafePerformIO . newIORef -}  

@@ -1,3 +1,6 @@++; Usage:+;   runhaskell examples/scheme.hs examples/test1.scm (let ((first-note-duration  5/3)        (second-note-duration 2)       (foo (lambda (x) x)))

@@ -0,0 +1,12 @@++; Usage:+;   runhaskell examples/scheme.hs examples/test2.scm+(let (+  (cell1 (compress 16 (scat c cs e)))+  (cell2 (compress 16 (scat fs f e)))+  )++  ; TODO variadic+  (define (seq i x y) (scat x (up i y)))++  (seq m3 (scat cell1 cell2) (scat cell2 cell1)))

@@ -6,11 +6,14 @@ main = open music  music = id+   $ title "Time signatures"-  $ fmap (over dynamics (! 0)) -  -- $ timeSignature (2/4)-  -- $ timeSignature (3/4)++  -- Try commenting out some of these lines   $ timeSignature (6/8)-  -- $ timeSignature ((4+3)/8)-  $ level (ff*stretch (2*14/8) sine)+  $ timeSignature (3/4)+  $ timeSignature (2/4)+  $ timeSignature ((4+3)/8)+  $ timeSignature ((3+4)/8)+     $ scat [c,c',b,bb,a,as,g^*2,scat [f,e,d,b_]^/2,d^*2,c^*2]^/8

@@ -18,7 +18,7 @@ vla         = tutti viola vc          = tutti cello -music :: Score Note+music :: Score StandardNote music = mainCanon2  tremCanon = compress 4 $@@ -30,12 +30,12 @@         <>     (delay 0 $ set parts' vc  $ subjs^*2)     where-        subjs = scat $ map (\n -> palindrome $ rev2 $ subj n) [1..40]+        subjs = scat $ map (\n -> palindrome $ rev2 $ subj n) [1..40::Int]         subj n              | n < 8     = a_^*2  |> e^*1   |> a^*1             | n < 16    = a_^*2  |> e^*1   |> a^*1   |> e^*1   |> a^*1             | n < 24    = a_^*2  |> e^*0.5 |> a^*0.5 |> e^*0.5 |> a^*0.5-            | otherwise = e^*0.5 |> a^*0.5+            | otherwise = e^*0.5 |> a^*0.5      mainCanon2 = palindrome mainCanon <> celloEntry @@ -55,7 +55,7 @@          <>      set parts' vc a'^*(25*5/8)-+                                        @@ -94,20 +94,20 @@     in take (length xs) $ map f evens `merge` map g odds  -openAudacity :: Score Note -> IO ()    +openAudacity :: Score StandardNote -> IO ()     openAudacity x = do     void $ writeMidi "test.mid" $ x     void $ system "timidity -Ow test.mid"     void $ system "open -a Audacity test.wav" -openAudio :: Score Note -> IO ()    +openAudio :: Score StandardNote -> IO ()     openAudio x = do     void $ writeMidi "test.mid" $ x     void $ system "timidity -Ow test.mid"     void $ system "open -a Audacity test.wav" -fixClefs :: Score Note -> Score Note-fixClefs = pcat . fmap (uncurry g) . extractParts'+fixClefs :: Score StandardNote -> Score StandardNote+fixClefs = pcat . fmap (uncurry g) . extractPartsWithInfo     where         g p x = clef (case defaultClef p of { 0 -> GClef; 1 -> CClef; 2 -> FClef } ) x @@ -127,7 +127,7 @@ main :: IO () main = open music -play, open, openAndPlay :: Score Note -> IO ()   +play, open, openAndPlay :: Score StandardNote -> IO ()    tempo_ = 130 play x = openAudio $ stretch ((60*(8/3))/tempo_) $ fixClefs $ x open x = openLilypond' LyScoreFormat $ fixClefs $ x

@@ -1,6 +1,6 @@  name:                   music-preludes-version:                1.7.1+version:                1.7.2 author:                 Hans Hoglund maintainer:             Hans Hoglund license:                BSD3@@ -28,7 +28,7 @@ library     build-depends:      base                    >= 4 && < 5,                         aeson                   >= 0.7.0.6 && < 1,-                        lens                    >= 4.3 && < 4.4,+                        lens                    >= 4.3.3 && < 4.4,                         split,                         containers,                         vector-space            >= 0.8.7 && < 0.9,@@ -37,18 +37,20 @@                         filepath                >= 1.3  && < 2,                         temporary               >= 1.1  && < 2,                         optparse-applicative    >= 0.8  && < 1,+                        average                 >= 0.6  && < 1,                         semigroups              >= 0.13.0.1 && < 1,                         data-default,                         monadplus,                         reverse-apply,-                        lilypond                == 1.7.1,-                        musicxml2               == 1.7.1,-                        music-score             == 1.7.1,-                        music-pitch             == 1.7.1,-                        music-dynamics          == 1.7.1,-                        music-parts             == 1.7.1,-                        music-pitch-literal     == 1.7.1,-                        music-dynamics-literal  == 1.7.1,+                        lilypond                == 1.7.2,+                        musicxml2               == 1.7.2,+                        music-score             == 1.7.2,+                        music-pitch             == 1.7.2,+                        music-dynamics          == 1.7.2,+                        music-articulation      == 1.7.2,+                        music-parts             == 1.7.2,+                        music-pitch-literal     == 1.7.2,+                        music-dynamics-literal  == 1.7.2,                         -- For examples:                         async     if !os(windows)

@@ -18,14 +18,15 @@ -------------------------------------------------------------------------------------  module Music.Prelude.Basic (-        module Music.Score,         module Music.Pitch,         module Music.Dynamics,+        module Music.Articulation,         module Music.Parts,+        module Music.Score,         module Control.Monad.Plus,         module Control.Lens.Operators,         BasicNote,-        BasicPitch,+        -- BasicPitch,         asScore,         asVoice,         asTrack,@@ -38,18 +39,15 @@ import           Data.Default import           Data.Typeable +import           Music.Pitch             hiding (Fifths, Note)+import qualified Music.Pitch import           Music.Dynamics+import           Music.Articulation import           Music.Parts             hiding (Part)-import           Music.Pitch             hiding (Fifths, Note, Part,-                                          pitch)--- Need to export Pitch.Pitch for transf for now--import qualified Music.Pitch-import           Music.Score             hiding (Pitch, Interval)+import           Music.Score             hiding (Pitch, Dynamics, Articulation, Interval)  import           Control.Lens.Operators  hiding ((<.>), (<|), (|>)) import           Control.Monad.Plus-import Data.Semigroup (Product)  import           Music.Prelude.Instances () @@ -71,11 +69,13 @@       (SlideT         (TremoloT           (HarmonicT-            (ArticulationT (Sum Double, Sum Double)-              (DynamicT (Sum Double)-                [Behavior BasicPitch]))))))))+            (ArticulationT Articulation+              (DynamicT Dynamics+                [Behavior Pitch])))))))) -type BasicPitch = Music.Pitch.Pitch+-- type BasicDynamics     = Music.Dynamics.Dynamics+-- type BasicArticulation = Music.Articulation.Articulation+-- type BasicPitch        = Music.Pitch.Pitch  open          = openLilypond . asScore play          = error "Not implemented: play"

@@ -1,6 +1,21 @@  {-# LANGUAGE CPP #-} +------------------------------------------------------------------------------------+-- |+-- Copyright   : (c) Hans Hoglund 2012+--+-- License     : BSD-style+--+-- Maintainer  : hans@hanshoglund.se+-- Stability   : experimental+-- Portability : non-portable (TF,GNTD)+--+-- Provides framework for building simple command-line converter programs such as+-- @music2midi@, @music2pdf@ etc.+--+-------------------------------------------------------------------------------------+ module Music.Prelude.CmdLine (         converterMain,         lilypondConverterMain,@@ -16,7 +31,9 @@ import           Data.Version          (showVersion) import           Data.Monoid import           Options.Applicative-import           Paths_music_preludes  (version)+#ifndef GHCI+import qualified Paths_music_preludes as Paths+#endif import           Data.Char import           Data.List          (intercalate, isPrefixOf) import           Data.List.Split@@ -24,7 +41,6 @@ import qualified Data.Map           as Map import           Data.Maybe import           Prelude            hiding (readFile, writeFile)--- import           System.Console.GetOpt import           System.Environment import           System.Exit import           System.FilePath@@ -38,10 +54,18 @@ import qualified Music.Prelude.Basic    as PreludeBasic import qualified Music.Prelude.Standard as PreludeStandard --- Note that Paths_music_preludes must be in other-modules for executables--- See haskell/cabal#1759+-- | Current Music Suite version.+#ifndef GHCI+version = Paths.version+#else+version = undefined+#endif++-- | Current Music Suite version as a string. versionString :: String versionString = showVersion version+-- Note that Paths_music_preludes must be in other-modules for executables+-- See haskell/cabal#1759   data ConverterOptions = ConverterOptions {@@ -56,9 +80,13 @@   (optional $ strOption $ mconcat [short 'o', long "output", metavar "<file>"])   (argument str $ metavar "<input>") --- A basic converter program--- Used for music2ly, music2musicxml et al-converterMain :: String -> String -> IO ()+-- | +-- Generates a basic converter program such as @music2ly@, @music2musicxml@ etc.+--+converterMain+  :: String   -- ^ Name of converter function.+  -> String   -- ^ Extension of generated file.+  -> IO () converterMain func ext = do    pgmName <- getProgName   options <- execParser (opts pgmName)@@ -84,9 +112,13 @@   (optional $ strOption $ mconcat [long "prelude", metavar "<name>"])   (argument str $ metavar "<input>") --- A converter program--- Used for music2ly, music2musicxml et al-lilypondConverterMain :: String -> IO ()+-- | +-- Generates a basic converter program that invokes @lilypond@ to generate+-- music notation. Used for @music2pdf@ etc.+--+lilypondConverterMain+  :: String -- ^ A file extension (supported by Lilypond).+  -> IO () lilypondConverterMain ext = do    pgmName <- getProgName   options <- execParser (opts pgmName)@@ -99,8 +131,9 @@       = translateFileAndRunLilypond ext prelude (Just inFile)  --+-- |+-- Translate an input file and invoke Lilypond on the resulting output file.+-- translateFileAndRunLilypond    :: String         -- ^ Output file suffix/format passed to Lilypond.   -> Maybe String   -- ^ Prelude to use.@@ -116,6 +149,9 @@   runCommand $ "rm -f " ++ takeBaseName inFile ++ "-*.tex " ++ takeBaseName inFile ++ "-*.texi " ++ takeBaseName inFile ++ "-*.count " ++ takeBaseName inFile ++ "-*.eps " ++ takeBaseName inFile ++ "-*.pdf " ++ takeBaseName inFile ++ ".eps"   return () +-- |+-- Translate an input file using the given paramters.+-- translateFile    :: String         -- ^ Translate function (of type @'FilePath' -> music -> 'IO' ()@).   -> String         -- ^ Output file suffix.@@ -124,17 +160,6 @@   -> Maybe FilePath -- ^ Output file.   -> IO () translateFile translationFunction outSuffix preludeName' inFile' outFile' = do-  let inFile      = fromMaybe "test.music" inFile'-  let preludeName = fromMaybe "basic" preludeName'-  let outFile     = fromMaybe (-                    takeDirectory inFile ++ "/" -                    ++ takeBaseName inFile -                    ++ "." ++ outSuffix) -                    outFile'--  let prelude   = "Music.Prelude." ++ toCamel preludeName-  let scoreType = "Score " ++ toCamel preludeName ++ "Note"-  let main      = translationFunction   code          <- readFile inFile   newScore      <- return $ if isNotExpression code      then expand declTempl (Map.fromList [@@ -163,8 +188,20 @@    return ()   where-    exprTempl = "module Main where { import $(prelude); main = $(main) \"$(outFile)\" ( $(score) :: $(scoreType) ) }"-    declTempl = "module Main where \nimport $(prelude) \n$(code) \nmain = $(main) \"$(outFile)\" ( example  :: $(scoreType) )"+    inFile      = fromMaybe "test.music" inFile'+    preludeName = fromMaybe "basic" preludeName'+    outFile     = fromMaybe (+                      takeDirectory inFile ++ "/" +                      ++ takeBaseName inFile +                      ++ "." ++ outSuffix) +                      outFile'++    prelude   = "Music.Prelude." ++ toCamel preludeName+    scoreType = "Score " ++ toCamel preludeName ++ "Note"+    main      = translationFunction++    exprTempl = "module Main where { import $(prelude); {-# LINE 1 \"" ++ inFile ++ "\" #-}\nmain = $(main) \"$(outFile)\" ( $(score) :: $(scoreType) ) }"+    declTempl = "module Main where \nimport $(prelude) {-# LINE 1 \"" ++ inFile ++ "\" #-}\n$(code) \nmain = $(main) \"$(outFile)\" ( example  :: $(scoreType) )"  -- TODO hackish, preferably parse using haskell-src-exts or similar isNotExpression :: String -> Bool

@@ -18,7 +18,7 @@ -- Stability   : experimental -- Portability : non-portable (TF,GNTD) ----- Provides orphan instances that does not fit into other packages.+-- Provides miscellaneous instances. -- ------------------------------------------------------------------------------------- @@ -69,6 +69,16 @@ instance (Transformable a, a ~ Score.Pitch a) => HasPitch Pitch a where   pitch = ($) instance (Transformable a, a ~ Score.Pitch a) => HasPitches Pitch a where+  pitches = ($)++instance Transformable Hertz where+  transform _ = id+type instance Score.Pitch Hertz = Hertz+type instance SetPitch a Hertz = a++instance (Transformable a, a ~ Score.Pitch a) => HasPitch Hertz a where+  pitch = ($)+instance (Transformable a, a ~ Score.Pitch a) => HasPitches Hertz a where   pitches = ($)  instance Tiable Pitch where

@@ -13,15 +13,16 @@ -- Stability   : experimental -- Portability : non-portable (TF,GNTD) ----- A basic music representation.+-- Standard music representation. -- -------------------------------------------------------------------------------------  module Music.Prelude.Standard (-        module Music.Score,         module Music.Pitch,         module Music.Dynamics,+        module Music.Articulation,         module Music.Parts,+        module Music.Score,         StandardNote,         asScore,         asVoice,@@ -35,11 +36,11 @@ import           Data.Default import           Data.Typeable +import           Music.Pitch import           Music.Dynamics+import           Music.Articulation import           Music.Parts-import           Music.Pitch-import           Music.Score             hiding (Fifths, Interval, Note, Part,-                                          Pitch, pitch)+import           Music.Score             hiding (Fifths, Interval, Note, Part, Pitch, Dynamics, Articulation)  import           Music.Prelude.Instances () @@ -69,14 +70,10 @@         (TremoloT           (HarmonicT             (SlideT-              (ArticulationT (Sum Double, Sum Double)-                (DynamicT (Average Double)+              (ArticulationT Articulation+                (DynamicT Dynamics                   [TieT-                    (Behavior StandardPitch)]))))))))--type StandardPitch = Music.Pitch.Pitch--- data StandardPitch = StandardPitch Music.Pitch.Pitch-    -- deriving (HasMidi, HasLilypond, HasMusicXml, HasPitch)+                    (Behavior Pitch)]))))))))   open          = openLilypond . asScore