/
Transition.hs
223 lines (176 loc) · 8.93 KB
/
Transition.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
{-# LANGUAGE BangPatterns #-}
module Sound.Tidal.Transition where
import Prelude hiding ((*>), (<*))
import Control.Concurrent.MVar (readMVar, swapMVar)
import qualified Data.Map.Strict as Map
-- import Data.Maybe (fromJust)
import qualified Sound.Tidal.Clock as Clock
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.Config
import Sound.Tidal.Stream.Types
-- import Sound.Tidal.Tempo as T
import Sound.Tidal.UI (fadeInFrom, fadeOutFrom)
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/>.
-}
type TransitionMapper = Time -> [ControlPattern] -> ControlPattern
-- 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 -> TransitionMapper -> ID -> ControlPattern -> IO ()
transition stream historyFlag mapper patId !pat = do
let
appendPat flag = if flag then (pat:) else id
updatePS (Just playState) = playState {psHistory = (appendPat historyFlag) (psHistory playState)}
updatePS Nothing = PlayState {psPattern = silence,
psMute = False,
psSolo = False,
psHistory = (appendPat historyFlag) (silence:[])
}
transition' pat' = do
t <- Clock.getCycleTime (cClockConfig $ sConfig stream) (sClockRef stream)
return $! mapper t pat'
pMap <- readMVar (sPMapMV stream)
let playState = updatePS $ Map.lookup (fromID patId) pMap
pat' <- transition' $ appendPat (not historyFlag) (psHistory playState)
let pMap' = Map.insert (fromID patId) (playState {psPattern = pat'}) pMap
_ <- swapMVar (sPMapMV stream) pMap'
return ()
mortalOverlay :: Time -> Time -> [Pattern a] -> Pattern a
mortalOverlay _ _ [] = silence
mortalOverlay t now (pat:ps) = overlay (pop ps) (playFor s (s+t) pat) where
pop [] = silence
pop (x:_) = x
s = sam (now - fromIntegral (floor now `mod` floor t :: Int)) + sam 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 _ _ _ _ _ _ [] = silence
wash _ _ _ _ _ _ (pat:[]) = pat
wash fout fin delay durin durout now (pat:pat':_) =
stack [(filterWhen (< (now + delay)) pat'),
(filterWhen (between (now + delay) (now + delay + durin)) $ fout pat'),
(filterWhen (between (now + delay + durin) (now + delay + durin + durout)) $ fin pat),
(filterWhen (>= (now + delay + durin + durout)) $ pat)
]
where
between lo hi x = (x >= lo) && (x < hi)
washIn :: (Pattern a -> Pattern a) -> Time -> Time -> [Pattern a] -> Pattern a
washIn f durin now pats = wash f id 0 durin 0 now pats
xfadeIn :: Time -> Time -> [ControlPattern] -> ControlPattern
xfadeIn _ _ [] = silence
xfadeIn _ _ (pat:[]) = pat
xfadeIn t now (pat:pat':_) = overlay (pat |* gain (now `rotR` (_slow t envEqR))) (pat' |* gain (now `rotR` (_slow t (envEq))))
-- | Pans the last n versions of the pattern across the field
histpan :: Int -> Time -> [ControlPattern] -> ControlPattern
histpan _ _ [] = silence
histpan 0 _ _ = silence
histpan n _ ps = stack $ map (\(i,pat) -> pat # pan (pure $ (fromIntegral i) / (fromIntegral n'))) (enumerate ps')
where ps' = take n ps
n' = length ps' -- in case there's fewer patterns than requested
-- | Just stop for a bit before playing new pattern
wait :: Time -> Time -> [ControlPattern] -> ControlPattern
wait _ _ [] = silence
wait t now (pat:_) = filterWhen (>= (nextSam (now+t-1))) 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 _ _ _ [] = silence
waitT f t now pats = filterWhen (>= (nextSam (now+t-1))) (f (now + t) 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 = jumpIn 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 n = wash id id (fromIntegral n) 0 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' n now = wash id id ((nextSam now) - now + (fromIntegral n)) 0 0 now
-- | Sharp `jump` transition at next cycle boundary where cycle mod n == 0
jumpMod :: Int -> Time -> [ControlPattern] -> ControlPattern
jumpMod n now = jumpIn' ((n-1) - ((floor now) `mod` n)) now
-- | Sharp `jump` transition at next cycle boundary where cycle mod n == p
jumpMod' :: Int -> Int -> Time -> [ControlPattern] -> ControlPattern
jumpMod' n p now = Sound.Tidal.Transition.jumpIn' ((n-1) - ((floor now) `mod` n) + p) now
-- | Degrade the new pattern over time until it ends in silence
mortal :: Time -> Time -> Time -> [ControlPattern] -> ControlPattern
mortal _ _ _ [] = silence
mortal lifespan release now (p:_) = overlay (filterWhen (<(now+lifespan)) p) (filterWhen (>= (now+lifespan)) (fadeOutFrom (now + lifespan) release p))
interpolate :: Time -> [ControlPattern] -> ControlPattern
interpolate = interpolateIn 4
interpolateIn :: Time -> Time -> [ControlPattern] -> ControlPattern
interpolateIn _ _ [] = silence
interpolateIn _ _ (p:[]) = p
interpolateIn t now (pat:pat':_) = f <$> pat' *> pat <* automation
where automation = now `rotR` (_slow t envL)
f = (\a b x -> Map.unionWith (fNum2 (\a' b' -> floor $ (fromIntegral a') * x + (fromIntegral b') * (1-x))
(\a' b' -> a' * x + b' * (1-x))
)
b 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 = clutchIn 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 _ _ [] = silence
clutchIn _ _ (p:[]) = p
clutchIn t now (p:p':_) = overlay (fadeOutFrom now t p') (fadeInFrom now t 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 t now pats = washIn (innerJoin . (\pat -> (\v -> _stut 8 0.2 v pat) <$> (now `rotR` (_slow t $ toRational <$> envLR)))) t now 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 = anticipateIn 8