-- | Time Signatures.
module Music.Theory.Time_Signature where

import Data.Function {- base -}
import Data.Ratio {- base -}

import Music.Theory.Duration
import Music.Theory.Duration.Name
import Music.Theory.Duration.Rq
import Music.Theory.Math

-- | A Time Signature is a /(numerator,denominator)/ pair.
type Time_Signature = (Integer,Integer)

-- | Tied, non-multiplied durations to fill a whole measure.
--
-- > ts_whole_note (3,8) == [dotted_quarter_note]
-- > ts_whole_note (2,2) == [whole_note]
ts_whole_note :: Time_Signature -> [Duration]
ts_whole_note :: Time_Signature -> [Duration]
ts_whole_note Time_Signature
t =
    case Time_Signature
t of
      (Integer
1,Integer
8) -> [Duration
eighth_note]
      (Integer
2,Integer
16) -> [Duration
eighth_note]
      (Integer
3,Integer
16) -> [Duration
dotted_eighth_note]
      (Integer
1,Integer
4) -> [Duration
quarter_note]
      (Integer
2,Integer
8) -> [Duration
quarter_note]
      (Integer
4,Integer
16) -> [Duration
quarter_note]
      (Integer
5,Integer
16) -> [Duration
quarter_note,Duration
sixteenth_note]
      (Integer
3,Integer
8) -> [Duration
dotted_quarter_note]
      (Integer
6,Integer
16) -> [Duration
dotted_quarter_note]
      (Integer
7,Integer
16) -> [Duration
quarter_note,Duration
dotted_eighth_note]
      (Integer
1,Integer
2) -> [Duration
half_note]
      (Integer
2,Integer
4) -> [Duration
half_note]
      (Integer
4,Integer
8) -> [Duration
half_note]
      (Integer
5,Integer
8) -> [Duration
half_note,Duration
eighth_note]
      (Integer
3,Integer
4) -> [Duration
dotted_half_note]
      (Integer
6,Integer
8) -> [Duration
dotted_half_note]
      (Integer
1,Integer
1) -> [Duration
whole_note]
      (Integer
2,Integer
2) -> [Duration
whole_note]
      (Integer
4,Integer
4) -> [Duration
whole_note]
      (Integer
8,Integer
8) -> [Duration
whole_note]
      (Integer
5,Integer
4) -> [Duration
whole_note,Duration
quarter_note]
      (Integer
3,Integer
2) -> [Duration
dotted_whole_note]
      (Integer
6,Integer
4) -> [Duration
dotted_whole_note]
      (Integer
7,Integer
4) -> [Duration
whole_note,Duration
dotted_half_note]
      (Integer
2,Integer
1) -> [Duration
breve]
      (Integer
4,Integer
2) -> [Duration
breve]
      (Integer
3,Integer
1) -> [Duration
dotted_breve]
      (Integer
6,Integer
2) -> [Duration
dotted_breve]
      Time_Signature
_ -> forall a. HasCallStack => [Char] -> a
error ([Char]
"ts_whole_note: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Time_Signature
t)

-- | Duration of measure in 'Rq'.
--
-- > map ts_whole_note_rq [(3,8),(2,2)] == [3/2,4]
ts_whole_note_rq :: Time_Signature -> Rq
ts_whole_note_rq :: Time_Signature -> Rational
ts_whole_note_rq = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Duration -> Rational
duration_to_rq forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time_Signature -> [Duration]
ts_whole_note

-- | Duration, in 'Rq', of a measure of indicated 'Time_Signature'.
--
-- > map ts_rq [(3,4),(5,8)] == [3,5/2]
ts_rq :: Time_Signature -> Rq
ts_rq :: Time_Signature -> Rational
ts_rq (Integer
n,Integer
d) = (Integer
4 forall a. Num a => a -> a -> a
* Integer
n) forall a. Integral a => a -> a -> Ratio a
% Integer
d

-- | 'compare' 'on' 'ts_rq'.
ts_compare :: Time_Signature -> Time_Signature -> Ordering
ts_compare :: Time_Signature -> Time_Signature -> Ordering
ts_compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Time_Signature -> Rational
ts_rq

-- | 'Time_Signature' derived from whole note duration in 'Rq' form.
--
-- > map rq_to_ts [4,3/2,7/4,6] == [(4,4),(3,8),(7,16),(6,4)]
rq_to_ts :: Rq -> Time_Signature
rq_to_ts :: Rational -> Time_Signature
rq_to_ts Rational
rq =
    let n :: Integer
n = forall a. Ratio a -> a
numerator Rational
rq
        d :: Integer
d = forall a. Ratio a -> a
denominator Rational
rq forall a. Num a => a -> a -> a
* Integer
4
    in (Integer
n,Integer
d)

