hly 0.14 → 0.15

raw patch · 11 files changed

+377/−199 lines, 11 filesdep ~hmtPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hmt

API changes (from Hackage documentation)

Files

• Music/LilyPond/Light.hs +1/−0
• Music/LilyPond/Light/Analysis.hs +8/−5
• Music/LilyPond/Light/Annotation.hs +25/−17
• Music/LilyPond/Light/Constant.hs +20/−65
• Music/LilyPond/Light/Model.hs +36/−12
• Music/LilyPond/Light/Notation.hs +89/−50
• Music/LilyPond/Light/Output/LilyPond.hs +80/−23
• Music/LilyPond/Light/Paper.hs +106/−0
• README +3/−3
• help/hly.help.lhs +0/−17
• hly.cabal +9/−7

@@ -6,3 +6,4 @@ import Music.LilyPond.Light.Model as L import Music.LilyPond.Light.Notation as L import Music.LilyPond.Light.Output.LilyPond as L+import Music.LilyPond.Light.Paper as L

@@ -198,7 +198,7 @@          Note {} -> error "locate_st: note without duration"          Chord _ d _ -> (location_step st d, [this])          Tremolo _ _ -> error "locate_st: Tremolo"-         Rest d _ -> (location_step st d, [this])+         Rest _ d _ -> (location_step st d, [this])          MMRest i (j,k) _ -> let d = Duration k 0 ((i * j) % 1)                              in (location_step st d, [this])          Skip d _ -> (location_step st d, [this])@@ -217,7 +217,7 @@          Clef _ -> (st, [this])          Time ts' -> ((ts', l), [this])          Key {} -> (st, [this])-         Tempo _ _ -> (st, [this])+         Tempo _ _ _ -> (st, [this])          Command _ _ -> (st, [this])          Polyphony x0 x1 ->               let (Location _ _ v _) = l@@ -365,7 +365,7 @@ lm_tempo_map :: [LM] -> [(Measure,Tempo_Marking)] lm_tempo_map =     let f (t,i) = case i of-                    Tempo d x -> Just (measure t,(d,x))+                    Tempo _ d x -> Just (measure t,(d,x))                     _ -> Nothing     in mapMaybe f @@ -428,10 +428,13 @@          Chord xs d a ->              let (st',xs') = mapAccumL rc st xs              in fn st' (Chord xs' d a)-         Tremolo (x0,x1) n ->+         Tremolo (Left x) n ->+             let (st',x') = rc st x+             in fn st' (Tremolo (Left x') n)+         Tremolo (Right (x0,x1)) n ->              let (st',x0') = rc st x0                  (st'',x1') = rc st' x1-             in fn st'' (Tremolo (x0', x1') n)+             in fn st'' (Tremolo (Right (x0', x1')) n)          Repeat n x ->              let (st',x') = rc st x              in fn st' (Repeat n x')

