{-# LANGUAGE BangPatterns #-}

module Sound.Tidal.Transition where

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

import Control.Concurrent.MVar (readMVar, swapMVar)

import qualified Sound.OSC.FD as O
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 (timeToCycles)
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 =
  do PlayMap
pMap <- MVar PlayMap -> IO PlayMap
forall a. MVar a -> IO a
readMVar (Stream -> MVar PlayMap
sPMapMV Stream
stream)
     let playState :: PlayState
playState = Maybe PlayState -> PlayState
updatePS (Maybe PlayState -> PlayState) -> Maybe PlayState -> PlayState
forall a b. (a -> b) -> a -> b
$ String -> PlayMap -> Maybe PlayState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ID -> String
fromID ID
patId) PlayMap
pMap
     ControlPattern
pat' <- [ControlPattern] -> IO ControlPattern
transition' ([ControlPattern] -> IO ControlPattern)
-> [ControlPattern] -> IO ControlPattern
forall a b. (a -> b) -> a -> b
$ Bool -> [ControlPattern] -> [ControlPattern]
appendPat (Bool -> Bool
not Bool
historyFlag) (PlayState -> [ControlPattern]
history PlayState
playState)
     let pMap' :: PlayMap
pMap' = String -> PlayState -> PlayMap -> PlayMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (ID -> String
fromID ID
patId) (PlayState
playState {pattern :: ControlPattern
pattern = ControlPattern
pat'}) PlayMap
pMap
     PlayMap
_ <- MVar PlayMap -> PlayMap -> IO PlayMap
forall a. MVar a -> a -> IO a
swapMVar (Stream -> MVar PlayMap
sPMapMV Stream
stream) PlayMap
pMap'
     () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    appendPat :: Bool -> [ControlPattern] -> [ControlPattern]
appendPat Bool
flag = if Bool
flag then (ControlPattern
patControlPattern -> [ControlPattern] -> [ControlPattern]
forall a. a -> [a] -> [a]
:) else [ControlPattern] -> [ControlPattern]
forall a. a -> a
id
    updatePS :: Maybe PlayState -> PlayState
updatePS (Just PlayState
playState) = PlayState
playState {history :: [ControlPattern]
history = (Bool -> [ControlPattern] -> [ControlPattern]
appendPat Bool
historyFlag) (PlayState -> [ControlPattern]
history PlayState
playState)}
    updatePS Maybe PlayState
Nothing = PlayState :: ControlPattern -> Bool -> Bool -> [ControlPattern] -> PlayState
PlayState {pattern :: ControlPattern
pattern = ControlPattern
forall a. Pattern a
silence,
                                  mute :: Bool
mute = Bool
False,
                                  solo :: Bool
solo = Bool
False,
                                  history :: [ControlPattern]
history = (Bool -> [ControlPattern] -> [ControlPattern]
appendPat Bool
historyFlag) (ControlPattern
forall a. Pattern a
silenceControlPattern -> [ControlPattern] -> [ControlPattern]
forall a. a -> [a] -> [a]
:[])
                                 }
    transition' :: [ControlPattern] -> IO ControlPattern
transition' [ControlPattern]
pat' = do Tempo
tempo <- MVar Tempo -> IO Tempo
forall a. MVar a -> IO a
readMVar (MVar Tempo -> IO Tempo) -> MVar Tempo -> IO Tempo
forall a b. (a -> b) -> a -> b
$ Stream -> MVar Tempo
sTempoMV Stream
stream
                          Time
now <- IO Time
forall (m :: * -> *). MonadIO m => m Time
O.time
                          let c :: Time
c = Tempo -> Time -> Time
timeToCycles Tempo
tempo Time
now
                          ControlPattern -> IO ControlPattern
forall (m :: * -> *) a. Monad m => a -> m a
return (ControlPattern -> IO ControlPattern)
-> ControlPattern -> IO ControlPattern
forall a b. (a -> b) -> a -> b
$ Time -> [ControlPattern] -> ControlPattern
f Time
c [ControlPattern]
pat'

mortalOverlay :: Time -> Time -> [Pattern a] -> Pattern a
mortalOverlay :: Time -> Time -> [Pattern a] -> Pattern a
mortalOverlay Time
_ Time
_ [] = Pattern a
forall a. Pattern a
silence
mortalOverlay Time
t Time
now (Pattern a
pat:[Pattern a]
ps) = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
overlay ([Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
pop [Pattern a]
ps) (Time -> Time -> Pattern a -> Pattern a
forall a. Time -> Time -> Pattern a -> Pattern a
playFor Time
s (Time
sTime -> Time -> Time
forall a. Num a => a -> a -> a
+Time
t) Pattern a
pat) where
  pop :: [Pattern a] -> Pattern a
pop [] = Pattern a
forall a. Pattern a
silence
  pop (Pattern a
x:[Pattern a]
_) = Pattern a
x
  s :: Time
s = Time -> Time
sam (Time
now Time -> Time -> Time
forall a. Num a => a -> a -> a
- Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Time -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Time
now Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Time -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Time
t :: Int)) Time -> Time -> Time
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 :: (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
_ [] = Pattern a
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]
_) =
   [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack [((Time -> Bool) -> Pattern a -> Pattern a
forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< (Time
now Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
delay)) Pattern a
pat'),
          ((Time -> Bool) -> Pattern a -> Pattern a
forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (Time -> Time -> Time -> Bool
forall a. Ord a => a -> a -> a -> Bool
between (Time
now Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
delay) (Time
now Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
delay Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
durin)) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern a -> Pattern a
fout Pattern a
pat'),
          ((Time -> Bool) -> Pattern a -> Pattern a
forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (Time -> Time -> Time -> Bool
forall a. Ord a => a -> a -> a -> Bool
between (Time
now Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
delay Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
durin) (Time
now Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
delay Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
durin Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
durout)) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern a -> Pattern a
fin Pattern a
pat),
          ((Time -> Bool) -> Pattern a -> Pattern a
forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= (Time
now Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
delay Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
durin Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
durout)) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
lo) Bool -> Bool -> Bool
&& (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
hi)

washIn :: (Pattern a -> Pattern a) -> Time -> Time -> [Pattern a] -> Pattern a
washIn :: (Pattern a -> Pattern a)
-> Time -> Time -> [Pattern a] -> Pattern a
washIn Pattern a -> Pattern a
f Time
durin Time
now [Pattern a]
pats = (Pattern a -> Pattern a)
-> (Pattern a -> Pattern a)
-> Time
-> Time
-> Time
-> Time
-> [Pattern a]
-> Pattern a
forall a.
(Pattern a -> Pattern a)
-> (Pattern a -> Pattern a)
-> Time
-> Time
-> Time
-> Time
-> [Pattern a]
-> Pattern a
wash Pattern a -> Pattern a
f Pattern a -> Pattern a
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
_ [] = ControlPattern
forall a. Pattern a
silence
xfadeIn Time
_ Time
_ (ControlPattern
pat:[]) = ControlPattern
pat
xfadeIn Time
t Time
now (ControlPattern
pat:ControlPattern
pat':[ControlPattern]
_) = ControlPattern -> ControlPattern -> ControlPattern
forall a. Pattern a -> Pattern a -> Pattern a
overlay (ControlPattern
pat ControlPattern -> ControlPattern -> ControlPattern
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Time -> ControlPattern
gain (Time
now Time -> Pattern Time -> Pattern Time
forall a. Time -> Pattern a -> Pattern a
`rotR` (Time -> Pattern Time -> Pattern Time
forall a. Time -> Pattern a -> Pattern a
_slow Time
t Pattern Time
envEqR))) (ControlPattern
pat' ControlPattern -> ControlPattern -> ControlPattern
forall a. Num a => Pattern a -> Pattern a -> Pattern a
|* Pattern Time -> ControlPattern
gain (Time
now Time -> Pattern Time -> Pattern Time
forall a. Time -> Pattern a -> Pattern a
`rotR` (Time -> Pattern Time -> Pattern Time
forall a. Time -> Pattern a -> Pattern a
_slow Time
t (Pattern Time
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
_ [] = ControlPattern
forall a. Pattern a
silence
histpan Int
0 Time
_ [ControlPattern]
_ = ControlPattern
forall a. Pattern a
silence
histpan Int
n Time
_ [ControlPattern]
ps = [ControlPattern] -> ControlPattern
forall a. [Pattern a] -> Pattern a
stack ([ControlPattern] -> ControlPattern)
-> [ControlPattern] -> ControlPattern
forall a b. (a -> b) -> a -> b
$ ((Int, ControlPattern) -> ControlPattern)
-> [(Int, ControlPattern)] -> [ControlPattern]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,ControlPattern
pat) -> ControlPattern
pat ControlPattern -> ControlPattern -> ControlPattern
forall b. Unionable b => Pattern b -> Pattern b -> Pattern b
# Pattern Time -> ControlPattern
pan (Time -> Pattern Time
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Time -> Pattern Time) -> Time -> Pattern Time
forall a b. (a -> b) -> a -> b
$ (Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ (Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n'))) ([ControlPattern] -> [(Int, ControlPattern)]
forall a. [a] -> [(Int, a)]
enumerate [ControlPattern]
ps')
  where ps' :: [ControlPattern]
ps' = Int -> [ControlPattern] -> [ControlPattern]
forall a. Int -> [a] -> [a]
take Int
n [ControlPattern]
ps
        n' :: Int
n' = [ControlPattern] -> Int
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
_ [] = ControlPattern
forall a. Pattern a
silence
wait Time
t Time
now (ControlPattern
pat:[ControlPattern]
_) = (Time -> Bool) -> ControlPattern -> ControlPattern
forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= (Time -> Time
nextSam (Time
nowTime -> Time -> Time
forall a. Num a => a -> a -> a
+Time
tTime -> Time -> Time
forall 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
_ [] = ControlPattern
forall a. Pattern a
silence
waitT Time -> [ControlPattern] -> ControlPattern
f Time
t Time
now [ControlPattern]
pats = (Time -> Bool) -> ControlPattern -> ControlPattern
forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= (Time -> Time
nextSam (Time
nowTime -> Time -> Time
forall a. Num a => a -> a -> a
+Time
tTime -> Time -> Time
forall a. Num a => a -> a -> a
-Time
1))) (Time -> [ControlPattern] -> ControlPattern
f (Time
now Time -> Time -> Time
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 = (ControlPattern -> ControlPattern)
-> (ControlPattern -> ControlPattern)
-> Time
-> Time
-> Time
-> Time
-> [ControlPattern]
-> ControlPattern
forall a.
(Pattern a -> Pattern a)
-> (Pattern a -> Pattern a)
-> Time
-> Time
-> Time
-> Time
-> [Pattern a]
-> Pattern a
wash ControlPattern -> ControlPattern
forall a. a -> a
id ControlPattern -> ControlPattern
forall a. a -> a
id (Int -> Time
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 = (ControlPattern -> ControlPattern)
-> (ControlPattern -> ControlPattern)
-> Time
-> Time
-> Time
-> Time
-> [ControlPattern]
-> ControlPattern
forall a.
(Pattern a -> Pattern a)
-> (Pattern a -> Pattern a)
-> Time
-> Time
-> Time
-> Time
-> [Pattern a]
-> Pattern a
wash ControlPattern -> ControlPattern
forall a. a -> a
id ControlPattern -> ControlPattern
forall a. a -> a
id ((Time -> Time
nextSam Time
now) Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
now Time -> Time -> Time
forall a. Num a => a -> a -> a
+ (Int -> Time
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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- ((Time -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Time
now) Int -> Int -> Int
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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- ((Time -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Time
now) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n) Int -> Int -> Int
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
_ [] = ControlPattern
forall a. Pattern a
silence
mortal Time
lifespan Time
release Time
now (ControlPattern
p:[ControlPattern]
_) = ControlPattern -> ControlPattern -> ControlPattern
forall a. Pattern a -> Pattern a -> Pattern a
overlay ((Time -> Bool) -> ControlPattern -> ControlPattern
forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<(Time
nowTime -> Time -> Time
forall a. Num a => a -> a -> a
+Time
lifespan)) ControlPattern
p) ((Time -> Bool) -> ControlPattern -> ControlPattern
forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= (Time
nowTime -> Time -> Time
forall a. Num a => a -> a -> a
+Time
lifespan)) (Time -> Time -> ControlPattern -> ControlPattern
forall a. Time -> Time -> Pattern a -> Pattern a
fadeOutFrom (Time
now Time -> Time -> Time
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
_ [] = ControlPattern
forall a. Pattern a
silence
interpolateIn Time
_ Time
_ (ControlPattern
p:[]) = ControlPattern
p
interpolateIn Time
t Time
now (ControlPattern
pat:ControlPattern
pat':[ControlPattern]
_) = Map String Value -> Map String Value -> Time -> Map String Value
f (Map String Value -> Map String Value -> Time -> Map String Value)
-> ControlPattern
-> Pattern (Map String Value -> Time -> Map String Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ControlPattern
pat' Pattern (Map String Value -> Time -> Map String Value)
-> ControlPattern -> Pattern (Time -> Map String Value)
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
*> ControlPattern
pat Pattern (Time -> Map String Value)
-> Pattern Time -> ControlPattern
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern Time
automation
  where automation :: Pattern Time
automation = Time
now Time -> Pattern Time -> Pattern Time
forall a. Time -> Pattern a -> Pattern a
`rotR` (Time -> Pattern Time -> Pattern Time
forall a. Time -> Pattern a -> Pattern a
_slow Time
t Pattern Time
envL)
        f :: Map String Value -> Map String Value -> Time -> Map String Value
f = (\Map String Value
a Map String Value
b Time
x -> (Value -> Value -> Value)
-> Map String Value -> Map String Value -> Map String Value
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith ((Int -> Int -> Int)
-> (Time -> Time -> Time) -> Value -> Value -> Value
fNum2 (\Int
a' Int
b' -> Time -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Time -> Int) -> Time -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a') Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
x Time -> Time -> Time
forall a. Num a => a -> a -> a
+ (Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b') Time -> Time -> Time
forall a. Num a => a -> a -> a
* (Time
1Time -> Time -> Time
forall a. Num a => a -> a -> a
-Time
x))
                                            (\Time
a' Time
b' -> Time
a' Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
x Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
b' Time -> Time -> Time
forall a. Num a => a -> a -> a
* (Time
1Time -> Time -> Time
forall a. Num a => a -> a -> a
-Time
x))
                                     )
                       Map String Value
b Map String Value
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 :: Time -> [Pattern a] -> Pattern a
clutch = Time -> Time -> [Pattern a] -> Pattern a
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 :: Time -> Time -> [Pattern a] -> Pattern a
clutchIn Time
_ Time
_ [] = Pattern a
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]
_) = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
overlay (Time -> Time -> Pattern a -> Pattern a
forall a. Time -> Time -> Pattern a -> Pattern a
fadeOutFrom Time
now Time
t Pattern a
p') (Time -> Time -> Pattern a -> Pattern a
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 = (ControlPattern -> ControlPattern)
-> Time -> Time -> [ControlPattern] -> ControlPattern
forall a.
(Pattern a -> Pattern a)
-> Time -> Time -> [Pattern a] -> Pattern a
washIn (Pattern ControlPattern -> ControlPattern
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern ControlPattern -> ControlPattern)
-> (ControlPattern -> Pattern ControlPattern)
-> ControlPattern
-> ControlPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ControlPattern
pat -> (\Time
v -> Integer -> Time -> Time -> ControlPattern -> ControlPattern
_stut Integer
8 Time
0.2 Time
v ControlPattern
pat) (Time -> ControlPattern) -> Pattern Time -> Pattern ControlPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Time
now Time -> Pattern Time -> Pattern Time
forall a. Time -> Pattern a -> Pattern a
`rotR` (Time -> Pattern Time -> Pattern Time
forall a. Time -> Pattern a -> Pattern a
_slow Time
t (Pattern Time -> Pattern Time) -> Pattern Time -> Pattern Time
forall a b. (a -> b) -> a -> b
$ Time -> Time
forall a. Real a => a -> Time
toRational (Time -> Time) -> Pattern Time -> Pattern Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Time
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