hly-0.15: Haskell LilyPond

Safe HaskellSafe-Inferred
LanguageHaskell98

Music.LilyPond.Light.Notation

Contents

Synopsis

Music category predicates

is_grace_skip :: Music -> Bool Source

These are required to avoid issues in lilypond (see manual)

Pitch

clr_acc :: Music -> Music Source

Remove any reminder or cautionary accidentals at note or chord.

Rests

rest :: Duration -> Music Source

Construct normal rest.

spacer_rest :: Duration -> Music Source

Construct spacer rest.

mm_rest :: Time_Signature -> Music Source

Multi-measure variant of rest.

skip :: Duration -> Music Source

Non-printing variant of rest.

empty_measure :: Integer -> Integer -> Music Source

Create an empty measure for the specified time signature.

null_measure :: Integer -> Integer -> Music Source

Like empty_measure, but with an invisible rest.

measure_rest :: Integer -> Integer -> Music Source

Like empty_measure but write time signature.

measure_null :: Integer -> Integer -> Music Source

Like measure_rest but write time signature.

Tuplets

edit_dur :: (Duration -> Duration) -> Music -> Music Source

Apply a Duration function to a Music node, if it has a duration.

tuplet :: Tuplet_T -> [Music] -> Music Source

Temporal scaling of music (tuplets).

tuplet_above :: Tuplet_T -> [Music] -> Music Source

Tuplet variants that set location, and then restore to neutral.

tuplet_below :: Tuplet_T -> [Music] -> Music Source

Tuplet variants that set location, and then restore to neutral.

scale_durations :: Tuplet_T -> [Music] -> Music Source

Like tuplet but does not annotate music, see also ts_set_fraction.

Time signatures

time_signature :: Time_Signature -> Music Source

Construct time signature.

with_time_signature :: Time_Signature -> [Music] -> Music Source

Allow proper auto-indenting of multiple measures with the same time signature.

ts_use_fractions :: Music Source

Command to request that 4/4 and 2/2 etc. are typeset as fractions.

ts_set_fraction :: Integer -> Integer -> Music Source

Set the printed time-signature fraction.

Key signatures

key :: Music -> Mode_T -> Music Source

Construct key signature.

Repetition

std_repeat :: Integer -> [Music] -> Music Source

Construct standard (two times) repeat.

Octave

note_edit_octave :: (Octave -> Octave) -> Music -> Music Source

Shift the octave of a note element, else identity.

note_shift_octave :: Octave -> Music -> Music Source

Shift the octave of a note element, else identity.

Duration

(##@) :: Pitch -> Duration_A -> Music Source

Add Duration_A to Pitch to make a Note Music element.

(##) :: Pitch -> Duration -> Music Source

Add Duration to Pitch to make a Note Music element.

(#@) :: Music -> Duration_A -> Music Source

Add Duration_A to either a Note or Chord Music element.

(#) :: Music -> Duration -> Music Source

Add Duration to either a Note or Chord Music element.

Chords

chd_p_ann :: [Pitch] -> [[Annotation]] -> Duration -> Music Source

Construct chord from Pitch elements.

chd_p :: [Pitch] -> Duration -> Music Source

Construct chord from Pitch elements.

chd :: [Music] -> Duration -> Music Source

Construct chord from Music elements.

Commands

bar_number_check :: Integer -> Music Source

Construct bar number check command.

bar_numbering :: Bool -> Music Source

Switch bar numbering visibility.

change :: String -> Music Source

Change staff (for cross staff notation).

partial :: Duration -> Music Source

Indicate initial partial measure.

hairpin_circled_tip :: Bool -> Music Source

Set or unset the circled-tip hairpin attribute.

hairpin_to_barline :: Bool -> Music Source

Set or unset the to-barline hairpin attribute.

hairpin_minimum_length :: Maybe Int -> Music Source

Set or unset the minimum-length hairpin attribute.

Staff and Parts

staff :: Staff_Name -> [Music] -> Staff Source

Construct staff.

rhythmic_staff :: Staff_Name -> [Music] -> Staff Source

Construct rhythmic staff.

text_staff :: Staff_Name -> String -> [Music] -> Staff Source

Construct staff with text underlay.

piano_staff :: Staff_Name -> [[Music]] -> Staff Source

Construct piano staff. For two staff piano music the staffs have identifiers rh and lh.

grand_staff' :: Staff_Name -> [Staff_Name] -> [[Music]] -> Staff Source

Variant with names for each staff.

polyphony :: Music -> Music -> Music Source

Interior polyphony. For two part music on one staff see two_part_staff.

Rests

join_rests :: [Music] -> [Music] Source

Joins directly adjacent rest elements. Type is adopted from the right when joining.

Duration_A functions

type DA_F x = (Duration_A, x) -> Music Source

Transform ascribed Duration_A value to Music.

da_to_music :: DA_F t -> [(Duration_A, t)] -> [Music] Source

Given DA_F transform, transform set of ascribed Duration_A values to Music.

import Music.Theory.Duration.Sequence.Notate as T
import Music.Theory.Duration.RQ.Tied as T
import Music.Theory.Pitch.Name as T
import Music.LilyPond.Light.Output.LilyPond as L
let {Right d = T.m_notate True [[(2/3,_f),(1/3,_t)],[(1,_t)],[(1,_f)]]
    ;jn (i,j) = j ##@ i
    ;n = T.ascribe d [c4,d4]
    ;r = "\\times 2/3 { c' 4 d' 8 ~ } d' 4 ~ d' 4"}
in L.ly_music_elem (Join (da_to_music jn n)) == r

da_to_measures :: DA_F x -> Maybe [Time_Signature] -> [[(Duration_A, x)]] -> [Measure] Source

Variant of da_to_music that operates on sets of measures.

rq_to_measures :: Show x => DA_F x -> [Simplify_T] -> [Time_Signature] -> Maybe [[RQ]] -> [RQ] -> [x] -> [Measure] Source

da_to_measures of notate_mm_ascribe.

import Music.Theory.Pitch.Name as T
import Music.LilyPond.Light.Output.LilyPond as L
let {jn (i,j) = j ##@ i
    ;[Measure _ m] = rq_to_measures jn [] [(3,4)] Nothing [2/3,1/3 + 2] [c4,d4]
    ;r = "\\times 2/3 { c' 4 d' 8 ~ } d' 2"}
in L.ly_music_elem (Join m) == r

Fragment

mk_fragment :: (Double, Double) -> [[Music]] -> Fragment Source

Make a fragment (possibly multiple staffs) from Music elements. Width and height are in millimeters.

Stem

Text

Measure operations

mm_delete_redundant_ts :: [Measure] -> [Measure] Source

Delete redundant (repeated) time signatures.

let mm = [Measure [Time (3,4)] [],Measure [Time (3,4)] []]
in mm_delete_redundant_ts mm == [Measure [Time (3,4)] [],Measure [] []]

Rehearsal marks