-- | Translations of some functions from <https://github.com/nosuchtim/keykit/blob/master/lib/basic1.k>
module Music.Theory.Time.KeyKit.Basic where

import Data.List {- base -}

import qualified Music.Theory.List as List {- hmt-base -}

import Music.Theory.Time.KeyKit {- hmt -}

{- | Returns an arpeggiated version of the phrase.
One way of describing desc it is that all the notes have been separated and then put back together, back-to-back.

> phrase_arpeggio (wseq_to_phrase (zip (repeat (0,1)) [60, 64, 67]))
-}
phrase_arpeggio :: Phrase t -> Phrase t
phrase_arpeggio :: forall t. Phrase t -> Phrase t
phrase_arpeggio (Phrase [Note t]
n Length
l) =
  case [Note t]
n of
    [] -> forall t. [Note t] -> Length -> Phrase t
Phrase [Note t]
n Length
l
    Note t
n1 : [Note t]
_ ->
      let t_seq :: [Length]
t_seq = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) (forall t. Note t -> Length
note_start_time Note t
n1) (forall a b. (a -> b) -> [a] -> [b]
map forall t. Note t -> Length
note_duration [Note t]
n)
          n' :: [Note t]
n' = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Length
t (Note Length
_ Length
d t
e) -> forall t. Length -> Length -> t -> Note t
Note Length
t Length
d t
e) [Length]
t_seq [Note t]
n
          l' :: Length
l' = forall t. Note t -> Length
note_end_time (forall a. [a] -> a
last [Note t]
n)
      in forall t. [Note t] -> Length -> Phrase t
Phrase [Note t]
n' Length
l'

-- | Return phrase ph echoed num times, with rtime delay between each echo.
phrase_echo :: Ord t => Phrase t -> Int -> Time -> Phrase t
phrase_echo :: forall t. Ord t => Phrase t -> Int -> Length -> Phrase t
phrase_echo Phrase t
p Int
n Length
t = forall t. Ord t => [Phrase t] -> Phrase t
phrase_merge_list (forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> forall t. Phrase t -> Length -> Phrase t
phrase_shift Phrase t
p (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Num a => a -> a -> a
* Length
t)) [Int
0 .. Int
n forall a. Num a => a -> a -> a
- Int
1])

{- | Convert a phrase to be in step time, ie. all notes with the same spacing and duration.
Overlapped notes (no matter how small the overlap) are played at the same time.

> phrase_step (wseq_to_phrase [((0, 1), 60), ((5, 2), 64), ((23, 3), 67)]) 1
-}
phrase_step :: Phrase t -> Duration -> Phrase t
phrase_step :: forall t. Phrase t -> Length -> Phrase t
phrase_step (Phrase [Note t]
n Length
_) Length
d =
  let g :: [[Note t]]
g = forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\Note t
i Note t
j -> forall t. Note t -> Length
note_start_time Note t
i forall a. Eq a => a -> a -> Bool
== forall t. Note t -> Length
note_start_time Note t
j) [Note t]
n
      f :: [Note t] -> Length -> [Note t]
f [Note t]
l Length
t = forall a b. (a -> b) -> [a] -> [b]
map (\(Note Length
_ Length
_ t
e) -> forall t. Length -> Length -> t -> Note t
Note Length
t Length
d t
e) [Note t]
l
      n' :: [Note t]
n' = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {t}. [Note t] -> Length -> [Note t]
f [[Note t]]
g [Length
0, Length
d ..])
  in forall t. [Note t] -> Length -> Phrase t
Phrase [Note t]
n' (forall t. Note t -> Length
note_end_time (forall a. [a] -> a
last [Note t]
n'))

{- | This function takes a phrase, splits in in 2 halves (along time) and shuffles the result
(ie. first a note from the first half, then a note from the second half, etc.).
The timing of the original phrase is applied to the result.

> phrase_to_wseq (phrase_shuffle (useq_to_phrase (1,[1..9])))
-}
phrase_shuffle :: Phrase t -> Phrase t
phrase_shuffle :: forall t. Phrase t -> Phrase t
phrase_shuffle (Phrase [Note t]
n Length
l) =
  let ([t]
lhs, [t]
rhs) = forall t. [t] -> ([t], [t])
List.split_into_halves (forall a b. (a -> b) -> [a] -> [b]
map forall t. Note t -> t
note_value [Note t]
n)
      f :: Note t -> t -> Note t
f (Note Length
t Length
d t
_) t
e = forall t. Length -> Length -> t -> Note t
Note Length
t Length
d t
e
      n' :: [Note t]
n' = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {t} {t}. Note t -> t -> Note t
f [Note t]
n (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. [[a]] -> [[a]]
transpose [[t]
lhs, [t]
rhs]))
  in forall t. [Note t] -> Length -> Phrase t
Phrase [Note t]
n' Length
l