module Music.Typesetting.Literal where
import Data.List
import Data.Maybe
import Data.Ratio
import Music.Theory.Clef
import Music.Theory.Duration
import Music.Theory.Duration.Annotation
import Music.Theory.Duration.RQ
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
n_annotate_l :: [N_Annotation] -> Note -> Note
n_annotate_l a' (Note d a) = Note d (a ++ a')
annotate_first :: (a -> x -> x) -> a -> [x] -> [x]
annotate_first fn a ns =
case ns of
[] -> []
(n:ns') -> fn a n : ns'
annotate_except_last :: (a -> x -> x) -> a -> [x] -> [x]
annotate_except_last fn a ns =
case ns of
[] -> []
[n] -> [n]
n:ns' -> fn a n : annotate_except_last fn a ns'
annotate_middle :: (a -> x -> x) -> a -> [x] -> [x]
annotate_middle fn a ns =
case ns of
[] -> []
n:ns' -> n : annotate_except_last fn a 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_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_annotate_l a0 n
| n_is_final_tie n = n_annotate_l an n
| 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)
bass_clef,tenor_clef,alto_clef,treble_clef,percussion_clef :: M_Annotation
bass_clef = M_Clef (Clef Bass 0) 1
tenor_clef = M_Clef (Clef Tenor 0) 1
alto_clef = M_Clef (Clef Alto 0) 1
treble_clef = M_Clef (Clef Treble 0) 1
percussion_clef = M_Clef (Clef Percussion 0) 1
bass_8vb_clef,treble_8va_clef,treble_8vb_clef,treble_15ma_clef :: M_Annotation
bass_8vb_clef = M_Clef (Clef Bass (1)) 1
treble_8va_clef = M_Clef (Clef Treble 1) 1
treble_8vb_clef = M_Clef (Clef Treble (1)) 1
treble_15ma_clef = M_Clef (Clef Treble 2) 1
accent :: N_Annotation
accent = N_Articulation Accent
trill_mark :: N_Annotation
trill_mark = N_Ornament Trill_Mark
begin_slur :: N_Annotation
begin_slur = N_Begin_Slur
end_slur :: N_Annotation
end_slur = N_End_Slur
begin_slide :: N_Annotation
begin_slide = N_Begin_Slide
end_slide :: N_Annotation
end_slide = N_End_Slide
laissez_vibrer :: N_Annotation
laissez_vibrer = N_Direction D_Laissez_Vibrer
fermata :: N_Annotation
fermata = N_Fermata
arpeggiate :: N_Annotation
arpeggiate = N_Arpeggiate
pedal_down_mark,pedal_up_mark :: N_Annotation
pedal_down_mark = N_Direction (D_Pedal Pedal_Start False True)
pedal_up_mark = N_Direction (D_Pedal Pedal_Stop False True)
pedal_down,pedal_up,pedal_change,pedal_continue :: N_Annotation
pedal_down = N_Direction (D_Pedal Pedal_Start True False)
pedal_up = N_Direction (D_Pedal Pedal_Stop True False)
pedal_change = N_Direction (D_Pedal Pedal_Change True False)
pedal_continue = N_Direction (D_Pedal Pedal_Continue True False)
part :: Name -> [Measure] -> Part
part nm = Part Nothing [P_Name nm]
group :: Name -> [Part] -> Part
group nm = Group Nothing [G_Name nm]
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