-- | Uniform division of time signature.
--
-- > ts_divisions (3,4) == [1,1,1]
-- > ts_divisions (3,8) == [1/2,1/2,1/2]
-- > ts_divisions (2,2) == [2,2]
-- > ts_divisions (1,1) == [4]
-- > ts_divisions (7,4) == [1,1,1,1,1,1,1]
ts_divisions :: Time_Signature -> [Rq]
ts_divisions :: Time_Signature -> [Rational]
ts_divisions (Integer
i,Integer
j) =
    let k :: Int
k = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i
    in forall a. Int -> a -> [a]
replicate Int
k (forall a. Fractional a => a -> a
recip (Integer
j forall a. Integral a => a -> a -> Ratio a
% Integer
4))

-- | Convert a duration to a pulse count in relation to the indicated
--   time signature.
--
-- > ts_duration_pulses (3,8) quarter_note == 2
ts_duration_pulses :: Time_Signature -> Duration -> Rational
ts_duration_pulses :: Time_Signature -> Duration -> Rational
ts_duration_pulses (Integer
_, Integer
b) (Duration Integer
dv Int
dt Rational
ml) =
    let n :: Rational
n = Integer
b forall a. Integral a => a -> a -> Ratio a
% Integer
dv
    in Rational -> Int -> Rational
rq_apply_dots Rational
n Int
dt forall a. Num a => a -> a -> a
* Rational
ml

-- | Rewrite time signature to indicated denominator.
--
-- > ts_rewrite 8 (3,4) == (6,8)
ts_rewrite :: Integer -> Time_Signature -> Time_Signature
ts_rewrite :: Integer -> Time_Signature -> Time_Signature
ts_rewrite Integer
d' =
    let dv :: a -> a -> a
dv a
i a
j = let (a
x,a
y) = a
i forall a. Integral a => a -> a -> (a, a)
`divMod` a
j
                 in if a
y forall a. Eq a => a -> a -> Bool
== a
0 then a
x else forall a. HasCallStack => [Char] -> a
error [Char]
"ts_rewrite"
        go :: (a, Integer) -> (a, Integer)
go (a
n,Integer
d) = case forall a. Ord a => a -> a -> Ordering
compare Integer
d Integer
d' of
                     Ordering
EQ -> (a
n,Integer
d)
                     Ordering
GT -> (a, Integer) -> (a, Integer)
go (a
n forall {a}. Integral a => a -> a -> a
`dv` a
2, Integer
d forall {a}. Integral a => a -> a -> a
`dv` Integer
2)
                     Ordering
LT -> (a, Integer) -> (a, Integer)
go (a
n forall a. Num a => a -> a -> a
* a
2, Integer
d forall a. Num a => a -> a -> a
* Integer
2)
    in forall {a}. Integral a => (a, Integer) -> (a, Integer)
go

-- | Sum time signatures.
--
-- > ts_sum [(3,16),(1,2)] == (11,16)
ts_sum :: [Time_Signature] -> Time_Signature
ts_sum :: [Time_Signature] -> Time_Signature
ts_sum [Time_Signature]
t =
    let i :: Integer
i = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [Time_Signature]
t)
        t' :: [Time_Signature]
t' = forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Time_Signature -> Time_Signature
ts_rewrite Integer
i) [Time_Signature]
t
        j :: Integer
j = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [Time_Signature]
t')
    in (Integer
j,Integer
i)

-- * Composite Time Signatures

-- | A composite time signature is a sequence of 'Time_Signature's.
type Composite_Time_Signature = [Time_Signature]

-- | The 'Rq' is the 'sum' of 'ts_rq' of the elements.
--
-- > cts_rq [(3,4),(1,8)] == 3 + 1/2
cts_rq :: Composite_Time_Signature -> Rq
cts_rq :: [Time_Signature] -> Rational
cts_rq = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Time_Signature -> Rational
ts_rq

-- | The divisions are the 'concat' of the 'ts_divisions' of the
-- elements.
--
-- > cts_divisions [(3,4),(1,8)] == [1,1,1,1/2]
cts_divisions :: Composite_Time_Signature -> [Rq]
cts_divisions :: [Time_Signature] -> [Rational]
cts_divisions = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Time_Signature -> [Rational]
ts_divisions

-- | Pulses are 1-indexed, Rq locations are 0-indexed.
--
-- > map (cts_pulse_to_rq [(2,4),(1,8),(1,4)]) [1 .. 4] == [0,1,2,2 + 1/2]
cts_pulse_to_rq :: Composite_Time_Signature -> Int -> Rq
cts_pulse_to_rq :: [Time_Signature] -> Int -> Rational
cts_pulse_to_rq [Time_Signature]
cts Int
p =
    let dv :: [Rational]
dv = [Time_Signature] -> [Rational]
cts_divisions [Time_Signature]
cts
    in forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a. Int -> [a] -> [a]
take (Int
p forall a. Num a => a -> a -> a
- Int
1) [Rational]
dv)

