module Music.Typesetting.Literal where
import Data.List
import Data.Maybe
import Data.Ratio
import Music.Theory.Duration
import Music.Typesetting.Model
import Music.Typesetting.Query
n_annotate :: N_Annotation -> Note -> Note
n_annotate a (Note d as) = Note d (a : as)
(&) :: Note -> N_Annotation -> Note
(&) = flip n_annotate
annotate_first :: (a -> x -> x) -> a -> [x] -> [x]
annotate_first fn a ns =
case ns of
[] -> []
(n:ns') -> fn a n : ns'
annotate_last :: (a -> x -> x) -> a -> [x] -> [x]
annotate_last fn a ns =
case ns of
[] -> []
[n] -> [fn a n]
(n:ns') -> n : annotate_last fn a ns'
annotate_bracket :: (a -> x -> x) -> (a,a) -> [x] -> [x]
annotate_bracket fn (a0,an) = annotate_last fn an . annotate_first fn a0
n_annotate_l :: [N_Annotation] -> Note -> Note
n_annotate_l as' (Note d as) = Note d (as ++ as')
n_annotate_first :: [N_Annotation] -> [Note] -> [Note]
n_annotate_first = annotate_first n_annotate_l
n_annotate_last :: [N_Annotation] -> [Note] -> [Note]
n_annotate_last = annotate_last n_annotate_l
n_annotate_bracket :: (N_Annotation,N_Annotation) -> [Note] -> [Note]
n_annotate_bracket = annotate_bracket n_annotate
n_annotate_tie_endpoints :: (N_Annotation,N_Annotation) -> Note -> Note
n_annotate_tie_endpoints (a0,an) n
| n_is_initial_tie n = n & a0
| n_is_final_tie n = n &an
| otherwise = n
n_edit_duration :: (Duration -> Duration) -> Note -> Note
n_edit_duration fn (Note d xs) = Note (fn d) xs
tuplet :: (Integer,Integer) -> [Note] -> [Note]
tuplet (d,n) =
let fn x = x { multiplier = n%d }
ann = n_annotate_bracket (N_Begin_Tuplet Nothing,N_End_Tuplet)
in map (n_edit_duration fn) . ann
m_annotate :: M_Annotation -> Measure -> Measure
m_annotate a (Measure as ns) = Measure (a : as) ns
(&.) :: Measure -> M_Annotation -> Measure
(&.) = flip m_annotate
m_annotate_l :: [M_Annotation] -> Measure -> Measure
m_annotate_l as' (Measure as ns) = Measure (as ++ as') ns
m_annotate_first :: [M_Annotation] -> [Measure] -> [Measure]
m_annotate_first = annotate_first m_annotate_l
m_annotate_last :: [M_Annotation] -> [Measure] -> [Measure]
m_annotate_last = annotate_last m_annotate_l
m_annotate_bracket :: (M_Annotation,M_Annotation) -> [Measure] -> [Measure]
m_annotate_bracket = annotate_bracket m_annotate
m_duration :: Measure -> [Duration]
m_duration (Measure _ ns) = mapMaybe n_duration_forward ns
m_duration_rq :: Measure -> Rational
m_duration_rq = sum . map duration_to_rq . m_duration
empty_measure :: (Integer,Integer) -> Measure
empty_measure n = Measure [M_Time_Signature n] []
stem_tremolo :: Integer -> Note -> Note
stem_tremolo n (Note d a) =
let x = duration_beam_count d
x' = max 0 (n x)
in Note d (N_Stem_Tremolo x' : a)
pppp,ppp,pp,p,mp,mf,f,ff,fff,ffff,fp,sfz :: N_Annotation
pppp = N_Dynamic_Mark PPPP
ppp = N_Dynamic_Mark PPP
pp = N_Dynamic_Mark PP
p = N_Dynamic_Mark P
mp = N_Dynamic_Mark MP
mf = N_Dynamic_Mark MF
f = N_Dynamic_Mark F
ff = N_Dynamic_Mark FF
fff = N_Dynamic_Mark FFF
ffff = N_Dynamic_Mark FFFF
fp = N_Dynamic_Mark FP
sfz = N_Dynamic_Mark SFZ
cresc,dim :: N_Annotation
cresc = N_Crescendo
dim = N_Diminuendo
bass_clef,tenor_clef,alto_clef,treble_clef,percussion_clef :: M_Annotation
bass_clef = M_Clef Bass 0
tenor_clef = M_Clef Tenor 0
alto_clef = M_Clef Alto 0
treble_clef = M_Clef Treble 0
percussion_clef = M_Clef Percussion 0
bass_8vb_clef,treble_8va_clef,treble_8vb_clef,treble_15ma_clef :: M_Annotation
bass_8vb_clef = M_Clef Bass (1)
treble_8va_clef = M_Clef Treble 1
treble_8vb_clef = M_Clef Treble (1)
treble_15ma_clef = M_Clef Treble 2
accent :: N_Annotation
accent = N_Articulation Accent
part :: Name -> [Measure] -> Part
part nm ms = Part Nothing [P_Name nm] ms
group :: Name -> [Part] -> Part
group nm ps = Group Nothing [G_Name nm] ps
voices :: [[Measure]] -> [Measure]
voices vs =
let vs' = transpose vs
vc_ann :: Integer -> Measure -> Measure
vc_ann i (Measure as ns) = Measure as (map (& (N_Voice i)) ns)
merge_m_ann :: [Measure] -> [M_Annotation]
merge_m_ann = foldl1 union . map m_annotations
fn ms = let (d:_) = map m_duration ms
bu = N_Backup d
ms' = zipWith vc_ann [1..] ms
ns = concatMap (n_annotate_last [bu] . m_notes) ms'
as = merge_m_ann ms
in Measure as ns
in map fn vs'
from_d_annotation :: D_Annotation -> N_Annotation
from_d_annotation x =
case x of
Tie_Right -> N_Begin_Tied
Tie_Left -> N_End_Tied
Begin_Tuplet (n,d,i) -> N_Begin_Tuplet (Just (n,i,d,i))
End_Tuplet -> N_End_Tuplet