{-# LANGUAGE BangPatterns #-}

module Sound.Tidal.Transition where

import Prelude hiding ((<*), (*>))

import Control.Concurrent.MVar (modifyMVar_)

import qualified Data.Map.Strict as Map
-- import Data.Maybe (fromJust)

import Sound.Tidal.Control
import Sound.Tidal.Core
import Sound.Tidal.ID
import Sound.Tidal.Params (gain, pan)
import Sound.Tidal.Pattern
import Sound.Tidal.Stream
import Sound.Tidal.Tempo as T
import Sound.Tidal.UI (fadeOutFrom, fadeInFrom)
import Sound.Tidal.Utils (enumerate)

{-
    Transition.hs - A library for handling transitions between patterns
    Copyright (C) 2020, Alex McLean and contributors

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

-- Evaluation of pat is forced so exceptions are picked up here, before replacing the existing pattern.
-- the "historyFlag" determines if the new pattern should be placed on the history stack or not
transition :: Stream -> Bool -> (Time -> [ControlPattern] -> ControlPattern) -> ID -> ControlPattern -> IO ()
transition :: Stream
-> Bool
-> (Time -> [ControlPattern] -> ControlPattern)
-> ID
-> ControlPattern
-> IO ()
transition Stream
stream Bool
historyFlag Time -> [ControlPattern] -> ControlPattern
f ID
patId !ControlPattern
pat =
  forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Stream -> MVar [TempoAction]
sActionsMV Stream
stream) (\[TempoAction]
actions -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Bool
-> (Time -> [ControlPattern] -> ControlPattern)
-> ID
-> ControlPattern
-> TempoAction
T.Transition Bool
historyFlag Time -> [ControlPattern] -> ControlPattern
f ID
patId ControlPattern
pat) forall a. a -> [a] -> [a]
: [TempoAction]
actions)

mortalOverlay :: Time -> Time -> [Pattern a] -> Pattern a
mortalOverlay :: forall a. Time -> Time -> [Pattern a] -> Pattern a
mortalOverlay Time
_ Time
_ [] = forall a. Pattern a
silence
mortalOverlay Time
t Time
now (Pattern a
pat:[Pattern a]
ps) = forall a. Pattern a -> Pattern a -> Pattern a
overlay (forall {a}. [Pattern a] -> Pattern a
pop [Pattern a]
ps) (forall a. Time -> Time -> Pattern a -> Pattern a
playFor Time
s (Time
sforall a. Num a => a -> a -> a
+Time
t) Pattern a
pat) where
  pop :: [Pattern a] -> Pattern a
pop [] = forall a. Pattern a
silence
  pop (Pattern a
x:[Pattern a]
_) = Pattern a
x
  s :: Time
s = Time -> Time
sam (Time
now forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (RealFrac a, Integral b) => a -> b
floor Time
now forall a. Integral a => a -> a -> a
`mod` forall a b. (RealFrac a, Integral b) => a -> b
floor Time
t :: Int)) forall a. Num a => a -> a -> a
+ Time -> Time
sam Time
t

{-| Washes away the current pattern after a certain delay by applying a
    function to it over time, then switching over to the next pattern to
    which another function is applied.
-}
wash :: (Pattern a -> Pattern a) -> (Pattern a -> Pattern a) -> Time -> Time -> Time -> Time -> [Pattern a] -> Pattern a
wash :: forall a.
(Pattern a -> Pattern a)
-> (Pattern a -> Pattern a)
-> Time
-> Time
-> Time
-> Time
-> [Pattern a]
-> Pattern a
wash Pattern a -> Pattern a
_ Pattern a -> Pattern a
_ Time
_ Time
_ Time
_ Time
_ [] = forall a. Pattern a
silence
wash Pattern a -> Pattern a
_ Pattern a -> Pattern a
_ Time
_ Time
_ Time
_ Time
_ (Pattern a
pat:[]) = Pattern a
pat
wash Pattern a -> Pattern a
fout Pattern a -> Pattern a
fin Time
delay Time
durin Time
durout Time
now (Pattern a
pat:Pattern a
pat':[Pattern a]
_) =
   forall {a}. [Pattern a] -> Pattern a
