module Music.LilyPond.Light.Notation where
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Ratio
import Text.Printf
import Music.Theory.Duration
import Music.Theory.Duration.Annotation as T
import Music.Theory.Duration.RQ
import Music.Theory.Duration.Sequence.Notate as T
import Music.Theory.Key
import Music.Theory.Pitch
import Music.Theory.Pitch.Spelling
import Music.Theory.Time_Signature
import Music.LilyPond.Light.Constant
import Music.LilyPond.Light.Measure
import Music.LilyPond.Light.Model
import Music.LilyPond.Light.Output.LilyPond
import Music.LilyPond.Light.Paper
is_music_c :: Music_C -> Music -> Bool
is_music_c c = (==) c . music_c
is_note :: Music -> Bool
is_note = is_music_c Note_C
is_chord :: Music -> Bool
is_chord = is_music_c Chord_C
is_rest :: Music -> Bool
is_rest = is_music_c Rest_C
is_skip :: Music -> Bool
is_skip = is_music_c Skip_C
is_mm_rest :: Music -> Bool
is_mm_rest = is_music_c MMRest_C
is_grace :: Music -> Bool
is_grace = is_music_c Grace_C
is_after_grace :: Music -> Bool
is_after_grace = is_music_c AfterGrace_C
is_grace_skip :: Music -> Bool
is_grace_skip m =
case m of
Grace (Skip _ _) -> True
_ -> False
is_clef :: Music -> Bool
is_clef = is_music_c Clef_C
is_time :: Music -> Bool
is_time = is_music_c Time_C
is_tempo :: Music -> Bool
is_tempo = is_music_c Tempo_C
is_command :: Music -> Bool
is_command = is_music_c Command_C
is_barlinecheck :: Music -> Bool
is_barlinecheck m =
case m of
Command BarlineCheck _ -> True
_ -> False
is_tied :: Music -> Bool
is_tied m =
case m of
Note _ _ xs -> Begin_Tie `elem` xs
Chord _ _ xs -> Begin_Tie `elem` xs
_ -> False
is_tuplet :: Music -> Bool
is_tuplet = is_music_c Tuplet_C
clr_acc :: Music -> Music
clr_acc m =
let rl = [rAcc,cAcc]
in case m of
Note x d a -> Note x d (a \\ rl)
Chord xs d a -> Chord (map clr_acc xs) d a
_ -> error ("clr_acc at non-note/chord: " ++ ly_music_elem m)
octpc_to_note :: (Octave, PitchClass) -> Music
octpc_to_note x = Note (octpc_to_pitch pc_spell_ks x) Nothing []
rest :: Duration -> Music
rest x = Rest Normal_Rest x []
spacer_rest :: Duration -> Music
spacer_rest x = Rest Spacer_Rest x []
mm_rest :: Time_Signature -> Music
mm_rest x = MMRest 1 x []
skip :: Duration -> Music
skip x = Skip x []
empty_measure :: Integer -> Integer -> Music
empty_measure n d = mconcat [MMRest 1 (n,d) [], bar_line_check]
null_measure :: Integer -> Integer -> Music
null_measure n d =
let x = Duration d 0 1
l = [bar_line_check]
in mconcat (map (\i -> Skip i []) (genericReplicate n x) ++ l)
measure_rest :: Integer -> Integer -> Music
measure_rest n d = mconcat [time_signature (n,d), empty_measure n d]
measure_null :: Integer -> Integer -> Music
measure_null n d = mconcat [time_signature (n,d), null_measure n d]
edit_dur :: (Duration -> Duration) -> Music -> Music
edit_dur fn x =
case x of
Note _ Nothing _ -> x
Note n (Just d) a -> Note n (Just (fn d)) a
Chord n d a -> Chord n (fn d) a
Rest ty d a -> Rest ty (fn d) a
Skip d a -> Skip (fn d) a
_ -> x
tuplet :: Tuplet_T -> [Music] -> Music
tuplet (d,n) =
let fn x = x { multiplier = n%d }
in Tuplet Normal_Tuplet (n,d) . mconcat . map (edit_dur fn)
tuplet_above,tuplet_below :: Tuplet_T -> [Music] -> Music
tuplet_above n xs = mconcat [tuplet_up, tuplet n xs, tuplet_neutral]
tuplet_below n xs = mconcat [tuplet_down, tuplet n xs, tuplet_neutral]
scale_durations :: Tuplet_T -> [Music] -> Music
scale_durations (n,d) =
let fn x = x { multiplier = d%n }
in Tuplet Scale_Durations (n,d) . mconcat . map (edit_dur fn)
time_signature :: Time_Signature -> Music
time_signature = Time
with_time_signature :: Time_Signature -> [Music] -> Music
with_time_signature ts xs = mconcat (time_signature ts : xs)
ts_use_fractions :: Music
ts_use_fractions =
let x = "\\override Staff.TimeSignature #'style = #'()"
in Command (User x) []
ts_set_fraction :: Integer -> Integer -> Music
ts_set_fraction n d =
let x = "#'(" ++ show n ++ " . " ++ show d ++ ")"
y = "\\set Staff.timeSignatureFraction = " ++ x
in Command (User y) []
numeric_time_signature :: Music
numeric_time_signature = Command (User "\\numericTimeSignature") []
ts_parentheses :: Music
ts_parentheses =
let x = "\\override Staff.TimeSignature #'stencil = #(lambda (grob) (bracketify-stencil (ly:time-signature::print grob) Y 0.1 0.2 0.1))"
in Command (User x) []
ts_stencil :: Bool -> Music
ts_stencil x =
let c = "\\override Staff.TimeSignature #'stencil = " ++ ly_bool x
in Command (User c) []
ts_transparent :: Bool -> Music
ts_transparent x =
let c = "\\override Staff.TimeSignature #'transparent = " ++ ly_bool x
in Command (User c) []
ts_all_invisible :: Music
ts_all_invisible =
let c = "\\override Staff.TimeSignature #'break-visibility = #all-invisible"
in Command (User c) []
key :: Music -> Mode_T -> Music
key m md =
case m of
(Note (Pitch n a _) _ _) -> Key n (Just a) md
_ -> error "key"
std_repeat :: Integer -> [Music] -> Music
std_repeat n = Repeat n . mconcat
note_edit_octave :: (Octave -> Octave) -> Music -> Music
note_edit_octave fn m =
case m of
Note (Pitch n a o) d xs -> Note (Pitch n a (fn o)) d xs
_ -> m
note_shift_octave :: Octave -> Music -> Music
note_shift_octave i = note_edit_octave (+ i)
tie_r_ann :: [D_Annotation] -> [Annotation]
tie_r_ann a = if any (== Tie_Right) a then [Begin_Tie] else []
da_rest :: Duration_A -> Music
da_rest (d,_) = Rest Normal_Rest d []
(##@) :: Pitch -> Duration_A -> Music
x ##@ (d,a) = Note x (Just d) (tie_r_ann a)
(##) :: Pitch -> Duration -> Music
x ## d = x ##@ (d,[])
(#@) :: Music -> Duration_A -> Music
x #@ (d,a) =
case x of
Note n _ a' -> Note n (Just d) (tie_r_ann a ++ a')
Chord n _ a' -> Chord n d (tie_r_ann a ++ a')
_ -> error ("###: " ++ show x)
(#) :: Music -> Duration -> Music
x # d = x #@ (d,[])
chd_p_ann :: [Pitch] -> [[Annotation]] -> Duration -> Music
chd_p_ann xs an d =
let f x a = Note x Nothing a
in case xs of
[] -> error "chd_p_ann: null elements"
_ -> Chord (zipWith f xs an) d []
chd_p :: [Pitch] -> Duration -> Music
chd_p xs = chd_p_ann xs (repeat [])
chd :: [Music] -> Duration -> Music
chd xs d =
case xs of
[] -> error "chd: null elements"
_ -> let fn x = let err msg = error (msg ++ ": " ++ show x)
in case x of
Note _ (Just _) _ -> err "chd: note has duration"
Note _ Nothing _ -> x
_ -> err "chd: non note element"
in Chord (map fn xs) d []
bar_number_check :: Integer -> Music
bar_number_check n = Command (BarNumberCheck n) []
bar_numbering :: Bool -> Music
bar_numbering x =
let r = if x then "#(#t #t #t)" else "#(#f #f #f)"
s = "\\override Score.BarNumber #'break-visibility = #'" ++ r
in Command (User s) []
change :: String -> Music
change x = Command (Change x) []
partial :: Duration -> Music
partial d = Command (Partial d) []
hairpin_circled_tip :: Bool -> Music
hairpin_circled_tip x =
let c = if x
then "\\override Hairpin #'circled-tip = ##t"
else "\\revert Hairpin #'circled-tip"
in Command (User c) []
hairpin_to_barline :: Bool -> Music
hairpin_to_barline x =
let c = if x
then "\\revert Hairpin #'to-barline"
else "\\override Hairpin #'to-barline = ##f"
in Command (User c) []
hairpin_minimum_length :: Maybe Int -> Music
hairpin_minimum_length x =
let c = case x of
Nothing -> "\\revert Hairpin #'minimum-length"
Just n -> "\\override Hairpin #'minimum-length = #" ++ show n
in Command (User c) []
set_8va_notation :: Music
set_8va_notation = Command (User "\\set Staff.ottavation = #\"8\"") []
name_to_id :: Staff_Name -> Staff_ID
name_to_id (x,_) =
case x of
"" -> "no_id"
_ -> "id_" ++ x
staff :: Staff_Name -> [Music] -> Staff
staff nm =
let st = Staff_Settings Normal_Staff (name_to_id nm) 0
in Staff st nm . Part Nothing
rhythmic_staff :: Staff_Name -> [Music] -> Staff
rhythmic_staff nm =
let st = Staff_Settings Rhythmic_Staff (name_to_id nm) 0
in Staff st nm . Part Nothing
text_staff :: Staff_Name -> String -> [Music] -> Staff
text_staff nm txt =
let st = Staff_Settings Normal_Staff (name_to_id nm) 0
in Staff st nm . Part (Just txt)
piano_staff :: Staff_Name -> [[Music]] -> Staff
piano_staff nm xs =
case xs of
[rh,lh] ->
let st x = Staff_Settings Normal_Staff x 0
in Staff_Set
PianoStaff
nm
[Staff (st "rh") ("","") (Part Nothing rh)
,Staff (st "lh") ("","") (Part Nothing lh)]
_ -> Staff_Set PianoStaff nm (map (staff ("","")) xs)
grand_staff :: Staff_Name -> [[Music]] -> Staff
grand_staff nm = Staff_Set GrandStaff nm . map (staff ("",""))
staff_group :: Staff_Name -> [[Music]] -> Staff
staff_group nm = Staff_Set StaffGroup nm . map (staff ("",""))
rhythmic_grand_staff :: Staff_Name -> [[Music]] -> Staff
rhythmic_grand_staff nm = Staff_Set GrandStaff nm . map (rhythmic_staff ("",""))
grand_staff' :: Staff_Name -> [Staff_Name] -> [[Music]] -> Staff
grand_staff' nm xs ys = Staff_Set GrandStaff nm (zipWith staff xs ys)
staff_group' :: Staff_Name -> [Staff_Name] -> [[Music]] -> Staff
staff_group' nm xs ys = Staff_Set StaffGroup nm (zipWith staff xs ys)
two_part_staff :: Staff_Name -> ([Music], [Music]) -> Staff
two_part_staff nm (p0, p1) =
let st = Staff_Settings Normal_Staff (name_to_id nm) 0
in Staff st nm (MultipleParts [voice_one:p0
,voice_two:p1])
instr_name :: Staff_Name -> Staff -> Staff
instr_name nm pt =
case pt of
Staff st _ x -> Staff st nm x
Staff_Set ty _ xs -> Staff_Set ty nm xs
resize_staff :: Int -> Staff -> Staff
resize_staff n st =
case st of
Staff (Staff_Settings ty i sc) nm pt ->
Staff (Staff_Settings ty i (sc + n)) nm pt
Staff_Set ty nm xs ->
Staff_Set ty nm (map (resize_staff n) xs)
score :: [Staff] -> Score
score = Score default_score_settings
polyphony :: Music -> Music -> Music
polyphony = Polyphony
polyphony' :: [Music] -> [Music] -> Music
polyphony' x y = polyphony (mconcat x) (mconcat y)
join_rests :: [Music] -> [Music]
join_rests =
let fn recur xs =
case xs of
[] -> []
Rest ty d a : Rest ty' d' a' : ys ->
case sum_dur d d' of
Nothing -> let zs = Rest ty d a : join_rests (Rest ty' d' a' : ys)
in if recur then fn False zs else zs
Just d'' -> join_rests (Rest ty' d'' (a ++ a') : ys)
y:ys -> y : join_rests ys
in fn True
type DA_F x = (Duration_A,x) -> Music
da_to_music :: DA_F t -> [(Duration_A,t)] -> [Music]
da_to_music fn x =
let g = T.da_group_tuplets_nn (map fst x)
g' = T.nn_reshape (,) g (map snd x)
tr el = case el of
Left i -> fn i
Right y -> let (y0,_):_ = y
(n,d,_) = fromJust (T.da_begin_tuplet y0)
in Tuplet Normal_Tuplet (d,n) (Join (map fn y))
in map tr g'
da_to_measures :: DA_F x -> Maybe [Time_Signature] -> [[(Duration_A,x)]] -> [Measure]
da_to_measures fn m_t x =
let m = map (da_to_music fn) x
jn i = Measure [i]
in case m_t of
Just t -> zipWith jn (map Time t) m
Nothing -> map (Measure []) m
rq_to_measures :: (Show x) => DA_F x -> [Simplify_T] -> [Time_Signature] -> Maybe [[RQ]] -> [RQ] -> [x] -> [Measure]
rq_to_measures fn r ts rqp rq x =
let da = T.notate_mm_ascribe_err r ts rqp rq x
in da_to_measures fn (Just ts) da
mk_fragment :: (Double, Double) -> [[Music]] -> Fragment
mk_fragment (w,h) m =
let pr = mk_fragment_paper w h
in Fragment default_version pr (grand_staff ("","") m)
mk_fragment_mm :: (Double, Double) -> [[Measure]] -> Fragment
mk_fragment_mm d = mk_fragment d . map mm_elements
stem_transparent :: Bool -> Music
stem_transparent x =
let c = "\\override Stem #'transparent = " ++ ly_bool x
in Command (User c) []
text_length_on :: Music
text_length_on = Command (User "\\textLengthOn") []
text_outside_staff_priority :: Maybe Double -> Music
text_outside_staff_priority x =
let pr = case x of
Nothing -> ly_bool False
Just n -> '#' : show n
s = "\\override TextScript #'outside-staff-priority = " ++ pr
in Command (User s) []
text_extra_spacing_width :: (Double,Double) -> Music
text_extra_spacing_width (i,j) =
let t = "\\override TextScript #'extra-spacing-width = #'(%f . %f)"
s = printf t i j
in Command (User s) []
mm_delete_redundant_ts :: [Measure] -> [Measure]
mm_delete_redundant_ts =
let f st m = let Measure a n = m
ts = find is_time a
in case (st,ts) of
(Just p,Just q) -> if p == q
then (st,Measure (delete q a) n)
else (ts,m)
(_,Just _) -> (ts,m)
_ -> (st,m)
in snd . mapAccumL f Nothing
default_rehearsal_mark :: Music
default_rehearsal_mark = Command (User "\\mark \\default") []