-- | Variant that gives the /window/ of the pulse (ie. the start
-- location and the duration).
--
-- > let r = [(0,1),(1,1),(2,1/2),(2 + 1/2,1)]
-- > in map (cts_pulse_to_rqw [(2,4),(1,8),(1,4)]) [1 .. 4] == r
cts_pulse_to_rqw :: Composite_Time_Signature -> Int -> (Rq,Rq)
cts_pulse_to_rqw :: [Time_Signature] -> Int -> (Rational, Rational)
cts_pulse_to_rqw [Time_Signature]
cts Int
p = ([Time_Signature] -> Int -> Rational
cts_pulse_to_rq [Time_Signature]
cts Int
p,[Time_Signature] -> [Rational]
cts_divisions [Time_Signature]
cts forall a. [a] -> Int -> a
!! (Int
p forall a. Num a => a -> a -> a
- Int
1))

-- * Rational Time Signatures

-- | A rational time signature is a 'Composite_Time_Signature' where
-- the parts are 'Rational'.
type Rational_Time_Signature = [(Rational,Rational)]

-- | The 'sum' of the Rq of the elements.
--
-- > rts_rq [(3,4),(1,8)] == 3 + 1/2
-- > rts_rq [(3/2,4),(1/2,8)] == 3/2 + 1/4
rts_rq :: Rational_Time_Signature -> Rq
rts_rq :: Rational_Time_Signature -> Rational
rts_rq =
    let f :: (a, a) -> a
f (a
n,a
d) = (a
4 forall a. Num a => a -> a -> a
* a
n) forall a. Fractional a => a -> a -> a
/ a
d
    in forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Fractional a => (a, a) -> a
f

-- | The /divisions/ of the elements.
--
-- > rts_divisions [(3,4),(1,8)] == [1,1,1,1/2]
-- > rts_divisions [(3/2,4),(1/2,8)] == [1,1/2,1/4]
rts_divisions :: Rational_Time_Signature -> [[Rq]]
rts_divisions :: Rational_Time_Signature -> [[Rational]]
rts_divisions =
    let f :: (b, b) -> [b]
f (b
n,b
d) = let (Int
ni,b
nf) = forall i t. (Integral i, RealFrac t) => t -> (i, t)
integral_and_fractional_parts b
n
                      rq :: b
rq = forall a. Fractional a => a -> a
recip (b
d forall a. Fractional a => a -> a -> a
/ b
4)
                      ip :: [b]
ip = forall a. Int -> a -> [a]
replicate Int
ni b
rq
                  in if b
nf forall a. Eq a => a -> a -> Bool
== b
0 then [b]
ip else [b]
ip forall a. [a] -> [a] -> [a]
++ [b
nf forall a. Num a => a -> a -> a
* b
rq]
    in forall a b. (a -> b) -> [a] -> [b]
map forall {b}. RealFrac b => (b, b) -> [b]
f

-- > rts_derive [1,1,1,1/2]
-- > rts_derive [1,1/2,1/4]
rts_derive :: [Rq] -> Rational_Time_Signature
rts_derive :: [Rational] -> Rational_Time_Signature
rts_derive = let f :: a -> (a, b)
f a
rq = (a
rq,b
4) in forall a b. (a -> b) -> [a] -> [b]
map forall {b} {a}. Num b => a -> (a, b)
f

-- | Pulses are 1-indexed, Rq locations are 0-indexed.
--
-- > map (rts_pulse_to_rq [(2,4),(1,8),(1,4)]) [1 .. 4] == [0,1,2,2 + 1/2]
-- > map (rts_pulse_to_rq [(3/2,4),(1/2,8),(1/4,4)]) [1 .. 4] == [0,1,3/2,7/4]
rts_pulse_to_rq :: Rational_Time_Signature -> Int -> Rq
rts_pulse_to_rq :: Rational_Time_Signature -> Int -> Rational
rts_pulse_to_rq Rational_Time_Signature
rts Int
p =
    let dv :: [Rational]
dv = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Rational_Time_Signature -> [[Rational]]
rts_divisions Rational_Time_Signature
rts)
    in forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a. Int -> [a] -> [a]
take (Int
p forall a. Num a => a -> a -> a
- Int
1) [Rational]
dv)

-- | Variant that gives the /window/ of the pulse (ie. the start
-- location and the duration).
--
-- > let r = [(0,1),(1,1),(2,1/2),(2 + 1/2,1)]
-- > in map (rts_pulse_to_rqw [(2,4),(1,8),(1,4)]) [1 .. 4] == r
rts_pulse_to_rqw :: Rational_Time_Signature -> Int -> (Rq,Rq)
rts_pulse_to_rqw :: Rational_Time_Signature -> Int -> (Rational, Rational)
rts_pulse_to_rqw Rational_Time_Signature
ts Int
p = (Rational_Time_Signature -> Int -> Rational
rts_pulse_to_rq Rational_Time_Signature
ts Int
p,forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Rational_Time_Signature -> [[Rational]]
rts_divisions Rational_Time_Signature
ts) forall a. [a] -> Int -> a
!! (Int
p forall a. Num a => a -> a -> a
- Int
1))