packages feed

hts 0.1 → 0.11

raw patch · 7 files changed

+69/−35 lines, 7 filesdep ~hmt

Dependency ranges changed: hmt

Files

Music/Typesetting/Literal.hs view
@@ -3,7 +3,8 @@ import Data.List import Data.Maybe import Data.Ratio-import Music.Theory.Duration+import Music.Theory.Duration {- hmt -}+import Music.Theory.Duration.RQ import Music.Typesetting.Model import Music.Typesetting.Query @@ -15,12 +16,18 @@ (&) :: Note -> N_Annotation -> Note (&) = flip n_annotate +-- | Apply function to first element of list.+--+-- > annotate_first (+) 9 [1,2,3] == [10,2,3] annotate_first :: (a -> x -> x) -> a -> [x] -> [x] annotate_first fn a ns =     case ns of       [] -> []       (n:ns') -> fn a n : ns' +-- | Apply function to last element of list.+--+-- > annotate_last (+) 7 [1,2,3] == [1,2,10] annotate_last :: (a -> x -> x) -> a -> [x] -> [x] annotate_last fn a ns =     case ns of@@ -28,6 +35,9 @@       [n] -> [fn a n]       (n:ns') -> n : annotate_last fn a ns' +-- | Apply function to first and last elements of list.+--+-- > annotate_bracket (+) (9,7) [1,2,3] == [10,2,10] annotate_bracket :: (a -> x -> x) -> (a,a) -> [x] -> [x] annotate_bracket fn (a0,an) = annotate_last fn an . annotate_first fn a0 @@ -44,10 +54,10 @@ n_annotate_bracket = annotate_bracket n_annotate  -- | Apply annotations to the start and end points of each tied note.-n_annotate_tie_endpoints :: (N_Annotation,N_Annotation) -> Note -> Note+n_annotate_tie_endpoints :: ([N_Annotation],[N_Annotation]) -> Note -> Note n_annotate_tie_endpoints (a0,an) n-    | n_is_initial_tie n = n & a0-    | n_is_final_tie n = n &an+    | n_is_initial_tie n = n_annotate_l a0 n+    | n_is_final_tie n = n_annotate_l an n     | otherwise = n  n_edit_duration :: (Duration -> Duration) -> Note -> Note@@ -63,6 +73,7 @@ m_annotate :: M_Annotation -> Measure -> Measure m_annotate a (Measure as ns) = Measure (a : as) ns +-- | Infix variant of 'm_annotate' with reverse argument order. (&.) :: Measure -> M_Annotation -> Measure (&.) = flip m_annotate @@ -130,17 +141,17 @@ -- * Parts, groups etc.  part :: Name -> [Measure] -> Part-part nm ms = Part Nothing [P_Name nm] ms+part nm = Part Nothing [P_Name nm]  group :: Name -> [Part] -> Part-group nm ps = Group Nothing [G_Name nm] ps+group nm = Group Nothing [G_Name nm] --- merge parallel voices+-- | Merge parallel voices voices :: [[Measure]] -> [Measure] voices vs =     let vs' = transpose vs         vc_ann :: Integer -> Measure -> Measure-        vc_ann i (Measure as ns) = Measure as (map (& (N_Voice i)) ns)+        vc_ann i (Measure as ns) = Measure as (map (& N_Voice i) ns)         merge_m_ann :: [Measure] -> [M_Annotation]         merge_m_ann = foldl1 union . map m_annotations         fn ms = let (d:_) = map m_duration ms@@ -153,7 +164,8 @@  -- * Interop --- note: ought to translate begin_tuplet correctly+-- | Translate from 'D_Annotation' to 'N_Annotation'.  Note: does not+-- necessarily translate 'Begin_Tuplet' correctly. from_d_annotation :: D_Annotation -> N_Annotation from_d_annotation x =     case x of
Music/Typesetting/Model.hs view
@@ -7,20 +7,21 @@ data Dynamic_Mark_T = PPPPP | PPPP | PPP | PP | P | MP                     | MF | F | FF | FFF | FFFF | FFFFF                     | FP | SF | SFP | SFPP | SFZ | SFFZ-                      deriving (Eq,Ord,Bounded,Show)+                      deriving (Eq,Ord,Enum,Bounded,Show)  data Articulation_T = Accent                     | Staccato+                    | Strong_Accent                     | Tenuto-                      deriving (Eq,Ord,Show)+                      deriving (Eq,Ord,Enum,Show)  data Clef_T = Bass | Tenor | Alto | Treble | Percussion-              deriving (Eq,Ord,Show)+              deriving (Eq,Ord,Enum,Show)  type Time_Signature_T = (Integer,Integer)  data Placement_T = Above | Below-                   deriving (Eq,Ord,Show)+                   deriving (Eq,Ord,Enum,Show)  type Tuplet_T = (Integer,Duration,Integer,Duration) @@ -37,6 +38,7 @@                   | N_Articulation Articulation_T                   | N_Dynamic_Mark Dynamic_Mark_T                   | N_Crescendo | N_Diminuendo | N_End_Hairpin+                  | N_Laissez_Vibrer                   | N_Voice Integer                   | N_Backup [Duration]                   | N_Natural_Harmonic
Music/Typesetting/Output/MusicXML.hs view
@@ -6,10 +6,11 @@ import Data.Ratio import Music.Typesetting.Model import Music.Typesetting.Output.MusicXML.Binding-import qualified Music.Theory.Duration as T+import qualified Music.Theory.Duration as T {- hmt -}+import qualified Music.Theory.Duration.RQ as T import qualified Music.Theory.Key as T import qualified Music.Theory.Pitch as T-import qualified Text.XML.Light as X+import qualified Text.XML.Light as X {- xml -}  x_clef_t :: Clef_T -> (String,Integer) x_clef_t c =@@ -36,7 +37,7 @@  x_key :: (T.Note_T,Maybe T.Alteration_T,T.Mode_T) -> X.Content x_key (n,a,m) =-    let a' = maybe T.Natural id a+    let a' = fromMaybe T.Natural a     in key [] [fifths [] [cdata (show (T.key_fifths (n,a',m)))]               ,mode [] [cdata (key_mode_t m)]] @@ -140,9 +141,14 @@ x_placement_t :: Placement_T -> X.Attr x_placement_t = placement . map toLower . show --- note: this requires '_' -> '-' translation+c_underscore_to_hyphen :: Char -> Char+c_underscore_to_hyphen x = if x == '_' then '-' else x++c_hs_to_xml :: Char -> Char+c_hs_to_xml = toLower . c_underscore_to_hyphen+ x_articulation_t :: Articulation_T -> X.Content-x_articulation_t = mk_empty_elem_no_attr . map toLower . show+x_articulation_t = mk_empty_elem_no_attr . map c_hs_to_xml . show  x_articulation :: N_Annotation -> Maybe X.Content x_articulation x =@@ -222,6 +228,9 @@       N_End_Hairpin ->           let ty = direction_type [] [wedge [type_A "stop"]]           in Just (direction [x_placement_t Below] [ty])+      N_Laissez_Vibrer ->+          let ty = direction_type [] [words' [] [cdata "l.v."]]+          in Just (direction [x_placement_t Above] [ty])       _ -> Nothing  x_m_direction :: M_Annotation -> Maybe X.Content@@ -297,7 +306,7 @@     case p of       (Part (Just i) as _) ->           let as' = concatMap x_p_annotation as-              i' = "P" ++ show i+              i' = 'P' : show i           in score_part [id_A i'] as'       _ -> error "x_score_part: no ID or GROUP" @@ -338,9 +347,9 @@ x_part p =     case p of       (Part (Just i) _ ms) ->-          let i' = "P" ++ show i+          let i' = 'P' : show i               ms' = set_divisions ms-          in part [id_A i'] (map x_measure (zip [1..] ms'))+          in part [id_A i'] (zipWith (curry x_measure) [1..] ms')       _ -> error "x_part: no ID or GROUP"  part_set_id :: (ID,Part) -> (ID,Part)@@ -367,7 +376,8 @@         pt = map x_part (concatMap f xs)     in pl : pt --- t = title, n = number, d = dedication, c = composer+-- | Make header from tuple of /title/, /number/, /dedication/ and+-- /composer/. x_header :: (String,String,String,String) -> [X.Content] x_header (t,n,d,c) =     let t' = work_title [] [cdata t]@@ -383,6 +393,6 @@  renderMusicXML :: [X.Content] -> String renderMusicXML xs =-    concat [musicxml_xml-           ,musicxml_partwise-           ,X.showElement (score_partwise' [] xs)]+    unlines [musicxml_xml+            ,musicxml_partwise+            ,X.ppElement (score_partwise' [] xs)]
Music/Typesetting/Output/MusicXML/Binding.hs view
@@ -47,6 +47,9 @@ wedge :: EMPTY_ELEM wedge = mk_empty_elem "wedge" +words' :: ELEM+words' = mk_elem "words"+ sign :: ELEM sign = mk_elem "sign"
Music/Typesetting/Process.hs view
@@ -4,7 +4,7 @@ import Music.Typesetting.Model import Music.Typesetting.Query --- delete persistent annotations or like+-- | Delete persistent annotations or like. prune :: (a -> a -> Bool) -> (b -> Maybe a) -> (a -> b -> b) -> [b] -> [b] prune cmp get del =     let go _ [] = []
Music/Typesetting/Query.hs view
@@ -4,7 +4,9 @@ import Data.List import Data.Maybe import Data.Ratio-import Music.Theory.Duration+import Music.Theory.Duration {- hmt -}+import Music.Theory.Duration.Name+import Music.Theory.Duration.RQ import Music.Theory.Pitch import Music.Typesetting.Model @@ -134,10 +136,14 @@     in (genericLength xs,ts_m,tm_m)  -- | Duration, in RQ, of a measure of indicated time signature.+--+-- > map time_signature_to_rq [(3,4),(5,8)] == [3,5/2] time_signature_to_rq :: Time_Signature_T -> Rational time_signature_to_rq (n,d) = (4 * n) % d  -- | Duration of a RQ value, in seconds, given indicated tempo.+--+-- > rq_to_seconds (quarter_note,90) 1 == 60/90 rq_to_seconds :: Tempo_Marking_T -> Rational -> Double rq_to_seconds (d,n) x =     let d' = duration_to_rq d@@ -146,17 +152,18 @@  -- | The duration, in seconds, of a measure at the indicated time --   signaure and tempo marking.+--+-- > time_signature_to_seconds (3,4) (quarter_note,90) == 2 time_signature_to_seconds :: Time_Signature_T -> Tempo_Marking_T -> Double time_signature_to_seconds ts tm =     let i = time_signature_to_rq ts     in rq_to_seconds tm i  -- | dx -> d+--+-- > integrate [1,3,6,10] == [1,4,10,20] integrate :: (Num a) => [a] -> [a]-integrate [] = []-integrate (x:xs) =-    let fn i c = (i + c, i + c)-    in x : snd (mapAccumL fn x xs)+integrate = scanl1 (+)  temporal_map_locate :: Temporal_Map -> [(Double,Double,Tempo_Marking_T)] temporal_map_locate (n,ts_m,tm_m) =
hts.cabal view
@@ -1,5 +1,5 @@ Name:              hts-Version:           0.1+Version:           0.11 Synopsis:          Haskell Music Typesetting Description:       A simple music typesetting model in haskell License:           GPL@@ -9,14 +9,14 @@ Maintainer:        rd@slavepianos.org Stability:         Experimental Homepage:          http://slavepianos.org/rd/?t=hts-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,+                   hmt==0.11.*,                    xml   GHC-Options:     -Wall -fwarn-tabs   Exposed-modules: Music.Typesetting.Model