stack [(forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (forall a. Ord a => a -> a -> Bool
< (Time
now forall a. Num a => a -> a -> a
+ Time
delay)) Pattern a
pat'),
          (forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (forall {a}. Ord a => a -> a -> a -> Bool
between (Time
now forall a. Num a => a -> a -> a
+ Time
delay) (Time
now forall a. Num a => a -> a -> a
+ Time
delay forall a. Num a => a -> a -> a
+ Time
durin)) forall a b. (a -> b) -> a -> b
$ Pattern a -> Pattern a
fout Pattern a
pat'),
          (forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (forall {a}. Ord a => a -> a -> a -> Bool
between (Time
now forall a. Num a => a -> a -> a
+ Time
delay forall a. Num a => a -> a -> a
+ Time
durin) (Time
now forall a. Num a => a -> a -> a
+ Time
delay forall a. Num a => a -> a -> a
+ Time
durin forall a. Num a => a -> a -> a
+ Time
durout)) forall a b. (a -> b) -> a -> b
$ Pattern a -> Pattern a
fin Pattern a
pat),
          (forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (forall a. Ord a => a -> a -> Bool
>= (Time
now forall a. Num a => a -> a -> a
+ Time
delay forall a. Num a => a -> a -> a
+ Time
durin forall a. Num a => a -> a -> a
+ Time
durout)) forall a b. (a -> b) -> a -> b
$ Pattern a
pat)
         ]
 where
   between :: a -> a -> a -> Bool
between a
lo a
hi a
x = (a
x forall a. Ord a => a -> a -> Bool
>= a
lo) Bool -> Bool -> Bool
&& (a
x forall a. Ord a => a -> a -> Bool
< a
hi)

washIn :: (Pattern a -> Pattern a) -> Time -> Time -> [Pattern a] -> Pattern a
washIn :: forall a.
(Pattern a -> Pattern a)
-> Time -> Time -> [Pattern a] -> Pattern a
washIn Pattern a -> Pattern a
f Time
durin Time
now [Pattern a]
pats = forall a.
(Pattern a -> Pattern a)
-> (Pattern a -> Pattern a)
-> Time
-> Time
-> Time
-> Time
-> [Pattern a]
-> Pattern a
wash Pattern a -> Pattern a
f forall a. a -> a
id Time
0 Time
durin Time
0 Time
now [Pattern a]
pats

xfadeIn :: Time -> Time -> [ControlPattern] -> ControlPattern
xfadeIn :: Time -> Time -> [ControlPattern] -> ControlPattern
xfadeIn Time
_ Time
_ [] = forall a. Pattern a
silence
xfadeIn Time
_ Time
_ (ControlPattern
pat:[]) = ControlPattern
pat
xfadeIn Time
t Time
now (ControlPattern
pat:ControlPattern
pat':[ControlPattern]
_) = forall a. Pattern a -> Pattern a -> Pattern a
overlay (ControlPattern
pat forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Double -> ControlPattern
gain (Time
now forall a. Time -> Pattern a -> Pattern a
`rotR` (forall a. Time -> Pattern a -> Pattern a
_slow Time
t Pattern Double
envEqR))) (ControlPattern
pat' forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Double -> ControlPattern
gain (Time
now forall a. Time -> Pattern a -> Pattern a
`rotR` (forall a. Time -> Pattern a -> Pattern a
_slow Time
t (Pattern Double
envEq))))

-- | Pans the last n versions of the pattern across the field
histpan :: Int -> Time -> [ControlPattern] -> ControlPattern
histpan :: Int -> Time -> [ControlPattern] -> ControlPattern
histpan Int
_ Time
_ [] = forall a. Pattern a
silence
histpan Int
0 Time
_ [ControlPattern]
_ = forall a. Pattern a
silence
histpan Int
n Time
_ [ControlPattern]
ps = forall {a}. [Pattern a] -> Pattern a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,ControlPattern
pat) -> ControlPattern
pat forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Double -> ControlPattern
pan (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n'))) (forall a. [a] -> [(Int, a)]
enumerate [ControlPattern]
ps')
  where ps' :: [ControlPattern]
ps' = forall a. Int -> [a] -> [a]
take Int
n [ControlPattern]
ps
        n' :: Int
n' = forall (t :: * -> *) a. Foldable t => t a -> Int
length [ControlPattern]
ps' -- in case there's fewer patterns than requested

-- | Just stop for a bit before playing new pattern
wait :: Time -> Time -> [ControlPattern] -> ControlPattern
wait :: Time -> Time -> [ControlPattern] -> ControlPattern
wait Time
_ Time
_ [] = forall a. Pattern a
silence
wait Time
t Time
now (ControlPattern
pat:[ControlPattern]
_) = forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (forall a. Ord a => a -> a -> Bool
>= (Time -> Time
nextSam (Time
nowforall a. Num a => a -> a -> a
+Time
tforall a. Num a => a -> a -> a
-Time
1))) ControlPattern
pat

{- | Just as `wait`, `waitT` stops for a bit and then applies the given transition to the playing pattern

@
d1 $ sound "bd"

t1 (waitT (xfadeIn 8) 4) $ sound "hh*8"
@
-}
waitT :: (Time -> [ControlPattern] -> ControlPattern) -> Time -> Time -> [ControlPattern] -> ControlPattern
waitT :: (Time -> [ControlPattern] -> ControlPattern)
-> Time -> Time -> [ControlPattern] -> ControlPattern
waitT Time -> [ControlPattern] -> ControlPattern
_ Time
_ Time
_ [] = forall a. Pattern a
silence
waitT Time -> [ControlPattern] -> ControlPattern
f Time
t Time
now [ControlPattern]
pats = forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (forall a. Ord a => a -> a -> Bool
>= (Time -> Time
nextSam (Time
nowforall a. Num a => a -> a -> a
+Time
tforall a. Num a => a -> a -> a
-Time
1))) (Time -> [ControlPattern] -> ControlPattern
f (Time
now forall a. Num a => a -> a -> a
+ Time
t) [ControlPattern]
pats)

{- |
Jumps directly into the given pattern, this is essentially the _no transition_-transition.

Variants of @jump@ provide more useful capabilities, see @jumpIn@ and @jumpMod@
-}
jump :: Time -> [ControlPattern] -> ControlPattern
jump :: Time -> [ControlPattern] -> ControlPattern
jump = Int -> Time -> [ControlPattern] -> ControlPattern
jumpIn Int
0

{- | Sharp `jump` transition after the specified number of cycles have passed.

@
t1 (jumpIn 2) $ sound "kick(3,8)"
@
-}
jumpIn :: Int -> Time -> [ControlPattern] -> ControlPattern
jumpIn :: Int -> Time -> [ControlPattern] -> ControlPattern
jumpIn Int
n = forall a.
(Pattern a -> Pattern a)
-> (Pattern a -> Pattern a)
-> Time
-> Time
-> Time
-> Time
-> [Pattern a]
-> Pattern a
wash forall a. a -> a
id forall a. a -> a
id (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Time
0 Time
0

{- | Unlike `jumpIn` the variant `jumpIn'` will only transition at cycle boundary (e.g. when the cycle count is an integer).
-}
jumpIn' :: Int -> Time -> [ControlPattern] -> ControlPattern
jumpIn' :: Int -> Time -> [ControlPattern] -> ControlPattern
jumpIn' Int
n Time
now = forall a.
(Pattern a -> Pattern a)
-> (Pattern a -> Pattern a)
-> Time
-> Time
-> Time
-> Time
-> [Pattern a]
-> Pattern a
wash forall a. a -> a
id forall a. a -> a
id ((Time -> Time
nextSam Time
now) forall a. Num a => a -> a -> a
- Time
now forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) Time
0 Time
0 Time
now

-- | Sharp `jump` transition at next cycle boundary where cycle mod n == 0
jumpMod :: Int -> Time -> [ControlPattern] -> ControlPattern
jumpMod :: Int -> Time -> [ControlPattern] -> ControlPattern
jumpMod Int
n Time
now = Int -> Time -> [ControlPattern] -> ControlPattern
jumpIn' ((Int
nforall a. Num a => a -> a -> a
-Int
1) forall a. Num a => a -> a -> a
- ((forall a b. (RealFrac a, Integral b) => a -> b
floor Time
now) forall a. Integral a => a -> a -> a
`mod` Int
n)) Time
now

-- | Sharp `jump` transition at next cycle boundary where cycle mod n == p
jumpMod' :: Int -> Int -> Time -> [ControlPattern] -> ControlPattern
jumpMod' :: Int -> Int -> Time -> [ControlPattern] -> ControlPattern
jumpMod' Int
n Int
p Time
now = Int -> Time -> [ControlPattern] -> ControlPattern
Sound.Tidal.Transition.jumpIn' ((Int
nforall a. Num a => a -> a -> a
-Int
1) forall a. Num a => a -> a -> a
- ((forall a b. (RealFrac a, Integral b) => a -> b
floor Time
now) forall a. Integral a => a -> a -> a
`mod` Int
n) forall a. Num a => a -> a -> a
+ Int
p) Time
now

