packages feed

hly 0.1 → 0.11

raw patch · 6 files changed

+131/−87 lines, 6 filesdep ~hmt

Dependency ranges changed: hmt

Files

Music/LilyPond/Light.hs view
@@ -1,71 +1,63 @@ module Music.LilyPond.Light (module Music.LilyPond.Light-                            ,module Music.LilyPond.Light.Constant-                            ,module Music.LilyPond.Light.Constant.NoteName-                            ,module Music.LilyPond.Light.Model-                            ,module Music.LilyPond.Light.Output.LilyPond-                            ,module Music.Theory.Duration-                            ,module Music.Theory.Duration.Name-                            ,module Music.Theory.Key-                            ,module Music.Theory.Pitch) where+                            ,module L) where  import Data.List import Data.Monoid import Data.Ratio-import Music.LilyPond.Light.Constant-import Music.LilyPond.Light.Constant.NoteName-import Music.LilyPond.Light.Model-import Music.LilyPond.Light.Output.LilyPond-import Music.Theory.Duration-import Music.Theory.Duration.Name-import Music.Theory.Pitch-import Music.Theory.Key+import Music.LilyPond.Light.Constant as L+import Music.LilyPond.Light.Constant.NoteName as L+import Music.LilyPond.Light.Model as L+import Music.LilyPond.Light.Output.LilyPond as L+import Music.Theory.Duration as L+import Music.Theory.Duration.Name as L+import Music.Theory.Key as L+import Music.Theory.Pitch as L+import Music.Theory.Pitch.Spelling  -- * Music category predicates +is_music_c :: Music_C -> Music -> Bool+is_music_c c = (==) c . music_c+ is_note :: Music -> Bool-is_note (Note _ _ _) = True-is_note _ = False+is_note = is_music_c Note_C  is_chord :: Music -> Bool-is_chord (Chord _ _ _) = True-is_chord _ = False+is_chord = is_music_c Chord_C  is_rest :: Music -> Bool-is_rest (Rest _ _) = True-is_rest _ = False+is_rest = is_music_c Rest_C  is_mm_rest :: Music -> Bool-is_mm_rest (MMRest _ _ _) = True-is_mm_rest _ = False+is_mm_rest = is_music_c MMRest_C  is_grace :: Music -> Bool-is_grace (Grace _) = True-is_grace _ = False+is_grace = is_music_c Grace_C  is_after_grace :: Music -> Bool-is_after_grace (AfterGrace _ _) = True-is_after_grace _ = False+is_after_grace = is_music_c AfterGrace_C  -- | These are required to avoid issues in lilypond (see manual) is_grace_skip :: Music -> Bool-is_grace_skip (Grace (Skip _)) = True-is_grace_skip _ = False+is_grace_skip m =+    case m of+      Grace (Skip _) -> True+      _ -> False  is_clef :: Music -> Bool-is_clef (Clef _ _) = True-is_clef _ = False+is_clef = is_music_c Clef_C  is_time :: Music -> Bool-is_time (Time _) = True-is_time _ = False+is_time = is_music_c Time_C  is_tempo :: Music -> Bool-is_tempo (Tempo _ _) = True-is_tempo _ = False+is_tempo = is_music_c Tempo_C  is_barlinecheck :: Music -> Bool-is_barlinecheck (Command BarlineCheck) = True-is_barlinecheck _ = False+is_barlinecheck m =+    case m of+      Command BarlineCheck -> True+      _ -> False  is_tied :: Music -> Bool is_tied m =@@ -75,8 +67,7 @@       _ -> False  is_tuplet :: Music -> Bool-is_tuplet (Tuplet _ _ _) = True-is_tuplet _ = False+is_tuplet = is_music_c Tuplet_C  -- * Pitch @@ -98,7 +89,7 @@          _ -> 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 x) Nothing []+octpc_to_note x = Note (octpc_to_pitch pc_spell_ks x) Nothing []  -- * Rests @@ -106,6 +97,7 @@ r :: Duration -> Music r x = Rest x [] +-- | Multi-measure variant of 'r'. r' :: TimeSignature -> Music r' x = MMRest 1 x [] @@ -113,17 +105,17 @@ empty_measure :: Integer -> Integer -> Music empty_measure n d = mconcat [MMRest 1 (n,d) [], l] --- | Like empty_measure, but with an invisible rest.+-- | Like 'empty_measure', but with an invisible rest. null_measure :: Integer -> Integer -> Music null_measure n d =     let x = Duration d 0 1     in mconcat (map Skip (genericReplicate n x) ++ [l]) --- | Like empty_measure but write time signature.+-- | Like 'empty_measure' but write time signature. measure_rest :: Integer -> Integer -> Music measure_rest n d = mconcat [time_signature (n,d), empty_measure n d] --- | Like measure_rest but write time signature.+-- | Like 'measure_rest' but write time signature. measure_null :: Integer -> Integer -> Music measure_null n d = mconcat [time_signature (n,d), null_measure n d] @@ -151,6 +143,9 @@       [x] -> [m_annotate' as x]       (x:xs') -> x : m_annotate_last' as xs' +m_append :: [Music] -> Measure -> Measure+m_append c (Measure as xs) = Measure as (xs++c)+ m_elements :: Measure -> [Music] m_elements (Measure as xs) = as ++ xs @@ -159,7 +154,7 @@  -- * Tuplets --- | Apply fn to the duration of x, if it has a duration.+-- | Apply a 'Duration' function to a 'Music' node, if it has a duration. edit_dur :: (Duration -> Duration) -> Music -> Music edit_dur fn x =     case x of@@ -228,7 +223,8 @@       (6,2) -> [dotted_breve]       _ -> error ("ts_whole_note: " ++ show t) --- | Command to request that 4/4 and 2/2 etc. are typeset as fractions.+-- | Command to request that @4\/4@ and @2\/2@ etc. are typeset as+-- fractions. ts_use_fractions :: Music ts_use_fractions =     let x = "\\override Staff.TimeSignature #'style = #'()"@@ -264,7 +260,7 @@  -- * Annotations --- | Can a music element be annotated?+-- | Can a 'Music' element be annotated? allows_annotations :: Music -> Bool allows_annotations m =     is_note m ||@@ -272,7 +268,7 @@     is_rest m ||     is_mm_rest m --- | Add an annotation to music element.+-- | Attempt to add an 'Annotation' to a 'Music' element. add_annotation :: Annotation -> Music -> Maybe Music add_annotation a m =     case m of@@ -282,22 +278,22 @@       MMRest i j as -> Just (MMRest i j (as ++ [a]))       _ -> Nothing --- | Add an annotation to music element or error.+-- | Add an 'Annotation' to a 'Music' element or 'error'. add_annotation_err :: Annotation -> Music -> Music add_annotation_err a m =     case add_annotation a m of       Just m' -> m'       Nothing -> error ("add_annotation failed: " ++ show (a,ly_music_elem m)) --- | Add an annotation to music element, or error.+-- | Infix form of 'add_annotation_err'. (&) :: Music -> Annotation -> Music m & a = add_annotation_err a m --- | Add an annotation to a pitch.+-- | Add an 'Annotation' to a 'Pitch'. (&#) :: Pitch -> Annotation -> Music x &# y = Note x Nothing [y] --- | Add an annotation to music element.+-- | Add an 'Annotation' to a 'Music' element. perhaps_annotate :: Annotation -> Music -> Music perhaps_annotate a m = maybe m id (add_annotation a m) @@ -357,7 +353,7 @@ place_above x = CompositeAnnotation [Above, x] place_below x = CompositeAnnotation [Below, x] --- | Add an annotation to a note element, else identity.+-- | Add an 'Annotation' to a @Note@ 'Music' element, else identity. note_annotate :: Annotation -> Music -> Music note_annotate a m =     case m of@@ -420,7 +416,10 @@ p_or p1 p2 = \x -> p1 x || p2 x p_and p1 p2 = \x -> p1 x && p2 x ---  span_r (< 0) [-1,-2,1,2,3,-3,-4] => ([-1,-2],[1,2,3],[-3,-4])+-- | Variant of 'span' that further spans the reverse of the right+-- hand side.+--+--  > span_r (< 0) [-1,-2,1,2,3,-3,-4] == ([-1,-2],[1,2,3],[-3,-4]) span_r :: (a -> Bool) -> [a] -> ([a], [a], [a]) span_r fn xs =     let (o1,o2) = span fn xs@@ -451,11 +450,11 @@  -- * Duration --- | Add duration to pitch to make a note.+-- | Add 'Duration' to 'Pitch' to make a @Note@ 'Music' element. (##) :: Pitch -> Duration -> Music x ## d = Note x (Just d) [] --- | Add duration to pitch to make a note.+-- | Add 'Duration' to either a @Note@ or @Chord@ 'Music' element. (#) :: Music -> Duration -> Music x # d =     case x of@@ -483,7 +482,7 @@  -- * Commands --- | Construct bar number check.+-- | Construct bar number check command. bar_number_check :: Integer -> Music bar_number_check = Command . BarNumberCheck @@ -495,6 +494,7 @@ partial :: Duration -> Music partial = Command . Partial +-- | Set or unset the @circled-tip@ hairpin attribute. hairpin_circled_tip :: Bool -> Music hairpin_circled_tip x =     let c = if x@@ -502,6 +502,7 @@             else "\\revert Hairpin #'circled-tip"     in Command (User c) +-- | Set or unset the @to-barline@ hairpin attribute. hairpin_to_barline :: Bool -> Music hairpin_to_barline x =     let c = if x@@ -602,7 +603,7 @@ tremolo = Tremolo  -- | Interior polyphony.  For two part music on one staff see---   two_part_staff.+--   'two_part_staff'. polyphony :: Music -> Music -> Music polyphony = Polyphony
Music/LilyPond/Light/Analysis.hs view
@@ -1,5 +1,6 @@ module Music.LilyPond.Light.Analysis where +import Control.Arrow import Data.Function import Data.List import Data.Maybe@@ -9,7 +10,7 @@ import Music.LilyPond.Light.Model import Music.Theory.Duration import Music.Theory.Pitch-import qualified Music.Theory.Spelling as T+import qualified Music.Theory.Pitch.Spelling as T  type R = Double @@ -192,7 +193,7 @@ -- | Update state part number. st_set_part :: Locate_ST -> Part_ID -> Locate_ST st_set_part st v =-    let (ts, (Location b p _ m)) = st+    let (ts, Location b p _ m) = st     in (ts, Location b p v m)  -- | Update state part number.@@ -253,7 +254,7 @@                   st' = map (st_set_part st) [v ..]                   r = zipWith locate_st st' [x0,x1]                   ((st'',_):_) = r-              in (st'', this : concat (map snd r))+              in (st'', this : concatMap snd r)          Empty -> (st, [this]) -- error "locate_st: empty"  -- | Run location calculations.@@ -286,7 +287,7 @@ lm_pitches :: [LM] -> [Pitch] lm_pitches l =     let m = map snd l-        p = concat (map collect_pitches (filter has_pitch m))+        p = concatMap collect_pitches (filter has_pitch m)     in (nub . sort) p  lm_pcset :: [LM] -> [PitchClass]@@ -354,7 +355,7 @@ lv_last_measure :: [LV a] -> Measure lv_last_measure =     let fn = compare `on` measure-    in measure . head . reverse . sortBy fn . map fst+    in measure . last . sortBy fn . map fst  time_unpack :: Music -> TimeSignature time_unpack (Time t) = t@@ -369,8 +370,8 @@         ps = lv_group_parts ts'         e xs = let (l,t) = last xs                in (t, lv_last_measure m' - measure l)-        f ((l1, t1), (l2, _)) = (t1, measure_diff l1 l2)-    in map (\ys -> map f (zip ys (tail ys)) ++ [e ys]) ps+        f (l1, t1) (l2, _) = (t1, measure_diff l1 l2)+    in map (\ys -> zipWith f ys (tail ys) ++ [e ys]) ps  ts_structure' :: [Music] -> [[(TimeSignature, Integer)]] ts_structure' = ts_structure . mconcat@@ -388,7 +389,7 @@ lm_ts_map :: [LM] -> TimeSignature_Map lm_ts_map xs =     let xs' = filter (L.is_time . snd) xs-    in map (\(t,x) -> (measure t, time_unpack x)) xs'+    in map (measure *** time_unpack) xs'  ts_map :: [Music] -> TimeSignature_Map ts_map = lm_ts_map . locate'@@ -411,9 +412,11 @@ -- * Tempo  lm_tempo_map :: [LM] -> [(Measure,(Duration,Integer))]-lm_tempo_map xs =-    let xs' = filter (L.is_tempo . snd) xs-    in map (\(t,Tempo d x) -> (measure t, (d,x))) xs'+lm_tempo_map =+    let f (t,i) = case i of+                    Tempo d x -> Just (measure t,(d,x))+                    _ -> Nothing+    in mapMaybe f  tempo_map :: [Music] -> [(Measure,(Duration,Integer))] tempo_map = lm_tempo_map . locate'@@ -444,7 +447,7 @@  -- | Apply functions to keys and values. kv_map :: (k -> k') -> (v -> v') -> [(k,v)] -> [(k',v')]-kv_map f g = map (\(k,v) -> (f k, g v))+kv_map f g = map (f *** g)  -- * Measure collation @@ -603,7 +606,7 @@  -- * Validation -v_assert :: String -> (Music -> Bool) -> (Music -> Maybe String)+v_assert :: String -> (Music -> Bool) -> Music -> Maybe String v_assert str fn m =     if fn m then Nothing else Just str
Music/LilyPond/Light/Constant.hs view
@@ -173,7 +173,7 @@ paper_incr_size x =     let wd = paper_width x         ht = paper_height x-    in x { paper_width = ht, paper_height = (length_scale 2 wd) }+    in x {paper_width = ht, paper_height = length_scale 2 wd}  a3_paper :: Paper a3_paper = paper_incr_size a4_paper@@ -185,13 +185,13 @@ landscape x =     let wd = paper_width x         ht = paper_height x-    in x { paper_width = ht, paper_height = wd }+    in x {paper_width = ht, paper_height = wd}  -- * Settings  default_score_settings :: Score_Settings default_score_settings =-    Score_Settings { independent_time_signatures = False }+    Score_Settings {independent_time_signatures = False}  -- * Header
Music/LilyPond/Light/Model.hs view
@@ -133,8 +133,49 @@                  | Scale_Durations                    deriving (Eq, Show) +-- | 'Music' element category enumeration.+data Music_C = Note_C+             | Chord_C+             | Tremolo_C+             | Rest_C | MMRest_C | Skip_C+             | Repeat_C+             | Tuplet_C+             | Grace_C | AfterGrace_C+             | Join_C+             | Clef_C+             | Time_C+             | Key_C+             | Tempo_C+             | Command_C+             | Polyphony_C+             | Empty_C+               deriving (Eq,Enum,Bounded)++-- | Categorise 'Music' element.+music_c :: Music -> Music_C+music_c m =+    case m of+      Note _ _ _ -> Note_C+      Chord _ _ _ -> Chord_C+      Tremolo _ _ -> Tremolo_C+      Rest _ _ -> Rest_C+      MMRest _ _ _ -> MMRest_C+      Skip _ -> Skip_C+      Repeat _ _ -> Repeat_C+      Tuplet _ _ _ -> Tuplet_C+      Grace _ -> Grace_C+      AfterGrace _ _ -> AfterGrace_C+      Join _ -> Join_C+      Clef _ _ -> Clef_C+      Time _ -> Time_C+      Key _ _ _ -> Key_C+      Tempo _ _ -> Tempo_C+      Command _ -> Command_C+      Polyphony _ _ -> Polyphony_C+      Empty -> Empty_C+ data Music = Note { note_pitch :: Pitch-                  , note_duration :: (Maybe Duration)+                  , note_duration :: Maybe Duration                   , note_annotations :: [Annotation] }            | Chord { chord_notes :: [Music]                    , chord_duration :: Duration@@ -160,7 +201,7 @@ instance Monoid Music where     mempty = Empty     mappend x y = Join [x,y]-    mconcat xs = Join xs+    mconcat = Join  type Staff_Name = (String,String)
Music/LilyPond/Light/Output/LilyPond.hs view
@@ -1,7 +1,6 @@ module Music.LilyPond.Light.Output.LilyPond (ly_work                                             ,ly_music_elem) where -import Data.List import Music.LilyPond.Light.Model import Music.Theory.Pitch import Music.Theory.Duration@@ -163,7 +162,7 @@       Open -> "\\open"       Portato -> "\\portato"       Staccato -> "\\staccato"-      StemTremolo x -> ":" ++ show x+      StemTremolo x -> ':' : show x       Stopped -> "\\stopped"       Tenuto -> "\\tenuto"       Trill -> "\\trill"@@ -221,7 +220,7 @@       Above -> "^"       Below -> "_"       Text x -> ly_str x-      CompositeAnnotation xs -> intercalate " " (map ly_annotation xs)+      CompositeAnnotation xs -> unwords (map ly_annotation xs)       ReminderAccidental -> "" -- see ly_pitch       CautionaryAccidental -> "" -- see ly_pitch @@ -386,7 +385,7 @@  ly_layout :: Score_Settings -> [String] ly_layout x =-    let mk_i nm = printf "\\context { \\%s \\consists \"Instrument_name_engraver\"}" nm+    let mk_i = printf "\\context { \\%s \\consists \"Instrument_name_engraver\"}"         is = unlines (map mk_i ["StaffGroup","ChoirStaff","GrandStaff"])     in ["\\layout", "{"        ,if independent_time_signatures x@@ -407,7 +406,7 @@              ly_paper p ++              ly_header hdr ++              ly_score sc-    in concat (intersperse " " xs)+    in unwords xs  ly_music_elem :: Music -> String-ly_music_elem = concat . intersperse " " . ly_music+ly_music_elem = unwords . ly_music
hly.cabal view
@@ -1,5 +1,5 @@ Name:              hly-Version:           0.1+Version:           0.11 Synopsis:          Haskell LilyPond Description:       A very lightweight embedding of the lilypond                    typesetting model in haskell@@ -10,14 +10,14 @@ Maintainer:        rd@slavepianos.org Stability:         Experimental Homepage:          http://slavepianos.org/rd/?t=hly-Tested-With:       GHC == 6.12.1+Tested-With:       GHC == 7.2.2 Build-Type:        Simple-Cabal-Version:     >= 1.6+Cabal-Version:     >= 1.8 Data-Files:        README  Library-  Build-Depends:   base == 4.*,-                   hmt+  Build-Depends:   base==4.*,+                   hmt==0.11.*   GHC-Options:     -Wall -fwarn-tabs   Exposed-modules: Music.LilyPond.Light                    Music.LilyPond.Light.Analysis