diff --git a/COPYING b/COPYING --- a/COPYING +++ b/COPYING @@ -9,14 +9,14 @@ * 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 nor the + * Neither the name of the Music Suite 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 BE LIABLE FOR ANY +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS 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 diff --git a/examples/complex.hs b/examples/complex.hs deleted file mode 100644 --- a/examples/complex.hs +++ /dev/null @@ -1,34 +0,0 @@ - -module Main where - -import Prelude -import System.Process (runCommand) -import Music.Prelude.StringQuartet - -main = do - -- writeMidi "test.mid" score - -- writeXml "test.xml" $ score^/4 - -- openXml score - openLy score - -- playMidiIO "Graphic MIDI" $ score^/10 - - --- infixr 7 // --- (//) = flip times - -score :: Score Note -score = test 1 test 2 - -test 1 = group 5 c |> c^*3 -test 2 = group 3 c |> c^*3 -test 3 = group 3 c |> group 5 c |> group 3 c |> group 7 c -test 4 = group 3 c |> group 5 c |> c |> group 7 c -test 5 = c |> group 5 c |> c |> group 7 c --- all above ok - - -test 8 = times 5 c^/5 |> times 3 c^/3 -- ok -test 9 = times 4 c^/5 |> c^*(1/5+1/3) -- not ok, needs to be bound from last quintuplet note - -test 99 = group 5 c |> group 3 c |> c^*2 - diff --git a/examples/duo.hs b/examples/duo.hs deleted file mode 100644 --- a/examples/duo.hs +++ /dev/null @@ -1,44 +0,0 @@ - -module Main where - -import System.Process (runCommand) -import Music.Prelude.StringQuartet - -main = do - -- writeMidi "test.mid" score - -- writeXml "test.xml" $ score^/4 - -- openXml score - openLy score - -- playMidiIO "Graphic MIDI" $ score^/10 - -score = piece - -subj1 = ((_p `cresc` mf |> mf `dim` _p)^*(duration subj1' - 2)) `dynamics` subj1' - -subj1' :: Score Note -subj1' = (^/2) $ - legato (b_ |> c) |> legato (c |> b_^*2) - |> legato (b_ |> c |> d) - |> b_ |> c |> b_^*2 - |> legato (e |> d |> b_ |> c) |> b_^*2 - |> d |> e |> b_ |> c^*2 |> b_ - -piece = part1 |> toLydian part2 - where - part1 = pres1 |> pres2 |> pres3 |> pres4 |> pres5 |> pres6 - part2 = pres1 |> pres2 |> pres3 |> pres4 |> pres5 |> pres6 - -pres1 = delay 0 (subj1^*(2/2)) -pres2 = delay 0 (subj1^*(2/2)) delay 2 (subj1^*(3/2)) -pres3 = delay 0 (subj1^*(2/2)) delay 2 (subj1^*(3/2)) -pres4 = delay 0 (subj1^*(2/3)) delay 2 (subj1^*(3/2)) -pres5 = delay 0 (subj1^*(2/3)) delay 4 (subj1^*(2/2)) -pres6 = delay 0 (subj1^*(2/3)) delay 4 (subj1^*(2/2)) - - -toLydian = modifyPitches (\p -> if p == c then cs else p) - --- (|>) :: Score a -> Score a -> Score a --- a |> b = mcatMaybes $ fmap Just a ||> fmap Just b - - diff --git a/examples/triplets.hs b/examples/triplets.hs deleted file mode 100644 --- a/examples/triplets.hs +++ /dev/null @@ -1,41 +0,0 @@ - -{-# LANGUAGE TypeFamilies #-} - -import System.Process (runCommand) -import Music.Prelude.Basic -import Music.Pitch -- DEBUG -import qualified Music.Lilypond as Lilypond -- DEBUG -import qualified Music.Score as Score - -main = do - -- writeMidi "test.mid" score - -- writeXml "test.xml" $ score^/4 - -- openXml score - openLy score - -- playMidiIO "Graphic MIDI" $ score^/10 - -subject = legato $ accent $ scat [c,cs^*2,d,db] - -score :: Score Note -score = - (times 5 $ up _P5 $ subject ^*(2/3 * 1/4)) - - (times 5 $ up _M3 $ subject ^*(1/4)) - - (times 5 $ up _P1 $ subject ^*(2/3 * 1/2)) - - (times 5 $ down _P4 $ subject ^*(1/2)) - - --- TODO - -instance HasPitch Pitch where { type Pitch Pitch = Pitch ; getPitch = id; modifyPitch = id } - -instance Tiable Pitch where { beginTie = id ; endTie = id } -instance HasLilypond Pitch where - getLilypond d p = Lilypond.note (Lilypond.NotePitch (Lilypond.Pitch (pc,acc,oct+5)) Nothing) ^*(fromDurationT $ d*4) - where - pc = toEnum $ fromEnum $ name p - acc = fromIntegral $ accidental p - oct = fromIntegral $ octaves (p .-. c) - diff --git a/music-preludes.cabal b/music-preludes.cabal --- a/music-preludes.cabal +++ b/music-preludes.cabal @@ -1,6 +1,6 @@ name: music-preludes -version: 1.3.1 +version: 1.6 cabal-version: >= 1.10 author: Hans Hoglund maintainer: Hans Hoglund @@ -14,102 +14,40 @@ description: Some useful preludes for the Music Suite. - This library is part of the Music Suite, see . + This library is part of the Music Suite, see . source-repository head type: git - location: git://github.com/hanshoglund/music-preludes.git + location: git://github.com/music-suite/music-preludes.git library build-depends: - base >= 4 && < 5, + base >= 4 && < 5, + lens, vector-space, - musicxml2, + vector-space-points, + lilypond == 1.6, + musicxml2 == 1.6, process, semigroups, + data-default, monadplus, reverse-apply, - music-score, - music-pitch, - music-pitch-literal, - music-dynamics, - music-dynamics-literal - + music-score == 1.6, + music-pitch == 1.6, + music-dynamics == 1.6, + music-parts == 1.6, + music-pitch-literal == 1.6, + music-dynamics-literal == 1.6 hs-source-dirs: src default-language: Haskell2010 exposed-modules: Music.Prelude.Basic + Music.Prelude.Standard Music.Prelude.Piano Music.Prelude.StringQuartet - -executable "complex" - build-depends: - base >= 4 && < 5, - process, - lilypond, - musicxml2, - music-pitch, - music-score, - music-preludes - hs-source-dirs: src examples - default-language: Haskell2010 - main-is: complex.hs - -executable "duo" - build-depends: - base >= 4 && < 5, - process, - lilypond, - musicxml2, - music-pitch, - music-score, - music-preludes - hs-source-dirs: src examples - default-language: Haskell2010 - main-is: duo.hs - --- executable "erlkonig" --- build-depends: --- base >= 4 && < 5, --- process, --- lilypond, --- musicxml2, --- music-pitch, --- music-score, --- music-preludes --- hs-source-dirs: src examples --- default-language: Haskell2010 --- main-is: erlkonig.hs - -executable "triplets" - build-depends: - base >= 4 && < 5, - process, - lilypond, - musicxml2, - music-pitch, - music-score, - music-preludes - hs-source-dirs: src examples - default-language: Haskell2010 - main-is: triplets.hs - + Music.Prelude.Instances --- executable "music2ly" --- hs-source-dirs: src examples --- default-language: Haskell2010 --- main-is: music2ly.hs --- --- executable "music2midi" --- hs-source-dirs: src examples --- default-language: Haskell2010 --- main-is: music2midi.hs --- --- executable "music2musicxml" --- hs-source-dirs: src examples --- default-language: Haskell2010 --- main-is: music2musicxml.hs --- -- test-suite properties -- type: exitcode-stdio-1.0 -- main-is: properties.hs diff --git a/src/Music/Prelude/Basic.hs b/src/Music/Prelude/Basic.hs --- a/src/Music/Prelude/Basic.hs +++ b/src/Music/Prelude/Basic.hs @@ -1,34 +1,83 @@ -{-# LANGUAGE - GeneralizedNewtypeDeriving, - DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------------------------------------------------ +-- | +-- Copyright : (c) Hans Hoglund 2012 +-- +-- License : BSD-style +-- +-- Maintainer : hans@hanshoglund.se +-- Stability : experimental +-- Portability : non-portable (TF,GNTD) +-- +-- A basic music representation. +-- +------------------------------------------------------------------------------------- + module Music.Prelude.Basic ( module Music.Score, - BasicPart, - Note, - asScore + module Music.Pitch, + module Music.Dynamics, + module Music.Parts, + module Control.Monad.Plus, + module Control.Lens.Operators, + BasicNote, + BasicPitch, + asScore, + asVoice, + asTrack, + asBasicNote, + open, + play, + openAndPlay ) where -import Music.Score hiding (Pitch) -import Music.Pitch -import Data.Typeable +import Data.Default +import Data.Typeable -asScore :: Score Note -> Score Note +import Music.Dynamics +import Music.Parts hiding (Part) +import Music.Pitch hiding (Fifths, Interval, Note, Part, + pitch) +-- Need to export Pitch.Pitch for transf for now + +import qualified Music.Pitch +import Music.Score hiding (Pitch) + +import Control.Monad.Plus +import Control.Lens.Operators hiding ((|>), (<|), (<.>)) + +import Music.Prelude.Instances () + +asBasicNote :: BasicNote -> BasicNote +asBasicNote = id + +asScore :: Score BasicNote -> Score BasicNote asScore = id -asVoice :: Voice Note -> Voice Note +asVoice :: Voice BasicNote -> Voice BasicNote asVoice = id -asTrack :: Track Note -> Track Note +asTrack :: Track BasicNote -> Track BasicNote asTrack = id -newtype BasicPart = BasicPart { getBasicPart :: Integer } - deriving (Eq, Ord, Enum, Typeable) +type BasicNote = (PartT BasicPart + (TremoloT + (TextT + (ArticulationT + (HarmonicT + (TieT + (SlideT + (DynamicT + (ChordT + BasicPitch))))))))) -instance Show BasicPart where - show _ = "" +type BasicPitch = Music.Pitch.Pitch -type Note = (PartT BasicPart (TieT - (TremoloT (HarmonicT (SlideT - (DynamicT (ArticulationT (TextT {-Integer-}Pitch)))))))) +open = openLilypond . asScore +play = playMidiIO mempty . asScore +openAndPlay x = open x >> play x + diff --git a/src/Music/Prelude/Instances.hs b/src/Music/Prelude/Instances.hs new file mode 100644 --- /dev/null +++ b/src/Music/Prelude/Instances.hs @@ -0,0 +1,179 @@ + +{-# LANGUAGE + GeneralizedNewtypeDeriving, + StandaloneDeriving, + MultiParamTypeClasses, + DeriveDataTypeable, + TypeFamilies, + FlexibleInstances, + UndecidableInstances, + ViewPatterns #-} + +------------------------------------------------------------------------------------ +-- | +-- Copyright : (c) Hans Hoglund 2012 +-- +-- License : BSD-style +-- +-- Maintainer : hans@hanshoglund.se +-- Stability : experimental +-- Portability : non-portable (TF,GNTD) +-- +-- A basic music representation. +-- +------------------------------------------------------------------------------------- + +module Music.Prelude.Instances () where + +import Data.Default +import Data.Typeable +import Data.AffineSpace.Point + +import Music.Pitch +import Music.Dynamics +import Music.Parts +import Music.Score hiding (Pitch, Interval, Fifths, Note) + +import qualified Music.Score as Score +import qualified Music.Lilypond as Lilypond +import qualified Music.MusicXml.Simple as Xml + +deriving instance Typeable Music.Parts.Part + +type instance Music.Score.Part BasicPart = BasicPart +instance HasPart BasicPart where + getPart = id + modifyPart = id + +-- FIXME +instance Delayable Pitch +instance Stretchable Pitch +type instance Score.Pitch Pitch = Pitch + +instance HasGetPitch Pitch where + __getPitch = id +instance (a ~ Score.Pitch a) => HasSetPitch Pitch a where + type SetPitch a Pitch = a + __mapPitch = id +instance Tiable Pitch where + beginTie = id + endTie = id + +instance HasMidi Semitones where + getMidi a = getMidi $ (60 + fromIntegral a :: Integer) + +instance HasMidi Pitch where + getMidi p = getMidi $ semitones (p .-. c) + +instance HasMusicXml Pitch where + getMusicXml (realToFrac -> d) = (`Xml.note` d) . snd3 Just . spellPitch + getMusicXmlChord (realToFrac -> d) = (`Xml.chord` (realToFrac d)) . fmap (snd3 Just . spellPitch) + +instance HasLilypond Pitch where + getLilypond d = (^*realToFrac (d*4)) . Lilypond.note . pitchLilypond . Lilypond.Pitch . spellPitch . (.+^ perfect octave) + getLilypondChord d = (^*realToFrac (d*4)) . Lilypond.chord . fmap (pitchLilypond . Lilypond.Pitch . spellPitch . (.+^ perfect octave)) + +-- TODO move +snd3 f (a, b, c) = (a, f b, c) +pitchLilypond a = Lilypond.NotePitch a Nothing + +spellPitch :: (Enum p, Num a, Num o) => Pitch -> (p, a, o) +spellPitch p = (pitchName, pitchAccidental, octave) + where + pitchName = toEnum $ fromEnum $ name p + pitchAccidental = fromIntegral $ accidental p + octave = fromIntegral $ (+ 4) $ octaves (p .-. c) + +instance Alterable a => Alterable (Score a) where + sharpen = fmap sharpen + flatten = fmap flatten + +instance Alterable a => Alterable (ChordT a) where + sharpen = fmap sharpen + flatten = fmap flatten + +instance Alterable a => Alterable (DynamicT a) where + sharpen = fmap sharpen + flatten = fmap flatten + +instance Alterable a => Alterable (SlideT a) where + sharpen = fmap sharpen + flatten = fmap flatten + +instance Alterable a => Alterable (TieT a) where + sharpen = fmap sharpen + flatten = fmap flatten + +instance Alterable a => Alterable (HarmonicT a) where + sharpen = fmap sharpen + flatten = fmap flatten + +instance Alterable a => Alterable (ArticulationT a) where + sharpen = fmap sharpen + flatten = fmap flatten + +instance Alterable a => Alterable (TextT a) where + sharpen = fmap sharpen + flatten = fmap flatten + +instance Alterable a => Alterable (TremoloT a) where + sharpen = fmap sharpen + flatten = fmap flatten + +instance Alterable a => Alterable (PartT n a) where + sharpen = fmap sharpen + flatten = fmap flatten + +instance Augmentable a => Augmentable (Score a) where + augment = fmap augment + diminish = fmap diminish + +instance Augmentable a => Augmentable (ChordT a) where + augment = fmap augment + diminish = fmap diminish + +instance Augmentable a => Augmentable (DynamicT a) where + augment = fmap augment + diminish = fmap diminish + +instance Augmentable a => Augmentable (SlideT a) where + augment = fmap augment + diminish = fmap diminish + +instance Augmentable a => Augmentable (TieT a) where + augment = fmap augment + diminish = fmap diminish + +instance Augmentable a => Augmentable (HarmonicT a) where + augment = fmap augment + diminish = fmap diminish + +instance Augmentable a => Augmentable (ArticulationT a) where + augment = fmap augment + diminish = fmap diminish + +instance Augmentable a => Augmentable (TextT a) where + augment = fmap augment + diminish = fmap diminish + +instance Augmentable a => Augmentable (TremoloT a) where + augment = fmap augment + diminish = fmap diminish + +instance Augmentable a => Augmentable (PartT n a) where + augment = fmap augment + diminish = fmap diminish + +instance HasMidiProgram BasicPart where + getMidiChannel _ = 0 + getMidiProgram _ = 0 + +instance HasMidiProgram Music.Parts.Part where + getMidiChannel = defaultMidiChannel + getMidiProgram = fixStrings . defaultMidiProgram + where + fixStrings x = case x of + 40 -> 48 + 41 -> 48 + 42 -> 48 + x -> x diff --git a/src/Music/Prelude/Piano.hs b/src/Music/Prelude/Piano.hs --- a/src/Music/Prelude/Piano.hs +++ b/src/Music/Prelude/Piano.hs @@ -3,6 +3,20 @@ GeneralizedNewtypeDeriving, DeriveDataTypeable #-} +------------------------------------------------------------------------------------ +-- | +-- Copyright : (c) Hans Hoglund 2012 +-- +-- License : BSD-style +-- +-- Maintainer : hans@hanshoglund.se +-- Stability : experimental +-- Portability : non-portable (TF,GNTD) +-- +-- A basic music representation for piano. +-- +------------------------------------------------------------------------------------- + module Music.Prelude.Piano ( module Music.Score, PianoPart, @@ -10,8 +24,14 @@ asScore ) where -import Music.Score +import Music.Pitch +import Music.Score hiding (Pitch, Interval, Note) +import Music.Dynamics.Literal --TODO import Data.Typeable +import Data.AffineSpace.Point +import qualified Music.Score as Score +import qualified Music.Lilypond as Lilypond +import qualified Music.MusicXml.Simple as Xml asScore :: Score Note -> Score Note asScore = id diff --git a/src/Music/Prelude/Standard.hs b/src/Music/Prelude/Standard.hs new file mode 100644 --- /dev/null +++ b/src/Music/Prelude/Standard.hs @@ -0,0 +1,83 @@ + +{-# LANGUAGE + GeneralizedNewtypeDeriving, + DeriveDataTypeable, + TypeFamilies #-} + +------------------------------------------------------------------------------------ +-- | +-- Copyright : (c) Hans Hoglund 2012 +-- +-- License : BSD-style +-- +-- Maintainer : hans@hanshoglund.se +-- Stability : experimental +-- Portability : non-portable (TF,GNTD) +-- +-- A basic music representation. +-- +------------------------------------------------------------------------------------- + +module Music.Prelude.Standard ( + module Music.Score, + module Music.Pitch, + module Music.Dynamics, + module Music.Parts, + Note, + asScore, + asVoice, + asTrack, + asNote, + open, + play, + openAndPlay + ) where + +import Data.Default +import Data.Typeable + +import Music.Pitch +import Music.Dynamics +import Music.Parts +import Music.Score hiding (Pitch, Interval, Fifths, Note, Part, pitch) + +import Music.Prelude.Instances () + +asNote :: Note -> Note +asNote = id + +asScore :: Score Note -> Score Note +asScore = id + +asVoice :: Voice Note -> Voice Note +asVoice = id + +asTrack :: Track Note -> Track Note +asTrack = id + +-- newtype BasicPart = BasicPart { getBasicPart :: Integer } +-- deriving (Eq, Ord, Num, Integral, Real, Enum, Typeable) +-- +-- instance Default BasicPart where def = BasicPart 0 +-- instance Show BasicPart where +-- show _ = "" + +type Note = (PartT Part + (TremoloT + (TextT + (ArticulationT + (HarmonicT + (TieT + (SlideT + (DynamicT + (ChordT + StandardPitch))))))))) +type StandardPitch = Music.Pitch.Pitch +-- data StandardPitch = StandardPitch Music.Pitch.Pitch + -- deriving (HasMidi, HasLilypond, HasMusicXml, HasPitch) + + +open = openLilypond . asScore +play = playMidiIO mempty . asScore +openAndPlay x = open x >> play x + diff --git a/src/Music/Prelude/StringQuartet.hs b/src/Music/Prelude/StringQuartet.hs --- a/src/Music/Prelude/StringQuartet.hs +++ b/src/Music/Prelude/StringQuartet.hs @@ -3,6 +3,19 @@ GeneralizedNewtypeDeriving, DeriveDataTypeable #-} +------------------------------------------------------------------------------------ +-- | +-- Copyright : (c) Hans Hoglund 2012 +-- +-- License : BSD-style +-- +-- Maintainer : hans@hanshoglund.se +-- Stability : experimental +-- Portability : non-portable (TF,GNTD) +-- +-- A basic music representation for string quartet. +-- +------------------------------------------------------------------------------------- module Music.Prelude.StringQuartet ( module Music.Score, StringQuartetPart, @@ -10,8 +23,14 @@ asScore ) where -import Music.Score +import Music.Pitch +import Music.Score hiding (Pitch, Interval, Note) +import Music.Dynamics.Literal --TODO import Data.Typeable +import Data.AffineSpace.Point +import qualified Music.Score as Score +import qualified Music.Lilypond as Lilypond +import qualified Music.MusicXml.Simple as Xml asScore :: Score Note -> Score Note asScore = id