module Music.LilyPond.Light.Output.LilyPond (ly_work
,ly_music_elem) where
import Data.List
import Music.LilyPond.Light.Model
import Music.Theory.Pitch
import Music.Theory.Duration
import Music.Theory.Key
import Text.Printf
with_brackets :: (String,String) -> [String] -> [String]
with_brackets (begin,end) xs = [begin] ++ xs ++ [end]
with_braces :: [String] -> [String]
with_braces = with_brackets ("{","}")
ly_str :: String -> String
ly_str x = "\"" ++ x ++ "\""
ly_version :: Version -> [String]
ly_version (Version v) = ["\\version", ly_str v]
ly_assign :: (String -> String) -> (String,String) -> [String]
ly_assign fn (key,value) = [key,"=",fn value]
ly_bool :: Bool -> String
ly_bool True = "##t"
ly_bool False = "##f"
ly_units :: Units -> String
ly_units x =
case x of
MM -> "\\mm"
CM -> "\\cm"
ly_length :: Length -> String
ly_length (Length n x) = show n ++ ly_units x
ly_delete_nil_values :: [(String,String)] -> [(String,String)]
ly_delete_nil_values = filter (not . null . snd)
ly_paper :: Paper -> [String]
ly_paper p =
let tw = two_sided p
mg = if tw
then [("binding-offset", ly_length (binding_offset p))
,("inner-margin", ly_length (inner_margin p))
,("outer-margin", ly_length (outer_margin p))]
else [("left-margin", ly_length (left_margin p))
,("right-margin", ly_length (right_margin p))]
xs = [("bottom-margin", ly_length (bottom_margin p))
,("indent", ly_length (indent p))
,("paper-width", ly_length (paper_width p))
,("paper-height", ly_length (paper_height p))
,("ragged-last", ly_bool (ragged_last p))
,("ragged-last-bottom", ly_bool (ragged_last_bottom p))
,("systems-per-page", maybe "" show (systems_per_page p))
,("top-margin", ly_length (top_margin p))
,("two-sided", ly_bool tw)]
ys = ly_delete_nil_values (xs ++ mg)
in "\\paper" : with_braces (concatMap (ly_assign id) ys)
ly_header :: Header -> [String]
ly_header hdr =
let xs = [("dedication", dedication hdr)
,("title", title hdr)
,("subtitle", subtitle hdr)
,("composer", composer hdr)
,("tagline", tagline hdr)]
in "\\header" : with_braces (concatMap (ly_assign ly_str) xs)
ly_clef_t :: Clef_T -> String
ly_clef_t c =
case c of
Treble -> "treble"
Alto -> "alto"
Tenor -> "tenor"
Bass -> "bass"
Percussion -> "percussion"
ly_clef :: Clef_T -> Int -> String
ly_clef c o =
let o' = case o of
(2) -> "_15"
(1) -> "_8"
1 -> "^8"
2 -> "^15"
_ -> error ("ly_clef: " ++ show (c,o))
in if o == 0
then ly_clef_t c
else concat ["\"", ly_clef_t c, o', "\""]
ly_note :: Note_T -> String
ly_note n =
case n of
C -> "c"
D -> "d"
E -> "e"
F -> "f"
G -> "g"
A -> "a"
B -> "b"
ly_alteration :: Alteration_T -> String
ly_alteration a =
case a of
DoubleFlat -> "eses"
ThreeQuarterToneFlat -> "eseh"
Flat -> "es"
QuarterToneFlat -> "eh"
Natural -> ""
QuarterToneSharp -> "ih"
Sharp -> "is"
ThreeQuarterToneSharp -> "isih"
DoubleSharp -> "isis"
ly_alteration' :: Maybe Alteration_T -> String
ly_alteration' = maybe "" ly_alteration
ly_alteration_rule :: [Annotation] -> String
ly_alteration_rule xs
| ReminderAccidental `elem` xs = "!"
| CautionaryAccidental `elem` xs = "?"
| otherwise = ""
ly_octave :: Octave -> String
ly_octave o =
case o of
(1) -> ",,,,"
0 -> ",,,"
1 -> ",,"
2 -> ","
3 -> ""
4 -> "'"
5 -> "''"
6 -> "'''"
7 -> "''''"
8 -> "'''''"
_ -> error ("ly_octave: " ++ show o)
ly_pitch :: [Annotation] -> Pitch -> String
ly_pitch xs (Pitch n a o) =
ly_note n ++
ly_alteration a ++
ly_octave o ++
ly_alteration_rule xs
ly_articulation :: Articulation_T -> String
ly_articulation a =
case a of
Accent -> "\\accent"
Arpeggio -> "\\arpeggio"
ArpeggioDown -> "\\arpeggioDown"
ArpeggioNeutral -> "\\arpeggioNeutral"
ArpeggioUp -> "\\arpeggioUp"
DownBow -> "\\downbow"
Fermata -> "\\fermata"
Flageolet -> "\\flageolet "
Glissando -> "\\glissando "
Harmonic -> "\\harmonic"
LaissezVibrer -> "\\laissezVibrer"
Marcato -> "\\marcato"
Open -> "\\open"
Portato -> "\\portato"
Staccato -> "\\staccato"
StemTremolo x -> ":" ++ show x
Stopped -> "\\stopped"
Tenuto -> "\\tenuto"
Trill -> "\\trill"
UpBow -> "\\upbow"
ly_dynamic :: Dynamic_T -> String
ly_dynamic d =
case d of
PPPP -> "\\pppp"
PPP -> "\\ppp"
Pianissimo -> "\\pp"
Piano -> "\\p"
MezzoPiano -> "\\mp"
MezzoForte -> "\\mf"
Forte -> "\\f"
Fortissimo -> "\\ff"
FFF -> "\\fff"
FFFF -> "\\ffff"
FP -> "\\fp"
SFZ -> "\\sfz"
Begin_Crescendo -> "\\<"
Begin_Decrescendo -> "\\>"
End_Dynamic -> "\\!"
Espressivo -> "\\espressivo"
ly_fraction :: (Integer,Integer) -> String
ly_fraction (n,d) = show n ++ "/" ++ show d
ly_duple :: (Show x) => (x,x) -> String
ly_duple (x,y) = "#'(" ++ show x ++ " . " ++ show y ++ ")"
ly_duration :: Duration -> String
ly_duration = duration_to_lilypond_type
ly_phrasing :: Phrasing_T -> String
ly_phrasing p =
case p of
Begin_Slur -> "("
End_Slur -> ")"
Begin_PhrasingSlur -> "\\("
End_PhrasingSlur -> "\\)"
Begin_Beam -> "["
End_Beam -> "]"
SustainOn -> "\\sustainOn"
SustainOff -> "\\sustainOff"
ly_annotation :: Annotation -> String
ly_annotation a =
case a of
Articulation x -> ly_articulation x
Dynamic x -> ly_dynamic x
Phrasing x -> ly_phrasing x
Begin_Tie -> "~"
Above -> "^"
Below -> "_"
Text x -> ly_str x
CompositeAnnotation xs -> intercalate " " (map ly_annotation xs)
ReminderAccidental -> ""
CautionaryAccidental -> ""
ly_bar :: Bar_T -> String
ly_bar b =
case b of
NormalBarline -> "|"
DoubleBarline -> "||"
LeftRepeatBarline -> "|:"
RightRepeatBarline -> ":|"
FinalBarline -> "|."
ly_command :: Command_T -> String
ly_command c =
case c of
AutoBeamOff -> "\\autoBeamOff"
Bar x -> "\\bar " ++ ly_str (ly_bar x)
BarlineCheck -> "|\n"
BarNumberCheck x -> "\\barNumberCheck #" ++ show x
Break -> "\\break"
Change x -> "\\change Staff = " ++ ly_str x
DynamicDown -> "\\dynamicDown"
DynamicNeutral -> "\\dynamicNeutral"
DynamicUp -> "\\dynamicUp"
NoBreak -> "\\noBreak"
NoPageBreak -> "\\noPageBreak"
Octavation x -> "\\ottava #" ++ show x
PageBreak -> "\\pageBreak"
Partial x -> "\\partial " ++ ly_duration x
StemDown -> "\\stemDown"
StemNeutral -> "\\stemNeutral"
StemUp -> "\\stemUp"
TupletDown -> "\\tupletDown"
TupletNeutral -> "\\tupletNeutral"
TupletUp -> "\\tupletUp"
User x -> x
VoiceOne -> "\\voiceOne"
VoiceTwo -> "\\voiceTwo"
VoiceThree -> "\\voiceThree"
VoiceFour -> "\\voiceFour"
ly_key_mode :: Mode_T -> String
ly_key_mode md =
case md of
Major_Mode -> "\\major"
Minor_Mode -> "\\minor"
ly_music_l :: [Music] -> [String]
ly_music_l = concatMap ly_music
ly_music :: Music -> [String]
ly_music m =
case m of
Note p d aa -> [ly_pitch aa p, maybe "" ly_duration d] ++
map ly_annotation aa
Chord xs d aa -> with_brackets ("<",">") (ly_music_l xs) ++
[ly_duration d] ++
map ly_annotation aa
Tremolo (x0,x1) n -> ["\\repeat", "\"tremolo\"", show n] ++
with_braces (ly_music x0 ++ ly_music x1)
Rest d aa -> ["r", ly_duration d] ++ map ly_annotation aa
MMRest i (j,k) aa -> let d = printf "R %d*%d " k (i*j)
in d : map ly_annotation aa
Skip d -> ["\\skip", ly_duration d]
Repeat n x -> ["\\repeat", "volta", show n] ++ with_braces (ly_music x)
Tuplet o n x ->
let (o',n') =
case o of
Normal_Tuplet -> ("\\times", ly_fraction n)
Scale_Durations -> ("\\scaleDurations", ly_duple n)
in [o', n'] ++ with_braces (ly_music x)
Grace x -> "\\grace" : with_braces (ly_music x)
AfterGrace x0 x1 -> "\\afterGrace" : concatMap ly_music [x0, x1]
Clef c o -> ["\\clef", ly_clef c o]
Time n -> ["\\time", ly_fraction n]
Key n a md -> ["\\key"
,ly_note n ++ ly_alteration' a
,ly_key_mode md]
Tempo d r -> ["\\tempo", ly_duration d, "=", show r]
Command x -> [ly_command x]
Join xs -> concatMap ly_music xs
Polyphony x1 x2 -> ["\\simultaneous", "{"] ++
with_braces (ly_music x1) ++
["\\\\"] ++
with_braces (ly_music x2) ++
["}"]
Empty -> []
ly_staff_name :: String -> Staff_Name -> [String]
ly_staff_name p (n1,n2) =
["\\set", p++".instrumentName", "=", ly_str (n1++" ")
,"\\set", p++".shortInstrumentName", "=", ly_str (n2++" ")]
ly_staff_t :: Staff_T -> String
ly_staff_t ty =
case ty of
Normal_Staff -> "Staff"
Rhythmic_Staff -> "RhythmicStaff"
ly_part :: [String] -> String -> Part -> [String]
ly_part nm i p =
let brk = with_brackets ("<<",">>")
mk_v xs = ["\\new"
,"Voice"
,"="
,ly_str i] ++ with_braces (ly_music (Join xs))
mk_txt txt = ["\\new"
,"Lyrics"
,"\\lyricsto"
,ly_str i] ++ with_braces [" " ++ txt ++ " "]
in case p of
(Part Nothing xs) -> with_braces (nm ++ ly_music (Join xs))
(Part (Just txt) xs) -> brk (nm ++ mk_v xs ++ mk_txt txt)
(MultipleParts xs) -> brk (concatMap mk_v xs)
ly_staff_set_t :: Staff_Set_T -> String
ly_staff_set_t x =
case x of
ChoirStaff -> "ChoirStaff"
GrandStaff -> "GrandStaff"
PianoStaff -> "PianoStaff"
StaffGroup -> "StaffGroup"
StaffGroup_SquareBracket -> "StaffGroup"
ly_staff :: Staff -> [String]
ly_staff s =
case s of
Staff (Staff_Settings ty i sc) nm pt ->
let i' = if null i then "no_id" else i
nm' = ly_staff_name "Staff" nm
sc' = if sc == 0
then ""
else printf " \\with { fontSize = #%d \\override StaffSymbol #'staff-space = #(magstep %d) } " sc sc
in ["\\new"
,ly_staff_t ty
,"="
,ly_str i'] ++ [sc'] ++ ly_part nm' i' pt
Staff_Set ty nm xs ->
let ty' = ly_staff_set_t ty
dlm = if ty == StaffGroup_SquareBracket
then "\\set StaffGroup.systemStartDelimiter = #'SystemStartSquare"
else ""
in (["\\new"
,ty'
,"\\simultaneous"
] ++
with_braces ([dlm] ++
ly_staff_name ty' nm ++
concatMap ly_staff xs))
ly_independent_time_signatures :: [String]
ly_independent_time_signatures =
["\\context { \\Score"
," \\remove \"Timing_translator\""
," \\remove \"Default_bar_line_engraver\""
," }"
," \\context {"
," \\Staff"
," \\consists \"Timing_translator\""
," \\consists \"Default_bar_line_engraver\""
," }"]
ly_layout :: Score_Settings -> [String]
ly_layout x =
let mk_i nm = printf "\\context { \\%s \\consists \"Instrument_name_engraver\"}" nm
is = unlines (map mk_i ["StaffGroup","ChoirStaff","GrandStaff"])
in ["\\layout", "{"
,if independent_time_signatures x
then unlines ly_independent_time_signatures
else ""
,is
,"}"]
ly_score :: Score -> [String]
ly_score (Score pr xs) =
let xs' = with_braces (concatMap ly_staff xs)
xs'' = with_braces ("\\simultaneous" : xs' ++ ly_layout pr)
in "\\score" : xs''
ly_work :: Work -> String
ly_work (Work v p hdr sc) =
let xs = ly_version v ++
ly_paper p ++
ly_header hdr ++
ly_score sc
in concat (intersperse " " xs)
ly_music_elem :: Music -> String
ly_music_elem = concat . intersperse " " . ly_music