hly 0.15 → 0.16

raw patch · 12 files changed

+446/−301 lines, 12 filesdep +splitdep ~basedep ~hmtPVP ok

version bump matches the API change (PVP)

Dependencies added: split

Dependency ranges changed: base, hmt

API changes (from Hackage documentation)

Files

• Music/LilyPond/Light/Analysis.hs +146/−139
• Music/LilyPond/Light/Annotation.hs +17/−5
• Music/LilyPond/Light/Constant.hs +17/−12
• Music/LilyPond/Light/Constant/Dynamic.hs +23/−18
• Music/LilyPond/Light/Literal.hs +3/−2
• Music/LilyPond/Light/Measure.hs +5/−0
• Music/LilyPond/Light/Model.hs +40/−26
• Music/LilyPond/Light/Notation.hs +121/−69
• Music/LilyPond/Light/Output/LilyPond.hs +48/−20
• Music/LilyPond/Light/Paper.hs +10/−3
• README +9/−1
• hly.cabal +7/−6

@@ -1,74 +1,76 @@ module Music.LilyPond.Light.Analysis where -import Control.Arrow-import Data.Function-import Data.List-import Data.Maybe-import Data.Monoid-import Data.Ratio-import qualified Music.LilyPond.Light as L-import Music.LilyPond.Light.Model-import Music.Theory.Duration {- hmt -}-import Music.Theory.Pitch-import qualified Music.Theory.Pitch.Spelling as T-import Music.Theory.Tempo_Marking-import Music.Theory.Time_Signature+import Control.Arrow {- base -}+import Data.Function {- base -}+import Data.List {- base -}+import Data.Maybe {- base -}+import Data.Ratio {- base -} +import qualified Music.Theory.Duration as T {- hmt -}+import qualified Music.Theory.Pitch as T {- hmt -}+import qualified Music.Theory.Pitch.Spelling.Table as T {- hmt -}+import qualified Music.Theory.Tempo_Marking as T {- hmt -}+import qualified Music.Theory.Time_Signature as T {- hmt -}++import qualified Music.LilyPond.Light.Model as L+import qualified Music.LilyPond.Light.Notation as L+import qualified Music.LilyPond.Light.Output.LilyPond as L (ly_music_elem)+ -- * Basic traversal  -- | Apply a function to all elements and collect results in a list.-traverse :: (Music -> a) -> Music -> [a]-traverse fn =+m_traverse :: (L.Music -> a) -> L.Music -> [a]+m_traverse fn =     let fn' xs m = (fn m : xs, m)     in reverse . fst . transform_st fn' []  -- | Collect all elements of a given type.-collect_entries :: (Music -> Bool) -> Music -> [Music]-collect_entries fn = filter fn . traverse id+collect_entries :: (L.Music -> Bool) -> L.Music -> [L.Music]+collect_entries fn = filter fn . m_traverse id  -- * Basic statistical analysis -count_entries :: (Music -> Bool) -> Music -> Integer-count_entries fn = genericLength . filter id . traverse fn+count_entries :: (L.Music -> Bool) -> L.Music -> Integer+count_entries fn = genericLength . filter id . m_traverse fn -count_notes :: Music -> Integer+count_notes :: L.Music -> Integer count_notes = count_entries L.is_note -count_chords :: Music -> Integer+count_chords :: L.Music -> Integer count_chords = count_entries L.is_chord -count_ts :: Music -> Integer+count_ts :: L.Music -> Integer count_ts = count_entries L.is_time  -- * Basic pitch analysis  -- | Does music element contain one or more pitches?-has_pitch :: Music -> Bool+has_pitch :: L.Music -> Bool has_pitch x = L.is_note x ||               L.is_chord x ||               L.is_grace x ||               L.is_after_grace x  -- | Collect pitches from a note or chord or join of such.-collect_pitches_no_grace :: Music -> [Pitch]+collect_pitches_no_grace :: L.Music -> [T.Pitch] collect_pitches_no_grace m =     case m of-      (Note x _ _) -> [x]-      (Chord xs _ _) -> concatMap collect_pitches xs-      (Skip _ _) -> []-      (Join xs) -> concatMap collect_pitches xs+      (L.Note x _ _) -> [x]+      (L.Chord xs _ _) -> concatMap collect_pitches xs+      (L.Skip _ _) -> []+      (L.Join xs) -> concatMap collect_pitches xs       _ -> error ("collect_pitches_no_grace: " ++ L.ly_music_elem m)  -- | Collect pitches from a note, chord, or grace note.-collect_pitches :: Music -> [Pitch]+collect_pitches :: L.Music -> [T.Pitch] collect_pitches m =     case m of-      (Grace x) -> collect_pitches x-      (AfterGrace x0 x1) -> collect_pitches x0 ++ collect_pitches x1+      (L.Grace x) -> collect_pitches x+      (L.AfterGrace x0 x1) -> collect_pitches x0 ++ collect_pitches x1       _ -> collect_pitches_no_grace m  -- | Collect note sequence, filters tied notes.-note_seq :: Music -> [Music]+note_seq :: L.Music -> [L.Music] note_seq = filter (not . L.is_tied) . collect_entries L.is_note  -- * Frequency analysis utilites@@ -83,11 +85,12 @@  -- * Temporal map -type Time_Signature_Map = [(Measure,Time_Signature)]-type Tempo_Marking_Map = [(Measure,Tempo_Marking)]+type Measure = Integer+type Time_Signature_Map = [(Measure,T.Time_Signature)]+type Tempo_Marking_Map = [(Measure,T.Tempo_Marking)] type Temporal_Map = (Time_Signature_Map,Tempo_Marking_Map) -temporal_map :: [Music] -> Temporal_Map+temporal_map :: [L.Music] -> Temporal_Map temporal_map xs =     let ts_m = ts_map xs         tm_m = tempo_map xs@@ -100,7 +103,7 @@         fn xs i = if i == n                   then xs                   else let t = get ts_m i-                           j = measure_duration t (get tm_m i)+                           j = T.measure_duration t (get tm_m i)                        in fn ((j,fst t):xs) (i+1)     in reverse (fn [] 0) @@ -122,7 +125,7 @@     let (x,y,z) = mm `genericIndex` measure l     in x + ((fromRational (pulse l) / fromIntegral z) * y) -locate_rt :: [Music] -> [(Rational,Music)]+locate_rt :: [L.Music] -> [(Rational,L.Music)] locate_rt xs =     let l = locate' xs         m = temporal_map xs@@ -136,7 +139,6 @@                  | LM_In_Tuplet                    deriving (Show, Eq, Ord) -type Measure = Integer type Pulse = Rational type Part_ID = Integer @@ -148,7 +150,7 @@                 deriving (Show, Eq, Ord)  -- | Convert a location to normal form under given time signature.-location_nf :: Time_Signature -> Location -> Location+location_nf :: T.Time_Signature -> Location -> Location location_nf ts l =     let (Location b p v m) = l         (n, _) = ts@@ -158,7 +160,7 @@        else l  -- | Type to thread state through location calculations.-type Locate_ST = (Time_Signature, Location)+type Locate_ST = (T.Time_Signature, Location)  -- | Update state part number. st_set_part :: Locate_ST -> Part_ID -> Locate_ST@@ -173,65 +175,66 @@     in (ts, Location b p v m)  -- | Step location state by duration.-location_step :: Locate_ST -> Duration -> Locate_ST+location_step :: Locate_ST -> T.Duration -> Locate_ST location_step st d =     let (ts, l) = st         (Location b p v m) = l-        p' = p + ts_duration_pulses ts d+        p' = p + T.ts_duration_pulses ts d         l' = location_nf ts (Location b p' v m)     in (ts, l')  -- | Located music-type LM = (Location, Music)+type LM = (Location, L.Music)  -- | Located value type LV a = (Location, a)  -- | State threading form of location calculations. --   Currently, nested polyphonic parts generate duplicate IDs (?)-locate_st :: Locate_ST -> Music -> (Locate_ST, [LM])+locate_st :: Locate_ST -> L.Music -> (Locate_ST, [LM]) locate_st st m =     let (ts, l) = st         this = (l,m)     in case m of-         Note _ (Just d) _ -> (location_step st d, [this])-         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])-         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])-         Repeat _ x -> locate_st st x-         Tuplet _ _ x ->+         L.Note _ (Just d) _ -> (location_step st d, [this])+         L.Note {} -> error "locate_st: note without duration"+         L.Chord _ d _ -> (location_step st d, [this])+         L.Tremolo _ _ -> error "locate_st: Tremolo"+         L.Rest _ d _ -> (location_step st d, [this])+         L.MMRest i (j,k) _ ->+             let d = T.Duration k 0 ((i * j) % 1)+             in (location_step st d, [this])+         L.Skip d _ -> (location_step st d, [this])+         L.Repeat _ x -> locate_st st x+         L.Tuplet _ _ x ->              let st' = (ts, l { mode = LM_In_Tuplet })                  ((ts', l''), r) = locate_st st' x              in ((ts', l'' { mode = LM_Normal } ), this:r)-         Grace _ -> (st, [this])-         AfterGrace x _ ->+         L.Grace _ -> (st, [this])+         L.AfterGrace x _ ->              let (st', _) = locate_st st x              in (st', [this])-         Join xs ->+         L.Join xs ->              let (st', r) = mapAccumL locate_st st xs              in (st', concat r)-         Clef _ -> (st, [this])-         Time ts' -> ((ts', l), [this])-         Key {} -> (st, [this])-         Tempo _ _ _ -> (st, [this])-         Command _ _ -> (st, [this])-         Polyphony x0 x1 ->+         L.Clef _ -> (st, [this])+         L.Time ts' -> ((ts', l), [this])+         L.Key {} -> (st, [this])+         L.Tempo _ _ _ -> (st, [this])+         L.Command _ _ -> (st, [this])+         L.Polyphony x0 x1 ->               let (Location _ _ v _) = l                   st' = map (st_set_part st) [v ..]                   r = zipWith locate_st st' [x0,x1]                   ((st'',_):_) = r               in (st'', this : concatMap snd r)-         Empty -> (st, [this]) -- error "locate_st: empty"+         L.Empty -> (st, [this]) -- error "locate_st: empty"  -- | Run location calculations.-locate :: Music -> [LM]+locate :: L.Music -> [LM] locate = snd . locate_st ((4,4), Location 0 0 0 LM_Normal) -locate' :: [Music] -> [LM]+locate' :: [L.Music] -> [LM] locate' = locate . mconcat  -- | Extract list of part identifiers.@@ -254,34 +257,34 @@ lv_extract_measure :: Measure -> [LV a] -> [LV a] lv_extract_measure n = filter ((== n) . measure . fst) -lm_pitches :: [LM] -> [Pitch]+lm_pitches :: [LM] -> [T.Pitch] lm_pitches l =     let m = map snd l         p = concatMap collect_pitches (filter has_pitch m)     in (nub . sort) p -lm_pcset :: [LM] -> [PitchClass]-lm_pcset = nub . sort . map pitch_to_pc . lm_pitches+lm_pcset :: [LM] -> [T.PitchClass]+lm_pcset = nub . sort . map T.pitch_to_pc . lm_pitches -lm_pitches_per_measure :: [LM] -> [[Pitch]]+lm_pitches_per_measure :: [LM] -> [[T.Pitch]] lm_pitches_per_measure = map lm_pitches . lv_group_measures -lm_pcset_per_measure :: [LM] -> [[PitchClass]]+lm_pcset_per_measure :: [LM] -> [[T.PitchClass]] lm_pcset_per_measure = map lm_pcset . lv_group_measures -unlocate_p :: Music -> Bool+unlocate_p :: L.Music -> Bool unlocate_p m =     case m of-      Note _ Nothing _ -> False-      Repeat _ _ -> False-      Join _ -> False-      Polyphony _ _ -> error "unlocate_p: Polyphony"+      L.Note _ Nothing _ -> False+      L.Repeat _ _ -> False+      L.Join _ -> False+      L.Polyphony _ _ -> error "unlocate_p: Polyphony"       _ -> True  normal_mode_p :: Location -> Bool normal_mode_p l = mode l == LM_Normal -lm_unlocate :: [LM] -> [Music]+lm_unlocate :: [LM] -> [L.Music] lm_unlocate = filter unlocate_p . map snd . filter (normal_mode_p . fst)  location_time :: Location -> (Measure,Pulse)@@ -290,7 +293,7 @@ lv_sort :: [LV a] -> [LV a] lv_sort = sortBy (compare `on` (location_time . fst)) -located_pitches :: [[Music]] -> [(Location, [Pitch])]+located_pitches :: [[L.Music]] -> [(Location, [T.Pitch])] located_pitches xs =     let xs' = map (lm_discard_tied_notes . locate') xs         set_vc i (j,x) = (j {part = i },x)@@ -308,12 +311,14 @@     let fn = compare `on` measure     in measure . maximumBy fn . map fst -time_unpack :: Music -> Time_Signature-time_unpack (Time t) = t-time_unpack _ = error "time_unpack"+time_unpack :: L.Music -> T.Time_Signature+time_unpack m =+    case m of+      L.Time t -> t+      _ -> error "time_unpack"  -- | Time signature structure of music.-ts_structure :: Music -> [[(Time_Signature, Integer)]]+ts_structure :: L.Music -> [[(T.Time_Signature, Integer)]] ts_structure m =     let m' = locate m         ts = filter (L.is_time . snd) m'@@ -324,7 +329,7 @@         f (l1, t1) (l2, _) = (t1, measure_diff l1 l2)     in map (\ys -> zipWith f ys (tail ys) ++ [e ys]) ps -ts_structure' :: [Music] -> [[(Time_Signature, Integer)]]+ts_structure' :: [L.Music] -> [[(T.Time_Signature, Integer)]] ts_structure' = ts_structure . mconcat  structure_unfold' :: (Integral i) => [(a,i)] -> [a]@@ -342,7 +347,7 @@     let xs' = filter (L.is_time . snd) xs     in map (measure *** time_unpack) xs' -ts_map :: [Music] -> Time_Signature_Map+ts_map :: [L.Music] -> Time_Signature_Map ts_map = lm_ts_map . locate'  -- | Keys are in ascending order, the value retrieved is the that with@@ -357,22 +362,24 @@          [(j,x)] -> if i >= j then x else error "map_lookup"          _ -> fn (error "map_lookup") mp -ts_lookup :: [(Measure,Time_Signature)] -> Measure -> Time_Signature+ts_lookup :: [(Measure,T.Time_Signature)] -> Measure -> T.Time_Signature ts_lookup = map_lookup  -- * Tempo -lm_tempo_map :: [LM] -> [(Measure,Tempo_Marking)]+lm_tempo_map :: [LM] -> [(Measure,T.Tempo_Marking)] lm_tempo_map =     let f (t,i) = case i of-                    Tempo _ d x -> Just (measure t,(d,x))+                    L.Tempo _ d x -> Just (measure t,(d,x))                     _ -> Nothing     in mapMaybe f -tempo_map :: [Music] -> [(Measure,Tempo_Marking)]+type Tempo_Map = [(Measure,T.Tempo_Marking)]++tempo_map :: [L.Music] -> Tempo_Map tempo_map = lm_tempo_map . locate' -tempo_lookup :: [(Measure,Tempo_Marking)] -> Measure -> Tempo_Marking+tempo_lookup :: Tempo_Map -> Measure -> T.Tempo_Marking tempo_lookup = map_lookup  -- * Key/value utilties@@ -402,7 +409,7 @@  -- * Measure collation -measure_collate :: (Music -> Bool) -> Music -> [[(Integer, [Music])]]+measure_collate :: (L.Music -> Bool) -> L.Music -> [[(Integer, [L.Music])]] measure_collate p m =     let m' = filter (p . snd) (locate m)     in map (kv_collate' . kv_map measure id) (lv_group_parts m')@@ -418,69 +425,69 @@  -- * Transformation -type ST_r st = (st, Music)-type ST_f st = (st -> Music -> ST_r st)+type ST_r st = (st, L.Music)+type ST_f st = (st -> L.Music -> ST_r st) -transform_st :: ST_f st -> st -> Music -> ST_r st+transform_st :: ST_f st -> st -> L.Music -> ST_r st transform_st fn st m =     let rc = transform_st fn     in case m of-         Chord xs d a ->+         L.Chord xs d a ->              let (st',xs') = mapAccumL rc st xs-             in fn st' (Chord xs' d a)-         Tremolo (Left x) n ->+             in fn st' (L.Chord xs' d a)+         L.Tremolo (Left x) n ->              let (st',x') = rc st x-             in fn st' (Tremolo (Left x') n)-         Tremolo (Right (x0,x1)) n ->+             in fn st' (L.Tremolo (Left x') n)+         L.Tremolo (Right (x0,x1)) n ->              let (st',x0') = rc st x0                  (st'',x1') = rc st' x1-             in fn st'' (Tremolo (Right (x0', x1')) n)-         Repeat n x ->+             in fn st'' (L.Tremolo (Right (x0', x1')) n)+         L.Repeat n x ->              let (st',x') = rc st x-             in fn st' (Repeat n x')-         Tuplet o t x ->+             in fn st' (L.Repeat n x')+         L.Tuplet o t x ->              let (st',x') = rc st x-             in fn st' (Tuplet o t x')-         Grace x ->+             in fn st' (L.Tuplet o t x')+         L.Grace x ->              let (st',x') = rc st x-             in fn st' (Grace x')-         AfterGrace x0 x1 ->+             in fn st' (L.Grace x')+         L.AfterGrace x0 x1 ->              let (st',x0') = rc st x0                  (st'',x1') = rc st' x1-             in fn st'' (AfterGrace x0' x1')-         Join xs ->+             in fn st'' (L.AfterGrace x0' x1')+         L.Join xs ->              let (st',xs') = mapAccumL rc st xs-             in fn st' (Join xs')-         Polyphony x0 x1 ->+             in fn st' (L.Join xs')+         L.Polyphony x0 x1 ->              let (st',x0') = rc st x0                  (st'',x1') = rc st' x1-             in fn st'' (Polyphony x0' x1')+             in fn st'' (L.Polyphony x0' x1')          _ -> fn st m -transform :: (Music -> Music) -> Music -> Music+transform :: (L.Music -> L.Music) -> L.Music -> L.Music transform fn =     let fn' _ m = ((), fn m)     in snd . transform_st fn' ()  -- * Repeats -write_out_repeats :: Music -> Music+write_out_repeats :: L.Music -> L.Music write_out_repeats =     let fn m = case m of-                 Repeat n x -> Join (genericReplicate n x)+                 L.Repeat n x -> L.Join (genericReplicate n x)                  _ -> m     in transform fn  -- * Replace  -- | Replace the pitch of note element n1 with that of n0.-note_replace_pitch :: Pitch -> Music -> Music-note_replace_pitch x n = n { note_pitch = x }+note_replace_pitch :: T.Pitch -> L.Music -> L.Music+note_replace_pitch x n = n { L.note_pitch = x } -note_replace_pitch_m :: Music -> Music -> Music-note_replace_pitch_m n0 n1 = n1 { note_pitch = note_pitch n0 }+note_replace_pitch_m :: L.Music -> L.Music -> L.Music+note_replace_pitch_m n0 n1 = n1 { L.note_pitch = L.note_pitch n0 } -replace_notes_fn :: (a -> Pitch) -> [a] -> Music -> ([a], Music)+replace_notes_fn :: (a -> T.Pitch) -> [a] -> L.Music -> ([a], L.Music) replace_notes_fn fn xs m =     case xs of       [] -> ([], m)@@ -494,26 +501,26 @@ -- | Replaces notes with indicated pitches, rhythms and annotations --   are not replaced.  Tied notes do not use multiple pitches from --   the input sequence.-replace_notes_p :: [Pitch] -> Music -> Music+replace_notes_p :: [T.Pitch] -> L.Music -> L.Music replace_notes_p ns = snd . transform_st (replace_notes_fn id) ns -replace_notes :: [Music] -> Music -> Music-replace_notes ns = snd . transform_st (replace_notes_fn note_pitch) ns+replace_notes :: [L.Music] -> L.Music -> L.Music+replace_notes ns = snd . transform_st (replace_notes_fn L.note_pitch) ns  -- * Insert -insert_after_notes_fn :: [Maybe Music] -> Music -> ([Maybe Music], Music)+insert_after_notes_fn :: [Maybe L.Music] -> L.Music -> ([Maybe L.Music], L.Music) insert_after_notes_fn xs m =     case xs of       [] -> ([], m)       (y:ys) -> if L.is_note m && not (L.is_tied m)                 then (ys, case y of                             Nothing -> m-                            Just y' -> Join [m,y'])+                            Just y' -> L.Join [m,y'])                 else (xs, m)  -- | Inserts a value after each note as indicated.-insert_after_notes :: [Maybe Music] -> Music -> Music+insert_after_notes :: [Maybe L.Music] -> L.Music -> L.Music insert_after_notes xs = snd . transform_st insert_after_notes_fn xs  -- * Tied notes@@ -529,7 +536,7 @@               _ -> ns     in fn True -discard_tied_notes :: [Music] -> [Music]+discard_tied_notes :: [L.Music] -> [L.Music] discard_tied_notes =     let i_pr = L.is_tied         f_pr = not . has_pitch@@ -543,37 +550,37 @@  -- * Spelling -spell_ks :: (Octave, PitchClass) -> Music+spell_ks :: (T.Octave, T.PitchClass) -> L.Music spell_ks (o,pc) =     let (n,a) = T.pc_spell_ks pc-    in Note (Pitch n a o) Nothing []+    in L.Note (T.Pitch n a o) Nothing [] -spell_sharp :: (Octave, PitchClass) -> Music+spell_sharp :: (T.Octave, T.PitchClass) -> L.Music spell_sharp (o,pc) =     let (n,a) = T.pc_spell_sharp pc-    in Note (Pitch n a o) Nothing []+    in L.Note (T.Pitch n a o) Nothing [] -spell_flat :: (Octave, PitchClass) -> Music+spell_flat :: (T.Octave, T.PitchClass) -> L.Music spell_flat (o,pc) =     let (n,a) = T.pc_spell_flat pc-    in Note (Pitch n a o) Nothing []+    in L.Note (T.Pitch n a o) Nothing []  -- * Validation -v_assert :: String -> (Music -> Bool) -> Music -> Maybe String+v_assert :: String -> (L.Music -> Bool) -> L.Music -> Maybe String v_assert str fn m =     if fn m then Nothing else Just str --- | Notes in chords must not have duration.-v_chord_note_valid :: Music -> Maybe String+-- | L.Notes in chords must not have duration.+v_chord_note_valid :: L.Music -> Maybe String v_chord_note_valid =-    let fn (Note _ Nothing _) = True+    let fn (L.Note _ Nothing _) = True         fn _ = False     in v_assert "v_chord_note_valid" fn -validate :: Music -> [String]+validate :: L.Music -> [String] validate m =     case m of-      Chord [] _ _ -> ["empty chord"]-      Chord xs _ _ -> mapMaybe v_chord_note_valid xs+      L.Chord [] _ _ -> ["empty chord"]+      L.Chord xs _ _ -> mapMaybe v_chord_note_valid xs       _ -> []

