lilypond (empty) → 1.0
raw patch · 8 files changed
+1177/−0 lines, 8 filesdep +basedep +data-defaultdep +music-dynamics-literalsetup-changed
Dependencies added: base, data-default, music-dynamics-literal, music-pitch-literal, prettify, process, semigroups, vector-space
Files
- COPYING +26/−0
- Setup.lhs +4/−0
- lilypond.cabal +41/−0
- src/Music/Lilypond.hs +876/−0
- src/Music/Lilypond/Dynamics.hs +62/−0
- src/Music/Lilypond/IO.hs +25/−0
- src/Music/Lilypond/Pitch.hs +67/−0
- src/Music/Lilypond/Value.hs +76/−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
+ lilypond.cabal view
@@ -0,0 +1,41 @@++name: lilypond+version: 1.0+cabal-version: >= 1.10+author: Hans Hoglund+maintainer: Hans Hoglund <hans@hanshoglund.se>+license: BSD3+license-file: COPYING+synopsis: Bindings to Lilypond+category: Music+tested-with: GHC+build-type: Simple++description:+ This package contains a terse Haskell representation of (a subset of) Lilypond+ expressions and a pretty-printer for such expressions. They can be used to generate+ musical notation.++source-repository head+ type: git+ location: git://github.com/hanshoglund/lilypond.git+++library+ build-depends:+ base >= 4 && < 5,+ semigroups,+ prettify,+ vector-space,+ process,+ data-default,+ music-pitch-literal,+ music-dynamics-literal+ hs-source-dirs: src+ default-language: Haskell2010+ exposed-modules:+ Music.Lilypond+ Music.Lilypond.Pitch+ Music.Lilypond.Dynamics+ Music.Lilypond.Value+ Music.Lilypond.IO
+ src/Music/Lilypond.hs view
@@ -0,0 +1,876 @@++{-# LANGUAGE + OverloadedStrings, + GeneralizedNewtypeDeriving,+ StandaloneDeriving,+ TypeFamilies,+ ScopedTypeVariables, + ExistentialQuantification #-}++-------------------------------------------------------------------------------------+-- |+-- Copyright : (c) Hans Hoglund 2012+--+-- License : BSD-style+--+-- Maintainer : hans@hanshoglund.se+-- Stability : experimental+-- Portability : GHC+--+-------------------------------------------------------------------------------------+module Music.Lilypond (++ -- * Representation+ + -- ** Music expressions+ Music(..),+ Note(..),+ Clef(..),+ Mode(..),+ + -- ** Attributes+ Value,+ toValue,++ -- ** Articulation and dynamics+ PostEvent(..),++ -- ** Text+ Articulation(..),+ Markup(..),+ HasMarkup(..),++ -- ** Miscellaneous types+ Direction(..),+ OctaveCheck(..),+ BreathingSign(..),++ -- ** Time+ Duration(..),+ -- ** Pitch+ Pitch(..),+ PitchClass(..),+ Accidental(..),+ Octaves(..),++ -- * Constructing Lilypond expresions+ -- ** Notes and rests+ rest,+ note,+ chord,+ + -- ** Composition+ scat,+ pcat,+ + -- ** Post events+ addPost,+ addText,+ addMarkup,+ addDynamics,+ addArticulation,+ addText',+ addMarkup',+ addDynamics',+ addArticulation',++ -- ** Curves and lines+ beginTie,+ beginBeam,+ endBeam,+ beginSlur,+ endSlur,+ beginPhraseSlur,+ endPhraseSlur,+ beginCresc,+ endCresc,+ beginDim,+ endDim,++ -- ** Marks+ addAccent,+ addMarcato,+ addStaccatissimo,+ addEspressivo,+ addStaccato,+ addTenuto,+ addPortato,+ addUpbow,+ addDownbow,+ addFlageolet,+ addThumb,+ addLeftHeel,+ addRightHeel,+ addLeftToe,+ addRightToe,+ addOpen,+ addStopped,+ addTurn,+ addReverseTurn,+ addTrill,+ addPrall,+ addMordent,+ addPrallPrall,+ addPrallMordent,+ addUpPrall,+ addDownPrall,+ addUpMordent,+ addDownMordent,+ addPrallDown,+ addPrallUp,+ addLinePrall,+ addSignumCongruentiae,+ addShortFermata,+ addFermata,+ addLongFermata,+ addVeryLongFermata,+ addSegno,+ addCoda,+ addVarCoda,+ )+where++import Data.Ratio+import Data.String+import Data.Default+import Data.Semigroup+import Data.VectorSpace+import Text.Pretty hiding (Mode)+import Music.Pitch.Literal++-- import System.Process -- TODO debug++import Music.Lilypond.Pitch+import Music.Lilypond.Dynamics+import Music.Lilypond.Value+++{-+data Lilypond + = Book Id [BookBlock]+ | BookPart Id [BookPartBlock]+ | Score Id [ScoreBlock]++data BookBlock+ = Paper OutputDef+ | Bookpart Id [BookPartBlock]+ | Score Id [ScoreBlock]+ | Music CompositeMusic+ -- full markup etc++data BookPartBlock+ = BookPartPaper OutputDef+ | BookPartScore Id [ScoreBlock]+ | BookPartMusic CompositeMusic+ -- full markup etc+ +data ScoreBlock+ = ScoreMusic Music+ -- full markup etc+-}++-- | A Lilypond music expression.+-- +-- Use the 'Pretty' instance to convert into Lilypond syntax.+-- +data Music + = Rest (Maybe Duration) [PostEvent] -- ^ Single rest.+ | Note Note (Maybe Duration) [PostEvent] -- ^ Single note.+ | Chord [Note] (Maybe Duration) [PostEvent] -- ^ Single chord.+ | Sequential [Music] -- ^ Sequential composition.+ | Simultaneous Bool [Music] -- ^ Parallel composition (split voices?).+ | Repeat Bool Int Music (Maybe (Music, Music)) -- ^ Repetition (unfold?, times, music, alternative).+ | Tremolo Int Music -- ^ Tremolo (multiplier).+ | Times Rational Music -- ^ Stretch music (multiplier).+ | Transpose Pitch Pitch Music -- ^ Transpose music (from to).+ | Relative Pitch Music -- ^ Use relative octave (octave).+ | Clef Clef -- ^ Clef.+ | Key Pitch Mode -- ^ Key signature.+ | Time Rational -- ^ Time signature.+ | Breathe (Maybe BreathingSign) -- ^ Breath mark (caesura)+ | Tempo (Maybe String) (Maybe (Duration,Integer)) -- ^ Tempo mark.+ | New String (Maybe String) Music -- ^ New expression.+ | Context String (Maybe String) Music -- ^ Context expression.+ | Set String Value + deriving (Eq, Show)++instance Pretty Music where+ pretty (Rest d p) = "r" <> pretty d <> prettyList p++ pretty (Note n d p) = pretty n <> pretty d <> prettyList p++ pretty (Chord ns d p) = "<" <> nest 4 (sepByS "" $ map pretty ns) <> char '>' + <> pretty d <> prettyList p++ pretty (Sequential xs) = "{" <=> nest 4 ((hsep . fmap pretty) xs) <=> "}"++ pretty (Simultaneous False xs) = "<<" <//> nest 4 ((vcat . fmap pretty) xs) <//> ">>"+ pretty (Simultaneous True xs) = "<<" <//> nest 4 ((sepByS " \\\\" . fmap pretty) xs) <//> ">>"++ pretty (Repeat unfold times x alts) = + "\\repeat" <=> unf unfold <=> int times <=> pretty x <=> alt alts+ where + unf p = if p then "unfold" else "volta"+ alt Nothing = empty+ alt (Just (x,y)) = "\\alternative" <> pretty x <> pretty y++ pretty (Tremolo n x) =+ "\\repeat tremolo" <+> pretty n <=> pretty x++ pretty (Times n x) = + "\\times" <+> frac n <=> pretty x+ where+ frac n = pretty (numerator n) <> "/" <> pretty (denominator n)++ pretty (Transpose from to x) =+ "\\transpose" <+> pretty from <=> pretty to <=> pretty x++ pretty (Relative p x) =+ "\\relative" <=> pretty p <=> pretty x++ pretty (Clef c) = "\\clef" <+> pretty c++ pretty (Key p m) = "\\clef" <+> pretty p <+> pretty m+ + pretty (Time n) = "\\time" <+> pretty n+ + pretty (Breathe Nothing) = "\\breathe"+ pretty (Breathe a) = notImpl "Non-standard breath marks"++ pretty (Tempo Nothing Nothing) = mempty+ pretty (Tempo (Just t) Nothing) = "\\time" <+> pretty t+ pretty (Tempo Nothing (Just (d,bpm))) = "\\time" <+> pretty d <+> "=" <+> pretty bpm+ pretty (Tempo (Just t) (Just (d,bpm))) = "\\time" <+> pretty t <+> pretty d <+> "=" <+> pretty bpm++ -- TODO metronome+ -- TODO tempo ++ pretty (New typ name x) = + "\\new" <+> string typ <+> pretty name <+> pretty x++ pretty (Context typ name x) = + "\\context" <+> string typ <+> pretty name <+> pretty x++ pretty (Set name val) =+ "\\set" <+> string name <+> "=" <+> (string . show) val++ -- pretty _ = notImpl "Unknown music expression"++ prettyList = hsep . fmap pretty++instance IsPitch Music where+ fromPitch = (\p -> Note p (Just (1/4)) []) . fromPitch++instance AdditiveGroup Music where+ zeroV = Rest (Just $ 1/4) []+ a ^+^ b = Sequential [a,b]+ negateV = error "No Music.Lilypond.Music.negateV"++instance VectorSpace Music where+ type Scalar Music = Duration+ a *^ (Rest (Just d) p) = Rest (Just $ a*d) p+ a *^ (Note n (Just d) p) = Note n (Just $ a*d) p+ a *^ (Chord ns (Just d) p) = Chord ns (Just $ a*d) p+ a *^ x = x+++data Note+ = NotePitch Pitch (Maybe OctaveCheck)+ | DrumNotePitch (Maybe Duration)+ deriving (Eq, Show)++instance Pretty Note where+ pretty (NotePitch p Nothing) = pretty p+ pretty (NotePitch p _) = notImpl "Non-standard pitch"+ pretty (DrumNotePitch _) = notImpl "Non-standard pitch"+ prettyList = hsep . fmap pretty++instance IsPitch Note where+ fromPitch = (\p -> (NotePitch p Nothing)) . fromPitch++data Clef+ = Treble+ | Alto+ | Tenor+ | Bass+ | French+ | Soprano+ | MezzoSoprano+ | Baritone+ | VarBaritone+ | SubBass+ | Percussion+ | Tab+ deriving (Eq, Show)++instance Pretty Clef where+ pretty Treble = "treble"+ pretty Alto = "alto"+ pretty Tenor = "tenor"+ pretty Bass = "bass"+ pretty French = "french"+ pretty Soprano = "soprano"+ pretty MezzoSoprano = "mezzosoprano"+ pretty Baritone = "baritone"+ pretty VarBaritone = "varbaritone"+ pretty SubBass = "subbass"+ pretty Percussion = "percussion"+ pretty Tab = "tab"++data BreathingSign+ = RightVarComma+ | StraightCaesura+ | CurvedCaesura+ deriving (Eq, Show)++data PostEvent+ = Articulation Direction Articulation+ | Dynamics Direction Dynamics+ | Tie+ | BeginBeam+ | EndBeam+ | BeginSlur+ | EndSlur+ | BeginPhraseSlur+ | EndPhraseSlur+ | BeginCresc+ | BeginDim+ | EndCrescDim+ | Text Direction String+ | Markup Direction Markup+ deriving (Eq, Show)++instance Pretty PostEvent where + pretty (Articulation d a) = pretty d <> pretty a+ pretty (Dynamics d a) = pretty d <> pretty a+ pretty Tie = "~"+ pretty BeginBeam = "["+ pretty EndBeam = "]"+ pretty BeginSlur = "("+ pretty EndSlur = ")"+ pretty BeginPhraseSlur = "\\("+ pretty EndPhraseSlur = "\\)"+ pretty BeginCresc = "\\<"+ pretty BeginDim = "\\>"+ pretty EndCrescDim = "\\!"+ pretty (Text d s) = pretty d <> (string . show) s -- add quotes+ pretty (Markup d m) = pretty d <> ("\\markup" <+> pretty m)+ prettyList = hcat . fmap pretty++data Markup+ = MarkupText String+ | MarkupList [Markup]+ | Bold Markup+ | Box Markup+ | Caps Markup+ | DynamicsFont Markup+ | FingeringFont Markup+ | Fontsize Double Markup+ | Huge Markup+ | Italic Markup+ | Large Markup+ | Larger Markup+ | Magnify Markup+ | Medium Markup+ | Roman Markup+ | Sans Markup+ | Sub Markup+ | Super Markup+ | TextFont Markup+ | Tiny Markup+ | TypewriterFont Markup+ | Upright Markup+ deriving (Eq, Show)++class HasMarkup a where+ markup :: a -> Markup++instance HasMarkup Markup where+ markup = id+instance HasMarkup a => HasMarkup [a] where+ markup = MarkupList . fmap markup+instance IsString Markup where+ fromString = MarkupText+ +instance Pretty Markup where+ pretty (MarkupText s) = (string . show) s + pretty (MarkupList as) = "{" <+> hsep (fmap pretty as) <+> "}"+ pretty (Bold a) = "\\bold" <+> pretty a+ pretty (Box a) = "\\box" <+> pretty a+ pretty (Caps a) = "\\caps" <+> pretty a+ pretty (DynamicsFont a) = "\\dynamics" <+> pretty a+ pretty (FingeringFont a) = "\\fingering" <+> pretty a+ pretty (Fontsize n a) = "\\fontsize" <+> ("#" <> pretty n) <+> pretty a+ pretty (Huge a) = "\\huge" <+> pretty a+ pretty (Italic a) = "\\italic" <+> pretty a+ pretty (Large a) = "\\large" <+> pretty a+ pretty (Larger a) = "\\larger" <+> pretty a+ pretty (Magnify a) = "\\magnify" <+> pretty a+ pretty (Medium a) = "\\medium" <+> pretty a+ pretty (Roman a) = "\\roman" <+> pretty a+ pretty (Sans a) = "\\sans" <+> pretty a+ pretty (Sub a) = "\\sub" <+> pretty a+ pretty (Super a) = "\\super" <+> pretty a+ pretty (TextFont a) = "\\text" <+> pretty a+ pretty (Tiny a) = "\\tiny" <+> pretty a+ pretty (TypewriterFont a) = "\\typewriter" <+> pretty a+ pretty (Upright a) = "\\upright" <+> pretty a+++-- | Articulations. These include ornaments.+data Articulation+ = Accent+ | Marcato+ | Staccatissimo+ | Espressivo+ | Staccato+ | Tenuto+ | Portato+ | Upbow+ | Downbow+ | Flageolet+ | Thumb+ | LeftHeel+ | RightHeel+ | LeftToe+ | RightToe+ | Open+ | Stopped+ | Turn+ | ReverseTurn+ | Trill+ | Prall+ | Mordent+ | PrallPrall+ | PrallMordent+ | UpPrall+ | DownPrall+ | UpMordent+ | DownMordent+ | PrallDown+ | PrallUp+ | LinePrall+ | SignumCongruentiae+ | ShortFermata+ | Fermata+ | LongFermata+ | VeryLongFermata+ | Segno+ | Coda+ | VarCoda+ deriving (Eq, Show)++instance Pretty Articulation where + -- pretty Accent = "\\accent"+ -- pretty Marcato = "\\marcato"+ -- pretty Staccatissimo = "\\staccatissimo"+ pretty Accent = ">"+ pretty Marcato = "^"+ pretty Staccatissimo = "|"+ pretty Espressivo = "\\espressivo"+ -- pretty Staccato = "\\staccato"+ -- pretty Tenuto = "\\tenuto"+ -- pretty Portato = "\\portato"+ pretty Staccato = "."+ pretty Tenuto = "-"+ pretty Portato = "_"+ pretty Upbow = "\\upbow"+ pretty Downbow = "\\downbow"+ pretty Flageolet = "\\flageolet"+ pretty Thumb = "\\thumb"+ pretty LeftHeel = "\\leftheel"+ pretty RightHeel = "\\rightheel"+ pretty LeftToe = "\\lefttoe"+ pretty RightToe = "\\righttoe"+ pretty Open = "\\open"+ -- pretty Stopped = "\\stopped"+ pretty Stopped = "+"+ pretty Turn = "\\turn"+ pretty ReverseTurn = "\\reverseturn"+ pretty Trill = "\\trill"+ pretty Prall = "\\prall"+ pretty Mordent = "\\mordent"+ pretty PrallPrall = "\\prallprall"+ pretty PrallMordent = "\\prallmordent"+ pretty UpPrall = "\\upprall"+ pretty DownPrall = "\\downprall"+ pretty UpMordent = "\\upmordent"+ pretty DownMordent = "\\downmordent"+ pretty PrallDown = "\\pralldown"+ pretty PrallUp = "\\prallup"+ pretty LinePrall = "\\lineprall"+ pretty SignumCongruentiae = "\\signumCongruentiae"+ pretty ShortFermata = "\\shortfermata"+ pretty Fermata = "\\fermata"+ pretty LongFermata = "\\longfermata"+ pretty VeryLongFermata = "\\verylongfermata"+ pretty Segno = "\\segno"+ pretty Coda = "\\coda"+ pretty VarCoda = "\\varcoda"+ prettyList = hcat . fmap pretty++data Direction+ = Above+ | Default+ | Below+ deriving (Eq, Ord, Show)++instance Default Direction where+ def = Default+ +instance Pretty Direction where+ pretty Above = "^"+ pretty Default = "-"+ pretty Below = "_"+++-- | Notated time in fractions, in @[2^^i | i <- [-10..3]]@.+newtype Duration = Duration { getDuration :: Rational }++deriving instance Eq Duration+deriving instance Ord Duration+deriving instance Num Duration+deriving instance Enum Duration+deriving instance Fractional Duration+deriving instance Real Duration+deriving instance RealFrac Duration+deriving instance Show Duration++instance Pretty Duration where+ pretty a = string $ pnv (toRational nv) ++ pds ds+ where+ pnv 4 = "\\longa"+ pnv 2 = "\\breve"+ pnv n = show (denominator n) + pds n = concat $ replicate n "."+ (nv, ds) = separateDots a++-- | Construct a rest of default duration @1/4@.+-- +-- Use the 'VectorSpace' methods to change duration.+-- +rest :: Music+rest = Rest (Just $ 1/4) []++-- | Construct a note of default duration @1/4@.+-- +-- Use the 'VectorSpace' methods to change duration.+-- +note :: Note -> Music+note n = Note n (Just $ 1/4) []++-- | Construct a chord of default duration @1/4@.+-- +-- Use the 'VectorSpace' methods to change duration.+-- +chord :: [Note] -> Music+chord ns = Chord ns (Just $ 1/4) []+++scat :: Music -> Music -> Music+Sequential as `scat` Sequential bs = Sequential (as <> bs)+Sequential as `scat` b = Sequential (as <> [b])+a `scat` Sequential bs = Sequential ([a] <> bs)+a `scat` b = Sequential ([a,b])++pcat :: Music -> Music -> Music+Simultaneous s as `pcat` Simultaneous t bs = Simultaneous True (as <> bs)+Simultaneous s as `pcat` b = Simultaneous s (as <> [b])+a `pcat` Simultaneous t bs = Simultaneous t ([a] <> bs)+a `pcat` b = Simultaneous True ([a,b])++++addPost :: PostEvent -> Music -> Music+addPost a (Rest d es) = Rest d (es ++ [a])+addPost a (Note n d es) = Note n d (es ++ [a])+addPost a (Chord ns d es) = Chord ns d (es ++ [a])+addPost a m = m++addText :: String -> Music -> Music+addText s = addPost (Text def s)++addText' :: Direction -> String -> Music -> Music+addText' d s = addPost (Text d s)++addMarkup :: HasMarkup a => a -> Music -> Music+addMarkup s = addPost (Markup def (markup s))++addMarkup' :: HasMarkup a => Direction -> a -> Music -> Music+addMarkup' d s = addPost (Markup d (markup s))++addArticulation :: Articulation -> Music -> Music+addArticulation a = addPost (Articulation def a)++addArticulation' :: Direction -> Articulation -> Music -> Music+addArticulation' d a = addPost (Articulation d a)++addDynamics :: Dynamics -> Music -> Music+addDynamics a = addPost (Dynamics def a)++addDynamics' :: Direction -> Dynamics -> Music -> Music+addDynamics' d a = addPost (Dynamics d a)++beginTie :: Music -> Music+beginTie = addPost Tie++beginBeam :: Music -> Music+beginBeam = addPost BeginBeam++endBeam :: Music -> Music+endBeam = addPost EndBeam++beginSlur :: Music -> Music+beginSlur = addPost BeginSlur++endSlur :: Music -> Music+endSlur = addPost EndSlur++beginPhraseSlur :: Music -> Music+beginPhraseSlur = addPost BeginPhraseSlur++endPhraseSlur :: Music -> Music+endPhraseSlur = addPost EndPhraseSlur++beginCresc :: Music -> Music+beginCresc = addPost BeginCresc++endCresc :: Music -> Music+endCresc = addPost EndCrescDim++beginDim :: Music -> Music+beginDim = addPost BeginDim++endDim :: Music -> Music+endDim = addPost EndCrescDim+++addAccent :: Music -> Music+addAccent = addArticulation Accent++addMarcato :: Music -> Music+addMarcato = addArticulation Marcato++addStaccatissimo :: Music -> Music+addStaccatissimo = addArticulation Staccatissimo++addEspressivo :: Music -> Music+addEspressivo = addArticulation Espressivo++addStaccato :: Music -> Music+addStaccato = addArticulation Staccato++addTenuto :: Music -> Music+addTenuto = addArticulation Tenuto++addPortato :: Music -> Music+addPortato = addArticulation Portato++addUpbow :: Music -> Music+addUpbow = addArticulation Upbow++addDownbow :: Music -> Music+addDownbow = addArticulation Downbow++addFlageolet :: Music -> Music+addFlageolet = addArticulation Flageolet++addThumb :: Music -> Music+addThumb = addArticulation Thumb++addLeftHeel :: Music -> Music+addLeftHeel = addArticulation LeftHeel++addRightHeel :: Music -> Music+addRightHeel = addArticulation RightHeel++addLeftToe :: Music -> Music+addLeftToe = addArticulation LeftToe++addRightToe :: Music -> Music+addRightToe = addArticulation RightToe++addOpen :: Music -> Music+addOpen = addArticulation Open++addStopped :: Music -> Music+addStopped = addArticulation Stopped++addTurn :: Music -> Music+addTurn = addArticulation Turn++addReverseTurn :: Music -> Music+addReverseTurn = addArticulation ReverseTurn++addTrill :: Music -> Music+addTrill = addArticulation Trill++addPrall :: Music -> Music+addPrall = addArticulation Prall++addMordent :: Music -> Music+addMordent = addArticulation Mordent++addPrallPrall :: Music -> Music+addPrallPrall = addArticulation PrallPrall++addPrallMordent :: Music -> Music+addPrallMordent = addArticulation PrallMordent++addUpPrall :: Music -> Music+addUpPrall = addArticulation UpPrall++addDownPrall :: Music -> Music+addDownPrall = addArticulation DownPrall++addUpMordent :: Music -> Music+addUpMordent = addArticulation UpMordent++addDownMordent :: Music -> Music+addDownMordent = addArticulation DownMordent++addPrallDown :: Music -> Music+addPrallDown = addArticulation PrallDown++addPrallUp :: Music -> Music+addPrallUp = addArticulation PrallUp++addLinePrall :: Music -> Music+addLinePrall = addArticulation LinePrall++addSignumCongruentiae :: Music -> Music+addSignumCongruentiae = addArticulation SignumCongruentiae++addShortFermata :: Music -> Music+addShortFermata = addArticulation ShortFermata++addFermata :: Music -> Music+addFermata = addArticulation Fermata++addLongFermata :: Music -> Music+addLongFermata = addArticulation LongFermata++addVeryLongFermata :: Music -> Music+addVeryLongFermata = addArticulation VeryLongFermata++addSegno :: Music -> Music+addSegno = addArticulation Segno++addCoda :: Music -> Music+addCoda = addArticulation Coda++addVarCoda :: Music -> Music+addVarCoda = addArticulation VarCoda+++++++++++notImpl a = error $ "Not implemented: " ++ a+asPitch = id+asPitch :: Pitch -> Pitch++++++++++++separateDots :: Duration -> (Duration, Int)+separateDots = separateDots' [2/3, 6/7, 14/15, 30/31, 62/63]++separateDots' :: [Duration] -> Duration -> (Duration, Int)+separateDots' [] nv = error "separateDots: Strange"+separateDots' (div:divs) nv + | isDivisibleBy 2 nv = (nv, 0)+ | otherwise = (nv', dots' + 1)+ where + (nv', dots') = separateDots' divs (nv*div)++logBaseR :: forall a . (RealFloat a, Floating a) => Rational -> Rational -> a+logBaseR k n + | isInfinite (fromRational n :: a) = logBaseR k (n/k) + 1+logBaseR k n + | isDenormalized (fromRational n :: a) = logBaseR k (n*k) - 1+logBaseR k n = logBase (fromRational k) (fromRational n)++isDivisibleBy :: (Real a, Real b) => a -> b -> Bool+isDivisibleBy n = (equalTo 0.0) . snd . properFraction . logBaseR (toRational n) . toRational++equalTo = (==)++infixl <=>+a <=> b = sep [a,b]++++{-+Debug stuff++runLy = runCommand "lilypond -f pdf test.ly"++engrave :: Music -> IO ()+engrave e = do+ writeFile "test.ly" $ show $ pretty e+ runLy+ return ()+++main = engrave test+-}++test = Simultaneous False [+ New "StaffGroup" Nothing (Simultaneous False [+ New "Staff" Nothing (Relative c' $ Sequential [+ Set "Staff.instrumentName" (toValue "Violin I"),+ (addDynamics FF c), d, e+ ]),+ New "Staff" Nothing (Sequential [+ Set "Staff.instrumentName" (toValue "Violin II"),+ Clef Bass, c, g_, c])+ ])+ ]++-- test =+-- Simultaneous False +-- [ Relative g' (Sequential [+-- addMarkup ([Bold "Hello", Italic (markup [MarkupText "cruel", Bold $ MarkupText "world"])]) rest,+-- addArticulation Mordent $ chord [c,e,g]^*2,+-- d^*1,+-- e^*2,+-- c^*(3/2),+-- fs^*(1/2)+-- ])+-- , Sequential [Tremolo 4 (Sequential [c^/4,d^/4]), Tremolo 4 (Sequential [c^/4,d^/4])]+-- , Sequential [rest,c^*2,d^*1,e^*2,c^*(3/2),fs^*(1/2)]+-- , Sequential [rest,c^*2,d^*1,e^*2,c^*(3/2),fs^*(1/2)]+-- , Relative g (Sequential [rest,c^*2,d^*1,e^*2,c^*(3/2),fs^*(1/2)])+-- , Sequential +-- [ Times (4/5) (Sequential +-- [+-- rest,+-- addArticulation Accent $ addPost BeginSlur $ addPost BeginCresc $ c^*2,+-- d^*1,+-- addPost Tie $ e^*1+-- ])+-- , Times (4/5) (Sequential +-- [ +-- addPost BeginDim $ addPost EndCrescDim $ e^*1,+-- c^*(3/2),+-- addPost EndSlur $ fs^*(1/2),+-- addPost EndCrescDim $ c^*2+-- ])+-- ]+-- ] + + +
+ src/Music/Lilypond/Dynamics.hs view
@@ -0,0 +1,62 @@++{-# LANGUAGE OverloadedStrings #-}++-------------------------------------------------------------------------------------+-- |+-- Copyright : (c) Hans Hoglund 2012+--+-- License : BSD-style+--+-- Maintainer : hans@hanshoglund.se+-- Stability : experimental+-- Portability : GHC+--+-------------------------------------------------------------------------------------++module Music.Lilypond.Dynamics (+ Dynamics(..),+ ) where++import Text.Pretty hiding (Mode)+import Music.Dynamics.Literal+import qualified Data.Char as Char++data Dynamics + = PPPPP + | PPPP + | PPP + | PP + | P + | MP + | MF + | F + | FF + | FFF + | FFFF + | SF+ | SFF + | SP + | SPP+ | SFZ + | RFZ + deriving (Eq, Ord, Show, Enum, Bounded)++instance Pretty Dynamics where+ pretty = string . ("\\" ++) . fmap Char.toLower . show++instance IsDynamics Dynamics where+ fromDynamics (DynamicsL (Just x, Nothing)) = case x of+ (-5.5) -> PPPPP+ (-4.5) -> PPPP+ (-3.5) -> PPP+ (-2.5) -> PP+ (-1.5) -> P+ (-0.5) -> MP+ 0.5 -> MF+ 1.5 -> F+ 2.5 -> FF+ 3.5 -> FFF+ 4.5 -> FFFF+ fromDynamics _ = error "fromDynamics: Unsupported literal for MusicXml.Dynamics"++
+ src/Music/Lilypond/IO.hs view
@@ -0,0 +1,25 @@++{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}++module Music.Lilypond.IO -- (+ -- )+where++import Music.Lilypond++writeMusic :: FilePath -> Music -> IO ()+writeMusic = error "writeMusic: Not implemented"++data Format = PDF | PNG | PS++data EngraveOptions+ = EngraveOptions {+ format :: Format, + include :: FilePath,+ initFile :: FilePath,+ logFile :: FilePath,+ logLevel :: Int+ }++writeAndEngraveMusic :: FilePath -> EngraveOptions -> Music -> IO ()+writeAndEngraveMusic = error "writeAndEngraveMusic: Not implemented"
+ src/Music/Lilypond/Pitch.hs view
@@ -0,0 +1,67 @@++{-# LANGUAGE OverloadedStrings #-}++-------------------------------------------------------------------------------------+-- |+-- Copyright : (c) Hans Hoglund 2012+--+-- License : BSD-style+--+-- Maintainer : hans@hanshoglund.se+-- Stability : experimental+-- Portability : GHC+--+-------------------------------------------------------------------------------------++module Music.Lilypond.Pitch (+ Pitch(..),+ PitchClass(..),+ Accidental(..),+ Octaves(..),+ Mode(..),+ OctaveCheck(..),+ ) where++import Text.Pretty hiding (Mode)+import Music.Pitch.Literal++data PitchClass = C | D | E | F | G | A | B+ deriving (Eq, Ord, Show, Enum)++newtype Pitch = Pitch { getPitch :: (PitchClass, Accidental, Octaves) }+ deriving (Eq, Ord, Show)++instance Pretty Pitch where+ pretty (Pitch (c,a,o)) = string $ pc c ++ acc a ++ oct (o-4)+ where+ pc C = "c" ; pc D = "d" ; pc E = "e" ; pc F = "f"+ pc G = "g" ; pc A = "a" ; pc B = "b" + acc n | n < 0 = concat $ replicate (negate n) "es"+ | n == 0 = ""+ | n > 0 = concat $ replicate (n) "is"+ oct n | n < 0 = concat $ replicate (negate n) ","+ | n == 0 = ""+ | n > 0 = concat $ replicate n "'"++instance IsPitch Pitch where+ fromPitch (PitchL (c, Nothing, o)) = Pitch (toEnum c, 0, o) + fromPitch (PitchL (c, Just a, o)) = Pitch (toEnum c, round a, o)+++-- | For double flat -2, flat -1, natural 0, sharp 1 and double sharp 2.+type Accidental = Int ++-- | Number of octaves raised (positive) or flattened (negative).+type Octaves = Int ++-- | Mode (for key signatures).+data Mode = Major | Minor+ deriving (Eq, Show)++instance Pretty Mode where+ pretty Major = "\\major"+ pretty Minor = "\\minor"++data OctaveCheck = OctaveCheck+ deriving (Eq, Show)+
+ src/Music/Lilypond/Value.hs view
@@ -0,0 +1,76 @@++{-# LANGUAGE + OverloadedStrings,+ ExistentialQuantification+ #-}++-------------------------------------------------------------------------------------+-- |+-- Copyright : (c) Hans Hoglund 2012+--+-- License : BSD-style+--+-- Maintainer : hans@hanshoglund.se+-- Stability : experimental+-- Portability : GHC+--+-------------------------------------------------------------------------------------++module Music.Lilypond.Value (+ Value,+ toValue,+ ) where++import Data.String+import Text.Pretty hiding (Mode)+import Music.Pitch.Literal++-- | +-- Value of a @\\set@ command.+-- These are simply wrappers for showable things.+--+-- For example use (with @OverloadedStrings@)+--+-- > Set "Staff.instrumentName" "Violin I"+-- > Set "Staff.instrumentName" 2+--+-- to generate+--+-- > \set Staff.instrumentName = "Violin I"+-- > \set Staff.instrumentName = 2+--+data Value = forall a . Show a => Value a++instance IsString Value where+ fromString = toValue++instance Num Value where+ (+) = noOverloading "(+)"+ (*) = noOverloading "(*)"+ (-) = noOverloading "(-)"+ negate = noOverloading "negate"+ abs = noOverloading "abs"+ signum = noOverloading "signum"+ fromInteger = toValue++instance Fractional Value where+ (/) = noOverloading "(/)"+ recip = noOverloading "recip"+ fromRational = (toValue . toDouble)++instance Show Value where+ show (Value a) = show a++instance Eq Value where+ a == b = show a == show b++toValue :: Show a => a -> Value+toValue = Value++++noOverloading :: String -> a+noOverloading n = error $ "No overloading of " ++ n ++ " for Value"++toDouble :: Rational -> Double+toDouble = fromRational