@@ -19,23 +19,31 @@  -- is_skip m ||  -- is_command m || --- | Attempt to add an 'Annotation' to a 'Music' element.-add_annotation :: Annotation -> Music -> Maybe Music-add_annotation a m =+-- | Attempt to add a set of 'Annotation' to a 'Music' element.+add_annotations :: [Annotation] -> Music -> Maybe Music+add_annotations as' m =     case m of-      Note n d as -> Just (Note n d (as ++ [a]))-      Chord n d as -> Just (Chord n d (as ++ [a]))-      Rest d as -> Just (Rest d (as ++ [a]))-      Skip d as -> Just (Skip d (as ++ [a]))-      MMRest i j as -> Just (MMRest i j (as ++ [a]))-      Command c as -> Just (Command c (as ++ [a]))+      Note n d as -> Just (Note n d (as ++ as'))+      Chord n d as -> Just (Chord n d (as ++ as'))+      Rest ty d as -> Just (Rest ty d (as ++ as'))+      Skip d as -> Just (Skip d (as ++ as'))+      MMRest i j as -> Just (MMRest i j (as ++ as'))+      Command c as -> Just (Command c (as ++ as'))       _ -> Nothing --- | Add an 'Annotation' to a 'Music' element or 'error'.+-- | Erroring variant.+add_annotations_err :: [Annotation] -> Music -> Music+add_annotations_err a m =+    let err = error ("add_annotations: " ++ show (a,ly_music_elem m))+    in fromMaybe err (add_annotations a m)++-- | Unary form.+add_annotation :: Annotation -> Music -> Maybe Music+add_annotation a = add_annotations [a]++-- | Erroring variant. add_annotation_err :: Annotation -> Music -> Music-add_annotation_err a m =-    let err = error ("add_annotation: " ++ show (a,ly_music_elem m))-    in fromMaybe err (add_annotation a m)+add_annotation_err a = add_annotations_err [a]  -- | Infix form of 'add_annotation_err'. (&) :: Music -> Annotation -> Music@@ -91,14 +99,14 @@ phrasing_slur = mconcat . phrasing_slur'  text_above,text_below,text_mark :: String -> Annotation-text_above x = CompositeAnnotation [Place_Above, Text Text_Plain x]-text_below x = CompositeAnnotation [Place_Below, Text Text_Plain x]-text_mark x = CompositeAnnotation [Text_Mark, Text Text_Plain x]+text_above x = CompositeAnnotation [Place_Above,Text Text_Plain x]+text_below x = CompositeAnnotation [Place_Below,Text Text_Plain x]+text_mark x = CompositeAnnotation [Text_Mark,Text Text_Plain x]  text_above_fmt,text_below_fmt,text_mark_fmt :: String -> Annotation text_above_fmt x = CompositeAnnotation [Place_Above,Text Text_Markup x] text_below_fmt x = CompositeAnnotation [Place_Below,Text Text_Markup x]-text_mark_fmt x = CompositeAnnotation [Text_Mark, Text Text_Markup x]+text_mark_fmt x = CompositeAnnotation [Text_Mark,Text Text_Markup x]  arco,pizz :: Annotation arco = text_above "arco"

@@ -44,9 +44,13 @@ bar_line_check :: Music bar_line_check = Command BarlineCheck [] -double_barline,final_barline :: Music+normal_barline,double_barline,final_barline,tick_barline,dashed_barline,dotted_barline :: Music+normal_barline = Command (Bar NormalBarline) [] double_barline = Command (Bar DoubleBarline) [] final_barline = Command (Bar FinalBarline) []+tick_barline = Command (Bar TickBarline) []+dashed_barline = Command (Bar DashedBarline) []+dotted_barline = Command (Bar DottedBarline) []  system_break,no_system_break :: Music system_break = Command Break []@@ -82,6 +86,9 @@ begin_8va = Command (Octavation 1) [] end_8va = Command (Octavation 0) [] +cadenzaOn :: Music+cadenzaOn = Command (User "\\cadenzaOn") []+ -- * Annotations  ped,no_ped :: Annotation@@ -162,77 +169,25 @@ revert_noteheads =     Command (User "\\revert NoteHead #'style") [] --- * Paper--a4_paper :: Paper-a4_paper =-    Paper {binding_offset = Length 0 MM-          ,bottom_margin = Length 6 MM-          ,indent = Length 15 MM-          ,inner_margin = Length 10 MM-          ,left_margin = Length 10 MM-          ,outer_margin = Length 20 MM-          ,paper_width = Length 210 MM-          ,paper_height = Length 297 MM-          ,ragged_last = False-          ,ragged_last_bottom = True-          ,ragged_right = False-          ,right_margin = Length 10 MM-          ,systems_per_page = Nothing-          ,top_margin = Length 5 MM-          ,two_sided = False-          ,print_page_number = True}--length_scale :: Double -> Length -> Length-length_scale n (Length x u) = Length (n * x) u--paper_incr_size :: Paper -> Paper-paper_incr_size x =-    let wd = paper_width x-        ht = paper_height x-    in x {paper_width = ht, paper_height = length_scale 2 wd}--a3_paper :: Paper-a3_paper = paper_incr_size a4_paper--a2_paper :: Paper-a2_paper = paper_incr_size a3_paper--landscape :: Paper -> Paper-landscape x =-    let wd = paper_width x-        ht = paper_height x-    in x {paper_width = ht, paper_height = wd}--mk_fragment_paper :: Double -> Double -> Paper-mk_fragment_paper w h =-    Paper {binding_offset = Length 0 MM-          ,bottom_margin = Length 0 MM-          ,indent = Length 0 MM-          ,inner_margin = Length 0 MM-          ,left_margin = Length 0 MM-          ,outer_margin = Length 0 MM-          ,paper_width = Length w MM-          ,paper_height = Length h MM-          ,ragged_last = True-          ,ragged_last_bottom = True-          ,ragged_right = True-          ,right_margin = Length 0 MM-          ,systems_per_page = Nothing-          ,top_margin = Length 0 MM-          ,two_sided = False-          ,print_page_number = False}- -- * Aliases  tempo :: Duration -> Integer -> Music-tempo d = Tempo d . fromIntegral+tempo d = Tempo Nothing d . fromIntegral +tempo_text :: String -> Duration -> Integer -> Music+tempo_text str d = Tempo (Just str) d . fromIntegral+ after_grace :: Music -> Music -> Music after_grace = AfterGrace  grace :: Music -> Music grace = Grace -tremolo :: (Music, Music) -> Integer -> Music-tremolo = Tremolo+tremolo1 :: Music -> Integer -> Music+tremolo1 e = Tremolo (Left e)++tremolo2 :: (Music, Music) -> Integer -> Music+tremolo2 e = Tremolo (Right e)++slash_separator :: String+slash_separator = "\\slashSeparator"

@@ -3,6 +3,7 @@ import Data.Monoid import qualified Music.Theory.Clef as C {- hmt -} import Music.Theory.Pitch+import Music.Theory.Pitch.Note import Music.Theory.Duration import Music.Theory.Dynamic_Mark import Music.Theory.Key@@ -25,20 +26,31 @@                    , outer_margin :: Length                    , paper_width :: Length                    , paper_height :: Length+                   , ragged_right :: Bool                    , ragged_last :: Bool+                   , ragged_bottom :: Bool                    , ragged_last_bottom :: Bool-                   , ragged_right :: Bool                    , right_margin :: Length-                   , systems_per_page :: Maybe Integer                    , top_margin :: Length                    , two_sided :: Bool-                   , print_page_number :: Bool }+                   , print_page_number :: Bool+                   , min_systems_per_page :: Maybe Integer+                   , max_systems_per_page :: Maybe Integer+                   , systems_per_page :: Maybe Integer+                   , systems_count :: Maybe Integer+                   , page_count :: Maybe Integer+                   , system_separator_markup :: Maybe String+                   }              deriving (Eq, Show)  data Header = Header { dedication :: String                      , title :: String                      , subtitle :: String+                     , subsubtitle :: String+                     , instrument :: String                      , composer :: String+                     , opus :: String+                     , poet :: String                      , tagline :: String }               deriving (Eq, Show) @@ -79,14 +91,14 @@                 | SustainOff                   deriving (Eq, Show) -data Text_T = Text_Plain | Text_Markup+data Text_T = Text_Symbol | Text_Plain | Text_Markup               deriving (Eq, Show)  data Annotation = Articulation Articulation_T                 | Dynamic Dynamic_T                 | Phrasing Phrasing_T                 | Begin_Tie-                | Place_Above | Place_Below+                | Place_Above | Place_Default | Place_Below                 | Text_Mark | Text Text_T String                 | ReminderAccidental | CautionaryAccidental                 | CompositeAnnotation [Annotation]@@ -97,13 +109,16 @@            | LeftRepeatBarline            | RightRepeatBarline            | FinalBarline+           | DottedBarline+           | DashedBarline+           | TickBarline              deriving (Eq, Show)  data Command_T = AutoBeamOff                | Bar Bar_T                | BarlineCheck                | BarNumberCheck Integer-               | Break+               | Break -- Line break                | Change String                | DynamicDown                | DynamicNeutral@@ -157,7 +172,7 @@       Note {} -> Note_C       Chord {} -> Chord_C       Tremolo _ _ -> Tremolo_C-      Rest _ _ -> Rest_C+      Rest _ _ _ -> Rest_C       MMRest {} -> MMRest_C       Skip _ _ -> Skip_C       Repeat _ _ -> Repeat_C@@ -168,19 +183,22 @@       Clef _ -> Clef_C       Time _ -> Time_C       Key {} -> Key_C-      Tempo _ _ -> Tempo_C+      Tempo _ _ _ -> Tempo_C       Command _ _ -> Command_C       Polyphony _ _ -> Polyphony_C       Empty -> Empty_C +-- | Type of rest.  Perhaps MMRest should be given here also.+data Rest_T = Normal_Rest | Spacer_Rest deriving (Eq,Show)+ data Music = Note { note_pitch :: Pitch                   , note_duration :: Maybe Duration                   , note_annotations :: [Annotation] }            | Chord { chord_notes :: [Music]                    , chord_duration :: Duration                    , chord_annotations :: [Annotation] }-           | Tremolo (Music,Music) Integer-           | Rest Duration [Annotation]+           | Tremolo (Either Music (Music,Music)) Integer+           | Rest Rest_T Duration [Annotation]            | MMRest Integer Time_Signature [Annotation]            | Skip Duration [Annotation]            | Repeat Integer Music@@ -191,7 +209,7 @@            | Clef (C.Clef Int)            | Time Time_Signature            | Key Note_T (Maybe Alteration_T) Mode_T-           | Tempo Duration Rational+           | Tempo (Maybe String) Duration Rational            | Command Command_T [Annotation]            | Polyphony Music Music            | Empty@@ -232,6 +250,7 @@  data Score_Settings =     Score_Settings {independent_time_signatures :: Bool+                   ,hide_time_signatures :: Bool                    ,remove_empty_staves :: Bool                    ,remove_empty_staves_first_system :: Bool}     deriving (Eq, Show)@@ -247,7 +266,7 @@  data Fragment = Fragment { fragment_version :: Version                          , fragment_paper :: Paper-                         , fragment_music :: Music }+                         , fragment_staff :: Staff }                 deriving (Eq, Show)  data Format = PDF | PS | PNG@@ -264,12 +283,17 @@     Header {dedication = ""            ,title = ""            ,subtitle = ""+           ,subsubtitle = ""+           ,instrument = ""            ,composer = ""+           ,opus = ""+           ,poet = ""            ,tagline = ""}  default_score_settings :: Score_Settings default_score_settings =     Score_Settings {independent_time_signatures = False+                   ,hide_time_signatures = False                    ,remove_empty_staves = False                    ,remove_empty_staves_first_system = False} 