-- | Degrade the new pattern over time until it ends in silence
mortal :: Time -> Time -> Time -> [ControlPattern] -> ControlPattern
mortal :: Time -> Time -> Time -> [ControlPattern] -> ControlPattern
mortal Time
_ Time
_ Time
_ [] = forall a. Pattern a
silence
mortal Time
lifespan Time
release Time
now (ControlPattern
p:[ControlPattern]
_) = forall a. Pattern a -> Pattern a -> Pattern a
overlay (forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (forall a. Ord a => a -> a -> Bool
<(Time
nowforall a. Num a => a -> a -> a
+Time
lifespan)) ControlPattern
p) (forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (forall a. Ord a => a -> a -> Bool
>= (Time
nowforall a. Num a => a -> a -> a
+Time
lifespan)) (forall a. Time -> Time -> Pattern a -> Pattern a
fadeOutFrom (Time
now forall a. Num a => a -> a -> a
+ Time
lifespan) Time
release ControlPattern
p))


interpolate :: Time -> [ControlPattern] -> ControlPattern
interpolate :: Time -> [ControlPattern] -> ControlPattern
interpolate = Time -> Time -> [ControlPattern] -> ControlPattern
interpolateIn Time
4

interpolateIn :: Time -> Time -> [ControlPattern] -> ControlPattern
interpolateIn :: Time -> Time -> [ControlPattern] -> ControlPattern
interpolateIn Time
_ Time
_ [] = forall a. Pattern a
silence
interpolateIn Time
_ Time
_ (ControlPattern
p:[]) = ControlPattern
p
interpolateIn Time
t Time
now (ControlPattern
pat:ControlPattern
pat':[ControlPattern]
_) = ValueMap -> ValueMap -> Double -> ValueMap
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ControlPattern
pat' forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
*> ControlPattern
pat forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern Double
automation
  where automation :: Pattern Double
