-- | Notation related constants. module Music.LilyPond.Light.Constant where import Music.LilyPond.Light.Model import qualified Music.Theory.Clef as C {- hmt -} import Music.Theory.Duration -- * Annotations arpeggio,fermata,flageolet,harmonic,laissezVibrer,glissando :: Annotation arpeggio = Articulation Arpeggio fermata = Articulation Fermata flageolet = Articulation Flageolet harmonic = Articulation Harmonic laissezVibrer = Articulation LaissezVibrer glissando = Articulation Glissando marcato,staccato,tenuto,accent :: Annotation marcato = Articulation Marcato staccato = Articulation Staccato tenuto = Articulation Tenuto accent = Articulation Accent stem_tremolo :: Integer -> Annotation stem_tremolo = Articulation . StemTremolo -- * Clefs bass_clef,tenor_clef,alto_clef,treble_clef,percussion_clef :: Music bass_clef = Clef (C.Clef C.Bass 0) tenor_clef = Clef (C.Clef C.Tenor 0) alto_clef = Clef (C.Clef C.Alto 0) treble_clef = Clef (C.Clef C.Treble 0) percussion_clef = Clef (C.Clef C.Percussion 0) bass_8vb_clef,treble_8va_clef,treble_8vb_clef,treble_15ma_clef :: Music bass_8vb_clef = Clef (C.Clef C.Bass (-1)) treble_8va_clef = Clef (C.Clef C.Treble 1) treble_8vb_clef = Clef (C.Clef C.Treble (-1)) treble_15ma_clef = Clef (C.Clef C.Treble 2) -- * Commands bar_line_check :: Music bar_line_check = Command BarlineCheck [] double_barline,final_barline :: Music double_barline = Command (Bar DoubleBarline) [] final_barline = Command (Bar FinalBarline) [] system_break,no_system_break :: Music system_break = Command Break [] no_system_break = Command NoBreak [] page_break,no_page_break :: Music page_break = Command PageBreak [] no_page_break = Command NoPageBreak [] auto_beam_off :: Music auto_beam_off = Command AutoBeamOff [] tuplet_down,tuplet_neutral,tuplet_up :: Music tuplet_down = Command TupletDown [] tuplet_neutral = Command TupletNeutral [] tuplet_up = Command TupletUp [] voice_one,voice_two :: Music voice_one = Command VoiceOne [] voice_two = Command VoiceTwo [] stem_down,stem_neutral,stem_up :: Music stem_down = Command StemDown [] stem_neutral = Command StemNeutral [] stem_up = Command StemUp [] dynamic_down,dynamic_neutral,dynamic_up :: Music dynamic_down = Command DynamicDown [] dynamic_neutral = Command DynamicNeutral [] dynamic_up = Command DynamicUp [] begin_8va,end_8va :: Music begin_8va = Command (Octavation 1) [] end_8va = Command (Octavation 0) [] -- * Annotations ped,no_ped :: Annotation ped = Phrasing SustainOn no_ped = Phrasing SustainOff tie :: Annotation tie = Begin_Tie -- | Beaming annotations. begin_beam,end_beam :: Annotation begin_beam = Phrasing Begin_Beam end_beam = Phrasing End_Beam -- | Slur annotations. begin_slur,end_slur :: Annotation begin_slur = Phrasing Begin_Slur end_slur = Phrasing End_Slur slur_down,slur_neutral,slur_up :: Music slur_down = Command (User "\\slurDown") [] slur_neutral = Command (User "\\slurNeutral") [] slur_up = Command (User "\\slurUp") [] -- | Phrasing slur annotations. begin_phrasing_slur,end_phrasing_slur :: Annotation begin_phrasing_slur = Phrasing Begin_PhrasingSlur end_phrasing_slur = Phrasing End_PhrasingSlur -- * Accidentals rAcc,cAcc :: Annotation rAcc = ReminderAccidental cAcc = CautionaryAccidental set_accidental_style_dodecaphonic :: Music set_accidental_style_dodecaphonic = let x = "#(set-accidental-style 'dodecaphonic)" in Command (User x) [] set_accidental_style_neo_modern :: Music set_accidental_style_neo_modern = let x = "#(set-accidental-style 'neo-modern)" in Command (User x) [] set_accidental_style_modern :: Music set_accidental_style_modern = let x = "#(set-accidental-style 'modern)" in Command (User x) [] -- * Noteheads -- | Request particular note-heads. set_noteheads :: String -> Music set_noteheads x = let u = "\\override NoteHead #'style = #'" ++ x in Command (User u) [] -- | Request specific note-heads. cross_noteheads :: Music cross_noteheads = set_noteheads "cross" baroque_noteheads :: Music baroque_noteheads = set_noteheads "baroque" neomensural_noteheads,mensural_noteheads,petrucci_noteheads :: Music neomensural_noteheads = set_noteheads "neomensural" mensural_noteheads = set_noteheads "mensural" petrucci_noteheads = set_noteheads "petrucci" harmonic_noteheads,harmonic_mixed_noteheads,diamond_noteheads :: Music harmonic_noteheads = set_noteheads "harmonic" harmonic_mixed_noteheads = set_noteheads "harmonic-mixed" diamond_noteheads = set_noteheads "diamond" -- | Revert to standard note-heads. revert_noteheads :: Music revert_noteheads = Command (User "\\revert NoteHead #'style") [] -- * Paper a4_paper :: Paper a4_paper = Paper {binding_offset = Length 0 MM ,bottom_margin = Length 6 MM ,indent = Length 15 MM ,inner_margin = Length 10 MM ,left_margin = Length 10 MM ,outer_margin = Length 20 MM ,paper_width = Length 210 MM ,paper_height = Length 297 MM ,ragged_last = False ,ragged_last_bottom = True ,ragged_right = False ,right_margin = Length 10 MM ,systems_per_page = Nothing ,top_margin = Length 5 MM ,two_sided = False ,print_page_number = True} length_scale :: Double -> Length -> Length length_scale n (Length x u) = Length (n * x) u paper_incr_size :: Paper -> Paper paper_incr_size x = let wd = paper_width x ht = paper_height x in x {paper_width = ht, paper_height = length_scale 2 wd} a3_paper :: Paper a3_paper = paper_incr_size a4_paper a2_paper :: Paper a2_paper = paper_incr_size a3_paper landscape :: Paper -> Paper landscape x = let wd = paper_width x ht = paper_height x in x {paper_width = ht, paper_height = wd} mk_fragment_paper :: Double -> Double -> Paper mk_fragment_paper w h = Paper {binding_offset = Length 0 MM ,bottom_margin = Length 0 MM ,indent = Length 0 MM ,inner_margin = Length 0 MM ,left_margin = Length 0 MM ,outer_margin = Length 0 MM ,paper_width = Length w MM ,paper_height = Length h MM ,ragged_last = True ,ragged_last_bottom = True ,ragged_right = True ,right_margin = Length 0 MM ,systems_per_page = Nothing ,top_margin = Length 0 MM ,two_sided = False ,print_page_number = False} -- * Aliases tempo :: Duration -> Integer -> Music tempo d = Tempo d . fromIntegral after_grace :: Music -> Music -> Music after_grace = AfterGrace grace :: Music -> Music grace = Grace tremolo :: (Music, Music) -> Integer -> Music tremolo = Tremolo