@@ -1,20 +1,25 @@ module Music.LilyPond.Light.Notation where -import Data.List-import Data.Maybe-import Data.Monoid-import Data.Ratio+import Data.List {- base -}+import Data.Maybe {- base -}+import Data.Monoid {- base -}+import Data.Ratio {- base -}+import Text.Printf {- base -}++import Music.Theory.Duration {- hmt -}+import Music.Theory.Duration.Annotation as T {- hmt -}+import Music.Theory.Duration.RQ {- hmt -}+import Music.Theory.Duration.Sequence.Notate as T {- hmt -}+import Music.Theory.Key {- hmt -}+import Music.Theory.Pitch {- hmt -}+import Music.Theory.Pitch.Spelling {- hmt -}+import Music.Theory.Time_Signature {- hmt -}+ import Music.LilyPond.Light.Constant import Music.LilyPond.Light.Measure import Music.LilyPond.Light.Model import Music.LilyPond.Light.Output.LilyPond-import Music.Theory.Duration {- hmt -}-import Music.Theory.Duration.Annotation-import Music.Theory.Key-import Music.Theory.Pitch-import Music.Theory.Pitch.Spelling-import Music.Theory.Time_Signature-import Text.Printf+import Music.LilyPond.Light.Paper  -- * Music category predicates @@ -93,11 +98,15 @@  -- * Rests --- | Construct rests.+-- | Construct normal rest. rest :: Duration -> Music-rest x = Rest x []+rest x = Rest Normal_Rest x [] --- | Multi-measure variant of 'r'.+-- | Construct spacer rest.+spacer_rest :: Duration -> Music+spacer_rest x = Rest Spacer_Rest x []++-- | Multi-measure variant of 'rest'. mm_rest :: Time_Signature -> Music mm_rest x = MMRest 1 x [] @@ -133,7 +142,7 @@       Note _ Nothing _ -> x       Note n (Just d) a -> Note n (Just (fn d)) a       Chord n d a -> Chord n (fn d) a-      Rest d a -> Rest (fn d) a+      Rest ty d a -> Rest ty (fn d) a       Skip d a -> Skip (fn d) a       _ -> x @@ -227,14 +236,14 @@ -- * Octave  -- | Shift the octave of a note element, else identity.-note_edit_octave :: (Integer -> Integer) -> Music -> Music+note_edit_octave :: (Octave -> Octave) -> Music -> Music note_edit_octave fn m =     case m of       Note (Pitch n a o) d xs -> Note (Pitch n a (fn o)) d xs       _ -> m  -- | Shift the octave of a note element, else identity.-note_shift_octave :: Integer -> Music -> Music+note_shift_octave :: Octave -> Music -> Music note_shift_octave i = note_edit_octave (+ i)  -- * Duration@@ -245,7 +254,7 @@  -- | Rest of  'Duration_A'. da_rest :: Duration_A -> Music-da_rest (d,_) = Rest d []+da_rest (d,_) = Rest Normal_Rest d []  -- | Add 'Duration_A' to 'Pitch' to make a @Note@ 'Music' element. (##@) :: Pitch -> Duration_A -> Music@@ -269,13 +278,19 @@  -- * Chords --- | Construct chord.+-- | Construct chord from 'Pitch' elements.+chd_p_ann :: [Pitch] -> [[Annotation]] -> Duration -> Music+chd_p_ann xs an d =+    let f x a = Note x Nothing a+    in case xs of+         [] -> error "chd_p_ann: null elements"+         _ -> Chord (zipWith f xs an) d []++-- | Construct chord from 'Pitch' elements. chd_p :: [Pitch] -> Duration -> Music-chd_p xs d =-    case xs of-      [] -> error "chd_p: null elements"-      _ -> Chord (map (\x -> Note x Nothing []) xs) d []+chd_p xs = chd_p_ann xs (repeat []) +-- | Construct chord from 'Music' elements. chd :: [Music] -> Duration -> Music chd xs d =     case xs of@@ -300,7 +315,7 @@         s = "\\override Score.BarNumber #'break-visibility = #'" ++ r     in Command (User s) [] --- | Change staff.+-- | Change staff (for cross staff notation). change :: String -> Music change x = Command (Change x) [] @@ -424,17 +439,18 @@  -- * Rests --- | Joins directly adjacent rest elements.+-- | Joins directly adjacent rest elements.  Type is adopted from the+-- right when joining. join_rests :: [Music] -> [Music] join_rests =     let fn recur xs =             case xs of               [] -> []-              Rest d a : Rest d' a' : ys ->+              Rest ty d a : Rest ty' d' a' : ys ->                   case sum_dur d d' of-                    Nothing -> let zs = Rest d a : join_rests (Rest d' a' : ys)+                    Nothing -> let zs = Rest ty d a : join_rests (Rest ty' d' a' : ys)                                in if recur then fn False zs else zs-                    Just d'' -> join_rests (Rest d'' (a ++ a') : ys)+                    Just d'' -> join_rests (Rest ty' d'' (a ++ a') : ys)               y:ys -> y : join_rests ys     in fn True @@ -443,27 +459,29 @@ -- | Transform ascribed 'Duration_A' value to 'Music'. type DA_F x = (Duration_A,x) -> Music --- | Given 'DA_F' transform, transform set of ascribed 'Duration_A'--- values to 'Music'.------ > import Music.Theory.Duration.Sequence.Notate--- > import Music.Theory.Duration.RQ.Tied--- > import Music.Theory.Pitch.Name--- > import Music.LilyPond.Light.Output.LilyPond------ > let {Just d = m_notate True [[(2/3,_f),(1/3,_t)],[(1,_t)],[(1,_f)]]--- >     ;jn (i,j) = j ##@ i--- >     ;n = ascribe d [c4,d4]--- >     ;r = "\\times 2/3 { c' 4 d' 8 ~ } d' 4 ~ d' 4"}--- > in ly_music_elem (Join (da_to_music jn n)) == r+{- | Given 'DA_F' transform, transform set of ascribed 'Duration_A'+values to 'Music'.++> import Music.Theory.Duration.Sequence.Notate as T+> import Music.Theory.Duration.RQ.Tied as T+> import Music.Theory.Pitch.Name as T+> import Music.LilyPond.Light.Output.LilyPond as L++> let {Right d = T.m_notate True [[(2/3,_f),(1/3,_t)],[(1,_t)],[(1,_f)]]+>     ;jn (i,j) = j ##@ i+>     ;n = T.ascribe d [c4,d4]+>     ;r = "\\times 2/3 { c' 4 d' 8 ~ } d' 4 ~ d' 4"}+> in L.ly_music_elem (Join (da_to_music jn n)) == r++-} da_to_music :: DA_F t -> [(Duration_A,t)] -> [Music] da_to_music fn x =-    let g = da_group_tuplets_nn (map fst x)-        g' = nn_reshape (,) g (map snd x)+    let g = T.da_group_tuplets_nn (map fst x)+        g' = T.nn_reshape (,) g (map snd x)         tr el = case el of                  Left i -> fn i                  Right y -> let (y0,_):_ = y-                                (n,d,_) = fromJust (da_begin_tuplet y0)+                                (n,d,_) = fromJust (T.da_begin_tuplet y0)                             in Tuplet Normal_Tuplet (d,n) (Join (map fn y))     in map tr g' @@ -476,18 +494,34 @@          Just t -> zipWith jn (map Time t) m          Nothing -> map (Measure []) m +{- | 'da_to_measures' of 'notate_mm_ascribe'.++> import Music.Theory.Pitch.Name as T+> import Music.LilyPond.Light.Output.LilyPond as L++> let {jn (i,j) = j ##@ i+>     ;[Measure _ m] = rq_to_measures jn [] [(3,4)] Nothing [2/3,1/3 + 2] [c4,d4]+>     ;r = "\\times 2/3 { c' 4 d' 8 ~ } d' 2"}+> in L.ly_music_elem (Join m) == r++-}+rq_to_measures :: (Show x) => DA_F x -> [Simplify_T] -> [Time_Signature] -> Maybe [[RQ]] -> [RQ] -> [x] -> [Measure]+rq_to_measures fn r ts rqp rq x =+    let da = T.notate_mm_ascribe_err r ts rqp rq x+    in da_to_measures fn (Just ts) da+ -- * Fragment --- | Make a fragment from a list of 'Music' elements.  Width and--- height are in millimeters.-mk_fragment :: (Double, Double) -> [Music] -> Fragment+-- | Make a fragment (possibly multiple staffs) from 'Music' elements.+-- Width and height are in millimeters.+mk_fragment :: (Double, Double) -> [[Music]] -> Fragment mk_fragment (w,h) m =     let pr = mk_fragment_paper w h-    in Fragment default_version pr (Join m)+    in Fragment default_version pr (grand_staff ("","") m)  -- | 'Measure' variant of 'mk_fragment'.-mk_fragment_mm :: (Double, Double) -> [Measure] -> Fragment-mk_fragment_mm d = mk_fragment d . mm_elements+mk_fragment_mm :: (Double, Double) -> [[Measure]] -> Fragment+mk_fragment_mm d = mk_fragment d . map mm_elements  -- * Stem @@ -532,3 +566,8 @@                       (_,Just _) -> (ts,m)                       _ -> (st,m)     in snd . mapAccumL f Nothing++-- * Rehearsal marks++default_rehearsal_mark :: Music+default_rehearsal_mark = Command (User "\\mark \\default") []

@@ -5,31 +5,48 @@     ,ly_process,ly_process_cwd     ,Lilypond(..)) where -import Data.Char-import Music.LilyPond.Light.Model+import Data.Char {- base -}+import Data.Maybe {- base -}+import System.Directory {- directory -}+import System.Exit {- base -}+import System.FilePath {- filepath -}+import System.Process {- process -}+import Text.Printf {- base -}+ import qualified Music.Theory.Clef as C {- hmt -} import Music.Theory.Pitch+import Music.Theory.Pitch.Note import Music.Theory.Duration import Music.Theory.Dynamic_Mark import Music.Theory.Key-import System.Directory {- directory -}-import System.Exit-import System.FilePath {- filepath -}-import System.Process {- process -}-import Text.Printf +import Music.LilyPond.Light.Model+ with_brackets :: (String,String) -> [String] -> [String] with_brackets (begin,end) xs = [begin] ++ xs ++ [end]  with_braces :: [String] -> [String] with_braces = with_brackets ("{","}") +-- > ly_sym "default"+ly_sym :: String -> String+ly_sym x = "\\" ++ x+ ly_str :: String -> String ly_str x = "\"" ++ x ++ "\"" +ly_markup :: String -> String+ly_markup x = "\\markup {" ++ x ++ "}"+ ly_version :: Version -> [String] ly_version (Version v) = ["\\version", ly_str v] +ly_assign' :: (String -> String) -> (String,String) -> Maybe [String]+ly_assign' fn (key,value) =+    if null value+    then Nothing+    else Just [key,"=",fn value]+ ly_assign :: (String -> String) -> (String,String) -> [String] ly_assign fn (key,value) = [key,"=",fn value] @@ -48,6 +65,7 @@ ly_paper :: Paper -> [String] ly_paper p =     let tw = two_sided p+        opt = maybe "" show         mg = if tw              then [("binding-offset", ly_length (binding_offset p))                   ,("inner-margin", ly_length (inner_margin p))@@ -58,24 +76,38 @@              ,("indent", ly_length (indent p))              ,("paper-width", ly_length (paper_width p))              ,("paper-height", ly_length (paper_height p))+             ,("ragged-right", ly_bool (ragged_right p))              ,("ragged-last", ly_bool (ragged_last p))+             ,("ragged-bottom", ly_bool (ragged_bottom p))              ,("ragged-last-bottom", ly_bool (ragged_last_bottom p))-             ,("ragged-right", ly_bool (ragged_right p))-             ,("systems-per-page", maybe "" show (systems_per_page p))              ,("top-margin", ly_length (top_margin p))              ,("two-sided", ly_bool tw)-             ,("print-page-number", ly_bool (print_page_number p))]+             ,("print-page-number", ly_bool (print_page_number p))+             ,("min-systems-per-page", opt (min_systems_per_page p))+             ,("max-systems-per-page", opt (max_systems_per_page p))+             ,("systems-per-page", opt (systems_per_page p))+             ,("systems-count", opt (systems_count p))+             ,("page-count", opt (page_count p))+             ,("system-separator-markup", fromMaybe "" (system_separator_markup p))+             ]         ys = ly_delete_nil_values (xs ++ mg)-    in "\\paper" : with_braces (concatMap (ly_assign id) ys)+    in "\\paper" : with_braces (concat (map (ly_assign id) ys)) +-- | @tagline@ is supressed if empty, else Lilypond adds one! ly_header :: Header -> [String] ly_header hdr =     let xs = [("dedication", dedication hdr)              ,("title", title hdr)              ,("subtitle", subtitle hdr)+             ,("subsubtitle", subsubtitle hdr)+             ,("instrument", instrument hdr)              ,("composer", composer hdr)-             ,("tagline", tagline hdr)]-    in "\\header" : with_braces (concatMap (ly_assign ly_str) xs)+             ,("opus", opus hdr)+             ,("poet", poet hdr)]+        ys = [("tagline", tagline hdr)]+    in "\\header" :+       with_braces (concat (mapMaybe (ly_assign' ly_markup) xs) +++                    concat (map (ly_assign ly_markup) ys))  ly_clef_t :: C.Clef_T -> String ly_clef_t c =@@ -102,7 +134,7 @@ ly_note = map toLower . show  ly_alteration' :: Maybe Alteration_T -> String-ly_alteration' = maybe "" alteration_ly_name+ly_alteration' = maybe "" alteration_tonh  ly_alteration_rule :: [Annotation] -> String ly_alteration_rule xs@@ -128,7 +160,7 @@ ly_pitch :: [Annotation] -> Pitch -> String ly_pitch xs (Pitch n a o) =     ly_note n ++-    alteration_ly_name a +++    alteration_tonh a ++     ly_octave o ++     ly_alteration_rule xs @@ -200,10 +232,12 @@       Phrasing x -> ly_phrasing x       Begin_Tie -> "~"       Place_Above -> "^"+      Place_Default -> "-"       Place_Below -> "_"       Text_Mark -> "\\mark"+      Text Text_Symbol x -> ly_sym x       Text Text_Plain x -> ly_str x-      Text Text_Markup x -> "\\markup {" ++ x ++ "}"+      Text Text_Markup x -> ly_markup x       CompositeAnnotation xs -> unwords (map ly_annotation xs)       ReminderAccidental -> "" -- see ly_pitch       CautionaryAccidental -> "" -- see ly_pitch@@ -216,6 +250,9 @@       LeftRepeatBarline -> "|:"       RightRepeatBarline -> ":|"       FinalBarline -> "|."+      DottedBarline -> ":"+      DashedBarline -> "dashed"+      TickBarline -> "'"  ly_command :: Command_T -> String ly_command c =@@ -255,6 +292,12 @@ ly_music_l :: [Music] -> [String] ly_music_l = concatMap ly_music +ly_rest_type :: Rest_T -> String+ly_rest_type ty =+    case ty of+      Normal_Rest -> "r"+      Spacer_Rest -> "s"+ ly_music :: Music -> [String] ly_music m =     case m of@@ -263,9 +306,11 @@       Chord xs d aa -> with_brackets ("<",">") (ly_music_l xs) ++                        [ly_duration d] ++                        map ly_annotation aa-      Tremolo (x0,x1) n -> ["\\repeat", "\"tremolo\"", show n] ++-                           with_braces (ly_music x0 ++ ly_music x1)-      Rest d aa -> ["r", ly_duration d] ++ map ly_annotation aa+      Tremolo (Left x) n -> ["\\repeat", "\"tremolo\"", show n] ++ ly_music x+      Tremolo (Right (x0,x1)) n -> ["\\repeat", "\"tremolo\"", show n] +++                                   with_braces (ly_music x0 ++ ly_music x1)+      Rest ty d aa -> [ly_rest_type ty, ly_duration d] +++                      map ly_annotation aa       MMRest i (j,k) aa -> let d = printf "R %d*%d " k (i*j)                            in d : map ly_annotation aa       Skip d aa -> ["\\skip", ly_duration d] ++ map ly_annotation aa@@ -283,9 +328,11 @@       Key n a md -> ["\\key"                     ,ly_note n ++ ly_alteration' a                     ,ly_key_mode md]-      Tempo d r ->+      Tempo m_str d r ->           let r' = floor r :: Integer-          in ["\\tempo", ly_duration d, "=", show r']+          in case m_str of+               Nothing -> ["\\tempo", ly_duration d, "=", show r']+               Just str -> ["\\tempo", ly_markup str, ly_duration d, "=", show r']       Command x aa -> ly_command x : map ly_annotation aa       Join xs -> concatMap ly_music xs       Polyphony x1 x2 -> ["\\simultaneous", "{"] ++@@ -378,6 +425,13 @@      else ""     ,"}"] +ly_hide_time_signatures :: [String]+ly_hide_time_signatures =+    ["\\context {"+    ,"  \\Staff"+    ,"  \\remove \"Time_signature_engraver\""+    ,"}"]+ ly_layout :: Score_Settings -> [String] ly_layout x =     let mk_i = printf "\\context { \\%s \\consists \"Instrument_name_engraver\"}"@@ -386,6 +440,9 @@        ,if independent_time_signatures x         then unlines ly_independent_time_signatures         else ""+       ,if hide_time_signatures x+        then unlines ly_hide_time_signatures+        else ""        ,if remove_empty_staves x         then unlines (ly_remove_empty_staves (remove_empty_staves_first_system x))         else ""@@ -416,11 +473,11 @@ ly_music_elem = unwords . ly_music  ly_fragment :: Fragment -> String-ly_fragment (Fragment v p m) =+ly_fragment (Fragment v p st) =     unlines (ly_version v ++              ly_paper p ++              ly_header default_header ++-             with_braces [ly_music_elem m])+             with_braces (ly_staff st))  class Lilypond a where ly_notate :: a -> String instance Lilypond Score where ly_notate = unlines . ly_score

@@ -0,0 +1,106 @@+-- | Paper related functions and constants.+module Music.LilyPond.Light.Paper where++import Music.LilyPond.Light.Model++-- * Paper++a4_paper :: Paper+a4_paper =+    Paper {binding_offset = Length 0 MM+          ,bottom_margin = Length 6 MM+          ,indent = Length 15 MM+          ,inner_margin = Length 10 MM+          ,left_margin = Length 10 MM+          ,outer_margin = Length 20 MM+          ,paper_width = Length 210 MM+          ,paper_height = Length 297 MM+          ,ragged_right = False+          ,ragged_last = False+          ,ragged_bottom = False+          ,ragged_last_bottom = True+          ,right_margin = Length 10 MM+          ,top_margin = Length 5 MM+          ,two_sided = False+          ,print_page_number = True+          ,min_systems_per_page = Nothing+          ,max_systems_per_page = Nothing+          ,systems_per_page = Nothing+          ,systems_count = Nothing+          ,page_count = Nothing+          ,system_separator_markup = Nothing+          }++b4_paper :: Paper+b4_paper = a4_paper {paper_width = Length 250 MM+                    ,paper_height = Length 353 MM}++-- | Set margins, ordering as for CSS, ie. clockwise from top.+paper_set_margins :: Length -> Length -> Length -> Length -> Paper -> Paper+paper_set_margins t r b l p =+    p {top_margin = t+      ,right_margin = r+      ,bottom_margin = b+      ,left_margin = l}++-- | Variant with margins given in /mm/.+paper_set_margins_mm :: Real n => n -> n -> n -> n -> Paper -> Paper+paper_set_margins_mm t l b r =+    let mm x = Length (realToFrac x) MM+    in paper_set_margins (mm t) (mm l) (mm b) (mm r)++length_scale :: Double -> Length -> Length+length_scale n (Length x u) = Length (n * x) u++paper_incr_size :: Paper -> Paper+paper_incr_size x =+    let wd = paper_width x+        ht = paper_height x+    in x {paper_width = ht, paper_height = length_scale 2 wd}++paper_decr_size :: Paper -> Paper+paper_decr_size x =+    let wd = paper_width x+        ht = paper_height x+    in x {paper_width = length_scale 0.5 ht, paper_height = wd}++a3_paper :: Paper+a3_paper = paper_incr_size a4_paper++a2_paper :: Paper+a2_paper = paper_incr_size a3_paper++b5_paper :: Paper+b5_paper = paper_decr_size b4_paper++landscape :: Paper -> Paper+landscape x =+    let wd = paper_width x+        ht = paper_height x+    in x {paper_width = ht, paper_height = wd}++mk_fragment_paper :: Double -> Double -> Paper+mk_fragment_paper w h =+    Paper {binding_offset = Length 0 MM+          ,bottom_margin = Length 0 MM+          ,indent = Length 0 MM+          ,inner_margin = Length 0 MM+          ,left_margin = Length 0 MM+          ,outer_margin = Length 0 MM+          ,paper_width = Length w MM+          ,paper_height = Length h MM+          ,ragged_right = True+          ,ragged_last = True+          ,ragged_bottom = True+          ,ragged_last_bottom = True+          ,right_margin = Length 0 MM+          ,top_margin = Length 0 MM+          ,two_sided = False+          ,print_page_number = False+          ,min_systems_per_page = Nothing+          ,max_systems_per_page = Nothing+          ,systems_per_page = Nothing+          ,systems_count = Nothing+          ,page_count = Nothing+          ,system_separator_markup = Nothing+          }

@@ -4,14 +4,14 @@ A lightweight embedding of the [lilypond][ly] typesetting model in [haskell][hs]. -See [hts][hts] for an alternative writing to [MusicXML][music-xml].+See [hts](?t=hts) for an alternative writing to [MusicXML][music-xml],+and [hmt-texts](?t=hmt-texts) for related work.  [hs]: http://haskell.org/ [ly]: http://lilypond.org/-[hts]: http://rd.slavepianos.org/?t=hts [music-xml]: http://www.makemusic.com/musicxml/ -© [rohan drape][rd], 2010-2013, [gpl]+© [rohan drape][rd], 2010-2014, [gpl]  [rd]: http://rd.slavepianos.org/ [gpl]: http://gnu.org/copyleft/

@@ -1,17 +0,0 @@-> import Music.Theory.Duration.Sequence.Notate-> import Music.Theory.Duration.Annotation-> import Music.Theory.Duration.RQ.Tied-> import Music.LilyPond.Light--![hly-00](hly-00.png)--> let {ts = [(3,4),(2,4),(3,4)]->     ;rq = [2/3,7/3,1,3/5,2/5+1/3,2/3,3/2,1/2]->     ;ps = [c4,d4,e4,f4,g4,a4,b4,c5]->     ;sr = default_rule []->     ;Just n = notate sr ts rq->     ;a = mm_ascribe n ps->     ;jn (i,j) = j #@ i->     ;m = da_to_measures jn ts a->     ;fr = mk_fragment_mm (105,20) m}-> in ly_process_cwd PNG "hly-00" fr

@@ -1,26 +1,27 @@ Name:              hly-Version:           0.14+Version:           0.15 Synopsis:          Haskell LilyPond Description:       A very lightweight embedding of the lilypond                    typesetting model in haskell License:           GPL Category:          Music-Copyright:         (c) Rohan Drape, 2010-2013+Copyright:         (c) Rohan Drape, 2010-2014 Author:            Rohan Drape Maintainer:        rd@slavepianos.org Stability:         Experimental-Homepage:          http://rd.slavepianos.org/?t=hly-Tested-With:       GHC == 7.6.1+Homepage:          http://rd.slavepianos.org/t/hly+Tested-With:       GHC == 7.8.2 Build-Type:        Simple Cabal-Version:     >= 1.8 Data-Files:        README-                   help/*.help.lhs +--                 help/*.help.lhs+ Library-  Build-Depends:   base==4.*,+  Build-Depends:   base == 4.*,                    directory,                    filepath,-                   hmt==0.14.*,+                   hmt == 0.15.*,                    process   GHC-Options:     -Wall -fwarn-tabs   Exposed-modules: Music.LilyPond.Light@@ -34,6 +35,7 @@                    Music.LilyPond.Light.Model                    Music.LilyPond.Light.Notation                    Music.LilyPond.Light.Output.LilyPond+                   Music.LilyPond.Light.Paper  Source-Repository  head   Type:            darcs