@@ -1,12 +1,12 @@ module Music.LilyPond.Light.Annotation where -import Data.Maybe-import Data.Monoid+import Data.Maybe {- base -}+import Music.Theory.Pitch {- hmt -}+ import Music.LilyPond.Light.Constant import Music.LilyPond.Light.Model import Music.LilyPond.Light.Notation import Music.LilyPond.Light.Output.LilyPond-import Music.Theory.Pitch {- hmt -}  -- | Can a 'Music' element be annotated?  'Skip' and 'Command' do not -- ordinarily allow annotations, though there are some cases...@@ -31,6 +31,18 @@       Command c as -> Just (Command c (as ++ as'))       _ -> Nothing +-- | Remove any annotations.+clear_annotations :: Music -> Music+clear_annotations m =+    case m of+      Note n d _ -> Note n d []+      Chord n d _ -> Chord n d []+      Rest ty d _ -> Rest ty d []+      Skip d _ -> Skip d []+      MMRest i j _ -> MMRest i j []+      Command c _ -> Command c []+      _ -> m+ -- | Erroring variant. add_annotations_err :: [Annotation] -> Music -> Music add_annotations_err a m =@@ -101,12 +113,12 @@ 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_mark x = CompositeAnnotation [Text_Mark 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_Markup x]  arco,pizz :: Annotation arco = text_above "arco"

@@ -15,9 +15,10 @@ laissezVibrer = Articulation LaissezVibrer glissando = Articulation Glissando -marcato,staccato,tenuto,accent :: Annotation+marcato,staccato,staccatissimo,tenuto,accent :: Annotation marcato = Articulation Marcato staccato = Articulation Staccato+staccatissimo = Articulation Staccatissimo tenuto = Articulation Tenuto accent = Articulation Accent @@ -33,8 +34,9 @@ treble_clef = Clef (C.Clef C.Treble 0) percussion_clef = Clef (C.Clef C.Percussion 0) -bass_8vb_clef,treble_8va_clef,treble_8vb_clef,treble_15ma_clef :: Music+bass_8vb_clef,bass_15mb_clef,treble_8va_clef,treble_8vb_clef,treble_15ma_clef :: Music bass_8vb_clef = Clef (C.Clef C.Bass (-1))+bass_15mb_clef = Clef (C.Clef C.Bass (-2)) treble_8va_clef = Clef (C.Clef C.Treble 1) treble_8vb_clef = Clef (C.Clef C.Treble (-1)) treble_15ma_clef = Clef (C.Clef C.Treble 2)@@ -44,14 +46,18 @@ bar_line_check :: Music bar_line_check = Command BarlineCheck [] -normal_barline,double_barline,final_barline,tick_barline,dashed_barline,dotted_barline :: Music+normal_barline,double_barline,final_barline,tick_barline,dashed_barline,dotted_barline,invisible_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) []+invisible_barline = Command (Bar InvisibleBarline) [] +user_barline :: String -> Music+user_barline x = Command (Bar (UserBarline x)) []+ system_break,no_system_break :: Music system_break = Command Break [] no_system_break = Command NoBreak []@@ -124,20 +130,19 @@ rAcc = ReminderAccidental cAcc = CautionaryAccidental -set_accidental_style_dodecaphonic :: Music-set_accidental_style_dodecaphonic =-    let x = "#(set-accidental-style 'dodecaphonic)"+set_accidental_style :: String -> Music+set_accidental_style ty =+    let x = "#(set-accidental-style '" ++ ty ++ ")"     in Command (User x) [] +set_accidental_style_dodecaphonic :: Music+set_accidental_style_dodecaphonic = set_accidental_style "dodecaphonic"+ set_accidental_style_neo_modern :: Music-set_accidental_style_neo_modern =-    let x = "#(set-accidental-style 'neo-modern)"-    in Command (User x) []+set_accidental_style_neo_modern = set_accidental_style "neo-modern"  set_accidental_style_modern :: Music-set_accidental_style_modern =-    let x = "#(set-accidental-style 'modern)"-    in Command (User x) []+set_accidental_style_modern = set_accidental_style "modern"  -- * Noteheads 

@@ -1,26 +1,31 @@ -- | Dynamic constants. module Music.LilyPond.Light.Constant.Dynamic where +import qualified Music.Theory.Dynamic_Mark as T {- hmt -}+ import Music.LilyPond.Light.Model-import Music.Theory.Dynamic_Mark {- hmt -} +dynamic_mark :: T.Dynamic_Mark_T -> Annotation+dynamic_mark dyn = Dynamic (Dynamic_Mark dyn)+ pppp,ppp,pp,p,mp,mf,f,ff,fff,ffff,fp,sfz :: Annotation-pppp = Dynamic (Dynamic_Mark PPPP)-ppp = Dynamic (Dynamic_Mark PPP)-pp = Dynamic (Dynamic_Mark PP)-p = Dynamic (Dynamic_Mark P)-mp = Dynamic (Dynamic_Mark MP)-mf = Dynamic (Dynamic_Mark MF)-f = Dynamic (Dynamic_Mark F)-ff = Dynamic (Dynamic_Mark FF)-fff = Dynamic (Dynamic_Mark FFF)-ffff = Dynamic (Dynamic_Mark FFFF)-fp = Dynamic (Dynamic_Mark FP)-sfz = Dynamic (Dynamic_Mark SFZ)+pppp = dynamic_mark T.PPPP+ppp = dynamic_mark T.PPP+pp = dynamic_mark T.PP+p = dynamic_mark T.P+mp = dynamic_mark T.MP+mf = dynamic_mark T.MF+f = dynamic_mark T.F+ff = dynamic_mark T.FF+fff = dynamic_mark T.FFF+ffff = dynamic_mark T.FFFF+fp = dynamic_mark T.FP+sfz = dynamic_mark T.SFZ -cresc,decr,end_cresc,end_decr,espressivo :: Annotation-cresc = Dynamic (Hairpin Crescendo)-decr = Dynamic (Hairpin Diminuendo)-end_cresc = Dynamic (Hairpin End_Hairpin)-end_decr = Dynamic (Hairpin End_Hairpin)+cresc,decr,end_hairpin,end_cresc,end_decr,espressivo :: Annotation+cresc = Dynamic (Hairpin T.Crescendo)+decr = Dynamic (Hairpin T.Diminuendo)+end_hairpin = Dynamic (Hairpin T.End_Hairpin)+end_cresc = end_hairpin+end_decr = end_hairpin espressivo = Dynamic Espressivo

@@ -1,12 +1,13 @@ module Music.LilyPond.Light.Literal (l,r,r',module L) where +import Music.Theory.Duration {- hmt -}+import Music.Theory.Time_Signature+ import Music.LilyPond.Light.Constant import Music.LilyPond.Light.Constant.Dynamic as L import Music.LilyPond.Light.Constant.Note as L import Music.LilyPond.Light.Model import Music.LilyPond.Light.Notation-import Music.Theory.Duration {- hmt -}-import Music.Theory.Time_Signature  l :: Music l = bar_line_check

@@ -5,6 +5,11 @@ type M_Annotation = Music data Measure = Measure [M_Annotation] [Music] deriving (Eq,Show) +-- | Prepend annotation to existing annotations at measure.+m_annotate_pre :: M_Annotation -> Measure -> Measure+m_annotate_pre a (Measure as xs) = Measure (a : as) xs++-- | Append annotation to existing annotations at measure. m_annotate :: M_Annotation -> Measure -> Measure m_annotate a (Measure as xs) = Measure (as++[a]) xs 

@@ -1,13 +1,12 @@ module Music.LilyPond.Light.Model where -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-import Music.Theory.Time_Signature+import qualified Music.Theory.Clef as T {- hmt -}+import qualified Music.Theory.Pitch as T {- hmt -}+import qualified Music.Theory.Pitch.Note as T {- hmt -}+import qualified Music.Theory.Duration as T {- hmt -}+import qualified Music.Theory.Dynamic_Mark as T {- hmt -}+import qualified Music.Theory.Key as T {- hmt -}+import qualified Music.Theory.Time_Signature as T {- hmt -}  data Version = Version String                deriving (Eq, Show)@@ -40,6 +39,8 @@                    , systems_count :: Maybe Integer                    , page_count :: Maybe Integer                    , system_separator_markup :: Maybe String+                   , system_spacing_basic_distance :: Maybe Integer+                   , system_spacing_minimum_distance :: Maybe Integer                    }              deriving (Eq, Show) @@ -68,7 +69,7 @@                     | Marcato                     | Open                     | Portato-                    | Staccato+                    | Staccato | Staccatissimo                     | StemTremolo Integer                     | Stopped                     | Tenuto@@ -76,8 +77,8 @@                     | UpBow                       deriving (Eq, Show) -data Dynamic_T = Dynamic_Mark Dynamic_Mark_T-               | Hairpin Hairpin_T+data Dynamic_T = Dynamic_Mark T.Dynamic_Mark_T+               | Hairpin T.Hairpin_T                | Espressivo                  deriving (Eq, Show) @@ -99,11 +100,15 @@                 | Phrasing Phrasing_T                 | Begin_Tie                 | Place_Above | Place_Default | Place_Below-                | Text_Mark | Text Text_T String-                | ReminderAccidental | CautionaryAccidental+                | Text_Mark Text_T String+                | Text Text_T String+                | ReminderAccidental | CautionaryAccidental | Parentheses                 | CompositeAnnotation [Annotation]+                | Tweak String                   deriving (Eq, Show) +{-| Repeat barline types = ".|:", ":..:", ":|.|:", ":|.:", ":.|.:",+"[|:", ":|][|:" ":|]", ":|."-} data Bar_T = NormalBarline            | DoubleBarline            | LeftRepeatBarline@@ -112,6 +117,8 @@            | DottedBarline            | DashedBarline            | TickBarline+           | InvisibleBarline+           | UserBarline String              deriving (Eq, Show)  data Command_T = AutoBeamOff@@ -127,7 +134,8 @@                | NoPageBreak                | Octavation Integer                | PageBreak-               | Partial Duration+               | Partial T.Duration+               | Rehearsal_Mark (Maybe Int)                | StemDown                | StemNeutral                | StemUp@@ -141,6 +149,7 @@                | VoiceFour                  deriving (Eq, Show) +-- | (Denominator,Numerator) type Tuplet_T = (Integer, Integer)  data Tuplet_Mode = Normal_Tuplet@@ -191,25 +200,25 @@ -- | 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+data Music = Note { note_pitch :: T.Pitch+                  , note_duration :: Maybe T.Duration                   , note_annotations :: [Annotation] }            | Chord { chord_notes :: [Music]-                   , chord_duration :: Duration+                   , chord_duration :: T.Duration                    , chord_annotations :: [Annotation] }            | Tremolo (Either Music (Music,Music)) Integer-           | Rest Rest_T Duration [Annotation]-           | MMRest Integer Time_Signature [Annotation]-           | Skip Duration [Annotation]+           | Rest Rest_T T.Duration [Annotation]+           | MMRest Integer T.Time_Signature [Annotation]+           | Skip T.Duration [Annotation]            | Repeat Integer Music            | Tuplet Tuplet_Mode Tuplet_T Music            | Grace Music            | AfterGrace Music Music            | Join [Music]-           | Clef (C.Clef Int)-           | Time Time_Signature-           | Key Note_T (Maybe Alteration_T) Mode_T-           | Tempo (Maybe String) Duration Rational+           | Clef (T.Clef Int)+           | Time T.Time_Signature+           | Key T.Note_T (Maybe T.Alteration_T) T.Mode_T+           | Tempo (Maybe String) T.Duration Rational            | Command Command_T [Annotation]            | Polyphony Music Music            | Empty@@ -228,7 +237,12 @@              | Rhythmic_Staff                deriving (Eq, Show) -data Part = Part (Maybe String) [Music]+-- data Part_Context = Lyrics String | Figured_Bass String++type Voice_Text = String+type Chord_Text = String++data Part = Part (Maybe Chord_Text) (Maybe Voice_Text) [Music]           | MultipleParts [[Music]]             deriving (Eq, Show) @@ -251,7 +265,7 @@ data Score_Settings =     Score_Settings {independent_time_signatures :: Bool                    ,hide_time_signatures :: Bool-                   ,remove_empty_staves :: Bool+                   ,remove_empty_staves :: Bool -- ^ French score (hide empty staves)                    ,remove_empty_staves_first_system :: Bool}     deriving (Eq, Show) 

@@ -1,19 +1,19 @@ module Music.LilyPond.Light.Notation where  import Data.List {- base -}+import qualified Data.List.Split as Split {- split -} 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 qualified Music.Theory.Duration as T {- hmt -}+import qualified Music.Theory.Duration.Annotation as T {- hmt -}+import qualified Music.Theory.Duration.RQ as T {- hmt -}+import qualified Music.Theory.Duration.Sequence.Notate as T {- hmt -}+import qualified Music.Theory.Key as T {- hmt -}+import qualified Music.Theory.Pitch as T {- hmt -}+import qualified Music.Theory.Pitch.Spelling.Table as T {- hmt -}+import qualified Music.Theory.Time_Signature as T {- hmt -}  import Music.LilyPond.Light.Constant import Music.LilyPond.Light.Measure@@ -82,6 +82,17 @@ is_tuplet :: Music -> Bool is_tuplet = is_music_c Tuplet_C +-- * Duration++-- | If 'Music' is a 'Note', 'Chord' or 'Rest' give duration, else 'Nothing'.+music_immediate_duration :: Music -> Maybe T.Duration+music_immediate_duration m =+    case m of+      Note _ d _ -> d+      Chord _ d _ -> Just d+      Rest _ d _ -> Just d+      _ -> Nothing+ -- * Pitch  -- | Remove any reminder or cautionary accidentals at note or chord.@@ -93,25 +104,25 @@          Chord xs d a -> Chord (map clr_acc xs) d a          _ -> error ("clr_acc at non-note/chord: " ++ ly_music_elem m) -octpc_to_note :: (Octave, PitchClass) -> Music-octpc_to_note x = Note (octpc_to_pitch pc_spell_ks x) Nothing []+octpc_to_note :: (T.Octave, T.PitchClass) -> Music+octpc_to_note x = Note (T.octpc_to_pitch T.pc_spell_ks x) Nothing []  -- * Rests  -- | Construct normal rest.-rest :: Duration -> Music+rest :: T.Duration -> Music rest x = Rest Normal_Rest x []  -- | Construct spacer rest.-spacer_rest :: Duration -> Music+spacer_rest :: T.Duration -> Music spacer_rest x = Rest Spacer_Rest x []  -- | Multi-measure variant of 'rest'.-mm_rest :: Time_Signature -> Music+mm_rest :: T.Time_Signature -> Music mm_rest x = MMRest 1 x []  -- | Non-printing variant of 'rest'.-skip :: Duration -> Music+skip :: T.Duration -> Music skip x = Skip x []  -- | Create an empty measure for the specified time signature.@@ -121,7 +132,7 @@ -- | Like 'empty_measure', but with an invisible rest. null_measure :: Integer -> Integer -> Music null_measure n d =-    let x = Duration d 0 1+    let x = T.Duration d 0 1         l = [bar_line_check]     in mconcat (map (\i -> Skip i []) (genericReplicate n x) ++ l) @@ -136,7 +147,7 @@ -- * Tuplets  -- | Apply a 'Duration' function to a 'Music' node, if it has a duration.-edit_dur :: (Duration -> Duration) -> Music -> Music+edit_dur :: (T.Duration -> T.Duration) -> Music -> Music edit_dur fn x =     case x of       Note _ Nothing _ -> x@@ -149,7 +160,7 @@ -- | Temporal scaling of music (tuplets). tuplet :: Tuplet_T -> [Music] -> Music tuplet (d,n) =-    let fn x = x { multiplier = n%d }+    let fn x = x { T.multiplier = n%d }     in Tuplet Normal_Tuplet (n,d) . mconcat . map (edit_dur fn)  -- | Tuplet variants that set location, and then restore to neutral.@@ -161,18 +172,18 @@ --   'ts_set_fraction'. scale_durations :: Tuplet_T -> [Music] -> Music scale_durations (n,d) =-    let fn x = x { multiplier = d%n }+    let fn x = x { T.multiplier = d%n }     in Tuplet Scale_Durations (n,d) . mconcat . map (edit_dur fn)  -- * Time signatures  -- | Construct time signature.-time_signature :: Time_Signature -> Music+time_signature :: T.Time_Signature -> Music time_signature = Time  -- | Allow proper auto-indenting of multiple measures with the same --   time signature.-with_time_signature :: Time_Signature -> [Music] -> Music+with_time_signature :: T.Time_Signature -> [Music] -> Music with_time_signature ts xs = mconcat (time_signature ts : xs)  {-@@ -203,11 +214,18 @@     let x = "\\override Staff.TimeSignature #'stencil = #(lambda (grob) (bracketify-stencil (ly:time-signature::print grob) Y 0.1 0.2 0.1))"     in Command (User x) [] +-- | Hide time signatures if 'False'. ts_stencil :: Bool -> Music ts_stencil x =     let c = "\\override Staff.TimeSignature #'stencil = " ++ ly_bool x     in Command (User c) [] +-- | Hide metronome mark if 'False'.+mm_stencil :: Bool -> Music+mm_stencil x =+    let c = "\\override Score.MetronomeMark #'stencil = " ++ ly_bool x+    in Command (User c) []+ ts_transparent :: Bool -> Music ts_transparent x =     let c = "\\override Staff.TimeSignature #'transparent = " ++ ly_bool x@@ -221,11 +239,8 @@ -- * Key signatures  -- | Construct key signature.-key :: Music -> Mode_T -> Music-key m md =-    case m of-      (Note (Pitch n a _) _ _) -> Key n (Just a) md-      _ -> error "key"+key :: T.Key -> Music+key (n,a,md) = Key n (Just a) md  -- * Repetition @@ -236,50 +251,59 @@ -- * Octave  -- | Shift the octave of a note element, else identity.-note_edit_octave :: (Octave -> Octave) -> Music -> Music+note_edit_octave :: (T.Octave -> T.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+      Note (T.Pitch n a o) d xs -> Note (T.Pitch n a (fn o)) d xs       _ -> m  -- | Shift the octave of a note element, else identity.-note_shift_octave :: Octave -> Music -> Music+note_shift_octave :: T.Octave -> Music -> Music note_shift_octave i = note_edit_octave (+ i)  -- * Duration --- > tie_r_ann [Tie_Right] == [Begin_Tie]-tie_r_ann :: [D_Annotation] -> [Annotation]-tie_r_ann a = if any (== Tie_Right) a then [Begin_Tie] else []+-- > tie_r_ann [T.Tie_Right] == [Begin_Tie]+tie_r_ann :: [T.D_Annotation] -> [Annotation]+tie_r_ann a = if any (== T.Tie_Right) a then [Begin_Tie] else [] +-- | If there is a 'T.Tie_Left', then clear the appropriate annotations.+-- (Actually just all...)+clear_l_ann :: [T.D_Annotation] -> [Annotation] -> [Annotation]+clear_l_ann d_a m_a = if any (== T.Tie_Left) d_a then [] else m_a+ -- | Rest of  'Duration_A'.-da_rest :: Duration_A -> Music+da_rest :: T.Duration_A -> Music da_rest (d,_) = Rest Normal_Rest d []  -- | Add 'Duration_A' to 'Pitch' to make a @Note@ 'Music' element.-(##@) :: Pitch -> Duration_A -> Music+(##@) :: T.Pitch -> T.Duration_A -> Music x ##@ (d,a) = Note x (Just d) (tie_r_ann a)  -- | Add 'Duration' to 'Pitch' to make a @Note@ 'Music' element.-(##) :: Pitch -> Duration -> Music+(##) :: T.Pitch -> T.Duration -> Music x ## d = x ##@ (d,[]) --- | Add 'Duration_A' to either a @Note@ or @Chord@ 'Music' element.-(#@) :: Music -> Duration_A -> Music+-- | Add 'Duration_A' to either a @Note@, @Chord@ or @Rest@ 'Music' element.+(#@) :: Music -> T.Duration_A -> Music x #@ (d,a) =     case x of-      Note n _ a' -> Note n (Just d) (tie_r_ann a ++ a')-      Chord n _ a' -> Chord n d (tie_r_ann a ++ a')-      _ -> error ("###: " ++ show x)+      Note n _ a' -> Note n (Just d) (tie_r_ann a ++ clear_l_ann a a')+      Chord n _ a' -> Chord n d (tie_r_ann a ++ clear_l_ann a a')+      Rest ty _ a' -> Rest ty d (clear_l_ann a a')+      _ -> error ("#@: " ++ show x) --- | Add 'Duration' to either a @Note@ or @Chord@ 'Music' element.-(#) :: Music -> Duration -> Music-x # d = x #@ (d,[])+-- | Add 'Duration' to either a @Note@ or @Chord@ or @Rest@ 'Music' element.+(#) :: Music -> T.Duration -> Music+x # d =+    case x of+      Rest ty _ a -> Rest ty d a+      _ -> x #@ (d,[])  -- * Chords  -- | Construct chord from 'Pitch' elements.-chd_p_ann :: [Pitch] -> [[Annotation]] -> Duration -> Music+chd_p_ann :: [T.Pitch] -> [[Annotation]] -> T.Duration -> Music chd_p_ann xs an d =     let f x a = Note x Nothing a     in case xs of@@ -287,11 +311,11 @@          _ -> Chord (zipWith f xs an) d []  -- | Construct chord from 'Pitch' elements.-chd_p :: [Pitch] -> Duration -> Music+chd_p :: [T.Pitch] -> T.Duration -> Music chd_p xs = chd_p_ann xs (repeat [])  -- | Construct chord from 'Music' elements.-chd :: [Music] -> Duration -> Music+chd :: [Music] -> T.Duration -> Music chd xs d =     case xs of       [] -> error "chd: null elements"@@ -320,7 +344,7 @@ change x = Command (Change x) []  -- | Indicate initial partial measure.-partial :: Duration -> Music+partial :: T.Duration -> Music partial d = Command (Partial d) []  -- | Set or unset the @circled-tip@ hairpin attribute.@@ -358,23 +382,29 @@       "" -> "no_id"       _ -> "id_" ++ x +staff_line_count :: Int -> Music+staff_line_count n =+    let x = "\\override Staff.StaffSymbol.line-count = #" ++ show n+    in Command (User x) []++staff' :: Staff_T -> Staff_Name -> [Music] -> Staff+staff' ty nm =+    let st = Staff_Settings ty (name_to_id nm) 0+    in Staff st nm . Part Nothing Nothing+ -- | Construct staff. staff :: Staff_Name -> [Music] -> Staff-staff nm =-    let st = Staff_Settings Normal_Staff (name_to_id nm) 0-    in Staff st nm . Part Nothing+staff = staff' Normal_Staff  -- | Construct rhythmic staff. rhythmic_staff :: Staff_Name -> [Music] -> Staff-rhythmic_staff nm =-    let st = Staff_Settings Rhythmic_Staff (name_to_id nm) 0-    in Staff st nm . Part Nothing+rhythmic_staff = staff' Rhythmic_Staff  -- | Construct staff with text underlay. text_staff :: Staff_Name -> String -> [Music] -> Staff text_staff nm txt =     let st = Staff_Settings Normal_Staff (name_to_id nm) 0-    in Staff st nm . Part (Just txt)+    in Staff st nm . Part Nothing (Just txt)  -- | Construct piano staff.  For two staff piano music the staffs have --   identifiers rh and lh.@@ -386,8 +416,8 @@           in Staff_Set              PianoStaff              nm-             [Staff (st "rh") ("","") (Part Nothing rh)-             ,Staff (st "lh") ("","") (Part Nothing lh)]+             [Staff (st "rh") ("","") (Part Nothing Nothing rh)+             ,Staff (st "lh") ("","") (Part Nothing Nothing lh)]       _ -> Staff_Set PianoStaff nm (map (staff ("","")) xs)  grand_staff :: Staff_Name -> [[Music]] -> Staff@@ -400,11 +430,14 @@ rhythmic_grand_staff nm = Staff_Set GrandStaff nm . map (rhythmic_staff ("",""))  -- | Variant with names for each staff.+staff_set :: (Staff_Set_T,Staff_T) -> Staff_Name -> [Staff_Name] -> [[Music]] -> Staff+staff_set (set_ty,stf_ty) nm xs ys = Staff_Set set_ty nm (zipWith (staff' stf_ty) xs ys)+ grand_staff' :: Staff_Name -> [Staff_Name] -> [[Music]] -> Staff-grand_staff' nm xs ys = Staff_Set GrandStaff nm (zipWith staff xs ys)+grand_staff' = staff_set (GrandStaff,Normal_Staff)  staff_group' :: Staff_Name -> [Staff_Name] -> [[Music]] -> Staff-staff_group' nm xs ys = Staff_Set StaffGroup nm (zipWith staff xs ys)+staff_group' = staff_set (StaffGroup,Normal_Staff)  two_part_staff :: Staff_Name -> ([Music], [Music]) -> Staff two_part_staff nm (p0, p1) =@@ -447,7 +480,7 @@             case xs of               [] -> []               Rest ty d a : Rest ty' d' a' : ys ->-                  case sum_dur d d' of+                  case T.sum_dur d d' of                     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 ty' d'' (a ++ a') : ys)@@ -457,7 +490,7 @@ -- * 'Duration_A' functions  -- | Transform ascribed 'Duration_A' value to 'Music'.-type DA_F x = (Duration_A,x) -> Music+type DA_F x = (T.Duration_A,x) -> Music  {- | Given 'DA_F' transform, transform set of ascribed 'Duration_A' values to 'Music'.@@ -474,7 +507,7 @@ > 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 :: DA_F t -> [(T.Duration_A,t)] -> [Music] da_to_music fn x =     let g = T.da_group_tuplets_nn (map fst x)         g' = T.nn_reshape (,) g (map snd x)@@ -486,7 +519,7 @@     in map tr g'  -- | Variant of 'da_to_music' that operates on sets of measures.-da_to_measures :: DA_F x -> Maybe [Time_Signature] -> [[(Duration_A,x)]] -> [Measure]+da_to_measures :: DA_F x -> Maybe [T.Time_Signature] -> [[(T.Duration_A,x)]] -> [Measure] da_to_measures fn m_t x =     let m = map (da_to_music fn) x         jn i = Measure [i]@@ -500,14 +533,14 @@ > 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]+>     ;[Measure _ m] = rq_to_measures 4 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+rq_to_measures :: (Show x) => Int -> DA_F x -> [T.Simplify_T] -> [T.Time_Signature] -> Maybe [[T.RQ]] -> [T.RQ] -> [x] -> [Measure]+rq_to_measures limit fn r ts rqp rq x =+    let da = T.notate_mm_ascribe_err limit r ts rqp rq x     in da_to_measures fn (Just ts) da  -- * Fragment@@ -532,8 +565,10 @@  -- * Text -text_length_on :: Music+-- | Make text annotations respace music to avoid vertical displacement.+text_length_on,text_length_off :: Music text_length_on = Command (User "\\textLengthOn") []+text_length_off = Command (User "\\textLengthOff") []  text_outside_staff_priority :: Maybe Double -> Music text_outside_staff_priority x =@@ -551,7 +586,7 @@  -- * Measure operations --- | Delete redundant (repeated) time signatures.+-- | Delete (remove) redundant (repeated, duplicated) time signatures. -- -- > let mm = [Measure [Time (3,4)] [],Measure [Time (3,4)] []] -- > in mm_delete_redundant_ts mm == [Measure [Time (3,4)] [],Measure [] []]@@ -567,7 +602,24 @@                       _ -> (st,m)     in snd . mapAccumL f Nothing +-- | Group measures per system.+mm_measures_per_system :: [Int] -> [Measure] -> [Measure]+mm_measures_per_system n mm =+  let f (m0:l) = m_annotate_pre system_break m0 : l+      f [] = error "mm_measures_per_system"+  in case Split.splitPlaces n mm of+       g0:l -> concat (g0 : map f l)+       _ -> mm++-- | Prepend 'system_break' at every nth measure.+mm_measures_per_system_eq :: Int -> [Measure] -> [Measure]+mm_measures_per_system_eq n =+    let f k m = if k /= 0 && k `mod` n == 0+                then m_annotate_pre system_break m+                else m+    in zipWith f [0..]+ -- * Rehearsal marks  default_rehearsal_mark :: Music-default_rehearsal_mark = Command (User "\\mark \\default") []+default_rehearsal_mark = Command (Rehearsal_Mark Nothing) []

@@ -89,6 +89,8 @@              ,("systems-count", opt (systems_count p))              ,("page-count", opt (page_count p))              ,("system-separator-markup", fromMaybe "" (system_separator_markup p))+             ,("system-system-spacing.basic-distance", opt (system_spacing_basic_distance p))+             ,("system-system-spacing.minimum-distance", opt (system_spacing_minimum_distance p))              ]         ys = ly_delete_nil_values (xs ++ mg)     in "\\paper" : with_braces (concat (map (ly_assign id) ys))@@ -182,6 +184,7 @@       Open -> "\\open"       Portato -> "\\portato"       Staccato -> "\\staccato"+      Staccatissimo -> "\\staccatissimo"       StemTremolo x -> ':' : show x       Stopped -> "\\stopped"       Tenuto -> "\\tenuto"@@ -224,6 +227,13 @@       SustainOn -> "\\sustainOn"       SustainOff -> "\\sustainOff" +ly_text :: Text_T -> String -> String+ly_text ty x =+    case ty of+      Text_Symbol -> ly_sym x+      Text_Plain -> ly_str x+      Text_Markup -> ly_markup x+ ly_annotation :: Annotation -> String ly_annotation a =     case a of@@ -234,25 +244,36 @@       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 -> ly_markup x+      Text_Mark ty x -> "\\mark " ++ ly_text ty x+      Text ty x -> ly_text ty x       CompositeAnnotation xs -> unwords (map ly_annotation xs)       ReminderAccidental -> "" -- see ly_pitch       CautionaryAccidental -> "" -- see ly_pitch+      Parentheses -> "" -- see ly_music+      Tweak _ -> "" -- see ly_music +ly_tweak :: Annotation -> Maybe String+ly_tweak a =+  case a of+    Tweak str -> Just ("\\tweak " ++ str)+    _ -> Nothing++ly_tweaks :: [Annotation] -> String+ly_tweaks = unwords . mapMaybe ly_tweak+ ly_bar :: Bar_T -> String ly_bar b =     case b of       NormalBarline -> "|"       DoubleBarline -> "||"-      LeftRepeatBarline -> "|:"-      RightRepeatBarline -> ":|"+      LeftRepeatBarline -> ".|:"+      RightRepeatBarline -> ":|."       FinalBarline -> "|."       DottedBarline -> ":"-      DashedBarline -> "dashed"+      DashedBarline -> "!"       TickBarline -> "'"+      InvisibleBarline -> ""+      UserBarline s -> s  ly_command :: Command_T -> String ly_command c =@@ -271,6 +292,8 @@       Octavation x -> "\\ottava #" ++ show x       PageBreak -> "\\pageBreak"       Partial x -> "\\partial " ++ ly_duration x+      Rehearsal_Mark Nothing -> "\\mark \\default"+      Rehearsal_Mark (Just n) -> "\\mark #" ++ show n       StemDown -> "\\stemDown"       StemNeutral -> "\\stemNeutral"       StemUp -> "\\stemUp"@@ -298,14 +321,16 @@       Normal_Rest -> "r"       Spacer_Rest -> "s" +ly_paren :: [Annotation] -> [String] -> [String]+ly_paren a = if Parentheses `elem` a then ("\\parenthesize" :) else id+ ly_music :: Music -> [String] ly_music m =     case m of-      Note p d aa -> [ly_pitch aa p, maybe "" ly_duration d] ++-                     map ly_annotation aa-      Chord xs d aa -> with_brackets ("<",">") (ly_music_l xs) ++-                       [ly_duration d] ++-                       map ly_annotation aa+      Note p d aa -> ly_paren aa ([ly_tweaks aa,ly_pitch aa p, maybe "" ly_duration d] ++ map ly_annotation aa)+      Chord xs d aa -> ly_paren aa (ly_tweaks aa :+                                     with_brackets ("<",">") (ly_music_l xs) +++                                     [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)@@ -364,9 +389,11 @@                      ,"Lyrics"                      ,"\\lyricsto"                      ,ly_str i] ++ with_braces [" " ++ txt ++ " "]+        mk_chd txt = ["\\new","ChordNames","\\chordmode"] +++                     with_braces [" " ++ txt ++ " "]     in case p of-         (Part Nothing xs) -> with_braces (nm ++ ly_music (Join xs))-         (Part (Just txt) xs) -> brk (nm ++ mk_v xs ++ mk_txt txt)+         (Part Nothing Nothing xs) -> with_braces (nm ++ ly_music (Join xs))+         (Part chd txt xs) -> brk (nm ++ mk_v xs ++ maybe [] mk_chd chd ++ maybe [] mk_txt txt)          (MultipleParts xs) -> brk (concatMap mk_v xs)  ly_staff_set_t :: Staff_Set_T -> String@@ -418,12 +445,13 @@  ly_remove_empty_staves :: Bool -> [String] ly_remove_empty_staves g =-    ["\\context {"-    ,"  \\Staff \\RemoveEmptyStaves"-    ,if g-     then "   \\override VerticalAxisGroup #'remove-first = ##t"-     else ""-    ,"}"]+    let f stf = ["\\context {"+                ,"  \\" ++ stf ++ "\\RemoveEmptyStaves"+                ,if g+                 then "   \\override VerticalAxisGroup #'remove-first = ##t"+                 else ""+                ,"}"]+    in concatMap f ["Staff","RhythmicStaff"]  ly_hide_time_signatures :: [String] ly_hide_time_signatures =

@@ -29,6 +29,8 @@           ,systems_count = Nothing           ,page_count = Nothing           ,system_separator_markup = Nothing+          ,system_spacing_basic_distance = Nothing+          ,system_spacing_minimum_distance = Nothing           }  b4_paper :: Paper@@ -43,12 +45,15 @@       ,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 =+paper_set_margins_mm_generic :: Real n => n -> n -> n -> n -> Paper -> Paper+paper_set_margins_mm_generic t l b r =     let mm x = Length (realToFrac x) MM     in paper_set_margins (mm t) (mm l) (mm b) (mm r) +-- | Variant with margins given in /mm/.+paper_set_margins_mm :: Double -> Double -> Double -> Double -> Paper -> Paper+paper_set_margins_mm = paper_set_margins_mm_generic+ length_scale :: Double -> Length -> Length length_scale n (Length x u) = Length (n * x) u @@ -103,4 +108,6 @@           ,systems_count = Nothing           ,page_count = Nothing           ,system_separator_markup = Nothing+          ,system_spacing_basic_distance = Nothing+          ,system_spacing_minimum_distance = Nothing           }

@@ -7,11 +7,19 @@ See [hts](?t=hts) for an alternative writing to [MusicXML][music-xml], and [hmt-texts](?t=hmt-texts) for related work. +- _He will now think he hears her_. (2015) [→](?t=the-center-is-between-us&e=hears/README)+- _Another Mind Is Signaling You_. (2014) [→](?t=another-mind)+- _Autochthons (#1 — #5)_. (2014) [→](?t=sp-id&e=md/autochthons.md)+- _Robert Smithson: Displacements (#1—8, #10—18)_. (2014) [→](?t=sp-id&e=md/displacements.md)+- _Guild∘Psaltery (for AP, after LP)_. (2012) [→](?t=guild-psaltery)+- _and I suffered a complete collapse_. (2011) [→](?t=collapse)+- _Byzantium_. (2010) [→](?t=byzantium)+ [hs]: http://haskell.org/ [ly]: http://lilypond.org/ [music-xml]: http://www.makemusic.com/musicxml/ -© [rohan drape][rd], 2010-2014, [gpl]+© [rohan drape][rd], 2010-2017, [gpl]  [rd]: http://rd.slavepianos.org/ [gpl]: http://gnu.org/copyleft/

@@ -1,16 +1,16 @@ Name:              hly-Version:           0.15+Version:           0.16 Synopsis:          Haskell LilyPond Description:       A very lightweight embedding of the lilypond                    typesetting model in haskell License:           GPL Category:          Music-Copyright:         (c) Rohan Drape, 2010-2014+Copyright:         (c) Rohan Drape, 2010-2017 Author:            Rohan Drape Maintainer:        rd@slavepianos.org Stability:         Experimental Homepage:          http://rd.slavepianos.org/t/hly-Tested-With:       GHC == 7.8.2+Tested-With:       GHC == 8.0.1 Build-Type:        Simple Cabal-Version:     >= 1.8 Data-Files:        README@@ -18,11 +18,12 @@ --                 help/*.help.lhs  Library-  Build-Depends:   base == 4.*,+  Build-Depends:   base >= 4.8 && < 5,                    directory,                    filepath,-                   hmt == 0.15.*,-                   process+                   hmt == 0.16.*,+                   process,+                   split   GHC-Options:     -Wall -fwarn-tabs   Exposed-modules: Music.LilyPond.Light                    Music.LilyPond.Light.Analysis