module Music.Theory.Time_Signature where
import Data.Function
import Data.Ratio
import Music.Theory.Duration
import Music.Theory.Duration.Name
import Music.Theory.Duration.RQ
import Music.Theory.Math
type Time_Signature = (Integer,Integer)
ts_whole_note :: Time_Signature -> [Duration]
ts_whole_note t =
case t of
(1,8) -> [eighth_note]
(2,16) -> [eighth_note]
(3,16) -> [dotted_eighth_note]
(1,4) -> [quarter_note]
(2,8) -> [quarter_note]
(4,16) -> [quarter_note]
(5,16) -> [quarter_note,sixteenth_note]
(3,8) -> [dotted_quarter_note]
(6,16) -> [dotted_quarter_note]
(7,16) -> [quarter_note,dotted_eighth_note]
(1,2) -> [half_note]
(2,4) -> [half_note]
(4,8) -> [half_note]
(5,8) -> [half_note,eighth_note]
(3,4) -> [dotted_half_note]
(6,8) -> [dotted_half_note]
(1,1) -> [whole_note]
(2,2) -> [whole_note]
(4,4) -> [whole_note]
(8,8) -> [whole_note]
(5,4) -> [whole_note,quarter_note]
(3,2) -> [dotted_whole_note]
(6,4) -> [dotted_whole_note]
(7,4) -> [whole_note,dotted_half_note]
(2,1) -> [breve]
(4,2) -> [breve]
(3,1) -> [dotted_breve]
(6,2) -> [dotted_breve]
_ -> error ("ts_whole_note: " ++ show t)
ts_whole_note_rq :: Time_Signature -> RQ
ts_whole_note_rq = sum . map duration_to_rq . ts_whole_note
ts_rq :: Time_Signature -> RQ
ts_rq (n,d) = (4 * n) % d
ts_compare :: Time_Signature -> Time_Signature -> Ordering
ts_compare = compare `on` ts_rq
rq_to_ts :: RQ -> Time_Signature
rq_to_ts rq =
let n = numerator rq
d = denominator rq * 4
in (n,d)
ts_divisions :: Time_Signature -> [RQ]
ts_divisions (i,j) =
let k = fromIntegral i
in replicate k (recip (j % 4))
ts_duration_pulses :: Time_Signature -> Duration -> Rational
ts_duration_pulses (_, b) (Duration dv dt ml) =
let n = b % dv
in rq_apply_dots n dt * ml
ts_rewrite :: Integer -> Time_Signature -> Time_Signature
ts_rewrite d' =
let dv i j = let (x,y) = i `divMod` j
in if y == 0 then x else error "ts_rewrite"
go (n,d) = case compare d d' of
EQ -> (n,d)
GT -> go (n `dv` 2, d `dv` 2)
LT -> go (n * 2, d * 2)
in go
ts_sum :: [Time_Signature] -> Time_Signature
ts_sum t =
let i = maximum (map snd t)
t' = map (ts_rewrite i) t
j = sum (map fst t')
in (j,i)
type Composite_Time_Signature = [Time_Signature]
cts_rq :: Composite_Time_Signature -> RQ
cts_rq = sum . map ts_rq
cts_divisions :: Composite_Time_Signature -> [RQ]
cts_divisions = concatMap ts_divisions
cts_pulse_to_rq :: Composite_Time_Signature -> Int -> RQ
cts_pulse_to_rq cts p =
let dv = cts_divisions cts
in sum (take (p 1) dv)
cts_pulse_to_rqw :: Composite_Time_Signature -> Int -> (RQ,RQ)
cts_pulse_to_rqw cts p = (cts_pulse_to_rq cts p,cts_divisions cts !! (p 1))
type Rational_Time_Signature = [(Rational,Rational)]
rts_rq :: Rational_Time_Signature -> RQ
rts_rq =
let f (n,d) = (4 * n) / d
in sum . map f
rts_divisions :: Rational_Time_Signature -> [[RQ]]
rts_divisions =
let f (n,d) = let (ni,nf) = integral_and_fractional_parts n
rq = recip (d / 4)
ip = replicate ni rq
in if nf == 0 then ip else ip ++ [nf * rq]
in map f
rts_derive :: [RQ] -> Rational_Time_Signature
rts_derive = let f rq = (rq,4) in map f
rts_pulse_to_rq :: Rational_Time_Signature -> Int -> RQ
rts_pulse_to_rq rts p =
let dv = concat (rts_divisions rts)
in sum (take (p 1) dv)
rts_pulse_to_rqw :: Rational_Time_Signature -> Int -> (RQ,RQ)
rts_pulse_to_rqw ts p = (rts_pulse_to_rq ts p,concat (rts_divisions ts) !! (p 1))