automation = Time
now forall a. Time -> Pattern a -> Pattern a
`rotR` (forall a. Time -> Pattern a -> Pattern a
_slow Time
t Pattern Double
envL)
        f :: ValueMap -> ValueMap -> Double -> ValueMap
f = (\ValueMap
a ValueMap
b Double
x -> forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith ((Int -> Int -> Int)
-> (Double -> Double -> Double) -> Value -> Value -> Value
fNum2 (\Int
a' Int
b' -> forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a') forall a. Num a => a -> a -> a
* Double
x forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b') forall a. Num a => a -> a -> a
* (Double
1forall a. Num a => a -> a -> a
-Double
x))
                                            (\Double
a' Double
b' -> Double
a' forall a. Num a => a -> a -> a
* Double
x forall a. Num a => a -> a -> a
+ Double
b' forall a. Num a => a -> a -> a
* (Double
1forall a. Num a => a -> a -> a
-Double
x))
                                     )
                       ValueMap
b ValueMap
a
            )

{-|
Degrades the current pattern while undegrading the next.

This is like @xfade@ but not by gain of samples but by randomly removing events from the current pattern and slowly adding back in missing events from the next one.

@
d1 $ sound "bd(3,8)"

t1 clutch $ sound "[hh*4, odx(3,8)]"
@

@clutch@ takes two cycles for the transition, essentially this is @clutchIn 2@.
-}
clutch :: Time -> [Pattern a] -> Pattern a
clutch :: forall a. Time -> [Pattern a] -> Pattern a
clutch = forall a. Time -> Time -> [Pattern a] -> Pattern a
clutchIn Time
2

