\begin{code} -- | -- Maintainer : silva.samuel@alumni.uminho.pt -- Stability : experimental -- Portability: HaXML -- module Text.XML.MusicXML.Note where import Text.XML.MusicXML.Common import Prelude (Maybe(..), Monad(..), Show, Eq, (.), (++)) import Control.Monad (MonadPlus(..)) import qualified Data.Char (String) import Text.XML.HaXml.Types (Content(..)) \end{code} \begin{musicxml} The common note elements between cue/grace notes and regular (full) notes: pitch, chord, and rest information, but not duration (cue and grace notes do not have duration encoded here). Unpitched elements are used for unpitched percussion, speaking voice, and other musical elements lacking determinate pitch. \end{musicxml} \begin{code} -- * Note entities -- | type Full_Note = (Maybe Chord, Full_Note_) -- | read_Full_Note :: StateT Result [Content i] Full_Note read_Full_Note = do y1 <- read_MAYBE read_Chord y2 <- read_Full_Note_ return (y1,y2) -- | show_Full_Note :: Full_Note -> [Content ()] show_Full_Note (a,b) = show_MAYBE show_Chord a ++ show_Full_Note_ b -- | data Full_Note_ = Full_Note_1 Pitch | Full_Note_2 Unpitched | Full_Note_3 Rest deriving (Eq, Show) -- | read_Full_Note_ :: StateT Result [Content i] Full_Note_ read_Full_Note_ = (read_Pitch >>= return . Full_Note_1) `mplus` (read_Unpitched >>= return . Full_Note_2) `mplus` (read_Rest >>= return . Full_Note_3) -- | show_Full_Note_ :: Full_Note_ -> [Content ()] show_Full_Note_ (Full_Note_1 x) = show_Pitch x show_Full_Note_ (Full_Note_2 x) = show_Unpitched x show_Full_Note_ (Full_Note_3 x) = show_Rest x \end{code} \begin{musicxml} Notes are the most common type of MusicXML data. The MusicXML format keeps the MuseData distinction between elements used for sound information and elements used for notation information (e.g., tie is used for sound, tied for notation). Thus grace notes do not have a duration element. Cue notes have a duration element, as do forward elements, but no tie elements. Having these two types of information available can make interchange considerably easier, as some programs handle one type of information much more readily than the other. The position and printout entities for printing suggestions are defined in the common.mod file. The dynamics and end-dynamics attributes correspond to MIDI 1.0's Note On and Note Off velocities, respectively. They are expressed in terms of percentages of the default forte value (90 for MIDI 1.0). The attack and release attributes are used to alter the staring and stopping time of the note from when it would otherwise occur based on the flow of durations - information that is specific to a performance. They are expressed in terms of divisions, either positive or negative. A note that starts a tie should not have a release attribute, and a note that stops a tie should not have an attack attribute. If a note is played only one time through a repeat, the time-only attribute shows which time to play the note. The pizzicato attribute is used when just this note is sounded pizzicato, vs. the pizzicato element which changes overall playback between pizzicato and arco. \end{musicxml} \begin{code} -- * Note -- | type Note = ((Print_Style, Printout, Maybe CDATA, Maybe CDATA, Maybe CDATA, Maybe CDATA, Maybe CDATA, Maybe Yes_No), (Note_, Maybe Instrument, Editorial_Voice, Maybe Type, [Dot], Maybe Accidental, Maybe Time_Modification, Maybe Stem, Maybe Notehead, Maybe Staff, [Beam], [Notations], [Lyric])) -- | read_Note :: Eq i => StateT Result [Content i] Note read_Note = do y <- read_ELEMENT "note" y1 <- read_8 read_Print_Style read_Printout (read_IMPLIED "dynamics" read_CDATA) (read_IMPLIED "end-dynamics" read_CDATA) (read_IMPLIED "attack" read_CDATA) (read_IMPLIED "release" read_CDATA) (read_IMPLIED "time-only" read_CDATA) (read_IMPLIED "pizzicato" read_Yes_No) (attributes y) y2 <- read_13 read_Note_ (read_MAYBE read_Instrument) read_Editorial_Voice (read_MAYBE read_Type) (read_LIST read_Dot) (read_MAYBE read_Accidental) (read_MAYBE read_Time_Modification) (read_MAYBE read_Stem) (read_MAYBE read_Notehead) (read_MAYBE read_Staff) (read_LIST read_Beam) (read_LIST read_Notations) (read_LIST read_Lyric) (childs y) return (y1,y2) show_Note :: Note -> [Content ()] show_Note ((a,b,c,d,e,f,g,h),(i,j,k,l,m,n,o,p,q,r,s,t,u)) = show_ELEMENT "note" (show_Print_Style a ++ show_Printout b ++ show_IMPLIED "dynamics" show_CDATA c ++ show_IMPLIED "end-dynamics" show_CDATA d ++ show_IMPLIED "attack" show_CDATA e ++ show_IMPLIED "release" show_CDATA f ++ show_IMPLIED "time-only" show_CDATA g ++ show_IMPLIED "pizzicato" show_Yes_No h) (show_Note_ i ++ show_MAYBE show_Instrument j ++ show_Editorial_Voice k ++ show_MAYBE show_Type l ++ show_LIST show_Dot m ++ show_MAYBE show_Accidental n ++ show_MAYBE show_Time_Modification o ++ show_MAYBE show_Stem p ++ show_MAYBE show_Notehead q ++ show_MAYBE show_Staff r ++ show_LIST show_Beam s ++ show_LIST show_Notations t ++ show_LIST show_Lyric u) -- ** Note_ -- | data Note_ = Note_1 (Grace, Full_Note, Maybe (Tie, Maybe Tie)) | Note_2 (Cue, Full_Note, Duration) | Note_3 (Full_Note, Duration, Maybe (Tie, Maybe Tie)) deriving (Eq, Show) -- | read_Note_ :: StateT Result [Content i] Note_ read_Note_ = (read_Note_aux1 >>= return . Note_1) `mplus` (read_Note_aux2 >>= return . Note_2) `mplus` (read_Note_aux3 >>= return . Note_3) read_Note_aux1 :: StateT Result [Content i] (Grace, Full_Note, Maybe (Tie, Maybe Tie)) read_Note_aux1 = do y1 <- read_Grace y2 <- read_Full_Note y3 <- read_MAYBE read_Note_aux4 return (y1,y2,y3) read_Note_aux2 :: StateT Result [Content i] (Cue, Full_Note, Duration) read_Note_aux2 = do y1 <- read_Cue y2 <- read_Full_Note y3 <- read_Duration return (y1,y2,y3) read_Note_aux3 :: StateT Result [Content i] (Full_Note, Duration, Maybe (Tie, Maybe Tie)) read_Note_aux3 = do y1 <- read_Full_Note y2 <- read_Duration y3 <- read_MAYBE read_Note_aux4 return (y1,y2,y3) read_Note_aux4 :: StateT Result [Content i] (Tie, Maybe Tie) read_Note_aux4 = do y1 <- read_Tie y2 <- read_MAYBE read_Tie return (y1,y2) -- | show_Note_ :: Note_ -> [Content ()] show_Note_ (Note_1 (a,b,c)) = show_Grace a ++ show_Full_Note b ++ show_MAYBE show_Note_aux1 c show_Note_ (Note_2 (a,b,c)) = show_Cue a ++ show_Full_Note b ++ show_Duration c show_Note_ (Note_3 (a,b,c)) = show_Full_Note a ++ show_Duration b ++ show_MAYBE show_Note_aux1 c -- | show_Note_aux1 :: (Tie, Maybe Tie) -> [Content ()] show_Note_aux1 (a,b) = show_Tie a ++ show_MAYBE show_Tie b \end{code} \begin{musicxml} Pitch is represented as a combination of the step of the diatonic scale, the chromatic alteration, and the octave. The step element uses the English letters A through G. The alter element represents chromatic alteration in number of semitones (e.g., -1 for flat, 1 for sharp). Decimal values like 0.5 (quarter tone sharp) may be used for microtones. The octave element is represented by the numbers 0 to 9, where 4 indicates the octave started by middle C. \end{musicxml} \begin{code} -- | type Pitch = (Step, Maybe Alter, Octave) -- | read_Pitch :: StateT Result [Content i] Pitch read_Pitch = do y <- read_ELEMENT "pitch" read_3 read_Step (read_MAYBE read_Alter) read_Octave (childs y) -- | show_Pitch :: Pitch -> [Content ()] show_Pitch (a,b,c) = show_ELEMENT "pitch" [] (show_Step a ++ show_MAYBE show_Alter b ++ show_Octave c) -- | type Step = PCDATA -- | read_Step :: StateT Result [Content i] Step read_Step = do y <- read_ELEMENT "step" read_1 read_PCDATA (childs y) -- | show_Step :: Step -> [Content ()] show_Step x = show_ELEMENT "step" [] (show_PCDATA x) -- | type Alter = PCDATA -- | read_Alter :: StateT Result [Content i] Alter read_Alter = do y <- read_ELEMENT "alter" read_1 read_PCDATA (childs y) -- | show_Alter :: Alter -> [Content ()] show_Alter x = show_ELEMENT "alter" [] (show_PCDATA x) -- | type Octave = PCDATA -- | read_Octave :: StateT Result [Content i] Octave read_Octave = do y <- read_ELEMENT "octave" read_1 read_PCDATA (childs y) -- | show_Octave :: Octave -> [Content ()] show_Octave x = show_ELEMENT "octave" [] (show_PCDATA x) \end{code} \begin{musicxml} The cue and grace elements indicate the presence of cue and grace notes. The slash attribute for a grace note is yes for slashed eighth notes. The other grace note attributes come from MuseData sound suggestions. Steal-time-previous indicates the percentage of time to steal from the previous note for the grace note. Steal-time-following indicates the percentage of time to steal from the following note for the grace note. Make-time indicates to make time, not steal time; the units are in real-time divisions for the grace note. \end{musicxml} \begin{code} -- | type Cue = () -- | read_Cue :: StateT Result [Content i] Cue read_Cue = read_ELEMENT "cue" >> return () -- | show_Cue :: Cue -> [Content ()] show_Cue _ = show_ELEMENT "cue" [] [] -- | type Grace = ((Maybe CDATA, Maybe CDATA, Maybe CDATA, Maybe Yes_No),()) -- | read_Grace :: StateT Result [Content i] Grace read_Grace = do y <- read_ELEMENT "grace" y1 <- read_4 (read_IMPLIED "steal-time-previous" read_CDATA) (read_IMPLIED "steal-time-following" read_CDATA) (read_IMPLIED "make-time" read_CDATA) (read_IMPLIED "slash" read_Yes_No) (attributes y) return (y1,()) -- | show_Grace :: Grace -> [Content ()] show_Grace ((a,b,c,d),_) = show_ELEMENT "grace" (show_IMPLIED "steal-time-previous" show_CDATA a ++ show_IMPLIED "steal-time-following" show_CDATA b ++ show_IMPLIED "make-time" show_CDATA c ++ show_IMPLIED "slash" show_Yes_No d) [] \end{code} \begin{musicxml} The chord element indicates that this note is an additional chord tone with the preceding note. The duration of this note can be no longer than the preceding note. In MuseData, a missing duration indicates the same length as the previous note, but the MusicXML format requires a duration for chord notes too. \end{musicxml} \begin{code} -- | type Chord = () -- | read_Chord :: StateT Result [Content i] Chord read_Chord = read_ELEMENT "chord" >> return () -- | show_Chord :: Chord -> [Content ()] show_Chord _ = show_ELEMENT "chord" [] [] \end{code} \begin{musicxml} The unpitched element indicates musical elements that are notated on the staff but lack definite pitch, such as unpitched percussion and speaking voice. Like notes, it uses step and octave elements to indicate placement on the staff, following the current clef. If percussion clef is used, the display-step and display-octave elements are interpreted as if in treble clef, with a G in octave 4 on line 2. If not present, the note is placed on the middle line of the staff, generally used for one-line staffs. \end{musicxml} \begin{code} type Unpitched = Maybe (Display_Step, Display_Octave) -- | read_Unpitched :: StateT Result [Content i] Unpitched read_Unpitched = do y <- read_ELEMENT "unpitched" read_1 (read_MAYBE read_Unpitched_aux1) (childs y) read_Unpitched_aux1 :: StateT Result [Content i] (Display_Step, Display_Octave) read_Unpitched_aux1 = do y1 <- read_Display_Step y2 <- read_Display_Octave return (y1,y2) -- | show_Unpitched :: Unpitched -> [Content ()] show_Unpitched x = show_ELEMENT "unpitched" [] (show_MAYBE (\(a,b) -> show_Display_Step a ++ show_Display_Octave b) x) -- | type Display_Step = PCDATA -- | read_Display_Step :: StateT Result [Content i] Display_Step read_Display_Step = do y <- read_ELEMENT "display-step" read_1 read_PCDATA (childs y) -- | show_Display_Step :: Display_Step -> [Content ()] show_Display_Step x = show_ELEMENT "display-step" [] (show_PCDATA x) -- | type Display_Octave = PCDATA -- | read_Display_Octave :: StateT Result [Content i] Display_Octave read_Display_Octave = do y <- read_ELEMENT "display-octave" read_1 read_PCDATA (childs y) -- | show_Display_Octave :: Display_Octave -> [Content ()] show_Display_Octave x = show_ELEMENT "display-octave" [] (show_PCDATA x) \end{code} \begin{musicxml} The rest element indicates notated rests or silences. Rest are usually empty, but placement on the staff can be specified using display-step and display-octave elements. \end{musicxml} \begin{code} -- | type Rest = Maybe (Display_Step, Display_Octave) -- | read_Rest :: StateT Result [Content i] Rest read_Rest = do y <- read_ELEMENT "rest" read_1 (read_MAYBE read_Rest_aux1) (childs y) -- | read_Rest_aux1 :: StateT Result [Content i] (Display_Step, Display_Octave) read_Rest_aux1 = do y1 <- read_Display_Step y2 <- read_Display_Octave return (y1,y2) -- | show_Rest :: Rest -> [Content ()] show_Rest x = show_ELEMENT "rest" [] (show_MAYBE (\(a,b) -> show_Display_Step a ++ show_Display_Octave b) x) \end{code} \begin{musicxml} Duration is a positive number specified in division units. This is the intended duration vs. notated duration (for instance, swing eighths vs. even eighths, or differences in dotted notes in Baroque-era music). Differences in duration specific to an interpretation or performance should use the note element's attack and release attributes. The tie element indicates that a tie begins or ends with this note. The tie element indicates sound; the tied element indicates notation. \end{musicxml} \begin{code} type Duration = PCDATA -- | read_Duration :: StateT Result [Content i] Duration read_Duration = do y <- read_ELEMENT "duration" read_1 read_PCDATA (childs y) -- | show_Duration :: Duration -> [Content ()] show_Duration x = show_ELEMENT "duration" [] (show_PCDATA x) -- | type Tie = (Start_Stop, ()) -- | read_Tie :: StateT Result [Content i] Tie read_Tie = do y <- read_ELEMENT "tie" y1 <- read_1 (read_REQUIRED "type" read_Start_Stop) (attributes y) return (y1,()) -- | show_Tie :: Tie -> [Content ()] show_Tie (a,_) = show_ELEMENT "tie" (show_REQUIRED "type" show_Start_Stop a) [] \end{code} \begin{musicxml} If multiple score-instruments are specified on a score-part, there should be an instrument element for each note in the part. The id attribute is an IDREF back to the score-instrument ID. \end{musicxml} \begin{code} -- ** Instrument -- | type Instrument = (ID, ()) -- | read_Instrument :: StateT Result [Content i] Instrument read_Instrument = do y <- read_ELEMENT "instrument" y1 <- read_1 (read_REQUIRED "id" read_ID) (attributes y) return (y1,()) -- | show_Instrument :: Instrument -> [Content ()] show_Instrument (a,_) = show_ELEMENT "instrument" (show_REQUIRED "id" show_ID a) [] \end{code} \begin{musicxml} Type indicates the graphic note type, Valid values (from shortest to longest) are 256th, 128th, 64th, 32nd, 16th, eighth, quarter, half, whole, breve, and long. The size attribute indicates full, cue, or large size, with full the default for regular notes and cue the default for cue and grace notes. \end{musicxml} \begin{code} -- ** Type -- | type Type = (Maybe Symbol_Size,PCDATA) -- | read_Type :: StateT Result [Content i] Type read_Type = do y <- read_ELEMENT "type" y1 <- read_1 (read_IMPLIED "size" read_Symbol_Size) (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Type :: Type -> [Content ()] show_Type (a,b) = show_ELEMENT "type" (show_IMPLIED "size" show_Symbol_Size a) (show_PCDATA b) \end{code} \begin{musicxml} One dot element is used for each dot of prolongation. The placement element is used to specify whether the dot should appear above or below the staff line. It is ignored for notes that appear on a staff space. \end{musicxml} \begin{code} -- ** Dot -- | type Dot = ((Print_Style, Placement), ()) -- | read_Dot :: StateT Result [Content i] Dot read_Dot = do y <- read_ELEMENT "dot" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Dot :: Dot -> [Content ()] show_Dot ((a,b),_) = show_ELEMENT "dot" (show_Print_Style a ++ show_Placement b) [] \end{code} \begin{musicxml} Actual notated accidentals. Valid values include: sharp, natural, flat, double-sharp, sharp-sharp, flat-flat, natural-sharp, natural-flat, quarter-flat, quarter-sharp, three-quarters-flat, and three-quarters-sharp. Editorial and cautionary indications are indicated by attributes. Values for these attributes are "no" if not present. Specific graphic display such as parentheses, brackets, and size are controlled by the level-display entity defined in the common.mod file. \end{musicxml} \begin{code} -- ** Accidental -- | type Accidental = ((Maybe Yes_No, Maybe Yes_No, Level_Display, Print_Style), PCDATA) -- | read_Accidental :: StateT Result [Content i] Accidental read_Accidental = do y <- read_ELEMENT "accidental" y1 <- read_4 (read_IMPLIED "cautionary" read_Yes_No) (read_IMPLIED "editorial" read_Yes_No) read_Level_Display read_Print_Style (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Accidental :: Accidental -> [Content ()] show_Accidental ((a,b,c,d),e) = show_ELEMENT "accidental" (show_IMPLIED "cautionary" show_Yes_No a ++ show_IMPLIED "editorial" show_Yes_No b ++ show_Level_Display c ++ show_Print_Style d) (show_PCDATA e) \end{code} \begin{musicxml} Time modification indicates tuplets and other durational changes. The child elements are defined in the common.mod file. \end{musicxml} \begin{code} -- ** Time_Modification -- | type Time_Modification = (Actual_Notes, Normal_Notes, Maybe (Normal_Type, [Normal_Dot])) -- | read_Time_Modification :: Eq i => StateT Result [Content i] Time_Modification read_Time_Modification = do y <- read_ELEMENT "time-modification" read_3 read_Actual_Notes read_Normal_Notes (read_MAYBE (read_Time_Modification_aux1)) (childs y) -- | read_Time_Modification_aux1 :: Eq i => StateT Result [Content i] (Normal_Type, [Normal_Dot]) read_Time_Modification_aux1 = do y1 <- read_Normal_Type y2 <- read_LIST read_Normal_Dot return (y1,y2) -- | show_Time_Modification :: Time_Modification -> [Content ()] show_Time_Modification (a,b,c) = show_ELEMENT "time-modification" [] (show_Actual_Notes a ++ show_Normal_Notes b ++ show_MAYBE (\(c1,c2) -> show_Normal_Type c1 ++ show_LIST show_Normal_Dot c2) c) \end{code} \begin{musicxml} Stems can be down, up, none, or double. For down and up stems, the position attributes can be used to specify stem length. The relative values specify the end of the stem relative to the program default. Default values specify an absolute end stem position. Negative values of relative-y that would flip a stem instead of shortening it are ignored. \end{musicxml} \begin{code} -- ** Stem -- | type Stem = ((Position, Color),PCDATA) -- | read_Stem :: StateT Result [Content i] Stem read_Stem = do y <- read_ELEMENT "stem" y1 <- read_2 read_Position read_Color (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Stem :: Stem -> [Content ()] show_Stem ((a,b),c) = show_ELEMENT "stem" (show_Position a ++ show_Color b) (show_PCDATA c) \end{code} \begin{musicxml} The notehead element indicates shapes other than the open and closed ovals associated with note durations. The element value can be slash, triangle, diamond, square, cross, x, circle-x, inverted triangle, arrow down, arrow up, slashed, back slashed, normal, cluster, or none. For shape note music, the element values do, re, mi, fa, so, la, and ti are used, corresponding to Aikin's 7-shape system. The arrow shapes differ from triangle and inverted triangle by being centered on the stem. Slashed and back slashed notes include both the normal notehead and a slash. The triangle shape has the tip of the triangle pointing up; the inverted triangle shape has the tip of the triangle pointing down. For the enclosed shapes, the default is to be hollow for half notes and longer, and filled otherwise. The filled attribute can be set to change this if needed. If the parentheses attribute is set to yes, the notehead is parenthesized. It is no by default. \end{musicxml} \begin{code} -- ** Notehead -- | type Notehead = ((Maybe Yes_No, Maybe Yes_No, Font, Color), PCDATA) -- | read_Notehead :: StateT Result [Content i] Notehead read_Notehead = do y <- read_ELEMENT "notehead" y1 <- read_4 (read_IMPLIED "filled" read_Yes_No) (read_IMPLIED "parentheses" read_Yes_No) read_Font read_Color (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Notehead :: Notehead -> [Content ()] show_Notehead ((a,b,c,d),e) = show_ELEMENT "notehead" (show_IMPLIED "filled" show_Yes_No a ++ show_IMPLIED "parentheses" show_Yes_No b ++ show_Font c ++ show_Color d) (show_PCDATA e) \end{code} \begin{musicxml} Beam types include begin, continue, end, forward hook, and backward hook. In MuseData, up to six concurrent beams are available to cover up to 256th notes. This seems sufficient so we use an enumerated type defined in the common.mod file. The repeater attribute, used for tremolos, needs to be specified with a "yes" value for each beam using it. Beams that have a begin value can also have a fan attribute to indicate accelerandos and ritardandos using fanned beams. The fan attribute may also be used with a continue value if the fanning direction changes on that note. The value is "none" if not specified. Note that the beam number does not distinguish sets of beams that overlap, as it does for slur and other elements. Beaming groups are distinguished by being in different voices and/or the presence or absence of grace and cue elements. \end{musicxml} \begin{code} -- ** Beam -- | type Beam = ((Beam_Level, Maybe Yes_No, Maybe Beam_, Color), PCDATA) -- | read_Beam :: StateT Result [Content i] Beam read_Beam = do y <- read_ELEMENT "beam" y1 <- read_4 (read_DEFAULT "number" read_Beam_Level Beam_Level_1) (read_IMPLIED "repeater" read_Yes_No) (read_IMPLIED "fan" read_Beam_) read_Color (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Beam :: Beam -> [Content ()] show_Beam ((a,b,c,d),e) = show_ELEMENT "beam" (show_IMPLIED "number" show_Beam_Level (Just a) ++ show_IMPLIED "repeater" show_Yes_No b ++ show_IMPLIED "fan" show_Beam_ c ++ show_Color d) (show_PCDATA e) -- | data Beam_ = Beam_Accel | Beam_Rit | Beam_None deriving (Eq, Show) -- | read_Beam_ :: Data.Char.String -> Result Beam_ read_Beam_ "accel" = return Beam_Accel read_Beam_ "rit" = return Beam_Rit read_Beam_ "none" = return Beam_None read_Beam_ _ = fail "I expect fan attribute" -- | show_Beam_ :: Beam_ -> Data.Char.String show_Beam_ Beam_Accel = "accel" show_Beam_ Beam_Rit = "rit" show_Beam_ Beam_None = "none" \end{code} \begin{musicxml} Notations are musical notations, not XML notations. Multiple notations are allowed in order to represent multiple editorial levels. The set of notations will be refined and expanded over time, especially to handle more instrument-specific technical notations. \end{musicxml} \begin{code} -- ** Notations -- | type Notations = (Editorial, [Notations_]) -- | read_Notations :: Eq i => StateT Result [Content i] Notations read_Notations = do y <- read_ELEMENT "notations" read_2 read_Editorial (read_LIST read_Notations_) (childs y) -- | show_Notations :: Notations -> [Content ()] show_Notations (a, b) = show_ELEMENT "notations" [] (show_Editorial a ++ show_LIST show_Notations_ b) -- | data Notations_ = Notations_1 Tied | Notations_2 Slur | Notations_3 Tuplet | Notations_4 Glissando | Notations_5 Slide | Notations_6 Ornaments | Notations_7 Technical | Notations_8 Articulations | Notations_9 Dynamics | Notations_10 Fermata | Notations_11 Arpeggiate | Notations_12 Non_Arpeggiate | Notations_13 Accidental_Mark | Notations_14 Other_Notation deriving (Eq, Show) -- | read_Notations_ :: Eq i => StateT Result [Content i] Notations_ read_Notations_ = (read_Tied >>= return . Notations_1) `mplus` (read_Slur >>= return . Notations_2) `mplus` (read_Tuplet >>= return . Notations_3) `mplus` (read_Glissando >>= return . Notations_4) `mplus` (read_Slide >>= return . Notations_5) `mplus` (read_Ornaments >>= return . Notations_6) `mplus` (read_Technical >>= return . Notations_7) `mplus` (read_Articulations >>= return . Notations_8) `mplus` (read_Dynamics >>= return . Notations_9) `mplus` (read_Fermata >>= return . Notations_10) `mplus` (read_Arpeggiate >>= return . Notations_11) `mplus` (read_Non_Arpeggiate >>= return . Notations_12) `mplus` (read_Accidental_Mark >>= return . Notations_13) `mplus` (read_Other_Notation >>= return . Notations_14) -- | show_Notations_ :: Notations_ -> [Content ()] show_Notations_ (Notations_1 x) = show_Tied x show_Notations_ (Notations_2 x) = show_Slur x show_Notations_ (Notations_3 x) = show_Tuplet x show_Notations_ (Notations_4 x) = show_Glissando x show_Notations_ (Notations_5 x) = show_Slide x show_Notations_ (Notations_6 x) = show_Ornaments x show_Notations_ (Notations_7 x) = show_Technical x show_Notations_ (Notations_8 x) = show_Articulations x show_Notations_ (Notations_9 x) = show_Dynamics x show_Notations_ (Notations_10 x) = show_Fermata x show_Notations_ (Notations_11 x) = show_Arpeggiate x show_Notations_ (Notations_12 x) = show_Non_Arpeggiate x show_Notations_ (Notations_13 x) = show_Accidental_Mark x show_Notations_ (Notations_14 x) = show_Other_Notation x -- *** Tied -- | type Tied = ((Start_Stop, Maybe Number_Level, Line_Type, Position, Placement, Orientation, Bezier, Color),()) -- | read_Tied :: StateT Result [Content i] Tied read_Tied = do y <- read_ELEMENT "tied" y1 <- read_8 (read_REQUIRED "type" read_Start_Stop) (read_IMPLIED "number" read_Number_Level) read_Line_Type read_Position read_Placement read_Orientation read_Bezier read_Color (attributes y) return (y1,()) -- | show_Tied :: Tied -> [Content ()] show_Tied ((a,b,c,d,e,f,g,h),_)= show_ELEMENT "tied" (show_REQUIRED "type" show_Start_Stop a ++ show_IMPLIED "number" show_Number_Level b ++ show_Line_Type c ++ show_Position d ++ show_Placement e ++ show_Orientation f ++ show_Bezier g ++ show_Color h) [] \end{code} \begin{musicxml} Slur elements are empty. Most slurs are represented with two elements: one with a start type, and one with a stop type. Slurs can add more elements using a continue type. This is typically used to specify the formatting of cross- system slurs, or to specify the shape of very complex slurs. \end{musicxml} \begin{code} -- *** Slur -- | type Slur = ((Start_Stop_Continue, Number_Level, Line_Type, Position, Placement, Orientation, Bezier, Color),()) -- | read_Slur :: StateT Result [Content i] Slur read_Slur = do y <- read_ELEMENT "slur" y1 <- read_8 (read_REQUIRED "type" read_Start_Stop_Continue) (read_DEFAULT "number" read_Number_Level Number_Level_1) read_Line_Type read_Position read_Placement read_Orientation read_Bezier read_Color (attributes y) return (y1,()) -- | show_Slur :: Slur -> [Content ()] show_Slur ((a,b,c,d,e,f,g,h),_)= show_ELEMENT "slur" (show_REQUIRED "type" show_Start_Stop_Continue a ++ show_IMPLIED "number" show_Number_Level (Just b) ++ show_Line_Type c ++ show_Position d ++ show_Placement e ++ show_Orientation f ++ show_Bezier g ++ show_Color h) [] \end{code} \begin{musicxml} A tuplet element is present when a tuplet is to be displayed graphically, in addition to the sound data provided by the time-modification elements. The number attribute is used to distinguish nested tuplets. The bracket attribute is used to indicate the presence of a bracket. If unspecified, the results are implementation-dependent. The line-shape attribute is used to specify whether the bracket is straight or in the older curved or slurred style. It is straight by default. Whereas a time-modification element shows how the cumulative, sounding effect of tuplets compare to the written note type, the tuplet element describes how this is displayed. The tuplet-actual and tuplet-normal elements provide optional full control over tuplet specifications. Each allows the number and note type (including dots) describing a single tuplet. If any of these elements are absent, their values are based on the time-modification element. The show-number attribute is used to display either the number of actual notes, the number of both actual and normal notes, or neither. It is actual by default. The show-type attribute is used to display either the actual type, both the actual and normal types, or neither. It is none by default. \end{musicxml} \begin{code} -- *** Tuplet -- | type Tuplet = ((Start_Stop, Maybe Number_Level, Maybe Yes_No, Maybe Tuplet_, Maybe Tuplet_, Line_Shape, Position, Placement), (Maybe Tuplet_Actual, Maybe Tuplet_Normal)) -- | read_Tuplet :: Eq i => StateT Result [Content i] Tuplet read_Tuplet = do y <- read_ELEMENT "tuplet" y1 <- read_8 (read_REQUIRED "type" read_Start_Stop) (read_IMPLIED "number" read_Number_Level) (read_IMPLIED "bracket" read_Yes_No) (read_IMPLIED "show-number" read_Tuplet_) (read_IMPLIED "show-type" read_Tuplet_) read_Line_Shape read_Position read_Placement (attributes y) y2 <- read_2 (read_MAYBE read_Tuplet_Actual) (read_MAYBE read_Tuplet_Normal) (childs y) return (y1,y2) -- | show_Tuplet :: Tuplet -> [Content ()] show_Tuplet ((a,b,c,d,e,f,g,h),(i,j)) = show_ELEMENT "tuplet" (show_REQUIRED "type" show_Start_Stop a ++ show_IMPLIED "number" show_Number_Level b ++ show_IMPLIED "bracket" show_Yes_No c ++ show_IMPLIED "show-number" show_Tuplet_ d ++ show_IMPLIED "show-type" show_Tuplet_ e ++ show_Line_Shape f ++ show_Position g ++ show_Placement h) (show_MAYBE show_Tuplet_Actual i ++ show_MAYBE show_Tuplet_Normal j) -- | data Tuplet_ = Tuplet_1 | Tuplet_2 | Tuplet_3 deriving (Eq, Show) -- | read_Tuplet_ :: Data.Char.String -> Result Tuplet_ read_Tuplet_ "actual" = return Tuplet_1 read_Tuplet_ "both" = return Tuplet_2 read_Tuplet_ "none" = return Tuplet_3 read_Tuplet_ _ = fail "wrong value at tuplet" -- | show_Tuplet_ :: Tuplet_ -> Data.Char.String show_Tuplet_ Tuplet_1 = "actual" show_Tuplet_ Tuplet_2 = "both" show_Tuplet_ Tuplet_3 = "none" -- | type Tuplet_Actual = (Maybe Tuplet_Number, Maybe Tuplet_Type, [Tuplet_Dot]) -- | read_Tuplet_Actual :: Eq i => StateT Result [Content i] Tuplet_Actual read_Tuplet_Actual = do y <- read_ELEMENT "tuplet-actual" read_3 (read_MAYBE read_Tuplet_Number) (read_MAYBE read_Tuplet_Type) (read_LIST read_Tuplet_Dot) (childs y) -- | show_Tuplet_Actual :: Tuplet_Actual -> [Content ()] show_Tuplet_Actual (a,b,c) = show_ELEMENT "tuplet-actual" [] (show_MAYBE show_Tuplet_Number a ++ show_MAYBE show_Tuplet_Type b ++ show_LIST show_Tuplet_Dot c) -- | type Tuplet_Normal = (Maybe Tuplet_Number, Maybe Tuplet_Type, [Tuplet_Dot]) -- | read_Tuplet_Normal :: Eq i => StateT Result [Content i] Tuplet_Normal read_Tuplet_Normal = do y <- read_ELEMENT "tuplet-normal" read_3 (read_MAYBE read_Tuplet_Number) (read_MAYBE read_Tuplet_Type) (read_LIST read_Tuplet_Dot) (childs y) -- | show_Tuplet_Normal :: Tuplet_Normal -> [Content ()] show_Tuplet_Normal (a,b,c) = show_ELEMENT "tuplet-normal" [] (show_MAYBE show_Tuplet_Number a ++ show_MAYBE show_Tuplet_Type b ++ show_LIST show_Tuplet_Dot c) -- | type Tuplet_Number = ((Font, Color), PCDATA) -- | read_Tuplet_Number :: StateT Result [Content i] Tuplet_Number read_Tuplet_Number = do y <- read_ELEMENT "tuplet-number" y1 <- read_2 read_Font read_Color (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Tuplet_Number :: Tuplet_Number -> [Content ()] show_Tuplet_Number ((a,b),c) = show_ELEMENT "tuplet-number" (show_Font a ++ show_Color b) (show_PCDATA c) -- | type Tuplet_Type = ((Font, Color), PCDATA) -- | read_Tuplet_Type :: StateT Result [Content i] Tuplet_Type read_Tuplet_Type = do y <- read_ELEMENT "tuplet-type" y1 <- read_2 read_Font read_Color (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Tuplet_Type :: Tuplet_Type -> [Content ()] show_Tuplet_Type ((a,b),c) = show_ELEMENT "tuplet-type" (show_Font a ++ show_Color b) (show_PCDATA c) -- | type Tuplet_Dot = ((Font, Color), ()) -- | read_Tuplet_Dot :: StateT Result [Content i] Tuplet_Dot read_Tuplet_Dot = do y <- read_ELEMENT "tuplet-dot" y1 <- read_2 read_Font read_Color (attributes y) return (y1,()) -- | show_Tuplet_Dot :: Tuplet_Dot -> [Content ()] show_Tuplet_Dot ((a,b),_) = show_ELEMENT "tuplet-dot" (show_Font a ++ show_Color b) [] \end{code} \begin{musicxml} Glissando and slide elements both indicate rapidly moving from one pitch to the other so that individual notes are not discerned. The distinction is similar to that between NIFF's glissando and portamento elements. A glissando sounds the half notes in between the slide and defaults to a wavy line. A slide is continuous between two notes and defaults to a solid line. The optional text for a glissando or slide is printed alongside the line. \end{musicxml} \begin{code} -- *** Glissando -- | type Glissando = ((Start_Stop, Number_Level, Line_Type, Print_Style),PCDATA) -- | read_Glissando :: StateT Result [Content i] Glissando read_Glissando = do y <- read_ELEMENT "glissando" y1 <- read_4 (read_REQUIRED "type" read_Start_Stop) (read_DEFAULT "number" read_Number_Level Number_Level_1) read_Line_Type read_Print_Style (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Glissando :: Glissando -> [Content ()] show_Glissando ((a,b,c,d),e) = show_ELEMENT "glissando" (show_REQUIRED "type" show_Start_Stop a ++ show_IMPLIED "number" show_Number_Level (Just b) ++ show_Line_Type c ++ show_Print_Style d) (show_PCDATA e) -- *** Slide -- | type Slide = ((Start_Stop, Number_Level, Line_Type, Print_Style, Bend_Sound), PCDATA) -- | read_Slide :: StateT Result [Content i] Slide read_Slide = do y <- read_ELEMENT "slide" y1 <- read_5 (read_REQUIRED "type" read_Start_Stop) (read_DEFAULT "number" read_Number_Level Number_Level_1) read_Line_Type read_Print_Style read_Bend_Sound (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Slide :: Slide -> [Content ()] show_Slide ((a,b,c,d,e),f) = show_ELEMENT "slide" (show_REQUIRED "type" show_Start_Stop a ++ show_IMPLIED "number" show_Number_Level (Just b) ++ show_Line_Type c ++ show_Print_Style d ++ show_Bend_Sound e) (show_PCDATA f) \end{code} \begin{musicxml} The other-notation element is used to define any notations not yet in the MusicXML format. This allows extended representation, though without application interoperability. It handles notations where more specific extension elements such as other-dynamics and other-technical are not appropriate. \end{musicxml} \begin{code} -- | type Other_Notation = ((Start_Stop_Single, Number_Level, Print_Object, Print_Style, Placement), PCDATA) -- | read_Other_Notation :: StateT Result [Content i] Other_Notation read_Other_Notation = do y <- read_ELEMENT "other-notation" y1 <- read_5 (read_REQUIRED "type" read_Start_Stop_Single) (read_DEFAULT "number" read_Number_Level Number_Level_1) read_Print_Object read_Print_Style read_Placement (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Other_Notation :: Other_Notation -> [Content ()] show_Other_Notation ((a,b,c,d,e),f) = show_ELEMENT "other-notation" (show_REQUIRED "type" show_Start_Stop_Single a ++ show_IMPLIED "number" show_Number_Level (Just b) ++ show_Print_Object c ++ show_Print_Style d ++ show_Placement e) (show_PCDATA f) \end{code} \begin{musicxml} Ornaments can be any of several types, followed optionally by accidentals. The accidental-mark element's content is represented the same as an accidental element, but with a different name to reflect the different musical meaning. \end{musicxml} \begin{code} -- *** Ornaments -- | type Ornaments = [(Ornaments_, [Accidental_Mark])] -- | read_Ornaments :: Eq i => StateT Result [Content i] Ornaments read_Ornaments = do y <- read_ELEMENT "ornaments" read_1 (read_LIST read_Ornaments_aux1) (childs y) read_Ornaments_aux1 :: Eq i => StateT Result [Content i] (Ornaments_, [Accidental_Mark]) read_Ornaments_aux1 = do y1 <- read_Ornaments_ y2 <- read_LIST read_Accidental_Mark return (y1,y2) -- | show_Ornaments :: Ornaments -> [Content ()] show_Ornaments l = show_ELEMENT "ornaments" [] (show_LIST show_Ornaments_aux1 l) show_Ornaments_aux1 :: (Ornaments_, [Accidental_Mark]) -> [Content ()] show_Ornaments_aux1 (a,b) = show_Ornaments_ a ++ show_LIST show_Accidental_Mark b -- | data Ornaments_ = Ornaments_1 Trill_Mark | Ornaments_2 Turn | Ornaments_3 Delayed_Turn | Ornaments_4 Inverted_Turn | Ornaments_5 Shake | Ornaments_6 Wavy_Line | Ornaments_7 Mordent | Ornaments_8 Inverted_Mordent | Ornaments_9 Schleifer | Ornaments_10 Tremolo | Ornaments_11 Other_Ornament deriving (Eq, Show) -- | read_Ornaments_ :: StateT Result [Content i] Ornaments_ read_Ornaments_ = (read_Trill_Mark >>= return . Ornaments_1) `mplus` (read_Turn >>= return . Ornaments_2) `mplus` (read_Delayed_Turn >>= return . Ornaments_3) `mplus` (read_Inverted_Turn >>= return . Ornaments_4) `mplus` (read_Shake >>= return . Ornaments_5) `mplus` (read_Wavy_Line >>= return . Ornaments_6) `mplus` (read_Mordent >>= return . Ornaments_7) `mplus` (read_Inverted_Mordent >>= return . Ornaments_8) `mplus` (read_Schleifer >>= return . Ornaments_9) `mplus` (read_Tremolo >>= return . Ornaments_10) `mplus` (read_Other_Ornament >>= return . Ornaments_11) -- | show_Ornaments_ :: Ornaments_ -> [Content ()] show_Ornaments_ (Ornaments_1 x) = show_Trill_Mark x show_Ornaments_ (Ornaments_2 x) = show_Turn x show_Ornaments_ (Ornaments_3 x) = show_Delayed_Turn x show_Ornaments_ (Ornaments_4 x) = show_Inverted_Turn x show_Ornaments_ (Ornaments_5 x) = show_Shake x show_Ornaments_ (Ornaments_6 x) = show_Wavy_Line x show_Ornaments_ (Ornaments_7 x) = show_Mordent x show_Ornaments_ (Ornaments_8 x) = show_Inverted_Mordent x show_Ornaments_ (Ornaments_9 x) = show_Schleifer x show_Ornaments_ (Ornaments_10 x) = show_Tremolo x show_Ornaments_ (Ornaments_11 x) = show_Other_Ornament x -- | type Trill_Mark = ((Print_Style, Placement, Trill_Sound),()) -- | read_Trill_Mark :: StateT Result [Content i] Trill_Mark read_Trill_Mark = do y <- read_ELEMENT "trill-mark" y1 <- read_3 read_Print_Style read_Placement read_Trill_Sound (attributes y) return (y1,()) -- | show_Trill_Mark :: Trill_Mark -> [Content ()] show_Trill_Mark ((a,b,c),_) = show_ELEMENT "trill-mark" (show_Print_Style a ++ show_Placement b ++ show_Trill_Sound c) [] \end{code} \begin{musicxml} The turn and delayed-turn elements are the normal turn shape which goes up then down. The delayed-turn element indicates a turn that is delayed until the end of the current note. The inverted-turn element has the shape which goes down and then up. \end{musicxml} \begin{code} -- | type Turn = ((Print_Style, Placement, Trill_Sound), ()) -- | read_Turn :: StateT Result [Content i] Turn read_Turn = do y <- read_ELEMENT "turn" y1 <- read_3 read_Print_Style read_Placement read_Trill_Sound (attributes y) return (y1,()) -- | show_Turn :: Turn -> [Content ()] show_Turn ((a,b,c),_) = show_ELEMENT "turn" (show_Print_Style a ++ show_Placement b ++ show_Trill_Sound c) [] -- | type Delayed_Turn = ((Print_Style, Placement, Trill_Sound), ()) -- | read_Delayed_Turn :: StateT Result [Content i] Delayed_Turn read_Delayed_Turn = do y <- read_ELEMENT "delayed-turn" y1 <- read_3 read_Print_Style read_Placement read_Trill_Sound (attributes y) return (y1,()) -- | show_Delayed_Turn :: Delayed_Turn -> [Content ()] show_Delayed_Turn ((a,b,c),_) = show_ELEMENT "delayed-turn" (show_Print_Style a ++ show_Placement b ++ show_Trill_Sound c) [] -- | type Inverted_Turn = ((Print_Style, Placement, Trill_Sound), ()) -- | read_Inverted_Turn :: StateT Result [Content i] Inverted_Turn read_Inverted_Turn = do y <- read_ELEMENT "inverted-turn" y1 <- read_3 read_Print_Style read_Placement read_Trill_Sound (attributes y) return (y1,()) -- | show_Inverted_Turn :: Inverted_Turn -> [Content ()] show_Inverted_Turn ((a,b,c),_) = show_ELEMENT "inverted-turn" (show_Print_Style a ++ show_Placement b ++ show_Trill_Sound c) [] -- | type Shake = ((Print_Style, Placement, Trill_Sound), ()) -- | read_Shake :: StateT Result [Content i] Shake read_Shake = do y <- read_ELEMENT "shake" y1 <- read_3 read_Print_Style read_Placement read_Trill_Sound (attributes y) return (y1,()) -- | show_Shake :: Shake -> [Content ()] show_Shake ((a,b,c),_) = show_ELEMENT "shake" (show_Print_Style a ++ show_Placement b ++ show_Trill_Sound c) [] \end{code} \begin{musicxml} The wavy-line element is defined in the Common.lhs file, as it applies to more than just note elements. The long attribute for the mordent and inverted-mordent elements is "no" by default. The mordent element represents the sign with the vertical line; the inverted-mordent element represents the sign without the vertical line. \end{musicxml} \begin{code} -- | type Mordent = ((Maybe Yes_No, Print_Style, Placement, Trill_Sound), ()) -- | read_Mordent :: StateT Result [Content i] Mordent read_Mordent = do y <- read_ELEMENT "mordent" y1 <- read_4 (read_IMPLIED "long" read_Yes_No) read_Print_Style read_Placement read_Trill_Sound (attributes y) return (y1,()) -- | show_Mordent :: Mordent -> [Content ()] show_Mordent ((a,b,c,d),_) = show_ELEMENT "mordent" (show_IMPLIED [] show_Yes_No a ++ show_Print_Style b ++ show_Placement c ++ show_Trill_Sound d) [] -- | type Inverted_Mordent = ((Maybe Yes_No, Print_Style, Placement, Trill_Sound), ()) -- | read_Inverted_Mordent :: StateT Result [Content i] Inverted_Mordent read_Inverted_Mordent = do y <- read_ELEMENT "inverted-mordent" y1 <- read_4 (read_IMPLIED "long" read_Yes_No) read_Print_Style read_Placement read_Trill_Sound (attributes y) return (y1,()) -- | show_Inverted_Mordent :: Inverted_Mordent -> [Content ()] show_Inverted_Mordent ((a,b,c,d),_) = show_ELEMENT "inverted-mordent" (show_IMPLIED [] show_Yes_No a ++ show_Print_Style b ++ show_Placement c ++ show_Trill_Sound d) [] \end{code} \begin{musicxml} The name for this ornament is based on the German, to avoid confusion with the more common slide element defined earlier. \end{musicxml} \begin{code} -- | type Schleifer = ((Print_Style, Placement), ()) -- | read_Schleifer :: StateT Result [Content i] Schleifer read_Schleifer = do y <- read_ELEMENT "schleifer" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Schleifer :: Schleifer -> [Content ()] show_Schleifer ((a,b),_) = show_ELEMENT "schleifer" (show_Print_Style a ++ show_Placement b) [] \end{code} \begin{musicxml} While using repeater beams is the preferred method for indicating tremolos, often playback and display are not well-enough integrated in an application to make that feasible. The tremolo ornament can be used to indicate either single-note or double-note tremolos. Single-note tremolos use the single type, while double-note tremolos use the start and stop types. The default is "single" for compatibility with Version 1.1. The text of the element indicates the number of tremolo marks and is an integer from 0 to 6. Note that the number of attached beams is not included in this value, but is represented separately using the beam element. \end{musicxml} \begin{code} -- | type Tremolo = ((Start_Stop_Single, Print_Style, Placement), PCDATA) -- | read_Tremolo :: StateT Result [Content i] Tremolo read_Tremolo = do y <- read_ELEMENT "tremolo" y1 <- read_3 (read_DEFAULT "type" read_Start_Stop_Single Start_Stop_Single_3) read_Print_Style read_Placement (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Tremolo :: Tremolo -> [Content ()] show_Tremolo ((a,b,c),d) = show_ELEMENT "tremolo" (show_IMPLIED "type" show_Start_Stop_Single (Just a) ++ show_Print_Style b ++ show_Placement c) (show_PCDATA d) \end{code} \begin{musicxml} The other-ornament element is used to define any ornaments not yet in the MusicXML format. This allows extended representation, though without application interoperability. \end{musicxml} \begin{code} -- | type Other_Ornament = ((Print_Style, Placement), PCDATA) -- | read_Other_Ornament :: StateT Result [Content i] Other_Ornament read_Other_Ornament = do y <- read_ELEMENT "other-ornament" y1 <- read_2 read_Print_Style read_Placement (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Other_Ornament :: Other_Ornament -> [Content ()] show_Other_Ornament ((a,b),c) = show_ELEMENT "other-ornament" (show_Print_Style a ++ show_Placement b) (show_PCDATA c) \end{code} \begin{musicxml} An accidental-mark can be used as a separate notation or as part of an ornament. When used in an ornament, position and placement are relative to the ornament, not relative to the note. \end{musicxml} \begin{code} -- | type Accidental_Mark = ((Print_Style, Placement), CDATA) -- | read_Accidental_Mark :: StateT Result [Content i] Accidental_Mark read_Accidental_Mark = do y <- read_ELEMENT "accidental-mark" y1 <- read_2 read_Print_Style read_Placement (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Accidental_Mark :: Accidental_Mark -> [Content ()] show_Accidental_Mark ((a,b),c) = show_ELEMENT "accidental-mark" (show_Print_Style a ++ show_Placement b) (show_PCDATA c) \end{code} \begin{musicxml} Technical indications give performance information for individual instruments. \end{musicxml} \begin{code} -- *** Technical -- | type Technical = [Technical_] -- | read_Technical :: Eq i => StateT Result [Content i] Technical read_Technical = do y <- read_ELEMENT "technical" read_1 (read_LIST read_Technical_) (childs y) -- | show_Technical :: Technical -> [Content ()] show_Technical x = show_ELEMENT "technical" [] (show_LIST show_Technical_ x) -- | data Technical_ = Technical_1 Up_Bow | Technical_2 Down_Bow | Technical_3 Harmonic | Technical_4 Open_String | Technical_5 Thumb_Position | Technical_6 Fingering | Technical_7 Pluck | Technical_8 Double_Tongue | Technical_9 Triple_Tongue | Technical_10 Stopped | Technical_11 Snap_Pizzicato | Technical_12 Fret | Technical_13 String | Technical_14 Hammer_On | Technical_15 Pull_Off | Technical_16 Bend | Technical_17 Tap | Technical_18 Heel | Technical_19 Toe | Technical_20 Fingernails | Technical_21 Other_Technical deriving (Eq, Show) -- | read_Technical_ :: StateT Result [Content i] Technical_ read_Technical_ = (read_Up_Bow >>= return . Technical_1) `mplus` (read_Down_Bow >>= return . Technical_2) `mplus` (read_Harmonic >>= return . Technical_3) `mplus` (read_Open_String >>= return . Technical_4) `mplus` (read_Thumb_Position >>= return . Technical_5) `mplus` (read_Fingering >>= return . Technical_6) `mplus` (read_Pluck >>= return . Technical_7) `mplus` (read_Double_Tongue >>= return . Technical_8) `mplus` (read_Triple_Tongue >>= return . Technical_9) `mplus` (read_Stopped >>= return . Technical_10) `mplus` (read_Snap_Pizzicato >>= return . Technical_11) `mplus` (read_Fret >>= return . Technical_12) `mplus` (read_String >>= return . Technical_13) `mplus` (read_Hammer_On >>= return . Technical_14) `mplus` (read_Pull_Off >>= return . Technical_15) `mplus` (read_Bend >>= return . Technical_16) `mplus` (read_Tap >>= return . Technical_17) `mplus` (read_Heel >>= return . Technical_18) `mplus` (read_Toe >>= return . Technical_19) `mplus` (read_Fingernails >>= return . Technical_20) `mplus` (read_Other_Technical >>= return . Technical_21) -- | show_Technical_ :: Technical_ -> [Content ()] show_Technical_ (Technical_1 x) = show_Up_Bow x show_Technical_ (Technical_2 x) = show_Down_Bow x show_Technical_ (Technical_3 x) = show_Harmonic x show_Technical_ (Technical_4 x) = show_Open_String x show_Technical_ (Technical_5 x) = show_Thumb_Position x show_Technical_ (Technical_6 x) = show_Fingering x show_Technical_ (Technical_7 x) = show_Pluck x show_Technical_ (Technical_8 x) = show_Double_Tongue x show_Technical_ (Technical_9 x) = show_Triple_Tongue x show_Technical_ (Technical_10 x) = show_Stopped x show_Technical_ (Technical_11 x) = show_Snap_Pizzicato x show_Technical_ (Technical_12 x) = show_Fret x show_Technical_ (Technical_13 x) = show_String x show_Technical_ (Technical_14 x) = show_Hammer_On x show_Technical_ (Technical_15 x) = show_Pull_Off x show_Technical_ (Technical_16 x) = show_Bend x show_Technical_ (Technical_17 x) = show_Tap x show_Technical_ (Technical_18 x) = show_Heel x show_Technical_ (Technical_19 x) = show_Toe x show_Technical_ (Technical_20 x) = show_Fingernails x show_Technical_ (Technical_21 x) = show_Other_Technical x \end{code} \begin{musicxml} The up-bow and down-bow elements represent the symbol that is used both for bowing indications on bowed instruments, and up-stroke / down-stoke indications on plucked instruments. \end{musicxml} \begin{code} -- | type Up_Bow = ((Print_Style, Placement), ()) -- | read_Up_Bow :: StateT Result [Content i] Up_Bow read_Up_Bow = do y <- read_ELEMENT "up-bow" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1, ()) -- | show_Up_Bow :: Up_Bow -> [Content ()] show_Up_Bow ((a,b),_) = show_ELEMENT "up-bow" (show_Print_Style a ++ show_Placement b) [] -- | type Down_Bow = ((Print_Style, Placement), ()) -- | read_Down_Bow :: StateT Result [Content i] Down_Bow read_Down_Bow = do y <- read_ELEMENT "down-bow" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1, ()) -- | show_Down_Bow :: Down_Bow -> [Content ()] show_Down_Bow ((a,b),_) = show_ELEMENT "down-bow" (show_Print_Style a ++ show_Placement b) [] \end{code} \begin{musicxml} The harmonic element indicates natural and artificial harmonics. Natural harmonics usually notate the base pitch rather than the sounding pitch. Allowing the type of pitch to be specified, combined with controls for appearance/playback differences, allows both the notation and the sound to be represented. Artificial harmonics can add a notated touching-pitch; the pitch or fret at which the string is touched lightly to produce the harmonic. Artificial pinch harmonics will usually not notate a touching pitch. The attributes for the harmonic element refer to the use of the circular harmonic symbol, typically but not always used with natural harmonics. \end{musicxml} \begin{code} type Harmonic = ((Print_Object, Print_Style, Placement), (Maybe Harmonic_A, Maybe Harmonic_B)) -- | read_Harmonic :: StateT Result [Content i] Harmonic read_Harmonic = do y <- read_ELEMENT "harmonic" y1 <- read_3 read_Print_Object read_Print_Style read_Placement (attributes y) y2 <- read_2 (read_MAYBE read_Harmonic_A) (read_MAYBE read_Harmonic_B) (childs y) return (y1,y2) -- | show_Harmonic :: Harmonic -> [Content ()] show_Harmonic ((a,b,c),(d,e)) = show_ELEMENT "harmonic" (show_Print_Object a ++ show_Print_Style b ++ show_Placement c) (show_MAYBE show_Harmonic_A d ++ show_MAYBE show_Harmonic_B e) data Harmonic_A = Harmonic_1 Natural | Harmonic_2 Artificial deriving (Eq, Show) -- | read_Harmonic_A :: StateT Result [Content i] Harmonic_A read_Harmonic_A = (read_Natural >>= return . Harmonic_1) `mplus` (read_Artificial >>= return . Harmonic_2) -- | show_Harmonic_A :: Harmonic_A -> [Content ()] show_Harmonic_A (Harmonic_1 x) = show_Natural x show_Harmonic_A (Harmonic_2 x) = show_Artificial x -- | data Harmonic_B = Harmonic_3 Base_Pitch | Harmonic_4 Touching_Pitch | Harmonic_5 Sounding_Pitch deriving (Eq, Show) -- | read_Harmonic_B :: StateT Result [Content i] Harmonic_B read_Harmonic_B = (read_Base_Pitch >>= return . Harmonic_3) `mplus` (read_Touching_Pitch >>= return . Harmonic_4) `mplus` (read_Sounding_Pitch >>= return . Harmonic_5) -- | show_Harmonic_B :: Harmonic_B -> [Content ()] show_Harmonic_B (Harmonic_3 x) = show_Base_Pitch x show_Harmonic_B (Harmonic_4 x) = show_Touching_Pitch x show_Harmonic_B (Harmonic_5 x) = show_Sounding_Pitch x -- | type Natural = () -- | read_Natural :: StateT Result [Content i] Natural read_Natural = do read_ELEMENT "natural" >> return () -- | show_Natural :: Natural -> [Content ()] show_Natural _ = show_ELEMENT "natural" [] [] -- | type Artificial = () -- | read_Artificial :: StateT Result [Content i] Artificial read_Artificial = do read_ELEMENT "artificial" >> return () -- | show_Artificial :: Artificial -> [Content ()] show_Artificial _ = show_ELEMENT "artificial" [] [] -- | type Base_Pitch = () -- | read_Base_Pitch :: StateT Result [Content i] Base_Pitch read_Base_Pitch = do read_ELEMENT "base-picth" >> return () -- | show_Base_Pitch :: Base_Pitch -> [Content ()] show_Base_Pitch _ = show_ELEMENT "base-pitch" [] [] -- | type Touching_Pitch = () -- | read_Touching_Pitch :: StateT Result [Content i] Touching_Pitch read_Touching_Pitch = do read_ELEMENT "touching-pitch" >> return () -- | show_Touching_Pitch :: Touching_Pitch -> [Content ()] show_Touching_Pitch _ = show_ELEMENT "touching-picth" [] [] -- | type Sounding_Pitch = () -- | read_Sounding_Pitch :: StateT Result [Content i] Sounding_Pitch read_Sounding_Pitch = do read_ELEMENT "sounding-picth" >> return () -- | show_Sounding_Pitch :: Sounding_Pitch -> [Content ()] show_Sounding_Pitch _ = show_ELEMENT "sounding-pitch" [] [] -- | type Open_String = ((Print_Style, Placement),()) -- | read_Open_String :: StateT Result [Content i] Open_String read_Open_String = do y <- read_ELEMENT "open-string" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1, ()) -- | show_Open_String :: Open_String -> [Content ()] show_Open_String ((a,b),_) = show_ELEMENT "open-string" (show_Print_Style a ++ show_Placement b) [] -- | type Thumb_Position = ((Print_Style, Placement),()) -- | read_Thumb_Position :: StateT Result [Content i] Thumb_Position read_Thumb_Position = do y <- read_ELEMENT "thumb-position" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1, ()) -- | show_Thumb_Position :: Thumb_Position -> [Content ()] show_Thumb_Position ((a,b),_) = show_ELEMENT "thumb-position" (show_Print_Style a ++ show_Placement b) [] \end{code} \begin{musicxml} The pluck element is used to specify the plucking fingering on a fretted instrument, where the fingering element refers to the fretting fingering. Typical values are p, i, m, a for pulgar/thumb, indicio/index, medio/middle, and anular/ring fingers. \end{musicxml} \begin{code} -- | type Pluck = ((Print_Style, Placement), PCDATA) -- | read_Pluck :: StateT Result [Content i] Pluck read_Pluck = do y <- read_ELEMENT "pluck" y1 <- read_2 read_Print_Style read_Placement (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Pluck :: Pluck -> [Content ()] show_Pluck ((a,b),c) = show_ELEMENT "pluck" (show_Print_Style a ++ show_Placement b) (show_PCDATA c) -- | type Double_Tongue = ((Print_Style, Placement),()) -- | read_Double_Tongue :: StateT Result [Content i] Double_Tongue read_Double_Tongue = do y <- read_ELEMENT "double-tongue" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1, ()) -- | show_Double_Tongue :: Double_Tongue -> [Content ()] show_Double_Tongue ((a,b),_) = show_ELEMENT "double-tongue" (show_Print_Style a ++ show_Placement b) [] -- | type Triple_Tongue = ((Print_Style, Placement),()) -- | read_Triple_Tongue :: StateT Result [Content i] Triple_Tongue read_Triple_Tongue = do y <- read_ELEMENT "triple-tongue" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1, ()) -- | show_Triple_Tongue :: Triple_Tongue -> [Content ()] show_Triple_Tongue ((a,b),_) = show_ELEMENT "triple-tongue" (show_Print_Style a ++ show_Placement b) [] -- | type Stopped = ((Print_Style, Placement),()) -- | read_Stopped :: StateT Result [Content i] Stopped read_Stopped = do y <- read_ELEMENT "stopped" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1, ()) -- | show_Stopped :: Stopped -> [Content ()] show_Stopped ((a,b),_) = show_ELEMENT "stopped" (show_Print_Style a ++ show_Placement b) [] -- | type Snap_Pizzicato = ((Print_Style, Placement),()) -- | read_Snap_Pizzicato :: StateT Result [Content i] Snap_Pizzicato read_Snap_Pizzicato = do y <- read_ELEMENT "snap-pizzicato" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1, ()) -- | show_Snap_Pizzicato :: Snap_Pizzicato -> [Content ()] show_Snap_Pizzicato ((a,b),_) = show_ELEMENT "snap-pizzicato" (show_Print_Style a ++ show_Placement b) [] \end{code} \begin{musicxml} The hammer-on and pull-off elements are used in guitar and fretted instrument notation. Since a single slur can be marked over many notes, the hammer-on and pull-off elements are separate so the individual pair of notes can be specified. The element content can be used to specify how the hammer-on or pull-off should be notated. An empty element leaves this choice up to the application. \end{musicxml} \begin{code} -- | type Hammer_On = ((Start_Stop, Number_Level, Print_Style, Placement), PCDATA) -- | read_Hammer_On :: StateT Result [Content i] Hammer_On read_Hammer_On = do y <- read_ELEMENT "hammer-on" y1 <- read_4 (read_REQUIRED "type" read_Start_Stop) (read_DEFAULT "number" read_Number_Level Number_Level_1) read_Print_Style read_Placement (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Hammer_On :: Hammer_On -> [Content ()] show_Hammer_On ((a,b,c,d),e) = show_ELEMENT "hammer-on" (show_REQUIRED "type" show_Start_Stop a ++ show_IMPLIED "number" show_Number_Level (Just b) ++ show_Print_Style c ++ show_Placement d) (show_PCDATA e) -- | type Pull_Off = ((Start_Stop, Number_Level, Print_Style, Placement), PCDATA) -- | read_Pull_Off :: StateT Result [Content i] Pull_Off read_Pull_Off = do y <- read_ELEMENT "pull-off" y1 <- read_4 (read_REQUIRED "type" read_Start_Stop) (read_DEFAULT "number" read_Number_Level Number_Level_1) read_Print_Style read_Placement (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Pull_Off :: Pull_Off -> [Content ()] show_Pull_Off ((a,b,c,d),e) = show_ELEMENT "pull-off" (show_REQUIRED "type" show_Start_Stop a ++ show_IMPLIED "number" show_Number_Level (Just b) ++ show_Print_Style c ++ show_Placement d) (show_PCDATA e) \end{code} \begin{musicxml} The bend element is used in guitar and tablature. The bend-alter element indicates the number of steps in the bend, similar to the alter element. As with the alter element, numbers like 0.5 can be used to indicate microtones. Negative numbers indicate pre-bends or releases; the pre-bend and release elements are used to distinguish what is intended. A with-bar element indicates that the bend is to be done at the bridge with a whammy or vibrato bar. The content of the element indicates how this should be notated. \end{musicxml} \begin{code} -- | type Bend = ((Print_Style, Bend_Sound), (Bend_Alter, Maybe Bend_, Maybe With_Bar)) -- | read_Bend :: StateT Result [Content i] Bend read_Bend = do y <- read_ELEMENT "bend" y1 <- read_2 read_Print_Style read_Bend_Sound (attributes y) y2 <- read_3 read_Bend_Alter (read_MAYBE read_Bend_) (read_MAYBE read_With_Bar) (childs y) return (y1,y2) -- | show_Bend :: Bend -> [Content ()] show_Bend ((a,b),(c,d,e)) = show_ELEMENT "bend" (show_Print_Style a ++ show_Bend_Sound b) (show_Bend_Alter c ++ show_MAYBE show_Bend_ d ++ show_MAYBE show_With_Bar e) -- | data Bend_ = Bend_1 Pre_Bend | Bend_2 Release deriving (Eq, Show) -- | read_Bend_ :: StateT Result [Content i] Bend_ read_Bend_ = (read_Pre_Bend >>= return . Bend_1) `mplus` (read_Release >>= return . Bend_2) -- | show_Bend_ :: Bend_ -> [Content ()] show_Bend_ (Bend_1 x) = show_Pre_Bend x show_Bend_ (Bend_2 x) = show_Release x -- | type Bend_Alter = PCDATA -- | read_Bend_Alter :: StateT Result [Content i] Bend_Alter read_Bend_Alter = do y <- read_ELEMENT "bend-alter" read_1 read_PCDATA (childs y) -- | show_Bend_Alter :: Bend_Alter -> [Content ()] show_Bend_Alter a = show_ELEMENT "bend-alter" [] (show_PCDATA a) -- | type Pre_Bend = () -- | read_Pre_Bend :: StateT Result [Content i] Pre_Bend read_Pre_Bend = read_ELEMENT "pre-bend" >> return () -- | show_Pre_Bend :: Pre_Bend -> [Content ()] show_Pre_Bend _ = show_ELEMENT "pre-bend" [] [] -- | type Release = () -- | read_Release :: StateT Result [Content i] Release read_Release = read_ELEMENT "release" >> return () -- | show_Release :: Release -> [Content ()] show_Release _ = show_ELEMENT "release" [] [] -- | type With_Bar = ((Print_Style, Placement), CDATA) -- | read_With_Bar :: StateT Result [Content i] With_Bar read_With_Bar = do y <- read_ELEMENT "with-bar" y1 <- read_2 read_Print_Style read_Placement (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_With_Bar :: With_Bar -> [Content ()] show_With_Bar ((a,b),c) = show_ELEMENT "with-bar" (show_Print_Style a ++ show_Placement b) (show_PCDATA c) \end{code} \begin{musicxml} The tap element indicates a tap on the fretboard. The element content allows specification of the notation; + and T are common choices. If empty, the display is application-specific. \end{musicxml} \begin{code} -- | type Tap = ((Print_Style, Placement), CDATA) -- | read_Tap :: StateT Result [Content i] Tap read_Tap = do y <- read_ELEMENT "tap" y1 <- read_2 read_Print_Style read_Placement (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Tap :: Tap -> [Content ()] show_Tap ((a,b),c) = show_ELEMENT "tap" (show_Print_Style a ++ show_Placement b) (show_PCDATA c) \end{code} \begin{musicxml} The heel and toe element are used with organ pedals. The substitution value is "no" if the attribute is not present. \end{musicxml} \begin{code} -- | type Heel = ((Maybe Yes_No, Print_Style, Placement), ()) -- | read_Heel :: StateT Result [Content i] Heel read_Heel = do y <- read_ELEMENT "heel" y1 <- read_3 (read_IMPLIED "substitution" read_Yes_No) read_Print_Style read_Placement (attributes y) return (y1, ()) -- | show_Heel :: Heel -> [Content ()] show_Heel ((a,b,c),_) = show_ELEMENT "heel" (show_IMPLIED "substitution" show_Yes_No a ++ show_Print_Style b ++ show_Placement c) [] -- | type Toe = ((Maybe Yes_No, Print_Style, Placement), ()) -- | read_Toe :: StateT Result [Content i] Toe read_Toe = do y <- read_ELEMENT "toe" y1 <- read_3 (read_IMPLIED "substitution" read_Yes_No) read_Print_Style read_Placement (attributes y) return (y1, ()) -- | show_Toe :: Toe -> [Content ()] show_Toe ((a,b,c),_) = show_ELEMENT "toe" (show_IMPLIED "substitution" show_Yes_No a ++ show_Print_Style b ++ show_Placement c) [] \end{code} \begin{musicxml} The fingernails element is used in harp notation. \end{musicxml} \begin{code} -- | type Fingernails = ((Print_Style, Placement), ()) -- | read_Fingernails :: StateT Result [Content i] Fingernails read_Fingernails = do y <- read_ELEMENT "fingernails" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1, ()) -- | show_Fingernails :: Fingernails -> [Content ()] show_Fingernails ((a,b),_) = show_ELEMENT "fingernails" (show_Print_Style a ++ show_Placement b) [] \end{code} \begin{musicxml} The other-technical element is used to define any technical indications not yet in the MusicXML format. This allows extended representation, though without application interoperability. \end{musicxml} \begin{code} -- | type Other_Technical = ((Print_Style, Placement), CDATA) -- | read_Other_Technical :: StateT Result [Content i] Other_Technical read_Other_Technical = do y <- read_ELEMENT "other-technical" y1 <- read_2 read_Print_Style read_Placement (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Other_Technical :: Other_Technical -> [Content ()] show_Other_Technical ((a,b),c) = show_ELEMENT "other-technical" (show_Print_Style a ++ show_Placement b) (show_PCDATA c) \end{code} \begin{musicxml} Articulations and accents are grouped together here. \end{musicxml} \begin{code} -- *** Articulations -- | type Articulations = [Articulations_] -- | read_Articulations :: Eq i => StateT Result [Content i] Articulations read_Articulations = do y <- read_ELEMENT "articulations" read_1 (read_LIST read_Articulations_) (childs y) -- | show_Articulations :: Articulations -> [Content ()] show_Articulations a = show_ELEMENT "articulations" [] (show_LIST show_Articulations_ a) data Articulations_ = Articulations_1 Accent | Articulations_2 Strong_Accent | Articulations_3 Staccato | Articulations_4 Tenuto | Articulations_5 Detached_Legato | Articulations_6 Staccatissimo | Articulations_7 Spiccato | Articulations_8 Scoop | Articulations_9 Plop | Articulations_10 Doit | Articulations_11 Falloff | Articulations_12 Breath_Mark | Articulations_13 Caesura | Articulations_14 Stress | Articulations_15 Unstress | Articulations_16 Other_Articulation deriving (Eq, Show) -- | read_Articulations_ :: StateT Result [Content i] Articulations_ read_Articulations_ = (read_Accent >>= return . Articulations_1) `mplus` (read_Strong_Accent >>= return . Articulations_2) `mplus` (read_Staccato >>= return . Articulations_3) `mplus` (read_Tenuto >>= return . Articulations_4) `mplus` (read_Detached_Legato >>= return . Articulations_5) `mplus` (read_Staccatissimo >>= return . Articulations_6) `mplus` (read_Spiccato >>= return . Articulations_7) `mplus` (read_Scoop >>= return . Articulations_8) `mplus` (read_Plop >>= return . Articulations_9) `mplus` (read_Doit >>= return . Articulations_10) `mplus` (read_Falloff >>= return . Articulations_11) `mplus` (read_Breath_Mark >>= return . Articulations_12) `mplus` (read_Caesura >>= return . Articulations_13) `mplus` (read_Stress >>= return . Articulations_14) `mplus` (read_Unstress >>= return . Articulations_15) `mplus` (read_Other_Articulation >>= return . Articulations_16) -- | show_Articulations_ :: Articulations_ -> [Content ()] show_Articulations_ (Articulations_1 x) = show_Accent x show_Articulations_ (Articulations_2 x) = show_Strong_Accent x show_Articulations_ (Articulations_3 x) = show_Staccato x show_Articulations_ (Articulations_4 x) = show_Tenuto x show_Articulations_ (Articulations_5 x) = show_Detached_Legato x show_Articulations_ (Articulations_6 x) = show_Staccatissimo x show_Articulations_ (Articulations_7 x) = show_Spiccato x show_Articulations_ (Articulations_8 x) = show_Scoop x show_Articulations_ (Articulations_9 x) = show_Plop x show_Articulations_ (Articulations_10 x) = show_Doit x show_Articulations_ (Articulations_11 x) = show_Falloff x show_Articulations_ (Articulations_12 x) = show_Breath_Mark x show_Articulations_ (Articulations_13 x) = show_Caesura x show_Articulations_ (Articulations_14 x) = show_Stress x show_Articulations_ (Articulations_15 x) = show_Unstress x show_Articulations_ (Articulations_16 x) = show_Other_Articulation x -- | type Accent = ((Print_Style, Placement), ()) -- | read_Accent :: StateT Result [Content i] Accent read_Accent = do y <- read_ELEMENT "accent" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Accent :: Accent -> [Content ()] show_Accent ((a,b),_) = show_ELEMENT "accent" (show_Print_Style a ++ show_Placement b) [] -- | type Strong_Accent = ((Print_Style, Placement, Up_Down), ()) -- | read_Strong_Accent :: StateT Result [Content i] Strong_Accent read_Strong_Accent = do y <- read_ELEMENT "strong-accent" y1 <- read_3 read_Print_Style read_Placement (read_DEFAULT "type" read_Up_Down Up_Down_1) (attributes y) return (y1,()) -- | show_Strong_Accent :: Strong_Accent -> [Content ()] show_Strong_Accent ((a,b,c),_) = show_ELEMENT "strong-accent" (show_Print_Style a ++ show_Placement b ++ show_REQUIRED "type" show_Up_Down c) [] \end{code} \begin{musicxml} The staccato element is used for a dot articulation, as opposed to a stroke or a wedge. \end{musicxml} \begin{code} -- | type Staccato = ((Print_Style, Placement), ()) -- | read_Staccato :: StateT Result [Content i] Staccato read_Staccato = do y <- read_ELEMENT "staccato" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Staccato :: Staccato -> [Content ()] show_Staccato ((a,b),_) = show_ELEMENT "staccato" (show_Print_Style a ++ show_Placement b) [] -- | type Tenuto = ((Print_Style, Placement), ()) -- | read_Tenuto :: StateT Result [Content i] Tenuto read_Tenuto = do y <- read_ELEMENT "tenuto" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Tenuto :: Tenuto -> [Content ()] show_Tenuto ((a,b),_) = show_ELEMENT "tenuto" (show_Print_Style a ++ show_Placement b) [] -- | type Detached_Legato = ((Print_Style, Placement), ()) -- | read_Detached_Legato :: StateT Result [Content i] Detached_Legato read_Detached_Legato = do y <- read_ELEMENT "detached-legato" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Detached_Legato :: Detached_Legato -> [Content ()] show_Detached_Legato ((a,b),_) = show_ELEMENT "detached-legato" (show_Print_Style a ++ show_Placement b) [] \end{code} \begin{musicxml} The staccatissimo element is used for a wedge articulation, as opposed to a dot or a stroke. \end{musicxml} \begin{code} -- | type Staccatissimo = ((Print_Style, Placement), ()) -- | read_Staccatissimo :: StateT Result [Content i] Staccato read_Staccatissimo = do y <- read_ELEMENT "staccatissimo" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Staccatissimo :: Staccatissimo -> [Content ()] show_Staccatissimo ((a,b),_) = show_ELEMENT "staccatissimo" (show_Print_Style a ++ show_Placement b) [] \end{code} \begin{musicxml} The spiccato element is used for a stroke articulation, as opposed to a dot or a wedge. \end{musicxml} \begin{code} -- | type Spiccato = ((Print_Style, Placement), ()) -- | read_Spiccato :: StateT Result [Content i] Spiccato read_Spiccato = do y <- read_ELEMENT "spiccato" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Spiccato :: Spiccato -> [Content ()] show_Spiccato ((a,b),_) = show_ELEMENT "spiccato" (show_Print_Style a ++ show_Placement b) [] \end{code} \begin{musicxml} The scoop, plop, doit, and falloff elements are indeterminate slides attached to a single note. Scoops and plops come before the main note, coming from below and above the pitch, respectively. Doits and falloffs come after the main note, going above and below the pitch, respectively. \end{musicxml} \begin{code} -- | type Scoop = ((Line_Shape, Line_Type, Print_Style, Placement),()) -- | read_Scoop :: StateT Result [Content i] Scoop read_Scoop = do y <- read_ELEMENT "scoop" y1 <- read_4 read_Line_Shape read_Line_Type read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Scoop :: Scoop -> [Content ()] show_Scoop ((a,b,c,d),_) = show_ELEMENT "scoop" (show_Line_Shape a ++ show_Line_Type b ++ show_Print_Style c ++ show_Placement d) [] -- | type Plop = ((Line_Shape, Line_Type, Print_Style, Placement),()) -- | read_Plop :: StateT Result [Content i] Plop read_Plop = do y <- read_ELEMENT "plop" y1 <- read_4 read_Line_Shape read_Line_Type read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Plop :: Plop -> [Content ()] show_Plop ((a,b,c,d),_) = show_ELEMENT "plop" (show_Line_Shape a ++ show_Line_Type b ++ show_Print_Style c ++ show_Placement d) [] -- | type Doit = ((Line_Shape, Line_Type, Print_Style, Placement),()) -- | read_Doit :: StateT Result [Content i] Doit read_Doit = do y <- read_ELEMENT "doit" y1 <- read_4 read_Line_Shape read_Line_Type read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Doit :: Doit -> [Content ()] show_Doit ((a,b,c,d),_) = show_ELEMENT "doit" (show_Line_Shape a ++ show_Line_Type b ++ show_Print_Style c ++ show_Placement d) [] -- | type Falloff = ((Line_Shape, Line_Type, Print_Style, Placement),()) -- | read_Falloff :: StateT Result [Content i] Falloff read_Falloff = do y <- read_ELEMENT "falloff" y1 <- read_4 read_Line_Shape read_Line_Type read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Falloff :: Falloff -> [Content ()] show_Falloff ((a,b,c,d),_) = show_ELEMENT "falloff" (show_Line_Shape a ++ show_Line_Type b ++ show_Print_Style c ++ show_Placement d) [] -- | type Breath_Mark = ((Print_Style, Placement), ()) -- | read_Breath_Mark :: StateT Result [Content i] Breath_Mark read_Breath_Mark = do y <- read_ELEMENT "breath-mark" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Breath_Mark :: Breath_Mark -> [Content ()] show_Breath_Mark ((a,b),_) = show_ELEMENT "breath-mark" (show_Print_Style a ++ show_Placement b) [] -- | type Caesura = ((Print_Style, Placement), ()) -- | read_Caesura :: StateT Result [Content i] Caesura read_Caesura = do y <- read_ELEMENT "caesura" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Caesura :: Caesura -> [Content ()] show_Caesura ((a,b),_) = show_ELEMENT "caesura" (show_Print_Style a ++ show_Placement b) [] -- | type Stress = ((Print_Style, Placement), ()) -- | read_Stress :: StateT Result [Content i] Stress read_Stress = do y <- read_ELEMENT "stress" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Stress :: Stress -> [Content ()] show_Stress ((a,b),_) = show_ELEMENT "stress" (show_Print_Style a ++ show_Placement b) [] -- | type Unstress = ((Print_Style, Placement), ()) -- | read_Unstress :: StateT Result [Content i] Unstress read_Unstress = do y <- read_ELEMENT "unstress" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Unstress :: Staccato -> [Content ()] show_Unstress ((a,b),_) = show_ELEMENT "unstress" (show_Print_Style a ++ show_Placement b) [] \end{code} \begin{musicxml} The other-articulation element is used to define any articulations not yet in the MusicXML format. This allows extended representation, though without application interoperability. \end{musicxml} \begin{code} -- | type Other_Articulation = ((Print_Style, Placement), ()) -- | read_Other_Articulation :: StateT Result [Content i] Other_Articulation read_Other_Articulation = do y <- read_ELEMENT "other-articulation" y1 <- read_2 read_Print_Style read_Placement (attributes y) return (y1,()) -- | show_Other_Articulation :: Other_Articulation -> [Content ()] show_Other_Articulation ((a,b),_) = show_ELEMENT "other-articulation" (show_Print_Style a ++ show_Placement b) [] \end{code} \begin{musicxml} The dynamics and fermata elements are defined in the common.mod file as they apply to more than just note elements. The arpeggiate element indicates that this note is part of an arpeggiated chord. The number attribute can be used to distinguish between two simultaneous chords arpeggiated separately (different numbers) or together (same number). The up-down attribute is used if there is an arrow on the arpeggio sign. By default, arpeggios go from the lowest to highest note. \end{musicxml} \begin{code} -- *** Arpeggiate -- | type Arpeggiate = ((Maybe Number_Level, Maybe Up_Down, Position, Placement, Color), ()) -- | read_Arpeggiate :: StateT Result [Content i] Arpeggiate read_Arpeggiate = do y <- read_ELEMENT "arpeggiate" y1 <- read_5 (read_IMPLIED "number" read_Number_Level) (read_IMPLIED "direction" read_Up_Down) read_Position read_Placement read_Color (attributes y) return (y1,()) -- | show_Arpeggiate :: Arpeggiate -> [Content ()] show_Arpeggiate ((a,b,c,d,e),_) = show_ELEMENT "arpeggiate" (show_IMPLIED "number" show_Number_Level a ++ show_IMPLIED "direction" show_Up_Down b ++ show_Position c ++ show_Placement d ++ show_Color e) [] \end{code} \begin{musicxml} The non-arpeggiate element indicates that this note is at the top or bottom of a bracket indicating to not arpeggiate these notes. Since this does not involve playback, it is only used on the top or bottom notes, not on each note as for the arpeggiate element. \end{musicxml} \begin{code} -- *** Non_Arpeggiate -- | type Non_Arpeggiate = ((Top_Bottom, Maybe Number_Level, Position, Placement,Color), ()) -- | read_Non_Arpeggiate :: StateT Result [Content i] Non_Arpeggiate read_Non_Arpeggiate = do y <- read_ELEMENT "non-arpeggiate" y1 <- read_5 (read_REQUIRED "type" read_Top_Bottom) (read_IMPLIED "number" read_Number_Level) read_Position read_Placement read_Color (attributes y) return (y1,()) -- | show_Non_Arpeggiate :: Non_Arpeggiate -> [Content ()] show_Non_Arpeggiate ((a,b,c,d,e),_) = show_ELEMENT "non-arpeggiate" (show_REQUIRED "type" show_Top_Bottom a ++ show_IMPLIED "number" show_Number_Level b ++ show_Position c ++ show_Placement d ++ show_Color e) [] \end{code} \begin{musicxml} Text underlays for lyrics, based on Humdrum with support for other formats. The lyric number indicates multiple lines, though a name can be used as well (as in Finale's verse/chorus/section specification). Word extensions are represented using the extend element. Hyphenation is indicated by the syllabic element, which can be single, begin, end, or middle. These represent single-syllable words, word-beginning syllables, word-ending syllables, and mid-word syllables. Multiple syllables on a single note are separated by elision elements. A hyphen in the text element should only be used for an actual hyphenated word. Two text elements that are not separated by an elision element are part of the same syllable, but may have different text formatting. Humming and laughing representations are taken from Humdrum. The end-line and end-paragraph elements come from RP-017 for Standard MIDI File Lyric meta-events; they help facilitate lyric display for Karaoke and similar applications. Language names for text elements come from ISO 639, with optional country subcodes from ISO 3166. Justification is center by default; placement is below by default. \end{musicxml} \begin{code} -- ** Lyric -- | type Lyric = ((Maybe CDATA, Maybe CDATA, Justify, Position, Placement, Color), (Lyric_, Maybe End_Line, Maybe End_Paragraph, Editorial)) read_Lyric :: Eq i => StateT Result [Content i] Lyric read_Lyric = do y <- read_ELEMENT "lyric" y1 <- read_6 (read_IMPLIED "number" read_CDATA) (read_IMPLIED "name" read_CDATA) read_Justify read_Position read_Placement read_Color (attributes y) y2 <- read_4 read_Lyric_ (read_MAYBE read_End_Line) (read_MAYBE read_End_Paragraph) read_Editorial (childs y) return (y1,y2) show_Lyric :: Lyric -> [Content ()] show_Lyric ((a,b,c,d,e,f),(g,h,i,j)) = show_ELEMENT "lyric" (show_IMPLIED "number" show_CDATA a ++ show_IMPLIED "name" show_CDATA b ++ show_Justify c ++ show_Position d ++ show_Placement e ++ show_Color f) (show_Lyric_ g ++ show_MAYBE show_End_Line h ++ show_MAYBE show_End_Paragraph i ++ show_Editorial j) -- | data Lyric_ = Lyric_1 ((Maybe Syllabic, Text), [(Maybe Elision, Maybe Syllabic,Text)], Maybe Extend) | Lyric_2 Extend | Lyric_3 Laughing | Lyric_4 Humming deriving (Eq, Show) read_Lyric_ :: Eq i => StateT Result [Content i] Lyric_ read_Lyric_ = (read_Lyric_aux1 >>= (return . Lyric_1)) `mplus` (read_Extend >>= (return . Lyric_2)) `mplus` (read_Laughing >>= (return . Lyric_3)) `mplus` (read_Humming >>= (return . Lyric_4)) `mplus` fail "No lyric_ parsed" read_Lyric_aux1 :: Eq i => StateT Result [Content i] ((Maybe Syllabic, Text), [(Maybe Elision, Maybe Syllabic,Text)], Maybe Extend) read_Lyric_aux1 = do y1 <- read_MAYBE read_Syllabic y2 <- read_Text y3 <- read_LIST read_Lyric_aux2 y4 <- read_MAYBE read_Extend return ((y1,y2),y3,y4) read_Lyric_aux2 :: StateT Result [Content i] (Maybe Elision, Maybe Syllabic,Text) read_Lyric_aux2 = do y1 <- read_MAYBE read_Elision y2 <- read_MAYBE read_Syllabic y3 <- read_Text return (y1,y2,y3) show_Lyric_ :: Lyric_ -> [Content ()] show_Lyric_ (Lyric_1 ((a,b),c,d)) = show_MAYBE show_Syllabic a ++ show_Text b ++ show_LIST show_Lyric_aux1 c ++ show_MAYBE show_Extend d show_Lyric_ (Lyric_2 x) = show_Extend x show_Lyric_ (Lyric_3 x) = show_Laughing x show_Lyric_ (Lyric_4 x) = show_Humming x show_Lyric_aux1 :: (Maybe Elision, Maybe Syllabic, Text) -> [Content ()] show_Lyric_aux1 (a,b,c) = show_MAYBE show_Elision a ++ show_MAYBE show_Syllabic b ++ show_Text c -- | type Text = ((Font, Color, Text_Decoration, Text_Rotation, Letter_Spacing, Maybe CDATA, Text_Direction), CDATA) -- | read_Text :: StateT Result [Content i] Text read_Text = do y <- read_ELEMENT "text" y1 <- read_7 read_Font read_Color read_Text_Decoration read_Text_Rotation read_Letter_Spacing (read_IMPLIED "xml:lang" read_CDATA) read_Text_Direction (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Text :: Text -> [Content ()] show_Text ((a,b,c,d,e,f,g),h) = show_ELEMENT "text" (show_Font a ++ show_Color b ++ show_Text_Decoration c ++ show_Text_Rotation d ++ show_Letter_Spacing e ++ show_IMPLIED "xml:lang" show_CDATA f ++ show_Text_Direction g) (show_PCDATA h) -- | type Syllabic = PCDATA -- | read_Syllabic :: StateT Result [Content i] Syllabic read_Syllabic = do y <- read_ELEMENT "syllabic" read_1 read_PCDATA (childs y) -- | show_Syllabic :: Syllabic -> [Content ()] show_Syllabic a = show_ELEMENT "syllabic" [] (show_PCDATA a) \end{code} \begin{musicxml} In Version 2.0, the elision element text is used to specify the symbol used to display the elision. Common values are a no-break space (Unicode 00A0), an underscore (Unicode 005F), or an undertie (Unicode 203F). \end{musicxml} \begin{code} type Elision = ((Font, Color), CDATA) -- | read_Elision :: StateT Result [Content i] Elision read_Elision = do y <- read_ELEMENT "elision" y1 <- read_2 read_Font read_Color (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Elision :: Elision -> [Content ()] show_Elision ((a,b),c) = show_ELEMENT "elision" (show_Font a ++ show_Color b) (show_PCDATA c) type Extend = ((Font, Color), ()) -- | read_Extend :: StateT Result [Content i] Extend read_Extend = do y <- read_ELEMENT "extend" y1 <- read_2 read_Font read_Color (attributes y) return (y1,()) -- | show_Extend :: Extend -> [Content ()] show_Extend ((a,b),_) = show_ELEMENT "extend" (show_Font a ++ show_Color b) [] -- | type Laughing = () -- | read_Laughing :: StateT Result [Content i] Laughing read_Laughing = read_ELEMENT "laughing" >> return () -- | show_Laughing :: Laughing -> [Content ()] show_Laughing _ = show_ELEMENT "laughing" [] [] -- | type Humming = () -- | read_Humming :: StateT Result [Content i] Humming read_Humming = read_ELEMENT "humming" >> return () -- | show_Humming :: Humming -> [Content ()] show_Humming _ = show_ELEMENT "humming" [] [] -- | type End_Line = () -- | read_End_Line :: StateT Result [Content i] End_Line read_End_Line = read_ELEMENT "end-line" >> return () -- | show_End_Line :: End_Line -> [Content ()] show_End_Line _ = show_ELEMENT "end-line" [] [] -- | type End_Paragraph = () -- | read_End_Paragraph :: StateT Result [Content i] End_Paragraph read_End_Paragraph = read_ELEMENT "end-paragraph" >> return () -- | show_End_Paragraph :: End_Paragraph -> [Content ()] show_End_Paragraph _ = show_ELEMENT "end-paragraph" [] [] -- | \end{code} \begin{musicxml} Figured bass elements take their position from the first regular note that follows. Figures are ordered from top to bottom. A figure-number is a number. Values for prefix and suffix include the accidental values sharp, flat, natural, double-sharp, flat-flat, and sharp-sharp. Suffixes include both symbols that come after the figure number and those that overstrike the figure number. The suffix value slash is used for slashed numbers indicating chromatic alteration. The orientation and display of the slash usually depends on the figure number. The prefix and suffix elements may contain additional values for symbols specific to particular figured bass styles. The value of parentheses is "no" if not present. \end{musicxml} \begin{code} -- | type Figured_Bass = ((Print_Style, Printout, Maybe Yes_No), ([Figure], Maybe Duration, Editorial)) -- | read_Figured_Bass :: Eq i => StateT Result [Content i] Figured_Bass read_Figured_Bass = do y <- read_ELEMENT "figured-bass" y1 <- read_3 read_Print_Style read_Printout (read_IMPLIED "parentheses" read_Yes_No) (attributes y) y2 <- read_3 (read_LIST read_Figure) (read_MAYBE read_Duration) read_Editorial (childs y) return (y1,y2) -- | show_Figured_Bass :: Figured_Bass -> [Content ()] show_Figured_Bass ((a,b,c),(d,e,f)) = show_ELEMENT "figured-bass" (show_Print_Style a ++ show_Printout b ++ show_IMPLIED "parentheses" show_Yes_No c) (show_LIST show_Figure d ++ show_MAYBE show_Duration e ++ show_Editorial f) -- | type Figure = (Maybe Prefix, Maybe Figure_Number, Maybe Suffix, Maybe Extend) -- | read_Figure :: StateT Result [Content i] Figure read_Figure = do y <- read_ELEMENT "figure" read_4 (read_MAYBE read_Prefix) (read_MAYBE read_Figure_Number) (read_MAYBE read_Suffix) (read_MAYBE read_Extend) (childs y) -- | show_Figure :: Figure -> [Content ()] show_Figure (a,b,c,d) = show_ELEMENT "figure" [] (show_MAYBE show_Prefix a ++ show_MAYBE show_Figure_Number b ++ show_MAYBE show_Suffix c ++ show_MAYBE show_Extend d) -- | type Prefix = (Print_Style, CDATA) -- | read_Prefix :: StateT Result [Content i] Prefix read_Prefix = do y <- read_ELEMENT "prefix" y1 <- read_1 read_Print_Style (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Prefix :: Prefix -> [Content ()] show_Prefix (a,b) = show_ELEMENT "prefix" (show_Print_Style a) (show_PCDATA b) -- | type Figure_Number = (Print_Style, PCDATA) -- | read_Figure_Number :: StateT Result [Content i] Figure_Number read_Figure_Number = do y <- read_ELEMENT "figure-number" y1 <- read_1 read_Print_Style (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Figure_Number :: Figure_Number -> [Content ()] show_Figure_Number (a,b) = show_ELEMENT "figure-number" (show_Print_Style a) (show_PCDATA b) -- | type Suffix = (Print_Style, PCDATA) -- | read_Suffix :: StateT Result [Content i] Suffix read_Suffix = do y <- read_ELEMENT "suffix" y1 <- read_1 read_Print_Style (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Suffix :: Suffix -> [Content ()] show_Suffix (a,b) = show_ELEMENT "suffix" (show_Print_Style a) (show_PCDATA b) \end{code} \begin{musicxml} The backup and forward elements are required to coordinate multiple voices in one part, including music on multiple staves. The forward element is generally used within voices and staves, while the backup element is generally used to move between voices and staves. Thus the backup element does not include voice or staff elements. Duration values should always be positive, and should not cross measure boundaries. \end{musicxml} \begin{code} -- | type Backup = (Duration, Editorial) -- | read_Backup :: StateT Result [Content i] Backup read_Backup = do y <- read_ELEMENT "backup" read_2 read_Duration read_Editorial (childs y) -- | show_Backup :: Backup -> [Content ()] show_Backup (a,b) = show_ELEMENT "backup" [] (show_Duration a ++ show_Editorial b) -- | type Forward = (Duration, Editorial_Voice, Maybe Staff) -- | read_Forward :: StateT Result [Content i] Forward read_Forward = do y <- read_ELEMENT "forward" read_3 read_Duration read_Editorial_Voice (read_MAYBE read_Staff) (childs y) -- | show_Forward :: Forward -> [Content ()] show_Forward (a,b,c) = show_ELEMENT "forward" [] (show_Duration a ++ show_Editorial_Voice b ++ show_MAYBE show_Staff c) \end{code}