{-|
Also degrades the current pattern and undegrades the next.
To change the number of cycles the transition takes, you can use @clutchIn@ like so:

@
d1 $ sound "bd(5,8)"

t1 (clutchIn 8) $ sound "[hh*4, odx(3,8)]"
@

will take 8 cycles for the transition.
-}
clutchIn :: Time -> Time -> [Pattern a] -> Pattern a
clutchIn :: forall a. Time -> Time -> [Pattern a] -> Pattern a
clutchIn Time
_ Time
_ [] = forall a. Pattern a
silence
clutchIn Time
_ Time
_ (Pattern a
p:[]) = Pattern a
p
clutchIn Time
t Time
now (Pattern a
p:Pattern a
p':[Pattern a]
_) = forall a. Pattern a -> Pattern a -> Pattern a
overlay (forall a. Time -> Time -> Pattern a -> Pattern a
fadeOutFrom Time
now Time
t Pattern a
p') (forall a. Time -> Time -> Pattern a -> Pattern a
fadeInFrom Time
now Time
t Pattern a
p)

{-| same as `anticipate` though it allows you to specify the number of cycles until dropping to the new pattern, e.g.:

@
d1 $ sound "jvbass(3,8)"

t1 (anticipateIn 4) $ sound "jvbass(5,8)"
@-}
anticipateIn :: Time -> Time -> [ControlPattern] -> ControlPattern
anticipateIn :: Time -> Time -> [ControlPattern] -> ControlPattern
anticipateIn Time
t Time
now [ControlPattern]
pats = forall a.
(Pattern a -> Pattern a)
-> Time -> Time -> [Pattern a] -> Pattern a
washIn (forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ControlPattern
pat -> (\Time
v -> Integer -> Double -> Time -> ControlPattern -> ControlPattern
_stut Integer
8 Double
0.2 Time
v ControlPattern
pat) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Time
now forall a. Time -> Pattern a -> Pattern a
`rotR` (forall a. Time -> Pattern a -> Pattern a
_slow Time
t forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Time
toRational forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
envLR)))) Time
t Time
now [ControlPattern]
pats

-- wash :: (Pattern a -> Pattern a) -> (Pattern a -> Pattern a) -> Time -> Time -> Time -> Time -> [Pattern a] -> Pattern a

{- | `anticipate` is an increasing comb filter.

Build up some tension, culminating in a _drop_ to the new pattern after 8 cycles.
-}
anticipate :: Time -> [ControlPattern] -> ControlPattern
anticipate :: Time -> [ControlPattern] -> ControlPattern
anticipate = Time -> Time -> [ControlPattern] -> ControlPattern
anticipateIn Time
8