tidal 0.9.10 → 1.0.0

raw patch · 54 files changed

+7554/−5472 lines, 54 filesdep +bifunctorsdep +microspecdep +mwc-randomdep −mersenne-random-pure64dep −tastydep −tasty-hunitPVP ok

version bump matches the API change (PVP)

Dependencies added: bifunctors, microspec, mwc-random, network, random, vector

Dependencies removed: mersenne-random-pure64, tasty, tasty-hunit, websockets

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−0
• LICENSE +2/−3
• README.md +2/−2
• Sound/Tidal/Bjorklund.hs +0/−34
• Sound/Tidal/Chords.hs +0/−166
• Sound/Tidal/Context.hs +0/−27
• Sound/Tidal/Dirt.hs +0/−390
• Sound/Tidal/EspGrid.hs +0/−114
• Sound/Tidal/MultiMode.hs +0/−106
• Sound/Tidal/OscStream.hs +0/−91
• Sound/Tidal/Params.hs +0/−391
• Sound/Tidal/Parse.hs +0/−436
• Sound/Tidal/Pattern.hs +0/−1752
• Sound/Tidal/Scales.hs +0/−224
• Sound/Tidal/Sieve.hs +0/−100
• Sound/Tidal/Simple.hs +0/−39
• Sound/Tidal/Strategies.hs +0/−421
• Sound/Tidal/Stream.hs +0/−329
• Sound/Tidal/SuperCollider.hs +0/−36
• Sound/Tidal/Tempo.hs +0/−341
• Sound/Tidal/Time.hs +0/−117
• Sound/Tidal/Transition.hs +0/−129
• Sound/Tidal/Utils.hs +0/−104
• Sound/Tidal/Version.hs +0/−4
• doc/tidal.md +0/−2
• src/Sound/Tidal/Bjorklund.hs +34/−0
• src/Sound/Tidal/Chords.hs +184/−0
• src/Sound/Tidal/Config.hs +19/−0
• src/Sound/Tidal/Context.hs +18/−0
• src/Sound/Tidal/Control.hs +675/−0
• src/Sound/Tidal/Core.hs +412/−0
• src/Sound/Tidal/EspGrid.hs +46/−0
• src/Sound/Tidal/MiniTidal.hs +547/−0
• src/Sound/Tidal/Params.hs +616/−0
• src/Sound/Tidal/ParseBP.hs +478/−0
• src/Sound/Tidal/Pattern.hs +727/−0
• src/Sound/Tidal/Scales.hs +227/−0
• src/Sound/Tidal/Simple.hs +42/−0
• src/Sound/Tidal/Stream.hs +305/−0
• src/Sound/Tidal/Tempo.hs +183/−0
• src/Sound/Tidal/Transition.hs +189/−0
• src/Sound/Tidal/UI.hs +1656/−0
• src/Sound/Tidal/Utils.hs +73/−0
• test/Sound/Tidal/CoreTest.hs +136/−0
• test/Sound/Tidal/MiniTidalTest.hs +135/−0
• test/Sound/Tidal/ParseTest.hs +69/−0
• test/Sound/Tidal/PatternTest.hs +430/−0
• test/Sound/Tidal/UITest.hs +171/−0
• test/Sound/Tidal/UtilsTest.hs +16/−0
• test/Test.hs +19/−0
• test/TestUtils.hs +32/−0
• tests/test.hs +0/−47
• tidal.cabal +48/−38
• tidal.el +48/−29

@@ -1,5 +1,20 @@ # TidalCycles log of changes +## 0.9.10 (and earlier missing versions from this log)++* arpg, a function to arpeggiate+* within', an alternate within with a different approach to time, following discussion here https://github.com/tidalcycles/Tidal/issues/313+* sine et al are now generalised so can be used as double or rational patterns+* New Sound.Tidal.Simple module with a range of simple transformations (faster, slower, higher, lower, mute, etc)+* slice upgraded to take a pattern of slice indexes+* espgrid support+* lindenmayerI+* sew function, for binary switching between two patterns+* somecycles alias for someCycles+* ply function, for repeating each event in a pattern a given number+  of times within their original timespan+* patternify juxBy, e, e', einv, efull, eoff+ ## 0.9.7  ### Enhancements

@@ -76,7 +76,7 @@    "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks.- +   "The Program" refers to any copyrightable work licensed under this License.  Each licensee is addressed as "you".  "Licensees" and "recipients" may be individuals or organizations.@@ -509,7 +509,7 @@ covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid.-  +   If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties@@ -672,4 +672,3 @@ the library.  If this is what you want to do, use the GNU Lesser General Public License instead of this License.  But first, please read <http://www.gnu.org/philosophy/why-not-lgpl.html>.-

@@ -1,5 +1,5 @@ -Tidal [![Build Status](https://travis-ci.org/tidalcycles/Tidal.svg?branch=1.0-dev)](https://travis-ci.org/tidalcycles/Tidal)+Tidal [![Build Status](https://travis-ci.org/tidalcycles/Tidal.svg)](https://travis-ci.org/tidalcycles/Tidal) =====  Language for live coding of pattern@@ -7,7 +7,7 @@ For documentation, mailing list and more info see here:   https://tidalcycles.org/ -(c) Alex McLean and contributors, 2016+(c) Alex McLean and contributors, 2018  Distributed under the terms of the GNU Public license version 3 (or later).

@@ -1,34 +0,0 @@-module Sound.Tidal.Bjorklund (bjorklund) where---- The below is (c) Rohan Drape, taken from the hmt library and--- distributed here under the terms of the GNU Public Licence.  Tidal--- used to just include the library but removed for now due to--- dependency problems.. We could however likely benefit from other--- parts of the library..--type STEP a = ((Int,Int),([[a]],[[a]]))--left :: STEP a -> STEP a-left ((i,j),(xs,ys)) =-    let (xs',xs'') = splitAt j xs-    in ((j,i-j),(zipWith (++) xs' ys,xs''))--right :: STEP a -> STEP a-right ((i,j),(xs,ys)) =-    let (ys',ys'') = splitAt i ys-    in ((i,j-i),(zipWith (++) xs ys',ys''))--bjorklund' :: STEP a -> STEP a-bjorklund' (n,x) =-    let (i,j) = n-    in if min i j <= 1-       then (n,x)-       else bjorklund' (if i > j then left (n,x) else right (n,x))--bjorklund :: (Int,Int) -> [Bool]-bjorklund (i,j') =-    let j = j' - i-        x = replicate i [True]-        y = replicate j [False]-        (_,(x',y')) = bjorklund' ((i,j),(x,y))-    in concat x' ++ concat y'

@@ -1,166 +0,0 @@-module Sound.Tidal.Chords where--import Sound.Tidal.Pattern-import Data.Maybe-import Control.Applicative--major :: Num a => [a]-major = [0,4,7]-minor :: Num a => [a]-minor = [0,3,7]-major7 :: Num a => [a]-major7 = [0,4,7,11]-dom7 :: Num a => [a]-dom7 = [0,4,7,10]-minor7 :: Num a => [a]-minor7 = [0,3,7,10]-aug :: Num a => [a]-aug = [0,4,8]-dim :: Num a => [a]-dim = [0,3,6]-dim7 :: Num a => [a]-dim7 = [0,3,6,9]-one :: Num a => [a]-one = [0]-five :: Num a => [a]-five = [0,7]-plus :: Num a => [a]-plus = [0,4,8]-sharp5 :: Num a => [a]-sharp5 = [0,4,8]-msharp5 :: Num a => [a]-msharp5 = [0,3,8]-sus2 :: Num a => [a]-sus2 = [0,2,7]-sus4 :: Num a => [a]-sus4 = [0,5,7]-six :: Num a => [a]-six = [0,4,7,9]-m6 :: Num a => [a]-m6 = [0,3,7,9]-sevenSus2 :: Num a => [a]-sevenSus2 = [0,2,7,10]-sevenSus4 :: Num a => [a]-sevenSus4 = [0,5,7,10]-sevenFlat5 :: Num a => [a]-sevenFlat5 = [0,4,6,10]-m7flat5 :: Num a => [a]-m7flat5 = [0,3,6,10]-sevenSharp5 :: Num a => [a]-sevenSharp5 = [0,4,8,10]-m7sharp5 :: Num a => [a]-m7sharp5 = [0,3,8,10]-nine :: Num a => [a]-nine = [0,4,7,10,14]-m9 :: Num a => [a]-m9 = [0,3,7,10,14]-m7sharp9 :: Num a => [a]-m7sharp9 = [0,3,7,10,14]-maj9 :: Num a => [a]-maj9 = [0,4,7,11,14]-nineSus4 :: Num a => [a]-nineSus4 = [0,5,7,10,14]-sixby9 :: Num a => [a]-sixby9 = [0,4,7,9,14]-m6by9 :: Num a => [a]-m6by9 = [0,3,9,7,14]-sevenFlat9 :: Num a => [a]-sevenFlat9 = [0,4,7,10,13]-m7flat9 :: Num a => [a]-m7flat9 = [0,3,7,10,13]-sevenFlat10 :: Num a => [a]-sevenFlat10 = [0,4,7,10,15]-nineSharp5 :: Num a => [a]-nineSharp5 = [0,1,13]-m9sharp5 :: Num a => [a]-m9sharp5 = [0,1,14]-sevenSharp5flat9 :: Num a => [a]-sevenSharp5flat9 = [0,4,8,10,13]-m7sharp5flat9 :: Num a => [a]-m7sharp5flat9 = [0,3,8,10,13]-eleven :: Num a => [a]-eleven = [0,4,7,10,14,17]-m11 :: Num a => [a]-m11 = [0,3,7,10,14,17]-maj11 :: Num a => [a]-maj11 = [0,4,7,11,14,17]-evelenSharp :: Num a => [a]-evelenSharp = [0,4,7,10,14,18]-m11sharp :: Num a => [a]-m11sharp = [0,3,7,10,14,18]-thirteen :: Num a => [a]-thirteen = [0,4,7,10,14,17,21]-m13 :: Num a => [a]-m13 = [0,3,7,10,14,17,21]---- | @chordate cs m n@ selects the @n@th "chord" (a chord is a list of Ints)--- from a list of chords @cs@ and transposes it by @m@-chordate :: Num b => [[b]] -> b -> Int -> [b]-chordate cs m n = map (+m) $ cs!!n---- | @enchord chords pn pc@ turns every note in the note pattern @pn@ into--- a chord, selecting from the chord lists @chords@ using the index pattern--- @pc@.  For example, @Chords.enchord [Chords.major Chords.minor] "c g" "0 1"@--- will create a pattern of a C-major chord followed by a G-minor chord.-enchord :: Num a => [[a]] -> Pattern a -> Pattern Int -> Pattern a-enchord chords pn pc = flatpat $ (chordate chords) <$> pn <*> pc--chordTable :: Num a => [(String, [a])]-chordTable = [("major", major),-              ("minor", minor),-              ("major7", major7),-              ("dom7", dom7),-              ("minor7", minor7),-              ("aug", aug),-              ("dim", dim),-              ("dim7", dim7),-              ("one", one),-              ("five", five),-              ("plus", plus),-              ("sharp5", sharp5),-              ("msharp5", msharp5),-              ("sus2", sus2),-              ("sus4", sus4),-              ("six", six),-              ("m6", m6),-              ("sevenSus2", sevenSus2),-              ("sevenSus4", sevenSus4),-              ("sevenFlat5", sevenFlat5),-              ("m7flat5", m7flat5),-              ("sevenSharp5", sevenSharp5),-              ("m7sharp5", m7sharp5),-              ("nine", nine),-              ("m9", m9),-              ("m7sharp9", m7sharp9),-              ("maj9", maj9),-              ("nineSus4", nineSus4),-              ("sixby9", sixby9),-              ("m6by9", m6by9),-              ("sevenFlat9", sevenFlat9),-              ("m7flat9", m7flat9),-              ("sevenFlat10", sevenFlat10),-              ("nineSharp5", nineSharp5),-              ("m9sharp5", m9sharp5),-              ("sevenSharp5flat9", sevenSharp5flat9),-              ("m7sharp5flat9", m7sharp5flat9),-              ("eleven", eleven),-              ("m11", m11),-              ("maj11", maj11),-              ("evelenSharp", evelenSharp),-              ("m11sharp", m11sharp),-              ("thirteen", thirteen),-              ("m13", m13)-             ]--chordL :: Num a => Pattern String -> Pattern [a]-chordL p = (\name -> fromMaybe [] $ lookup name chordTable) <$> p---- | @chord p@ turns a pattern of chord names into a pattern of--- numbers, representing note value offsets for the chords-chord :: Num a => Pattern String -> Pattern a-chord p = flatpat $ chordL p---- | @arpg p@ turns a pattern of chord names into a pattern of arpeggios--- of the those chords respectively-arpg :: Num a => Pattern String -> Pattern a-arpg p = breakUp $ chord p

@@ -1,27 +0,0 @@-module Sound.Tidal.Context (module C) where--import Control.Concurrent as C-import Data.List as C-import Control.Applicative as C-import Data.Ratio as C-import Data.Monoid as C-import Sound.Tidal.Parse as C-import Sound.Tidal.Pattern as C--- import Sound.Tidal.PatternList as C-import Sound.Tidal.Stream as C-import Sound.Tidal.Dirt as C-import Sound.Tidal.Strategies as C-import Sound.Tidal.Tempo as C-import Sound.Tidal.Time as C-import Sound.Tidal.Sieve as C-import Sound.Tidal.SuperCollider as C-import Sound.Tidal.Params as C-import Sound.Tidal.Transition as C-import Sound.Tidal.EspGrid as C-import Sound.Tidal.MultiMode as C-import Sound.Tidal.Version as C-import Sound.Tidal.Chords as C (chord)-import Sound.Tidal.Scales as C (scaleP)--import qualified Sound.Tidal.Scales as C.Scales-import qualified Sound.Tidal.Chords as C.Chords

@@ -1,390 +0,0 @@-{-# LANGUAGE NoMonomorphismRestriction #-}-module Sound.Tidal.Dirt where--import Sound.OSC.Datum (Datum)-import qualified Data.Map as Map-import Control.Applicative-import Control.Concurrent.MVar---import Visual-import Data.Colour.SRGB-import Data.Colour.Names-import Data.Hashable-import Data.Bits-import Data.Maybe-import Data.Fixed-import Data.Ratio-import Data.List (elemIndex, sort)--import Sound.Tidal.Stream-import Sound.Tidal.OscStream-import Sound.Tidal.Pattern-import Sound.Tidal.Parse-import Sound.Tidal.Params-import Sound.Tidal.Time-import Sound.Tidal.Tempo-import Sound.Tidal.Transition (transition, wash)-import Sound.Tidal.Utils (enumerate, fst')--dirt :: Shape-dirt = Shape {   params = [ s_p,-                            offset_p,-                            begin_p,-                            end_p,-                            speed_p,-                            pan_p,-                            velocity_p,-                            vowel_p,-                            cutoff_p,-                            resonance_p,-                            accelerate_p,-                            shape_p,-                            kriole_p,-                            gain_p,-                            cut_p,-                            delay_p,-                            delaytime_p,-                            delayfeedback_p,-                            crush_p,-                            coarse_p,-                            hcutoff_p,-                            hresonance_p,-                            bandf_p,-                            bandq_p,-                            unit_p,-                            loop_p,-                            n_p,-                            attack_p,-                            hold_p,-                            release_p,-                            orbit_p-                          ],-                 cpsStamp = True,-                 latency = 0.3-                }--dirtSlang = OscSlang {-  path = "/play",-  timestamp = MessageStamp,-  namedParams = False,-  preamble = []-  }--superDirtSlang = dirtSlang { timestamp = BundleStamp, path = "/play2", namedParams = True }--superDirtBackend port = do-  s <- makeConnection "127.0.0.1" port superDirtSlang-  return $ Backend s (\_ _ _ -> return ())--superDirtState port = do-  backend <- superDirtBackend port-  Sound.Tidal.Stream.state backend dirt--dirtBackend = do-  s <- makeConnection "127.0.0.1" 7771 dirtSlang-  return $ Backend s (\_ _ _ -> return ())---- dirtstart name = start "127.0.0.1" 7771 dirt--dirtStream = do-  backend <- dirtBackend-  stream backend dirt--dirtState = do-  backend <- dirtBackend-  Sound.Tidal.Stream.state backend dirt--dirtSetters :: IO Time -> IO (ParamPattern -> IO (), (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ())-dirtSetters getNow = do ds <- dirtState-                        return (setter ds, transition getNow ds)--superDirtSetters :: IO Time -> IO (ParamPattern -> IO (), (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ())-superDirtSetters getNow = do ds <- superDirtState 57120-                             return (setter ds, transition getNow ds)---superDirts :: [Int]  -> IO [(ParamPattern -> IO (), (Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ())]-superDirts ports = do (_, getNow) <- cpsUtils-                      states <- mapM (superDirtState) ports-                      return $ map (\state -> (setter state, transition getNow state)) states---- -- disused parameter..-dirtstream _ = dirtStream---- doubledirt = do remote <- stream "178.77.72.138" 7777 dirt---                 local <- stream "192.168.0.102" 7771 dirt---                 return $ \p -> do remote p---                                   local p---                                   return ()---dirtToColour :: ParamPattern -> Pattern ColourD---dirtToColour p = s---  where s = fmap (\x -> maybe black (datumToColour) (Map.lookup (param dirt "s") x)) p-dirtToColour = fmap (stringToColour . show)--showToColour :: Show a => a -> ColourD-showToColour = stringToColour . show--datumToColour :: Value -> ColourD-datumToColour = showToColour--stringToColour :: String -> ColourD-stringToColour s = sRGB (r/256) (g/256) (b/256)-  where i = (hash s) `mod` 16777216-        r = fromIntegral $ (i .&. 0xFF0000) `shiftR` 16;-        g = fromIntegral $ (i .&. 0x00FF00) `shiftR` 8;-        b = fromIntegral $ (i .&. 0x0000FF);--{--visualcallback :: IO (ParamPattern -> IO ())-visualcallback = do t <- ticker-                    mv <- startVis t-                    let f p = do let p' = dirtToColour p-                                 swapMVar mv p'-                                 return ()-                    return f--}----dirtyvisualstream name = do cb <- visualcallback---                            streamcallback cb "127.0.0.1" "127.0.0.1" name "127.0.0.1" 7771 dirt--pick :: String -> Int -> String-pick name n = name ++ ":" ++ (show n)--{- | Striate is a kind of granulator, for example:--@-d1 $ striate 3 $ sound "ho ho:2 ho:3 hc"-@--This plays the loop the given number of times, but triggering-progressive portions of each sample. So in this case it plays the loop-three times, the first time playing the first third of each sample,-then the second time playing the second third of each sample, etc..-With the highhat samples in the above example it sounds a bit like-reverb, but it isn't really.--You can also use striate with very long samples, to cut it into short-chunks and pattern those chunks. This is where things get towards-granular synthesis. The following cuts a sample into 128 parts, plays-it over 8 cycles and manipulates those parts by reversing and rotating-the loops.--@-d1 $  slow 8 $ striate 128 $ sound "bev"-@--}--striate :: Pattern Int -> ParamPattern -> ParamPattern-striate = temporalParam _striate--_striate :: Int -> ParamPattern -> ParamPattern-_striate n p = fastcat $ map (\x -> off (fromIntegral x) p) [0 .. n-1]-  where off i p = p-                  # begin (atom (fromIntegral i / fromIntegral n))-                  # end (atom (fromIntegral (i+1) / fromIntegral n))--{-|-The `striate'` function is a variant of `striate` with an extra-parameter, which specifies the length of each part. The `striate'`-function still scans across the sample over a single cycle, but if-each bit is longer, it creates a sort of stuttering effect. For-example the following will cut the bev sample into 32 parts, but each-will be 1/16th of a sample long:--@-d1 $ slow 32 $ striate' 32 (1/16) $ sound "bev"-@--Note that `striate` uses the `begin` and `end` parameters-internally. This means that if you're using `striate` (or `striate'`)-you probably shouldn't also specify `begin` or `end`. -}-striate' :: Pattern Int -> Pattern Double -> ParamPattern -> ParamPattern-striate' = temporalParam2 _striate'--_striate' :: Int -> Double -> ParamPattern -> ParamPattern-_striate' n f p = fastcat $ map (\x -> off (fromIntegral x) p) [0 .. n-1]-  where off i p = p # begin (atom (slot * i) :: Pattern Double) # end (atom ((slot * i) + f) :: Pattern Double)-        slot = (1 - f) / (fromIntegral n)--{- | like `striate`, but with an offset to the begin and end values -}-striateO :: Pattern Int -> Pattern Double -> ParamPattern -> ParamPattern-striateO = temporalParam2 _striateO--_striateO :: Int -> Double -> ParamPattern -> ParamPattern-_striateO n o p = _striate n p |+| begin (atom o :: Pattern Double) |+| end (atom o :: Pattern Double)--{- | Just like `striate`, but also loops each sample chunk a number of times specified in the second argument.-The primed version is just like `striate'`, where the loop count is the third argument. For example:--@-d1 $ striateL' 3 0.125 4 $ sound "feel sn:2"-@--Like `striate`, these use the `begin` and `end` parameters internally, as well as the `loop` parameter for these versions.--}-striateL :: Pattern Int -> Pattern Int -> ParamPattern -> ParamPattern-striateL = temporalParam2 _striateL--striateL' :: Pattern Int -> Pattern Double -> Pattern Int -> ParamPattern -> ParamPattern-striateL' = temporalParam3 _striateL'--_striateL :: Int -> Int -> ParamPattern -> ParamPattern-_striateL n l p = _striate n p # loop (atom $ fromIntegral l)-_striateL' n f l p = _striate' n f p # loop (atom $ fromIntegral l)--metronome = _slow 2 $ sound (p "[odx, [hh]*8]")--{-|-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 (fadeOut' now t p') (fadeIn' now t p)--{-|-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--{- | crossfades between old and new pattern over given number of cycles, e.g.:--@-d1 $ sound "bd sn"--t1 (xfadeIn 16) $ sound "jvbass*3"-@--Will fade over 16 cycles from "bd sn" to "jvbass*3"--}-xfadeIn :: Time -> Time -> [ParamPattern] -> ParamPattern-xfadeIn _ _ [] = silence-xfadeIn _ _ (p:[]) = p-xfadeIn t now (p:p':_) = overlay (p |*| gain (now `rotR` (_slow t envEqR))) (p' |*| gain (now `rotR` (_slow t (envEq))))--{- |-Crossfade between old and new pattern over the next two cycles.--@-d1 $ sound "bd sn"--t1 xfade $ sound "can*3"-@--`xfade` is built with `xfadeIn` in this case taking two cycles for the fade.--}-xfade :: Time -> [ParamPattern] -> ParamPattern-xfade = xfadeIn 2--{- | Stut applies a type of delay to a pattern. It has three parameters,-which could be called depth, feedback and time. Depth is an integer-and the others floating point. This adds a bit of echo:--@-d1 $ stut 4 0.5 0.2 $ sound "bd sn"-@--The above results in 4 echos, each one 50% quieter than the last,-with 1/5th of a cycle between them. It is possible to reverse the echo:--@-d1 $ stut 4 0.5 (-0.2) $ sound "bd sn"-@--}--stut :: Pattern Integer -> Pattern Double -> Pattern Rational -> ParamPattern -> ParamPattern-stut = temporalParam3 _stut--_stut :: Integer -> Double -> Rational -> ParamPattern -> ParamPattern-_stut steps feedback time p = stack (p:(map (\x -> (((x%steps)*time) `rotR` (p |*| gain (pure $ scale (fromIntegral x))))) [1..(steps-1)]))-  where scale x-          = ((+feedback) . (*(1-feedback)) . (/(fromIntegral steps)) . ((fromIntegral steps)-)) x--{- | Instead of just decreasing volume to produce echoes, @stut'@ allows to apply a function for each step and overlays the result delayed by the given time.--@-d1 $ stut' 2 (1%3) (# vowel "{a e i o u}%2") $ sound "bd sn"-@--In this case there are two _overlays_ delayed by 1/3 of a cycle, where each has the @vowel@ filter applied.--}-stut' :: Pattern Int -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-stut' n t f p = unwrap $ (\a b -> _stut' a b f p) <$> n <*> t--_stut' :: (Num n, Ord n) => n -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-_stut' steps steptime f p | steps <= 0 = p-                         | otherwise = overlay (f (steptime `rotR` _stut' (steps-1) steptime f p)) p--{- | @durPattern@ takes a pattern and returns the length of events in that-pattern as a new pattern.  For example the result of `durPattern "[a ~] b"`-would be `"[0.25 ~] 0.5"`.--}--durPattern :: Pattern a -> Pattern Time-durPattern p = Pattern $ \a -> map eventLengthEvent $ arc p a-  where eventLengthEvent (a1@(s1,e1), a2, x) = (a1, a2, e1-s1)--{- | @durPattern'@ is similar to @durPattern@, but does some lookahead to try-to find the length of time to the *next* event. For example, the result of-`durPattern' "[a ~] b"` would be `"[0.5 ~] 0.5"`.--}--durPattern' :: Pattern a -> Pattern Time-durPattern' p = Pattern $ \a@(s,e) -> map (eventDurToNext (arc p (s,e+1))) (arc p a)-      where eventDurToNext evs ev@(a1,a2,x) = (a1, a2, (nextNum (t ev) (mt evs)) - (t ev))-            t = fst . fst'-            mt = (map fst) . (map fst')-            nextNum a = head . sort . filter (\x -> x >a)--{- | @stutx@ is like @stut'@ but will limit the number of repeats using the -duration of the original sound.  This usually prevents overlapping "stutters"-from subsequent sounds.--}--stutx :: Pattern Int -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-stutx n t f p = stut' (liftA2 min n (fmap floor $ durPattern' p / (t+0.001))) t f 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 -> [ParamPattern] -> ParamPattern-anticipateIn t now = wash (spread' (_stut 8 0.2) (now `rotR` (_slow t $ (toRational . (1-)) <$> envL))) t now--{- | `anticipate` is an increasing comb filter.--Build up some tension, culminating in a _drop_ to the new pattern after 8 cycles.--}-anticipate :: Time -> [ParamPattern] -> ParamPattern-anticipate = anticipateIn 8--{- | Copies the @n@ parameter to the @orbit@ parameter, so different sound variants or notes go to different orbits in SuperDirt. -}-nToOrbit = copyParam n_p orbit_p--{- | Maps the sample or synth names to different @orbit@s, using indexes from the given list. E.g. @soundToOrbit ["bd", "sn", "cp"] $ sound "bd [cp sn]"@ would cause the bd, sn and cp smamples to be sent to orbit 0, 1, 2 respectively.-}-soundToOrbit :: [String] -> ParamPattern -> ParamPattern-soundToOrbit sounds p = follow s_p orbit_p ((\s -> fromMaybe 0 $ elemIndex s sounds) <$>) p

@@ -1,114 +0,0 @@-module Sound.Tidal.EspGrid where
-
-import Control.Concurrent.MVar
-import Control.Concurrent
-import Control.Monad (forever)
-import Control.Monad.Loops (iterateM_)
-import Sound.OSC.FD
-import Data.Time.Clock
-import Data.Time.Clock.POSIX
-import Data.Time.Calendar (fromGregorian)
-
-import Sound.Tidal.Tempo
-import Sound.Tidal.Time as T
-import Sound.Tidal.Stream
-import Sound.Tidal.Dirt
-import Sound.Tidal.Transition (transition)
-import Sound.Tidal.Pattern (silence)
-
-parseEspTempo :: [Datum] -> Maybe Tempo
-parseEspTempo d = do
-  on <- datum_integral (d!!0)
-  bpm <- datum_floating (d!!1)
-  t1 <- datum_integral (d!!2)
-  t2 <- datum_integral (d!!3)
-  n <- datum_integral (d!!4)
-  let nanos = (t1*1000000000) + t2
-  let utc = posixSecondsToUTCTime ((realToFrac nanos)/1000000000)
-  return (Tempo utc (fromIntegral n) (bpm/60) (on==0) 0.04)
-
-changeTempo :: MVar Tempo -> Packet -> IO ()
-changeTempo mvar (Packet_Message msg) = do
-    case parseEspTempo (messageDatum msg) of
-      Just t -> tryTakeMVar mvar >> putMVar mvar t
-      Nothing -> putStrLn "Unable to parse message as Tempo"
-changeTempo _ _ = putStrLn "Can only process Packet_Message"
-
-getTempo :: MVar Tempo -> IO Tempo
-getTempo = readMVar
-
-runClientEsp :: IO (MVar Tempo,MVar Double)
-runClientEsp = do
-  mTempo <- newEmptyMVar
-  mCps <- newEmptyMVar
-  socket <- openUDP "127.0.0.1" 5510
-  forkIO $ forever $ do
-    sendOSC socket $ Message "/esp/tempo/q" []
-    response <- waitAddress socket "/esp/tempo/r"
-    changeTempo mTempo response
-    threadDelay 100000
-  return (mTempo, mCps)
-
-sendEspTempo :: Real t => t -> IO ()
-sendEspTempo t = do
-  socket <- openUDP "127.0.0.1" 5510
-  sendOSC socket $ Message "/esp/beat/tempo" [float (t*60)]
-
-cpsUtilsEsp :: IO (Double -> IO (), IO Rational, IO Tempo)
-cpsUtilsEsp = do
-  (mTempo,mCps) <- runClientEsp
-  return (sendEspTempo,getCurrentBeat mTempo,getTempo mTempo)
-
-clockedTickEsp :: Int -> (Tempo -> Int -> IO ()) -> IO ()
-clockedTickEsp tpb callback = do
-  (mTempo, _) <- runClientEsp
-  nowBeat <- getCurrentBeat mTempo
-  let nextTick = ceiling (nowBeat * (fromIntegral tpb))
-  iterateM_ (clockedTickLoopEsp tpb callback mTempo) nextTick
-
-clockedTickLoopEsp :: Int -> (Tempo -> Int -> IO ()) -> MVar Tempo -> Int -> IO Int
-clockedTickLoopEsp tpb callback mTempo tick = do
-  tempo <- readMVar mTempo
-  if (paused tempo)
-    then do  -- TODO - do this via blocking read on the mvar somehow rather than polling
-      let pause = 0.01
-      threadDelay $ floor (pause * 1000000)
-      return $ if cps tempo < 0 then 0 else tick  -- reset tick to 0 if cps is negative
-    else do
-      now <- getCurrentTime
-      let beatsFromAtToTick = fromIntegral tick / fromIntegral tpb - beat tempo
-          delayUntilTick = beatsFromAtToTick / cps tempo - realToFrac (diffUTCTime now (at tempo))
-      threadDelay $ floor (delayUntilTick * 1000000)
-      callback tempo tick
-      return $ tick + 1
-
-streamEsp :: Backend a -> Shape -> IO (ParamPattern -> IO ())
-streamEsp backend shape = do
-  patternM <- newMVar silence
-  forkIO $ clockedTickEsp ticksPerCycle (onTick backend shape patternM)
-  return $ \p -> do swapMVar patternM p
-                    return ()
-
-dirtStreamEsp :: IO (ParamPattern -> IO ())
-dirtStreamEsp = do
-  backend <- dirtBackend
-  streamEsp backend dirt
-
-stateEsp :: Backend a -> Shape -> IO (MVar (ParamPattern, [ParamPattern]))
-stateEsp backend shape = do
-  patternsM <- newMVar (silence, [])
-  let ot = (onTick' backend shape patternsM) :: Tempo -> Int -> IO ()
-  forkIO $ clockedTickEsp ticksPerCycle ot
-  return patternsM
-
-dirtSettersEsp :: IO T.Time -> IO (ParamPattern -> IO (), (T.Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ())
-dirtSettersEsp getNow = do
-  backend <- dirtBackend
-  ds <- stateEsp backend dirt
-  return (setter ds, transition getNow ds)
-
-superDirtSettersEsp :: IO T.Time -> IO (ParamPattern -> IO (), (T.Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ())
-superDirtSettersEsp getNow = do
-  backend <- superDirtBackend 57120
-  ds <- stateEsp backend dirt
-  return (setter ds, transition getNow ds)

@@ -1,106 +0,0 @@-module Sound.Tidal.MultiMode where
-
-import Control.Concurrent.MVar
-import Control.Concurrent
-import Control.Monad (forever)
-import Control.Monad.Loops (iterateM_)
-import Sound.OSC.FD
-import Data.Time.Clock
-import Data.Time.Clock.POSIX
-import Data.Time.Calendar (fromGregorian)
-
-import Sound.Tidal.Tempo
-import Sound.Tidal.Time as T
-import Sound.Tidal.Stream
-import Sound.Tidal.Dirt
-import Sound.Tidal.EspGrid
-import Sound.Tidal.Transition (transition)
-import Sound.Tidal.Pattern (silence)
-
-data StreamType = Dirt | SuperDirt
-
-data SyncType = NoSync | Esp
-
-initializeStreamType :: IO (MVar StreamType)
-initializeStreamType = newMVar SuperDirt
-
-changeStreamType :: MVar StreamType -> StreamType -> IO (IO StreamType)
-changeStreamType mvar t = return (swapMVar mvar t)
-
-initializeSyncType :: IO (MVar SyncType)
-initializeSyncType = newMVar NoSync
-
-changeSyncType :: MVar SyncType -> SyncType -> IO (IO SyncType)
-changeSyncType mvar t = return (swapMVar mvar t)
-
-type CpsUtils = (Double -> IO(), IO Rational)
-
-multiModeCpsUtils :: CpsUtils -> CpsUtils -> MVar SyncType -> IO CpsUtils
-multiModeCpsUtils (cpsNone,getNowNone) (cpsEsp,getNowEsp) mSync = return (cps,getNow)
-  where cps x = do s <- readMVar mSync
-                   case s of NoSync -> cpsNone x
-                             Esp -> cpsEsp x
-        getNow = do s <- readMVar mSync
-                    case s of NoSync -> getNowNone
-                              Esp -> getNowEsp
-
-multiModeSetters :: IO Rational -> IO Rational -> MVar SyncType -> MVar StreamType -> IO (ParamPattern -> IO ())
-multiModeSetters getNowNone getNowEsp mSync mStream = do
-  (classicDirt,tClassic) <- dirtSetters getNowNone
-  (espDirt,tEsp) <- dirtSettersEsp getNowEsp
-  (superDirt,tSuper) <- superDirtSetters getNowNone
-  (espSuperDirt,tEspSuper) <- superDirtSettersEsp getNowEsp
-  let f NoSync Dirt p = do classicDirt p
-                           espDirt silence
-                           superDirt silence
-                           espSuperDirt silence
-      f Esp Dirt p = do espDirt p
-                        classicDirt silence
-                        superDirt silence
-                        espSuperDirt silence
-      f NoSync SuperDirt p = do superDirt p
-                                classicDirt silence
-                                espDirt silence
-                                espSuperDirt silence
-      f Esp SuperDirt p = do espSuperDirt p
-                             classicDirt silence
-                             espDirt silence
-                             superDirt silence
-  return $ \p -> readMVar mSync >>= \s -> readMVar mStream >>= \t -> f s t p
-
-{-
-
-Example of using the above definitions:
-(note: if using Atom, evaluate each of the lines below one by one using shift-Enter)
-
-syncType <- initializeSyncType
-nosync <- changeSyncType syncType NoSync
-esp <- changeSyncType syncType Esp
-(cpsNone,getNowNone) <- cpsUtils
-(cpsEsp,getNowEsp,getTempoEsp) <- cpsUtilsEsp
-(cps,getNow) <- multiModeCpsUtils (cpsNone,getNowNone) (cpsEsp,getNowEsp) syncType
-
-streamType <- initializeStreamType
-classicDirt <- changeStreamType streamType Dirt
-superDirt <- changeStreamType streamType SuperDirt
-d1 <- multiModeSetters getNowNone getNowEsp syncType streamType
-d2 <- multiModeSetters getNowNone getNowEsp syncType streamType
-d3 <- multiModeSetters getNowNone getNowEsp syncType streamType
-d4 <- multiModeSetters getNowNone getNowEsp syncType streamType
-d5 <- multiModeSetters getNowNone getNowEsp syncType streamType
-d6 <- multiModeSetters getNowNone getNowEsp syncType streamType
-d7 <- multiModeSetters getNowNone getNowEsp syncType streamType
-d8 <- multiModeSetters getNowNone getNowEsp syncType streamType
-d9 <- multiModeSetters getNowNone getNowEsp syncType streamType
-d10 <- multiModeSetters getNowNone getNowEsp syncType streamType
-
-let bps x = cps (x/2)
-let hush = mapM_ ($ silence) [d1,d2,d3,d4,d5,d6,d7,d8,d9,d10]
-let solo = (>>) hush
-
-then you can evaluate "classicDirt" to switch to classic Dirt
-and "superDirt" to switch back to SuperDirt (the default)
-and "esp" to turn on EspGrid-aware synchronization
-and "nosync" to switch off EspGrid-aware synchronization (the default)
-(switching between sync types is only noticeable after the next time a pattern is redefined right now)
--}

@@ -1,91 +0,0 @@-module Sound.Tidal.OscStream where--import qualified Data.Map as Map-import Data.Maybe-import Sound.Tidal.Tempo (Tempo, cps)-import Sound.Tidal.Stream-import Sound.Tidal.Utils-import GHC.Float (float2Double, double2Float)-import Sound.OSC.FD-import Sound.OSC.Datum-import Sound.Tidal.Params--data TimeStamp = BundleStamp | MessageStamp | NoStamp- deriving Eq--data OscSlang = OscSlang {path :: String,-                          timestamp :: TimeStamp,-                          namedParams :: Bool,-                          preamble :: [Datum]-                         }--type OscMap = Map.Map Param Datum--toOscDatum :: Value -> Datum-toOscDatum (VF x) = float x-toOscDatum (VI x) = int32 x-toOscDatum (VS x) = string x--toOscMap :: ParamMap -> OscMap-toOscMap m = Map.map (toOscDatum) m---- constructs and sends an Osc Message according to the given slang--- and other params - this is essentially the same as the former--- toMessage in Stream.hs--send-  :: (Integral a) =>-     UDP-     -> OscSlang-     -> Shape-     -> Tempo-     -> a-     -> (Double,-         Double,-         OscMap)-     -> IO ()-send s slang shape change tick (on, off, m) = osc-    where-      osc | timestamp slang == BundleStamp =-            sendOSC s $ Bundle (ut_to_ntpr logicalOnset) [Message (path slang) oscdata]-          | timestamp slang == MessageStamp =-            sendOSC s $ Message (path slang) ((int32 sec):(int32 usec):oscdata)-          | otherwise =-            doAt logicalOnset $ sendOSC s $ Message (path slang) oscdata-      oscPreamble = cpsPrefix ++ preamble slang-      oscdata | namedParams slang = oscPreamble ++ (concatMap (\(k, v) -> [string (name k), v] )-                                                    $ Map.assocs m)-              | otherwise = oscPreamble ++ (catMaybes $ map (\x -> Map.lookup x m) (params shape))-      cpsPrefix | cpsStamp shape && namedParams slang = [string "cps",-                                                         float (cps change),-                                                         string "delta",-                                                         float (logicalOffset-                                                                - logicalOnset),-                                                         string "cycle", float cycle-                                                        ]-                | cpsStamp shape = [float (cps change)]-                | otherwise = []-      cycle = (on + fromIntegral tick) / (fromIntegral ticksPerCycle)-      _parameterise ds = mergelists (map (string . name) (params shape)) ds-      usec = floor $ 1000000 * (logicalOnset - (fromIntegral sec))-      sec = floor logicalOnset-      logicalOnset = logicalOnset' change tick on ((latency shape) + nudge)-      logicalOffset = logicalOnset' change tick off ((latency shape) + nudge)-      nudge = maybe 0 (toF) (Map.lookup nudge_p (m :: OscMap))-      toF (Float f) = float2Double f-      toF _ = 0---- type OscMap = Map.Map Param (Maybe Datum)-              --- Returns a function that will convert a generic ParamMap into a specific Osc message and send it over UDP to the supplied server--- messages will be built according to the given OscSlang-makeConnection :: String -> Int -> OscSlang -> IO (ToMessageFunc)-makeConnection address port slang = do-  s <- openUDP address port-  return (\ shape change tick (on,off,m) -> do-             let m' = if (namedParams slang) then (Just m) else (applyShape' shape m)-             -- this might result in Nothing, make sure we do this first-             m'' <- fmap (toOscMap) m'-             -- to allow us to simplify `send` (no `do`)-             return $ send s slang shape change tick (on,off,m'')-         )

@@ -1,391 +0,0 @@-module Sound.Tidal.Params where--import Sound.Tidal.Stream-import Sound.Tidal.Pattern-import qualified Data.Map as Map-import Sound.Tidal.Utils-import Control.Applicative---- | group multiple params into one-grp :: [Param] -> Pattern String -> ParamPattern-grp [] _ = silence-grp params p = (fmap lookupPattern p)-  where lookupPattern :: String -> ParamMap-        lookupPattern s = Map.fromList $ map (\(param,s') -> toPV param s') $ zip params $ (split s)-        split s = wordsBy (==':') s-        toPV :: Param -> String -> (Param, Value)-        toPV param@(S _ _) s = (param, (VS s))-        toPV param@(F _ _) s = (param, (VF $ read s))-        toPV param@(I _ _) s = (param, (VI $ read s))-{- |--A pattern of strings representing sounds or synth notes.--Internally, `sound` or its shorter alias `s` is a combination of the samplebank name and number when used with samples, or synth name and note number when used with a synthesiser. For example `bd:2` specifies the third sample (not the second as you might expect, because we start counting at zero) in the `bd` sample folder.--*Internally, `sound`/`s` is a combination of two parameters, the-hidden parameter `s'` which specifies the samplebank or synth, and the-`n` parameter which specifies the sample or note number. For example:--@-d1 $ sound "bd:2 sn:0"-@--is essentially the same as:--@-d1 $ s' "bd sn" # n "2 0"-@--`n` is therefore useful when you want to pattern the sample or note-number separately from the samplebank or synth. For example:--@-d1 $ n "0 5 ~ 2" # sound "drum"-@--is equivalent to:--@-d1 $ sound "drum:0 drum:5 ~ drum:2"-@--}-sound :: Pattern String -> ParamPattern-sound = grp [s_p, n_p]-s = sound--pF name defaultV = (make' VF param, param)-  where param = F name defaultV-pI name defaultV = (make' VI param, param)-  where param = I name defaultV-pS name defaultV = (make' VS param, param)-  where param = S name defaultV--- | a pattern of numbers that speed up (or slow down) samples while they play.-(accelerate, accelerate_p)       = pF "accelerate" (Just 0)--- | a pattern of numbers to specify the attack time (in seconds) of an envelope applied to each sample. Only takes effect if `release` is also specified.-(attack, attack_p)               = pF "attack" (Just (-1))--- | a pattern of numbers from 0 to 1. Sets the center frequency of the band-pass filter.-(bandf, bandf_p)                 = pF "bandf" (Just 0)--- | a pattern of numbers from 0 to 1. Sets the q-factor of the band-pass filter.y-(bandq, bandq_p)                 = pF "bandq" (Just 0)-{- | a pattern of numbers from 0 to 1. Skips the beginning of each sample, e.g. `0.25` to cut off the first quarter from each sample.--Using `begin "-1"` combined with `cut "-1"` means that when the sample cuts itself it will begin playback from where the previous one left off, so it will sound like one seamless sample. This allows you to apply a synth param across a long sample in a way similar to `chop`:--@-cps 0.5--d1 $ sound "breaks125*8" # unit "c" # begin "-1" # cut "-1" # coarse "1 2 4 8 16 32 64 128"-@--This will play the `breaks125` sample and apply the changing `coarse` parameter over the sample. Compare to:--@-d1 $ (chop 8 $ sounds "breaks125") # unit "c" # coarse "1 2 4 8 16 32 64 128"-@--which performs a similar effect, but due to differences in implementation sounds different.--}-begin_p, channel_p, legato_p, clhatdecay_p, coarse_p, crush_p :: Param-begin, legato, clhatdecay, crush :: Pattern Double -> ParamPattern-channel, coarse :: Pattern Int -> ParamPattern-(begin, begin_p)                 = pF "begin" (Just 0)--- | choose the physical channel the pattern is sent to, this is super dirt specific-(channel, channel_p)             = pI "channel" Nothing----legato controls the amount of overlap between two adjacent synth sounds-(legato, legato_p)             = pF "legato" (Just 1)--(clhatdecay, clhatdecay_p)       = pF "clhatdecay" (Just 0)--- | fake-resampling, a pattern of numbers for lowering the sample rate, i.e. 1 for original 2 for half, 3 for a third and so on.-(coarse, coarse_p)               = pI "coarse" (Just 0)--- | bit crushing, a pattern of numbers from 1 (for drastic reduction in bit-depth) to 16 (for barely no reduction).-(crush, crush_p)                 = pF "crush" (Just 0)-{- |-In the style of classic drum-machines, `cut` will stop a playing sample as soon as another samples with in same cutgroup is to be played.--An example would be an open hi-hat followed by a closed one, essentially muting the open.--@-d1 $ stack [-  sound "bd",-  sound "~ [~ [ho:2 hc/2]]" # cut "1"-  ]-@--This will mute the open hi-hat every second cycle when the closed one is played.--Using `cut` with negative values will only cut the same sample. This is useful to cut very long samples--@-d1 $ sound "[bev, [ho:3](3,8)]" # cut "-1"-@--Using `cut "0"` is effectively _no_ cutgroup.--}-(cut, cut_p)                     = pI "cut" (Just 0)--- | a pattern of numbers from 0 to 1. Applies the cutoff frequency of the low-pass filter.-(cutoff, cutoff_p)               = pF "cutoff" (Just 0)-(cutoffegint, cutoffegint_p)     = pF "cutoffegint" (Just 0)-(decay, decay_p)                 = pF "decay" (Just 0)--- | a pattern of numbers from 0 to 1. Sets the level of the delay signal.-(delay, delay_p)                 = pF "delay" (Just 0)--- | a pattern of numbers from 0 to 1. Sets the amount of delay feedback.-(delayfeedback, delayfeedback_p) = pF "delayfeedback" (Just (-1))--- | a pattern of numbers from 0 to 1. Sets the length of the delay.-(delaytime, delaytime_p)         = pF "delaytime" (Just (-1))-(detune, detune_p)               = pF "detune" (Just 0)--- | when set to `1` will disable all reverb for this pattern. See `room` and `size` for more information about reverb.-(dry, dry_p)                     = pF "dry" (Just 0)-{- the same as `begin`, but cuts the end off samples, shortening them;-  e.g. `0.75` to cut off the last quarter of each sample.--}-(end, end_p)                     = pF "end" (Just 1)--- | a pattern of numbers that specify volume. Values less than 1 make the sound quieter. Values greater than 1 make the sound louder.-(gain, gain_p)                   = pF "gain" (Just 1)-(gate, gate_p)                   = pF "gate" (Just 0)-(hatgrain, hatgrain_p)           = pF "hatgrain" (Just 0)--- | a pattern of numbers from 0 to 1. Applies the cutoff frequency of the high-pass filter.-(hcutoff, hcutoff_p)             = pF "hcutoff" (Just 0)--- | a pattern of numbers to specify the hold time (in seconds) of an envelope applied to each sample. Only takes effect if `attack` and `release` are also specified.-(hold, hold_p)                   = pF "hold" (Just 0)--- | a pattern of numbers from 0 to 1. Applies the resonance of the high-pass filter.-(hresonance, hresonance_p)       = pF "hresonance" (Just 0)-(kriole, kriole_p)               = pI "kriole" (Just 0)-(lagogo, lagogo_p)               = pF "lagogo" (Just 0)-(lclap, lclap_p)                 = pF "lclap" (Just 0)-(lclaves, lclaves_p)             = pF "lclaves" (Just 0)-(lclhat, lclhat_p)               = pF "lclhat" (Just 0)-(lcrash, lcrash_p)               = pF "lcrash" (Just 0)-(leslie, leslie_p)               = pF "leslie" (Just 0)-(lrate, lrate_p)                 = pF "lrate" (Just 0)-(lsize, lsize_p)                 = pF "lsize" (Just 0) -(lfo, lfo_p)                     = pF "lfo" (Just 0)-(lfocutoffint, lfocutoffint_p)   = pF "lfocutoffint" (Just 0)-(lfodelay, lfodelay_p)           = pF "lfodelay" (Just 0)-(lfoint, lfoint_p)               = pF "lfoint" (Just 0)-(lfopitchint, lfopitchint_p)     = pF "lfopitchint" (Just 0)-(lfoshape, lfoshape_p)           = pF "lfoshape" (Just 0)-(lfosync, lfosync_p)             = pF "lfosync" (Just 0)-(lhitom, lhitom_p)               = pF "lhitom" (Just 0)-(lkick, lkick_p)                 = pF "lkick" (Just 0)-(llotom, llotom_p)               = pF "llotom" (Just 0)-{- |  A pattern of numbers. Specifies whether delaytime is calculated relative to cps. When set to 1, delaytime is a direct multiple of a cycle.--}-(lock, lock_p)                 = pF "lock" (Just 0)--- | loops the sample (from `begin` to `end`) the specified number of times.-(loop, loop_p)                   = pF "loop" (Just 1)-(lophat, lophat_p)               = pF "lophat" (Just 0)-(lsnare, lsnare_p)               = pF "lsnare" (Just 0)--- | specifies the sample or note number to be used-(n, n_p)                         = pF "n" (Just 0)-(note, note_p)                   = pF "note" (Just 0)-{- |-Pushes things forward (or backwards within built-in latency) in time. Allows for nice things like _swing_ feeling:--@-d1 $ stack [-  sound "bd bd/4",-  sound "hh(5,8)"-  ] # nudge "[0 0.04]*4"-@----pitch model -}--degree, mtranspose, ctranspose, harmonic, stepsPerOctave, octaveRatio :: Pattern Double -> ParamPattern-degree_p, mtranspose_p, ctranspose_p, harmonic_p, stepsPerOctave_p, octaveRatio_p :: Param-(degree, degree_p)               = pF "degree" Nothing-(mtranspose, mtranspose_p)       = pF "mtranspose" Nothing-(ctranspose, ctranspose_p)       = pF "ctranspose" Nothing-(harmonic, harmonic_p)           = pF "ctranspose" Nothing-(stepsPerOctave, stepsPerOctave_p)           = pF "stepsPerOctave" Nothing-(octaveRatio, octaveRatio_p)           = pF "octaveRatio" Nothing-----Low values will give a more _human_ feeling, high values might result in quite the contrary.--(nudge, nudge_p)                 = pF "nudge" (Just 0)-(octave, octave_p)               = pI "octave" (Just 3)-(offset, offset_p)               = pF "offset" (Just 0)-(ophatdecay, ophatdecay_p)       = pF "ophatdecay" (Just 0)-{- |  a pattern of numbers. An `orbit` is a global parameter context for patterns. Patterns with the same orbit will share hardware output bus offset and global effects, e.g. reverb and delay. The maximum number of orbits is specified in the superdirt startup, numbers higher than maximum will wrap around.--}-(orbit, orbit_p)                 = pI "orbit" (Just 0)--- | a pattern of numbers between 0 and 1, from left to right (assuming stereo), once round a circle (assuming multichannel)-(pan, pan_p)                     = pF "pan" (Just 0.5)--- | a pattern of numbers between -inf and inf, which controls how much multichannel output is fanned out (negative is backwards ordering)-(panspan, panspan_p)                     = pF "span" (Just 1.0)--- | a pattern of numbers between 0.0 and 1.0, which controls the multichannel spread range (multichannel only)-(pansplay, pansplay_p)                     = pF "splay" (Just 1.0)--- | a pattern of numbers between 0.0 and inf, which controls how much each channel is distributed over neighbours (multichannel only)-(panwidth, panwidth_p)                     = pF "panwidth" (Just 2.0)--- | a pattern of numbers between -1.0 and 1.0, which controls the relative position of the centre pan in a pair of adjacent speakers (multichannel only)-(panorient, panorient_p)                     = pF "orientation" (Just 0.5)--(pitch1, pitch1_p)               = pF "pitch1" (Just 0)-(pitch2, pitch2_p)               = pF "pitch2" (Just 0)-(pitch3, pitch3_p)               = pF "pitch3" (Just 0)-(portamento, portamento_p)       = pF "portamento" (Just 0)--- | a pattern of numbers to specify the release time (in seconds) of an envelope applied to each sample. Only takes effect if `attack` is also specified.-(release, release_p)             = pF "release" (Just (-1))--- | a pattern of numbers from 0 to 1. Specifies the resonance of the low-pass filter.-(resonance, resonance_p)         = pF "resonance" (Just 0)--- | a pattern of numbers from 0 to 1. Sets the level of reverb.-(room, room_p)                   = pF "room" Nothing-(sagogo, sagogo_p)               = pF "sagogo" (Just 0)-(sclap, sclap_p)                 = pF "sclap" (Just 0)-(sclaves, sclaves_p)             = pF "sclaves" (Just 0)-(scrash, scrash_p)               = pF "scrash" (Just 0)-(semitone, semitone_p)           = pF "semitone" (Just 0)--- | wave shaping distortion, a pattern of numbers from 0 for no distortion up to 1 for loads of distortion.-(shape, shape_p)                 = pF "shape" (Just 0)--- | a pattern of numbers from 0 to 1. Sets the perceptual size (reverb time) of the `room` to be used in reverb.-(size, size_p)                   = pF "size" Nothing-(slide, slide_p)                 = pF "slide" (Just 0)--- | a pattern of numbers which changes the speed of sample playback, i.e. a cheap way of changing pitch. Negative values will play the sample backwards!-(speed, speed_p)                 = pF "speed" (Just 1)--- | a pattern of strings. Selects the sample to be played.-(s', s_p)                         = pS "s" Nothing-(stutterdepth, stutterdepth_p)   = pF "stutterdepth" (Just 0)-(stuttertime, stuttertime_p)     = pF "stuttertime" (Just 0)-(sustain, sustain_p)             = pF "sustain" (Just 0)-(tomdecay, tomdecay_p)           = pF "tomdecay" (Just 0)-{- | used in conjunction with `speed`, accepts values of "r" (rate, default behavior), "c" (cycles), or "s" (seconds).-Using `unit "c"` means `speed` will be interpreted in units of cycles, e.g. `speed "1"` means samples will be stretched to fill a cycle.-Using `unit "s"` means the playback speed will be adjusted so that the duration is the number of seconds specified by `speed`.--}-(unit, unit_p)                   = pS "unit" (Just "rate")-(velocity, velocity_p)           = pF "velocity" (Just 0.5)-(vcfegint, vcfegint_p)           = pF "vcfegint" (Just 0)-(vcoegint, vcoegint_p)           = pF "vcoegint" (Just 0)-(voice, voice_p)                 = pF "voice" (Just 0)--- | formant filter to make things sound like vowels, a pattern of either `a`, `e`, `i`, `o` or `u`. Use a rest (`~`) for no effect.-(vowel, vowel_p)                 = pS "vowel" (Just "")---- MIDI-specific params--(dur,dur_p)                      = pF "dur" (Just 0.05)-(modwheel,modwheel_p)            = pF "modwheel" (Just 0)-(expression,expression_p)        = pF "expression" (Just 1)-(sustainpedal,sustainpedal_p)    = pF "sustainpedal" (Just 0)---- Tremolo Audio DSP effect | params are "tremolorate" and "tremolodepth"-tremolorate, tremolodepth :: Pattern Double -> ParamPattern-tremolorate_p, tremolodepth_p :: Param-(tremolorate,tremolorate_p)      = pF "tremolorate" (Just 1)-(tremolodepth,tremolodepth_p)    = pF "tremolodepth" (Just 0.5)---- Phaser Audio DSP effect | params are "phaserrate" and "phaserdepth"-phaserrate, phaserdepth :: Pattern Double -> ParamPattern-phaserrate_p, phaserdepth_p :: Param-(phaserrate,phaserrate_p)      = pF "phaserrate" (Just 1)-(phaserdepth,phaserdepth_p)    = pF "phaserdepth" (Just 0.5)---- aliases-att, chdecay, ctf, ctfg, delayfb, delayt, lbd, lch, lcl, lcp, lcr, lfoc, lfoi-   , lfop, lht, llt, loh, lsn, ohdecay, phasdp, phasr, pit1, pit2, pit3, por, sag, scl, scp-   , scr, sld, std, stt, sus, tdecay, tremdp, tremr, vcf, vco, voi-      :: Pattern Double -> ParamPattern-att = attack-bpf = bandf-bpf_p = bandf_p-bpq = bandq-bpq_p = bandq_p-chdecay = clhatdecay-ctf  = cutoff-ctfg = cutoffegint-delayfb = delayfeedback-delayt  = delaytime-det  = detune-gat = gate-hg = hatgrain-hpf = hcutoff-hpf_p = hcutoff_p-hpq = hresonance-hpq_p = hresonance_p-lag = lagogo-lbd = lkick-lch = lclhat-lcl = lclaves-lcp = lclap-lcr = lcrash-lfoc = lfocutoffint-lfoi = lfoint-lfop = lfopitchint-lht = lhitom-llt = llotom-loh = lophat-lpf = cutoff-lpf_p = cutoff_p-lpq = resonance-lpq_p = resonance_p-lsn = lsnare-ohdecay = ophatdecay-phasdp = phaserdepth-phasr = phaserrate-pit1 = pitch1-pit2 = pitch2-pit3 = pitch3-por = portamento-rel = release-sag = sagogo-scl = sclaves-scp = sclap-scr = scrash-sz  = size-sld = slide-std = stutterdepth-stt = stuttertime-sus  = sustain-tdecay = tomdecay-tremdp = tremolodepth-tremr = tremolorate-vcf  = vcfegint-vco  = vcoegint-voi  = voice--midinote :: Pattern Double -> ParamPattern-midinote = note . ((subtract 60) <$>)--drum :: Pattern String -> ParamPattern-drum = n . ((subtract 60) . drumN <$>)--drumN :: Num a => String -> a-drumN "bd"  = 36-drumN "sn"  = 38-drumN "lt"  = 43-drumN "ht"  = 50-drumN "ch"  = 42-drumN "oh"  = 46-drumN "cp"  = 39-drumN "cl"  = 75-drumN "ag"  = 67-drumN "cr"  = 49-drumN _ = 0----- SuperDirt MIDI Params--(array, array_p) = pF "array" Nothing-(midichan, midichan_p) = pF "midichan" Nothing-(control, control_p) = pF "control" Nothing--(ccn, ccn_p) = pF "ccn" Nothing-(ccv, ccv_p) = pF "ccv" Nothing-cc = grp [ccn_p, ccv_p]--(ctlNum, ctlNum_p) = pF "ctlNum" Nothing--(frameRate, frameRate_p) = pF "frameRate" Nothing-(frames, frames_p) = pF "frames" Nothing-(hours, hours_p) = pF "hours" Nothing--(midicmd, midicmd_p) = pS "midicmd" Nothing-command = midicmd--(minutes, minutes_p) = pF "minutes" Nothing-(progNum, progNum_p) = pF "progNum" Nothing-(seconds, seconds_p) = pF "seconds" Nothing-(songPtr, songPtr_p) = pF "songPtr" Nothing-(uid, uid_p) = pF "uid" Nothing-(val, val_p) = pF "val" Nothing

@@ -1,436 +0,0 @@-{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, CPP #-}-{-# LANGUAGE LambdaCase #-}--module Sound.Tidal.Parse where--import Text.ParserCombinators.Parsec-import qualified Text.ParserCombinators.Parsec.Token as P-import Text.ParserCombinators.Parsec.Language ( haskellDef )-import Data.Ratio-import Data.Colour-import Data.Colour.Names-import Data.Colour.SRGB-import GHC.Exts( IsString(..) )--- import Data.Monoid--- import qualified Data.Semigroup as Sem-import Control.Exception as E-import Control.Applicative ((<$>), (<*>), pure)-import Data.Maybe-import Data.List--import Sound.Tidal.Pattern-import Sound.Tidal.Time (Arc, Time)--{--#ifdef TIDAL_SEMIGROUP-import qualified Data.Semigroup as Sem-#endif--}---- | AST representation of patterns--data TPat a = TPat_Atom a-            | TPat_Density (TPat Time) (TPat a)-            | TPat_Slow (TPat Time) (TPat a)-            | TPat_Zoom Arc (TPat a)-            | TPat_DegradeBy Double (TPat a)-            | TPat_Silence-            | TPat_Foot-            | TPat_Elongate Int-            | TPat_EnumFromTo (TPat a) (TPat a)-            | TPat_Cat [TPat a]-            | TPat_TimeCat [TPat a]-            | TPat_Overlay (TPat a) (TPat a)-            | TPat_ShiftL Time (TPat a)-              -- TPat_E Int Int (TPat a)-            | TPat_pE (TPat Int) (TPat Int) (TPat Integer) (TPat a)-            deriving (Show)--{--#ifdef TIDAL_SEMIGROUP-instance Sem.Semigroup (TPat a) where-  (<>) = TPat_Overlay--instance Parseable a => Monoid (TPat a) where-   mempty = TPat_Silence-   mappend = (<>)-#else-instance Parseable a => Monoid (TPat a) where-   mempty = TPat_Silence-   mappend = TPat_Overlay-#endif--}--toPat :: Enumerable a => TPat a -> Pattern a-toPat = \case-   TPat_Atom x -> atom x-   TPat_Density t x -> density (toPat t) $ toPat x-   TPat_Slow t x -> slow (toPat t) $ toPat x-   TPat_Zoom arc x -> zoom arc $ toPat x-   TPat_DegradeBy amt x -> _degradeBy amt $ toPat x-   TPat_Silence -> silence-   TPat_Cat xs -> fastcat $ map toPat xs-   TPat_TimeCat xs -> timeCat $ map (\(n, p) -> (toRational n, toPat p)) $ durations xs-   TPat_Overlay x0 x1 -> overlay (toPat x0) (toPat x1)-   TPat_ShiftL t x -> t `rotL` toPat x-   TPat_pE n k s thing ->-      unwrap $ _eoff <$> toPat n <*> toPat k <*> toPat s <*> pure (toPat thing)-   TPat_Foot -> error "Can't happen, feet (.'s) only used internally.."-   TPat_EnumFromTo a b -> unwrap $ fromTo <$> (toPat a) <*> (toPat b)-   -- TPat_EnumFromThenTo a b c -> unwrap $ fromThenTo <$> (toPat a) <*> (toPat b) <*> (toPat c)--durations :: [TPat a] -> [(Int, TPat a)]-durations [] = []-durations ((TPat_Elongate n):xs) = (n, TPat_Silence):(durations xs)-durations (a:(TPat_Elongate n):xs) = (n+1,a):(durations xs)-durations (a:xs) = (1,a):(durations xs)--p :: (Enumerable a, Parseable a) => String -> Pattern a-p = toPat . parseTPat--class Parseable a where-  parseTPat :: String -> TPat a--class Enumerable a where-  fromTo :: a -> a -> Pattern a-  fromThenTo :: a -> a -> a -> Pattern a--instance Parseable Double where-  parseTPat = parseRhythm pDouble-instance Enumerable Double where-  fromTo a b = enumFromTo' a b-  fromThenTo a b c = enumFromThenTo' a b c--instance Parseable String where-  parseTPat = parseRhythm pVocable-instance Enumerable String where-  fromTo a b = listToPat [a,b]-  fromThenTo a b c = listToPat [a,b,c]--instance Parseable Bool where-  parseTPat = parseRhythm pBool-instance Enumerable Bool where-  fromTo a b = listToPat [a,b]-  fromThenTo a b c = listToPat [a,b,c]--instance Parseable Int where-  parseTPat = parseRhythm pIntegral-instance Enumerable Int where-  fromTo a b = enumFromTo' a b-  fromThenTo a b c = enumFromThenTo' a b c--instance Parseable Integer where-  parseTPat s = parseRhythm pIntegral s-instance Enumerable Integer where-  fromTo a b = enumFromTo' a b-  fromThenTo a b c = enumFromThenTo' a b c--instance Parseable Rational where-  parseTPat = parseRhythm pRational-instance Enumerable Rational where-  fromTo a b = enumFromTo' a b-  fromThenTo a b c = enumFromThenTo' a b c--enumFromTo' a b | a > b = listToPat $ reverse $ enumFromTo b a-                | otherwise = listToPat $ enumFromTo a b--enumFromThenTo' a b c | a > c = listToPat $ reverse $ enumFromThenTo c (c + (a-b)) a-                      | otherwise = listToPat $ enumFromThenTo a b c--type ColourD = Colour Double --instance Parseable ColourD where-  parseTPat = parseRhythm pColour-instance Enumerable ColourD where-  fromTo a b = listToPat [a,b]-  fromThenTo a b c = listToPat [a,b,c]--instance (Enumerable a, Parseable a) => IsString (Pattern a) where-  fromString = toPat . parseTPat----instance (Parseable a, Pattern p) => IsString (p a) where---  fromString = p :: String -> p a--lexer   = P.makeTokenParser haskellDef--braces, brackets, parens, angles:: Parser a -> Parser a-braces  = P.braces lexer-brackets = P.brackets lexer-parens = P.parens lexer-angles = P.angles lexer--symbol :: String -> Parser String-symbol  = P.symbol lexer--natural, integer :: Parser Integer-natural = P.natural lexer-integer = P.integer lexer--float :: Parser Double-float = P.float lexer--naturalOrFloat :: Parser (Either Integer Double)-naturalOrFloat = P.naturalOrFloat lexer--data Sign      = Positive | Negative--applySign          :: Num a => Sign -> a -> a-applySign Positive =  id-applySign Negative =  negate--sign  :: Parser Sign-sign  =  do char '-'-            return Negative-         <|> do char '+'-                return Positive-         <|> return Positive--intOrFloat :: Parser Double-intOrFloat =  do s   <- sign-                 num <- naturalOrFloat-                 return (case num of-                            Right x -> applySign s x-                            Left  x -> fromIntegral $ applySign s x-                        )--r :: (Enumerable a, Parseable a) => String -> Pattern a -> IO (Pattern a)-r s orig = do E.handle -                (\err -> do putStrLn (show (err :: E.SomeException))-                            return orig -                )-                (return $ p s)--parseRhythm :: Parseable a => Parser (TPat a) -> String -> TPat a-parseRhythm f input = either (const TPat_Silence) id $ parse (pSequence f') "" input-  where f' = f-             <|> do symbol "~" <?> "rest"-                    return TPat_Silence--pSequenceN :: Parseable a => Parser (TPat a) -> GenParser Char () (Int, TPat a)-pSequenceN f = do spaces-                  -- d <- pDensity-                  ps <- many $ do a <- pPart f-                                  do Text.ParserCombinators.Parsec.try $ symbol ".."-                                     b <- pPart f-                                     return [TPat_EnumFromTo (TPat_Cat a) (TPat_Cat b)]-                                    <|> return a-                               <|> do symbol "."-                                      return [TPat_Foot]-                               <|> do es <- many1 (symbol "_")-                                      return [TPat_Elongate (length es)]-                  let ps' = TPat_Cat $ map elongate $ splitFeet $ concat ps-                  return (length ps, ps')--elongate xs | any (isElongate) xs = TPat_TimeCat xs-            | otherwise = TPat_Cat xs-  where isElongate (TPat_Elongate _) = True-        isElongate _ = False-{--expandEnum :: Parseable t => Maybe (TPat t) -> [TPat t] -> [TPat t]-expandEnum a [] = [a]-expandEnum (Just a) (TPat_Enum:b:ps) = (TPat_EnumFromTo a b) : (expandEnum Nothing ps)--- ignore ..s in other places-expandEnum a (TPat_Enum:ps) = expandEnum a ps-expandEnum (Just a) (b:ps) = a:(expandEnum b (Just c) ps)-expandEnum Nothing (c:ps) = expandEnum (Just c) ps--}---- could use splitOn here but `TPat a` isn't a member of `EQ`..-splitFeet :: [TPat t] -> [[TPat t]]-splitFeet [] = []-splitFeet ps = foot:(splitFeet ps')-  where (foot, ps') = takeFoot ps-        takeFoot [] = ([], [])-        takeFoot (TPat_Foot:ps) = ([], ps)-        takeFoot (p:ps) = (\(a,b) -> (p:a,b)) $ takeFoot ps--pSequence :: Parseable a => Parser (TPat a) -> GenParser Char () (TPat a)-pSequence f = do (_, p) <- pSequenceN f-                 return p--pSingle :: Parseable a => Parser (TPat a) -> Parser (TPat a)-pSingle f = f >>= pRand >>= pMult--pPart :: Parseable a => Parser (TPat a) -> Parser [TPat a]-pPart f = do part <- pSingle f <|> pPolyIn f <|> pPolyOut f-             part <- pE part-             part <- pRand part-             spaces-             parts <- pStretch part-                      <|> pReplicate part-             spaces-             return $ parts--pPolyIn :: Parseable a => Parser (TPat a) -> Parser (TPat a)-pPolyIn f = do ps <- brackets (pSequence f `sepBy` symbol ",")-               spaces-               pMult $ foldr TPat_Overlay TPat_Silence ps--pPolyOut :: Parseable a => Parser (TPat a) -> Parser (TPat a)-pPolyOut f = do ps <- braces (pSequenceN f `sepBy` symbol ",")-                spaces-                base <- do char '%'-                           spaces-                           i <- integer <?> "integer"-                           return $ Just (fromIntegral i)-                        <|> return Nothing-                pMult $ foldr TPat_Overlay TPat_Silence $ scale base ps-             <|>-             do ps <- angles (pSequenceN f `sepBy` symbol ",")-                spaces-                pMult $ foldr TPat_Overlay TPat_Silence $ scale (Just 1) ps-  where scale _ [] = []-        scale base (ps@((n,_):_)) = map (\(n',p) -> TPat_Density (TPat_Atom $ fromIntegral (fromMaybe n base)/ fromIntegral n') p) ps--pString :: Parser (String)-pString = do c <- (letter <|> oneOf "0123456789") <?> "charnum"-             cs <- many (letter <|> oneOf "0123456789:.-_") <?> "string"-             return (c:cs)--pVocable :: Parser (TPat String)-pVocable = do v <- pString-              return $ TPat_Atom v--pDouble :: Parser (TPat Double)-pDouble = do f <- choice [intOrFloat, parseNote] <?> "float"-             return $ TPat_Atom f--pBool :: Parser (TPat Bool)-pBool = do oneOf "t1"-           return $ TPat_Atom True-        <|>-        do oneOf "f0"-           return $ TPat_Atom False--parseIntNote  :: Integral i => Parser i-parseIntNote = do s <- sign-                  i <- choice [integer, parseNote]-                  return $ applySign s $ fromIntegral i--parseInt :: Parser Int-parseInt = do s <- sign-              i <- integer-              return $ applySign s $ fromIntegral i--pIntegral :: Parseable a => Integral a => Parser (TPat a)-pIntegral = TPat_Atom <$> parseIntNote--parseNote :: Num a => Parser a-parseNote = do n <- notenum-               modifiers <- many noteModifier-               octave <- option 5 natural-               let n' = foldr (+) n modifiers-               return $ fromIntegral $ n' + ((octave-5)*12)-  where-        notenum :: Parser Integer-        notenum = choice [char 'c' >> return 0,-                          char 'd' >> return 2,-                          char 'e' >> return 4,-                          char 'f' >> return 5,-                          char 'g' >> return 7,-                          char 'a' >> return 9,-                          char 'b' >> return 11-                         ]-        noteModifier :: Parser Integer-        noteModifier = choice [char 's' >> return 1,-                               char 'f' >> return (-1),-                               char 'n' >> return 0-                              ]--fromNote :: Num a => Pattern String -> Pattern a-fromNote p = (\s -> either (const 0) id $ parse parseNote "" s) <$> p--pColour :: Parser (TPat ColourD)-pColour = do name <- many1 letter <?> "colour name"-             colour <- readColourName name <?> "known colour"-             return $ TPat_Atom colour--pMult :: Parseable a => TPat a -> Parser (TPat a)-pMult thing = do char '*'-                 spaces-                 r <- (pRational <|> pPolyIn pRational  <|> pPolyOut pRational)-                 return $ TPat_Density r thing-              <|>-              do char '/'-                 spaces-                 r <- (pRational <|> pPolyIn pRational  <|> pPolyOut pRational)-                 return $ TPat_Slow r thing-              <|>-              return thing----pRand :: Parseable a => TPat a -> Parser (TPat a)-pRand thing = do char '?'-                 spaces-                 return $ TPat_DegradeBy 0.5 thing-              <|> return thing--pE :: Parseable a => TPat a -> Parser (TPat a)-pE thing = do (n,k,s) <- parens (pair)-              pure $ TPat_pE n k s thing-            <|> return thing-   where pair :: Parser (TPat Int, TPat Int, TPat Integer)-         pair = do a <- pSequence pIntegral-                   spaces-                   symbol ","-                   spaces-                   b <- pSequence pIntegral-                   c <- do symbol ","-                           spaces-                           pSequence pIntegral-                        <|> return (TPat_Atom 0)-                   return (a, b, c)--eoff :: Pattern Int -> Pattern Int -> Pattern Integer -> Pattern a -> Pattern a-eoff = temporalParam3 _eoff--_eoff :: Int -> Int -> Integer -> Pattern a -> Pattern a-_eoff n k s p = ((s%(fromIntegral k)) `rotL`) (_e n k p)-   -- TPat_ShiftL (s%(fromIntegral k)) (TPat_E n k p)--pReplicate :: Parseable a => TPat a -> Parser [TPat a]-pReplicate thing =-  do extras <- many $ do char '!'-                         -- if a number is given (without a space)slow 2 $ fast-                         -- replicate that number of times-                         n <- ((read <$> many1 digit) <|> return 2)-                         spaces-                         thing' <- pRand thing-                         -- -1 because we already have parsed the original one-                         return $ replicate (fromIntegral (n-1)) thing'-     return (thing:concat extras)---pStretch :: Parseable a => TPat a -> Parser [TPat a]-pStretch thing =-  do char '@'-     n <- ((read <$> many1 digit) <|> return 1)-     return $ map (\x -> TPat_Zoom (x%n,(x+1)%n) thing) [0 .. (n-1)]--pRatio :: Parser (Rational)-pRatio = do s <- sign-            n <- natural-            result <- do char '%'-                         d <- natural-                         return (n%d)-                      <|>-                      do char '.'-                         s <- many1 digit-                         -- A hack, but not sure if doing this-                         -- numerically would be any faster..-                         return (toRational $ ((read $ show n ++ "." ++ s)  :: Double))-                      <|>-                      return (n%1)-            return $ applySign s result--pRational :: Parser (TPat Rational)-pRational = do r <- pRatio-               return $ TPat_Atom r--{--pDensity :: Parser (Rational)-pDensity = angles (pRatio <?> "ratio")-           <|>-           return (1 % 1)--}

@@ -1,1752 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, CPP #-}-{-# OPTIONS_GHC -Wall -fno-warn-orphans -fno-warn-name-shadowing #-}--module Sound.Tidal.Pattern where--import Control.Applicative--- import Data.Monoid-import Data.Fixed-import Data.List-import Data.Maybe-import Data.Ord-import Data.Ratio--- import Debug.Trace-import Data.Typeable-import Data.Function-import System.Random.Mersenne.Pure64-import Data.Char (digitToInt)-import qualified Data.Text as T--import Sound.Tidal.Time-import Sound.Tidal.Utils-import Sound.Tidal.Bjorklund--import Text.Show.Functions ()-import qualified Control.Exception as E--{--#ifdef TIDAL_SEMIGROUP-import qualified Data.Semigroup as Sem-#endif--}---- | The pattern datatype, a function from a time @Arc@ to @Event@--- values. For discrete patterns, this returns the events which are--- active during that time. For continuous patterns, events with--- values for the midpoint of the given @Arc@ is returned.-newtype Pattern a = Pattern {arc :: Arc -> [Event a]}-  deriving Typeable--noOv :: String -> a-noOv meth = error $ meth ++ ": No overloading"--instance Eq (Pattern a) where-  (==) = noOv "(==)"--instance Ord a => Ord (Pattern a) where-  min = liftA2 min-  max = liftA2 max--instance Num a => Num (Pattern a) where-  negate      = fmap negate-  (+)         = liftA2 (+)-  (*)         = liftA2 (*)-  fromInteger = pure . fromInteger-  abs         = fmap abs-  signum      = fmap signum--instance Enum a => Enum (Pattern a) where-  succ           = fmap succ-  pred           = fmap pred-  toEnum         = pure . toEnum-  fromEnum       = noOv "fromEnum"-  enumFrom       = noOv "enumFrom"-  enumFromThen   = noOv "enumFromThen"-  enumFromTo     = noOv "enumFromTo"-  enumFromThenTo = noOv "enumFromThenTo"--instance (Num a, Ord a) => Real (Pattern a) where-  toRational = noOv "toRational"--instance (Integral a) => Integral (Pattern a) where-  quot          = liftA2 quot-  rem           = liftA2 rem-  div           = liftA2 div-  mod           = liftA2 mod-  toInteger     = noOv "toInteger"-  x `quotRem` y = (x `quot` y, x `rem` y)-  x `divMod`  y = (x `div`  y, x `mod` y)--instance (Fractional a) => Fractional (Pattern a) where-  recip        = fmap recip-  fromRational = pure . fromRational--instance (Floating a) => Floating (Pattern a) where-  pi    = pure pi-  sqrt  = fmap sqrt-  exp   = fmap exp-  log   = fmap log-  sin   = fmap sin-  cos   = fmap cos-  asin  = fmap asin-  atan  = fmap atan-  acos  = fmap acos-  sinh  = fmap sinh-  cosh  = fmap cosh-  asinh = fmap asinh-  atanh = fmap atanh-  acosh = fmap acosh--instance (RealFrac a) => RealFrac (Pattern a) where-  properFraction = noOv "properFraction"-  truncate       = noOv "truncate"-  round          = noOv "round"-  ceiling        = noOv "ceiling"-  floor          = noOv "floor"--instance (RealFloat a) => RealFloat (Pattern a) where-  floatRadix     = noOv "floatRadix"-  floatDigits    = noOv "floatDigits"-  floatRange     = noOv "floatRange"-  decodeFloat    = noOv "decodeFloat"-  encodeFloat    = ((.).(.)) pure encodeFloat-  exponent       = noOv "exponent"-  significand    = noOv "significand"-  scaleFloat n   = fmap (scaleFloat n)-  isNaN          = noOv "isNaN"-  isInfinite     = noOv "isInfinite"-  isDenormalized = noOv "isDenormalized"-  isNegativeZero = noOv "isNegativeZero"-  isIEEE         = noOv "isIEEE"-  atan2          = liftA2 atan2---- | @show (p :: Pattern)@ returns a text string representing the--- event values active during the first cycle of the given pattern.-instance (Show a) => Show (Pattern a) where-  show p@(Pattern _) = unwords $ map showEvent $ arc p (0, 1)---- | converts a ratio into human readable string, e.g. @1/3@-showTime :: (Show a, Integral a) => Ratio a -> String-showTime t | denominator t == 1 = show (numerator t)-           | otherwise = show (numerator t) ++ ('/':show (denominator t))---- | converts a time arc into human readable string, e.g. @1/3 3/4@-showArc :: Arc -> String-showArc a = (showTime $ fst a) ++ (' ':showTime (snd a))---- | converts an event into human readable string, e.g. @("bd" 1/4 2/3)@-showEvent :: (Show a) => Event a -> String-showEvent e@(_, b, v) = concat[on, show v, off,-                               (' ':showArc b),-                               "\n"-                              ]-  where on | hasOnset e = ""-           | otherwise = ".."-        off | hasOffset e = ""-            | otherwise = ".."--instance Functor Pattern where-  fmap f (Pattern a) = Pattern $ fmap (fmap (mapThd' f)) a---- | @pure a@ returns a pattern with an event with value @a@, which--- has a duration of one cycle, and repeats every cycle.-instance Applicative Pattern where-  pure x = Pattern $ \(s, e) -> map-                                (\t -> ((t%1, (t+1)%1),-                                        (t%1, (t+1)%1),-                                        x-                                       )-                                )-                                [floor s .. ((ceiling e) - 1)]-  (Pattern fs) <*> (Pattern xs) =-    Pattern $ \a -> concatMap applyX (fs a)-    where applyX ((s,e), (s', e'), f) =-            map (\(_, _, x) -> ((s,e), (s', e'), f x))-                (filter-                 (\(_, a', _) -> isIn a' s)-                 (xs (s',e'))-                )--{--#ifdef TIDAL_SEMIGROUP--- | @mappend@ a.k.a. @<>@ is a synonym for @overlay@.-instance Sem.Semigroup (Pattern a) where-  (<>) = overlay--instance Monoid (Pattern a) where-  mempty = silence-  mappend = (<>)--#else--- | @mempty@ is a synonym for @silence@.-instance Monoid (Pattern a) where-  mempty = silence-  mappend = overlay-#endif--}--instance Monad Pattern where-  return = pure--  p >>= f = unwrap (f <$> p)--unwrap :: Pattern (Pattern a) -> Pattern a-unwrap p = Pattern $ \a -> concatMap (\(_, outerPart, p') -> mapMaybe (munge outerPart) $ arc p' a) (arc p a)-  where munge a (whole,part,v) = do part' <- subArc a part-                                    return (whole, part',v)----- | @atom@ is a synonym for @pure@.-atom :: a -> Pattern a-atom = pure---- | @silence@ returns a pattern with no events.-silence :: Pattern a-silence = Pattern $ const []---- | @withQueryArc f p@ returns a new @Pattern@ with function @f@--- applied to the @Arc@ values passed to the original @Pattern@ @p@.-withQueryArc :: (Arc -> Arc) -> Pattern a -> Pattern a-withQueryArc f p = Pattern $ \a -> arc p (f a)---- | @withQueryTime f p@ returns a new @Pattern@ with function @f@--- applied to the both the start and end @Time@ of the @Arc@ passed to--- @Pattern@ @p@.-withQueryTime :: (Time -> Time) -> Pattern a -> Pattern a-withQueryTime = withQueryArc . mapArc---- | @withResultArc f p@ returns a new @Pattern@ with function @f@--- applied to the @Arc@ values in the events returned from the--- original @Pattern@ @p@.-withResultArc :: (Arc -> Arc) -> Pattern a -> Pattern a-withResultArc f p = Pattern $ \a -> mapArcs f $ arc p a---- | @withResultTime f p@ returns a new @Pattern@ with function @f@--- applied to the both the start and end @Time@ of the @Arc@ values in--- the events returned from the original @Pattern@ @p@.-withResultTime :: (Time -> Time) -> Pattern a -> Pattern a-withResultTime = withResultArc . mapArc---- | @withEvent f p@ returns a new @Pattern@ with events mapped over--- function @f@.-withEvent :: (Event a -> Event b) -> Pattern a -> Pattern b-withEvent f p = Pattern $ \a -> map f $ arc p a---- | @timedValues p@ returns a new @Pattern@ where values are turned--- into tuples of @Arc@ and value.-timedValues :: Pattern a -> Pattern (Arc, a)-timedValues = withEvent (\(a,a',v) -> (a,a',(a,v)))---- | @overlay@ combines two @Pattern@s into a new pattern, so that--- their events are combined over time. This is the same as the infix--- operator `<>`.-overlay :: Pattern a -> Pattern a -> Pattern a-overlay p p' = Pattern $ \a -> (arc p a) ++ (arc p' a)---- | @stack@ combines a list of @Pattern@s into a new pattern, so that--- their events are combined over time.-stack :: [Pattern a] -> Pattern a-stack = foldr overlay silence---- | @append@ combines two patterns @Pattern@s into a new pattern, so--- that the events of the second pattern are appended to those of the--- first pattern, within a single cycle--append :: Pattern a -> Pattern a -> Pattern a-append a b = fastcat [a,b]---- | @append'@ does the same as @append@, but over two cycles, so that--- the cycles alternate between the two patterns.-append' :: Pattern a -> Pattern a -> Pattern a-append' a b  = slowcat [a,b]---- | @fastcat@ returns a new pattern which interlaces the cycles of the--- given patterns, within a single cycle. It's the equivalent of--- @append@, but with a list of patterns.-fastcat :: [Pattern a] -> Pattern a-fastcat ps = _density (fromIntegral $ length ps) $ slowcat ps--splitAtSam :: Pattern a -> Pattern a-splitAtSam p =-  splitQueries $ Pattern $ \(s,e) -> mapSnds' (trimArc (sam s)) $ arc p (s,e)-  where trimArc s' (s,e) = (max s' s, min (s'+1) e)---- | @slowcat@ does the same as @fastcat@, but maintaining the duration of--- the original patterns. It is the equivalent of @append'@, but with--- a list of patterns.--slowcat :: [Pattern a] -> Pattern a-slowcat [] = silence-slowcat ps = splitQueries $ Pattern f-  where ps' = map splitAtSam ps-        l = length ps'-        f (s,e) = arc (withResultTime (+offset) p) (s',e')-          where p = ps' !! n-                r = (floor s) :: Int-                n = (r `mod` l) :: Int-                offset = (fromIntegral $ r - ((r - n) `div` l)) :: Time-                (s', e') = (s-offset, e-offset)---- | @cat@ is an alias of @slowcat@-cat :: [Pattern a] -> Pattern a-cat = slowcat---- | @listToPat@ turns the given list of values to a Pattern, which--- cycles through the list.-listToPat :: [a] -> Pattern a-listToPat = fastcat . map atom--patToList :: Pattern a -> [a]-patToList p = map thd' $ sortBy (\a b -> compare (snd' a) (snd' b)) $ filter ((\x -> x >= 0 && x < 1) . fst . snd' ) (arc p (0,1))---- | @maybeListToPat@ is similar to @listToPat@, but allows values to--- be optional using the @Maybe@ type, so that @Nothing@ results in--- gaps in the pattern.-maybeListToPat :: [Maybe a] -> Pattern a-maybeListToPat = fastcat . map f-  where f Nothing = silence-        f (Just x) = atom x---- | @run@ @n@ returns a pattern representing a cycle of numbers from @0@ to @n-1@.-run :: (Enum a, Num a) => Pattern a -> Pattern a-run tp =  tp >>= _run--_run :: (Enum a, Num a) => a -> Pattern a-_run n = listToPat [0 .. n-1]--scan :: (Enum a, Num a) => Pattern a -> Pattern a-scan tp =  tp >>= _scan--_scan :: (Enum a, Num a) => a -> Pattern a-_scan n = slowcat $ map _run [1 .. n]--temporalParam :: (a -> Pattern b -> Pattern c) -> (Pattern a -> Pattern b -> Pattern c)-temporalParam f tv p = unwrap $ (`f` p) <$> tv--temporalParam2 :: (a -> b -> Pattern c -> Pattern d) -> (Pattern a -> Pattern b -> Pattern c -> Pattern d)-temporalParam2 f a b p = unwrap $ (\x y -> f x y p) <$> a <*> b--temporalParam3 :: (a -> b -> c -> Pattern d -> Pattern e) -> (Pattern a -> Pattern b -> Pattern c -> Pattern d -> Pattern e)-temporalParam3 f a b c p = unwrap $ (\x y z -> f x y z p) <$> a <*> b <*> c--temporalParam' :: (a -> Pattern b -> Pattern c) -> (Pattern a -> Pattern b -> Pattern c)-temporalParam' f tv p = unwrap' $ (`f` p) <$> tv--temporalParam2' :: (a -> b -> Pattern c -> Pattern d) -> (Pattern a -> Pattern b -> Pattern c -> Pattern d)-temporalParam2' f a b p = unwrap' $ (\x y -> f x y p) <$> a <*> b--temporalParam3' :: (a -> b -> c -> Pattern d -> Pattern e) -> (Pattern a -> Pattern b -> Pattern c -> Pattern d -> Pattern e)-temporalParam3' f a b c p = unwrap' $ (\x y z -> f x y z p) <$> a <*> b <*> c---- | @fast@ (also known as @density@) returns the given pattern with speed--- (or density) increased by the given @Time@ factor. Therefore @fast 2 p@--- will return a pattern that is twice as fast, and @fast (1/3) p@--- will return one three times as slow.-fast :: Pattern Time -> Pattern a -> Pattern a-fast = temporalParam _density--_fast :: Time -> Pattern a -> Pattern a-_fast = _density--fast' :: Pattern Time -> Pattern a -> Pattern a-fast' = temporalParam' _density---- | @density@ is an alias of @fast@. @fast@ is quicker to type, but--- @density@ is its old name so is used in a lot of examples.-density :: Pattern Time -> Pattern a -> Pattern a-density = fast--_density :: Time -> Pattern a -> Pattern a-_density r p | r == 0 = silence-             | r < 0 = rev $ _density (negate r) p-             | otherwise = withResultTime (/ r) $ withQueryTime (* r) p---- | @fastGap@ (also known as @densityGap@ is similar to @fast@ but maintains its cyclic--- alignment. For example, @fastGap 2 p@ would squash the events in--- pattern @p@ into the first half of each cycle (and the second--- halves would be empty).-fastGap :: Time -> Pattern a -> Pattern a-fastGap 0 _ = silence-fastGap r p = splitQueries $ withResultArc (\(s,e) -> (sam s + ((s - sam s)/r), (sam s + ((e - sam s)/r)))) $ Pattern (\a -> arc p $ mapArc (\t -> sam t + (min 1 (r * cyclePos t))) a)--densityGap :: Time -> Pattern a -> Pattern a-densityGap = fastGap---- | @slow@ does the opposite of @fast@, i.e. @slow 2 p@ will return a--- pattern that is half the speed.-slow :: Pattern Time -> Pattern a -> Pattern a-slow = temporalParam _slow--sparsity :: Pattern Time -> Pattern a -> Pattern a-sparsity = slow--slow' :: Pattern Time -> Pattern a -> Pattern a-slow' = temporalParam' _slow--_slow :: Time -> Pattern a -> Pattern a-_slow t p = _density (1/t) p---- | The @<~@ operator shifts (or rotates) a pattern to the left (or--- counter-clockwise) by the given @Time@ value. For example--- @(1%16) <~ p@ will return a pattern with all the events moved--- one 16th of a cycle to the left.-rotL :: Time -> Pattern a -> Pattern a-rotL t p = withResultTime (subtract t) $ withQueryTime (+ t) p--(<~) :: Pattern Time -> Pattern a -> Pattern a-(<~) = temporalParam rotL---- | The @~>@ operator does the same as @<~@ but shifts events to the--- right (or clockwise) rather than to the left.-rotR :: Time -> Pattern a -> Pattern a-rotR = rotL . (0-)--(~>) :: Pattern Time -> Pattern a -> Pattern a-(~>) = temporalParam rotR--{- | (The above means that `brak` is a function from patterns of any type,-to a pattern of the same type.)--Make a pattern sound a bit like a breakbeat--Example:--@-d1 $ sound (brak "bd sn kurt")-@--}-brak :: Pattern a -> Pattern a-brak = when ((== 1) . (`mod` 2)) (((1%4) `rotR`) . (\x -> fastcat [x, silence]))--{- | Divides a pattern into a given number of subdivisions, plays the subdivisions-in order, but increments the starting subdivision each cycle. The pattern-wraps to the first subdivision after the last subdivision is played.--Example:--@-d1 $ iter 4 $ sound "bd hh sn cp"-@--This will produce the following over four cycles:--@-bd hh sn cp-hh sn cp bd-sn cp bd hh-cp bd hh sn-@--There is also `iter'`, which shifts the pattern in the opposite direction.---}-iter :: Pattern Int -> Pattern c -> Pattern c-iter = temporalParam _iter--_iter :: Int -> Pattern a -> Pattern a-_iter n p = slowcat $ map (\i -> ((fromIntegral i)%(fromIntegral n)) `rotL` p) [0 .. (n-1)]---- | @iter'@ is the same as @iter@, but decrements the starting--- subdivision instead of incrementing it.-iter' :: Pattern Int -> Pattern c -> Pattern c-iter' = temporalParam _iter'--_iter' :: Int -> Pattern a -> Pattern a-_iter' n p = slowcat $ map (\i -> ((fromIntegral i)%(fromIntegral n)) `rotR` p) [0 .. (n-1)]---- | @rev p@ returns @p@ with the event positions in each cycle--- reversed (or mirrored).-rev :: Pattern a -> Pattern a-rev p = splitQueries $ Pattern $ \a -> map makeWholeAbsolute $ mapSnds' (mirrorArc (mid a)) $ map makeWholeRelative (arc p (mirrorArc (mid a) a))-  where makeWholeRelative ((s,e), part@(s',e'), v) = ((s'-s, e-e'), part, v)-        makeWholeAbsolute ((s,e), part@(s',e'), v) = ((s'-e,e'+s), part, v)-        mid (s,_) = (sam s) + 0.5---- | @palindrome p@ applies @rev@ to @p@ every other cycle, so that--- the pattern alternates between forwards and backwards.-palindrome :: Pattern a -> Pattern a-palindrome p = append' p (rev p)--{-|-Only `when` the given test function returns `True` the given pattern transformation is applied. The test function will be called with the current cycle as a number.--@-d1 $ when ((elem '4').show)-  (striate 4)-  $ sound "hh hc"-@--The above will only apply `striate 4` to the pattern if the current cycle number contains the number 4. So the fourth cycle will be striated and the fourteenth and so on. Expect lots of striates after cycle number 399.--}-when :: (Int -> Bool) -> (Pattern a -> Pattern a) ->  Pattern a -> Pattern a-when test f p = splitQueries $ Pattern apply-  where apply a | test (floor $ fst a) = (arc $ f p) a-                | otherwise = (arc p) a--whenT :: (Time -> Bool) -> (Pattern a -> Pattern a) ->  Pattern a -> Pattern a-whenT test f p = splitQueries $ Pattern apply-  where apply a | test (fst a) = (arc $ f p) a-                | otherwise = (arc p) a--playWhen :: (Time -> Bool) -> Pattern a -> Pattern a-playWhen test (Pattern f) = Pattern $ (filter (\e -> test (eventOnset e))) . f--playFor :: Time -> Time -> Pattern a -> Pattern a-playFor s e = playWhen (\t -> and [t >= s, t < e])--{- | The function @seqP@ allows you to define when-a sound within a list starts and ends. The code below contains three-separate patterns in a `stack`, but each has different start times-(zero cycles, eight cycles, and sixteen cycles, respectively). All-patterns stop after 128 cycles:--@-d1 $ seqP [-  (0, 128, sound "bd bd*2"),-  (8, 128, sound "hh*2 [sn cp] cp future*4"),-  (16, 128, sound (samples "arpy*8" (run 16)))-]-@--}-seqP :: [(Time, Time, Pattern a)] -> Pattern a-seqP ps = stack $ map (\(s, e, p) -> playFor s e ((sam s) `rotR` p)) ps---- | @every n f p@ applies the function @f@ to @p@, but only affects--- every @n@ cycles.-every :: Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-every tp f p = tp >>= \t -> _every t f p--_every :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-_every 0 _ p = p-_every n f p = when ((== 0) . (`mod` n)) f p---- | @every n o f'@ is like @every n f@ with an offset of @o@ cycles-every' :: Pattern Int -> Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-every' np op f p = do { n <- np; o <- op; _every' n o f p }--_every' :: Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-_every' n o f = when ((== o) . (`mod` n)) f---- | @foldEvery ns f p@ applies the function @f@ to @p@, and is applied for--- each cycle in @ns@.-foldEvery :: [Int] -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-foldEvery ns f p = foldr ($) p (map (\x -> _every x f) ns)---- | @sig f@ takes a function from time to values, and turns it into a--- @Pattern@.-sig :: (Time -> a) -> Pattern a-sig f = Pattern f'-  where f' (s,e) | s > e = []-                 | otherwise = [((s,e), (s,e), f s)]---- | @sinewave@ returns a @Pattern@ of continuous @Fractional@ values following a--- sinewave with frequency of one cycle, and amplitude from 0 to 1.-sinewave :: Fractional a => Pattern a-sinewave = sig $ \t -> ((sin_rat $ pi * 2 * (fromRational t)) + 1) / 2-  where sin_rat = fromRational . toRational . sin---- | @sine@ is a synonym for @sinewave@.-sine :: Fractional a => Pattern a-sine = sinewave---- | @sine@ is a synonym for @0.25 ~> sine@.-cosine :: Fractional a => Pattern a-cosine = 0.25 ~> sine---- | @sineAmp d@ returns @sinewave@ with its amplitude offset by @d@.--- Deprecated, as these days you can simply do e.g. (sine + 0.5)-sineAmp :: Fractional a => a -> Pattern a-sineAmp offset = (+ offset) <$> sinewave1---- | @sawwave@ is the equivalent of @sinewave@ for (ascending) sawtooth waves.-sawwave :: (Fractional a, Real a) => Pattern a-sawwave = sig $ \t -> mod' (fromRational t) 1---- | @saw@ is a synonym for @sawwave@.-saw :: (Fractional a, Real a) => Pattern a-saw = sawwave---- | @triwave@ is the equivalent of @sinewave@ for triangular waves.-triwave :: (Fractional a, Real a) => Pattern a-triwave = append sawwave1 (rev sawwave1)---- | @tri@ is a synonym for @triwave@.-tri :: (Fractional a, Real a) => Pattern a-tri = triwave---- | @squarewave1@ is the equivalent of @sinewave@ for square waves.-squarewave :: (Fractional a, Real a) => Pattern a-squarewave = sig $-             \t -> fromIntegral $ ((floor $ (mod' (fromRational t :: Double) 1) * 2) :: Integer)---- | @square@ is a synonym for @squarewave@.-square :: (Fractional a, Real a) => Pattern a-square = squarewave---- deprecated..-sinewave1 :: Fractional a => Pattern a-sinewave1 = sinewave-sine1 :: Fractional a => Pattern a-sine1 = sinewave-sinerat = sine-ratsine = sine-sinerat1 = sine-sineAmp1 :: Fractional a => a -> Pattern a-sineAmp1 = sineAmp-sawwave1 :: (Fractional a, Real a) => Pattern a-sawwave1 = sawwave-saw1 :: (Fractional a, Real a) => Pattern a-saw1 = sawwave-sawrat = saw-sawrat1 = saw-triwave1 :: (Fractional a, Real a) => Pattern a-triwave1 = triwave-tri1 :: (Fractional a, Real a) => Pattern a-tri1 = triwave-trirat = tri-trirat1 = tri-squarewave1 :: (Fractional a, Real a) => Pattern a-squarewave1 = squarewave-square1 :: (Fractional a, Real a) => Pattern a-square1 = square---- | @envL@ is a @Pattern@ of continuous @Double@ values, representing--- a linear interpolation between 0 and 1 during the first cycle, then--- staying constant at 1 for all following cycles. Possibly only--- useful if you're using something like the retrig function defined--- in tidal.el.-envL :: Pattern Double-envL = sig $ \t -> max 0 $ min (fromRational t) 1---- like envL but reversed.-envLR :: Pattern Double-envLR = (1-) <$> envL---- 'Equal power' for gain-based transitions-envEq :: Pattern Double-envEq = sig $ \t -> sqrt (sin (pi/2 * (max 0 $ min (fromRational (1-t)) 1)))---- Equal power reversed-envEqR :: Pattern Double-envEqR = sig $ \t -> sqrt (cos (pi/2 * (max 0 $ min (fromRational (1-t)) 1)))--fadeOut :: Time -> Pattern a -> Pattern a-fadeOut n = spread' (_degradeBy) (_slow n $ envL)---- Alternate versions where you can provide the time from which the fade starts-fadeOut' :: Time -> Time -> Pattern a -> Pattern a-fadeOut' from dur p = spread' (_degradeBy) (from `rotR` _slow dur envL) p---- The 1 <~ is so fade ins and outs have different degredations-fadeIn' :: Time -> Time -> Pattern a -> Pattern a-fadeIn' from dur p = spread' (\n p -> 1 `rotL` _degradeBy n p) (from `rotR` _slow dur ((1-) <$> envL)) p--fadeIn :: Time -> Pattern a -> Pattern a-fadeIn n = spread' (_degradeBy) (_slow n $ (1-) <$> envL)--{- | (The above is difficult to describe, if you don't understand Haskell,-just ignore it and read the below..)--The `spread` function allows you to take a pattern transformation-which takes a parameter, such as `slow`, and provide several-parameters which are switched between. In other words it 'spreads' a-function across several values.--Taking a simple high hat loop as an example:--@-d1 $ sound "ho ho:2 ho:3 hc"-@--We can slow it down by different amounts, such as by a half:--@-d1 $ slow 2 $ sound "ho ho:2 ho:3 hc"-@--Or by four thirds (i.e. speeding it up by a third; `4%3` means four over-three):--@-d1 $ slow (4%3) $ sound "ho ho:2 ho:3 hc"-@--But if we use `spread`, we can make a pattern which alternates between-the two speeds:--@-d1 $ spread slow [2,4%3] $ sound "ho ho:2 ho:3 hc"-@--Note that if you pass ($) as the function to spread values over, you-can put functions as the list of values. For example:--@-d1 $ spread ($) [density 2, rev, slow 2, striate 3, (# speed "0.8")]-    $ sound "[bd*2 [~ bd]] [sn future]*2 cp jvbass*4"-@--Above, the pattern will have these transforms applied to it, one at a time, per cycle:--* cycle 1: `density 2` - pattern will increase in speed-* cycle 2: `rev` - pattern will be reversed-* cycle 3: `slow 2` - pattern will decrease in speed-* cycle 4: `striate 3` - pattern will be granualized-* cycle 5: `(# speed "0.8")` - pattern samples will be played back more slowly--After `(# speed "0.8")`, the transforms will repeat and start at `density 2` again.--}-spread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b-spread f xs p = slowcat $ map (`f` p) xs--slowspread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b-slowspread = spread--{- | @fastspread@ works the same as @spread@, but the result is squashed into a single cycle. If you gave four values to @spread@, then the result would seem to speed up by a factor of four. Compare these two:--d1 $ spread chop [4,64,32,16] $ sound "ho ho:2 ho:3 hc"--d1 $ fastspread chop [4,64,32,16] $ sound "ho ho:2 ho:3 hc"--There is also @slowspread@, which is an alias of @spread@.--}-fastspread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b-fastspread f xs p = fastcat $ map (\x -> f x p) xs--{- | There's a version of this function, `spread'` (pronounced "spread prime"), which takes a *pattern* of parameters, instead of a list:--@-d1 $ spread' slow "2 4%3" $ sound "ho ho:2 ho:3 hc"-@--This is quite a messy area of Tidal - due to a slight difference of-implementation this sounds completely different! One advantage of-using `spread'` though is that you can provide polyphonic parameters, e.g.:--@-d1 $ spread' slow "[2 4%3, 3]" $ sound "ho ho:2 ho:3 hc"-@--}-spread' :: Monad m => (a -> b -> m c) -> m a -> b -> m c-spread' f vpat pat = vpat >>= \v -> f v pat--{- | `spreadChoose f xs p` is similar to `slowspread` but picks values from-`xs` at random, rather than cycling through them in order. It has a-shorter alias `spreadr`.--}-spreadChoose :: (t -> t1 -> Pattern b) -> [t] -> t1 -> Pattern b-spreadChoose f vs p = do v <- _discretise 1 (choose vs)-                         f v p--spreadr :: (t -> t1 -> Pattern b) -> [t] -> t1 -> Pattern b-spreadr = spreadChoose--filterValues :: (a -> Bool) -> Pattern a -> Pattern a-filterValues f (Pattern x) = Pattern $ (filter (f . thd')) . x--filterJust :: Pattern (Maybe a) -> Pattern a-filterJust p = fromJust <$> (filterValues (isJust) p)---- Filter out events that have had their onsets cut off-filterOnsets :: Pattern a -> Pattern a-filterOnsets (Pattern f) =-  Pattern $ (filter (\e -> eventOnset e >= eventStart e)) . f---- Filter events which have onsets, which are within the given range--- TODO - what about < e ??-filterStartInRange :: Pattern a -> Pattern a-filterStartInRange (Pattern f) =-  Pattern $ \(s,e) -> filter ((isIn (s,e)) . eventOnset) $ f (s,e)--filterOnsetsInRange :: Pattern a -> Pattern a-filterOnsetsInRange = filterOnsets . filterStartInRange---- Samples some events from a pattern, returning a list of onsets--- (relative to the given arc), deltas (durations) and values.-seqToRelOnsetDeltas :: Arc -> Pattern a -> [(Double, Double, a)]-seqToRelOnsetDeltas (s, e) p = map (\((s', e'), _, x) -> (fromRational $ (s'-s) / (e-s), fromRational $ (e'-s) / (e-s), x)) $ arc (filterOnsetsInRange p) (s, e)--segment :: Pattern a -> Pattern [a]-segment p = Pattern $ \(s,e) -> filter (\(_,(s',e'),_) -> s' < e && e' > s) $ groupByTime (segment' (arc p (s,e)))--segment' :: [Event a] -> [Event a]-segment' es = foldr split es pts-  where pts = nub $ points es--split :: Time -> [Event a] -> [Event a]-split _ [] = []-split t ((ev@(a,(s,e), v)):es) | t > s && t < e = (a,(s,t),v):(a,(t,e),v):(split t es)-                               | otherwise = ev:split t es--points :: [Event a] -> [Time]-points [] = []-points ((_,(s,e), _):es) = s:e:(points es)--groupByTime :: [Event a] -> [Event [a]]-groupByTime es = map mrg $ groupBy ((==) `on` snd') $ sortBy (compare `on` snd') es-  where mrg es@((a, a', _):_) = (a, a', map thd' es)-        mrg _ = error "groupByTime"---{-| Decide whether to apply one or another function depending on the result of a test function that is passed the current cycle as a number.--@-d1 $ ifp ((== 0).(flip mod 2))-  (striate 4)-  (# coarse "24 48") $-  sound "hh hc"-@--This will apply `striate 4` for every _even_ cycle and aply `# coarse "24 48"` for every _odd_.--Detail: As you can see the test function is arbitrary and does not rely on anything tidal specific. In fact it uses only plain haskell functionality, that is: it calculates the modulo of 2 of the current cycle which is either 0 (for even cycles) or 1. It then compares this value against 0 and returns the result, which is either `True` or `False`. This is what the `ifp` signature's first part signifies `(Int -> Bool)`, a function that takes a whole number and returns either `True` or `False`.--}-ifp :: (Int -> Bool) -> (Pattern a -> Pattern a) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-ifp test f1 f2 p = splitQueries $ Pattern apply-  where apply a | test (floor $ fst a) = (arc $ f1 p) a-                | otherwise = (arc $ f2 p) a--{-|--`rand` generates a continuous pattern of (pseudo-)random, floating point numbers between `0` and `1`.--@-d1 $ sound "bd*8" # pan rand-@--pans bass drums randomly--@-d1 $ sound "sn sn ~ sn" # gain rand-@--makes the snares' randomly loud and quiet.--Numbers coming from this pattern are random, but dependent on time. So if you reset time via `cps (-1)` the random pattern will emit the exact same _random_ numbers again.--In cases where you need two different random patterns, you can shift one of them around to change the time from which the _random_ pattern is read, note the difference:--@-d1 $ jux (|+| gain rand) $ sound "sn sn ~ sn" # gain rand-@--and with the juxed version shifted backwards for 1024 cycles:--@-d1 $ jux (|+| ((1024 <~) $ gain rand)) $ sound "sn sn ~ sn" # gain rand-@--}-rand :: Pattern Double-rand = Pattern $ \a -> [(a, a, timeToRand $ (midPoint a))]--timeToRand :: RealFrac r => r -> Double-timeToRand t = fst $ randomDouble $ pureMT $ floor $ (*1000000) t--{- | Just like `rand` but for whole numbers, `irand n` generates a pattern of (pseudo-) random whole numbers between `0` to `n-1` inclusive. Notably used to pick a random-samples from a folder:--@-d1 $ n (irand 5) # sound "drum"-@--}-irand :: Num a => Int -> Pattern a-irand i = (fromIntegral . (floor :: Double -> Int) . (* (fromIntegral i))) <$> rand--{- | Randomly picks an element from the given list--@-d1 $ sound (samples "xx(3,8)" (tom $ choose ["a", "e", "g", "c"]))-@--plays a melody randomly choosing one of the four notes \"a\", \"e\", \"g\", \"c\".--}-choose :: [a] -> Pattern a-choose [] =  E.throw (E.ErrorCall "Empty list. Nothing to choose from.")-choose xs = (xs !!) <$> (irand $ length xs)--{- |-Similar to `degrade` `degradeBy` allows you to control the percentage of events that-are removed. For example, to remove events 90% of the time:--@-d1 $ slow 2 $ degradeBy 0.9 $ sound "[[[feel:5*8,feel*3] feel:3*8], feel*4]"-   # accelerate "-6"-   # speed "2"-@---}--degradeBy :: Pattern Double -> Pattern a -> Pattern a-degradeBy = temporalParam _degradeBy--_degradeBy :: Double -> Pattern a -> Pattern a-_degradeBy x p = fmap fst $ filterValues ((> x) . snd) $ (,) <$> p <*> rand--unDegradeBy :: Pattern Double -> Pattern a -> Pattern a-unDegradeBy = temporalParam _unDegradeBy--_unDegradeBy :: Double -> Pattern a -> Pattern a-_unDegradeBy x p = fmap fst $ filterValues ((<= x) . snd) $ (,) <$> p <*> rand--degradeOverBy :: Int -> Pattern Double -> Pattern a -> Pattern a-degradeOverBy i tx p = unwrap $ (\x -> (fmap fst $ filterValues ((> x) . snd) $ (,) <$> p <*> repeatCycles i rand)) <$> (slow (fromIntegral i) tx)---{- | Use @sometimesBy@ to apply a given function "sometimes". For example, the-following code results in `density 2` being applied about 25% of the time:--@-d1 $ sometimesBy 0.25 (density 2) $ sound "bd*8"-@--There are some aliases as well:--@-sometimes = sometimesBy 0.5-often = sometimesBy 0.75-rarely = sometimesBy 0.25-almostNever = sometimesBy 0.1-almostAlways = sometimesBy 0.9-@--}-sometimesBy :: Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-sometimesBy x f p = overlay (_degradeBy x p) (f $ _unDegradeBy x p)---- | @sometimes@ is an alias for sometimesBy 0.5.-sometimes :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a-sometimes = sometimesBy 0.5---- | @often@ is an alias for sometimesBy 0.75.-often :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a-often = sometimesBy 0.75---- | @rarely@ is an alias for sometimesBy 0.25.-rarely :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a-rarely = sometimesBy 0.25---- | @almostNever@ is an alias for sometimesBy 0.1-almostNever :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a-almostNever = sometimesBy 0.1---- | @almostAlways@ is an alias for sometimesBy 0.9-almostAlways :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a-almostAlways = sometimesBy 0.9--never :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a-never = flip const--always :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a-always = id--{- | @someCyclesBy@ is a cycle-by-cycle version of @sometimesBy@. It has a-`someCycles = someCyclesBy 0.5` alias -}-someCyclesBy :: Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-someCyclesBy x = when (test x)-  where test x c = (timeToRand (fromIntegral c :: Double)) < x--somecyclesBy :: Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-somecyclesBy = someCyclesBy--someCycles :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a-someCycles = someCyclesBy 0.5--somecycles :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a-somecycles = someCycles--{- | `degrade` randomly removes events from a pattern 50% of the time:--@-d1 $ slow 2 $ degrade $ sound "[[[feel:5*8,feel*3] feel:3*8], feel*4]"-   # accelerate "-6"-   # speed "2"-@--The shorthand syntax for `degrade` is a question mark: `?`. Using `?`-will allow you to randomly remove events from a portion of a pattern:--@-d1 $ slow 2 $ sound "bd ~ sn bd ~ bd? [sn bd?] ~"-@--You can also use `?` to randomly remove events from entire sub-patterns:--@-d1 $ slow 2 $ sound "[[[feel:5*8,feel*3] feel:3*8]?, feel*4]"-@--}-degrade :: Pattern a -> Pattern a-degrade = _degradeBy 0.5---- | @wedge t p p'@ combines patterns @p@ and @p'@ by squashing the--- @p@ into the portion of each cycle given by @t@, and @p'@ into the--- remainer of each cycle.-wedge :: Time -> Pattern a -> Pattern a -> Pattern a-wedge t p p' = overlay (densityGap (1/t) p) (t `rotR` densityGap (1/(1-t)) p')--timeCat :: [(Time, Pattern a)] -> Pattern a-timeCat tps = stack $ map (\(s,e,p) -> compress (s/total, e/total) p) $ arrange 0 tps-    where total = sum $ map fst tps-          arrange :: Time -> [(Time, Pattern a)] -> [(Time, Time, Pattern a)]-          arrange _ [] = []-          arrange t ((t',p):tps) = (t,t+t',p):(arrange (t+t') tps)--{- | @whenmod@ has a similar form and behavior to `every`, but requires an-additional number. Applies the function to the pattern, when the-remainder of the current loop number divided by the first parameter,-is greater or equal than the second parameter.--For example the following makes every other block of four loops twice-as dense:--@-d1 $ whenmod 8 4 (density 2) (sound "bd sn kurt")-@--}-whenmod :: Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-whenmod a b = Sound.Tidal.Pattern.when ((\t -> (t `mod` a) >= b ))--{- |-@-superimpose f p = stack [p, f p]-@--`superimpose` plays a modified version of a pattern at the same time as the original pattern,-resulting in two patterns being played at the same time.--@-d1 $ superimpose (density 2) $ sound "bd sn [cp ht] hh"-d1 $ superimpose ((# speed "2") . (0.125 <~)) $ sound "bd sn cp hh"-@---}-superimpose :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a-superimpose f p = stack [p, f p]---- | @splitQueries p@ wraps `p` to ensure that it does not get--- queries that span arcs. For example `arc p (0.5, 1.5)` would be--- turned into two queries, `(0.5,1)` and `(1,1.5)`, and the results--- combined. Being able to assume queries don't span cycles often--- makes transformations easier to specify.-splitQueries :: Pattern a -> Pattern a-splitQueries p = Pattern $ \a -> concatMap (arc p) $ arcCycles a--{- | @trunc@ truncates a pattern so that only a fraction of the pattern is played.-The following example plays only the first quarter of the pattern:--@-d1 $ trunc 0.25 $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2"-@--}-trunc :: Pattern Time -> Pattern a -> Pattern a-trunc = temporalParam _trunc--_trunc :: Time -> Pattern a -> Pattern a-_trunc t = compress (0,t) . zoom (0,t)--{- | @linger@ is similar to `trunc` but the truncated part of the pattern loops until the end of the cycle--@-d1 $ linger 0.25 $ sound "bd sn*2 cp hh*4 arpy bd*2 cp bd*2"-@--}-linger :: Pattern Time -> Pattern a -> Pattern a-linger = temporalParam _linger--_linger :: Time -> Pattern a -> Pattern a-_linger n p = _density (1/n) $ zoom (0,n) p--{- | Plays a portion of a pattern, specified by a beginning and end arc of time.-The new resulting pattern is played over the time period of the original pattern:--@-d1 $ zoom (0.25, 0.75) $ sound "bd*2 hh*3 [sn bd]*2 drum"-@--In the pattern above, `zoom` is used with an arc from 25% to 75%. It is equivalent to this pattern:--@-d1 $ sound "hh*3 [sn bd]*2"-@--}-zoom :: Arc -> Pattern a -> Pattern a-zoom (s,e) p = splitQueries $ withResultArc (mapCycle ((/d) . (subtract s))) $ withQueryArc (mapCycle ((+s) . (*d))) p-     where d = e-s--compress :: Arc -> Pattern a -> Pattern a-compress (s,e) p | s >= e = silence-                 | otherwise = s `rotR` densityGap (1/(e-s)) p--sliceArc :: Arc -> Pattern a -> Pattern a-sliceArc a@(s,e) p | s >= e = silence-                   | otherwise = compress a $ zoom a p--{- |-Use `within` to apply a function to only a part of a pattern. For example, to-apply `density 2` to only the first half of a pattern:--@-d1 $ within (0, 0.5) (density 2) $ sound "bd*2 sn lt mt hh hh hh hh"-@--Or, to apply `(# speed "0.5") to only the last quarter of a pattern:--@-d1 $ within (0.75, 1) (# speed "0.5") $ sound "bd*2 sn lt mt hh hh hh hh"-@--}-within :: Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-within (s,e) f p = stack [playWhen (\t -> cyclePos t >= s && cyclePos t < e) $ f p,-                          playWhen (\t -> not $ cyclePos t >= s && cyclePos t < e) $ p-                         ]--{- |-For many cases, @within'@ will function exactly as within.  -The difference between the two occurs when applying functions that change the timing of notes such as 'fast' or '<~'. -within first applies the function to all notes in the cycle, then keeps the results in the specified interval, and then combines it with the old cycle (an "apply split combine" paradigm). -within' first keeps notes in the specified interval, then applies the function to these notes, and then combines it with the old cycle (a "split apply combine" paradigm).---For example, whereas using the standard version of within--@-d1 $ within (0, 0.25) (fast 2) $ sound "bd hh cp sd"-@--sounds like:--@-d1 $ sound "[bd hh] hh cp sd"-@--using this alternative version, within'--@-d1 $ within' (0, 0.25) (fast 2) $ sound "bd hh cp sd"-@--sounds like: --@-d1 $ sound "[bd bd] hh cp sd"-@---}--within' :: Arc -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-within' (s,e) f p = stack [playWhen (\t -> cyclePos t >= s && cyclePos t < e) $ compress (s,e) $ f $ zoom (s,e) $ p, -                           playWhen (\t -> not $ cyclePos t >= s && cyclePos t < e) $ p -                          ]---revArc :: Arc -> Pattern a -> Pattern a-revArc a = within a rev--{- | You can use the @e@ function to apply a Euclidean algorithm over a-complex pattern, although the structure of that pattern will be lost:--@-d1 $ e 3 8 $ sound "bd*2 [sn cp]"-@--In the above, three sounds are picked from the pattern on the right according-to the structure given by the `e 3 8`. It ends up picking two `bd` sounds, a-`cp` and missing the `sn` entirely.--These types of sequences use "Bjorklund's algorithm", which wasn't made for-music but for an application in nuclear physics, which is exciting. More-exciting still is that it is very similar in structure to the one of the first-known algorithms written in Euclid's book of elements in 300 BC. You can read-more about this in the paper-[The Euclidean Algorithm Generates Traditional Musical Rhythms](http://cgm.cs.mcgill.ca/~godfried/publications/banff.pdf)-by Toussaint. Some examples from this paper are included below,-including rotation in some cases.--@-- (2,5) : A thirteenth century Persian rhythm called Khafif-e-ramal.-- (3,4) : The archetypal pattern of the Cumbia from Colombia, as well as a Calypso rhythm from Trinidad.-- (3,5,2) : Another thirteenth century Persian rhythm by the name of Khafif-e-ramal, as well as a Rumanian folk-dance rhythm.-- (3,7) : A Ruchenitza rhythm used in a Bulgarian folk-dance.-- (3,8) : The Cuban tresillo pattern.-- (4,7) : Another Ruchenitza Bulgarian folk-dance rhythm.-- (4,9) : The Aksak rhythm of Turkey.-- (4,11) : The metric pattern used by Frank Zappa in his piece titled Outside Now.-- (5,6) : Yields the York-Samai pattern, a popular Arab rhythm.-- (5,7) : The Nawakhat pattern, another popular Arab rhythm.-- (5,8) : The Cuban cinquillo pattern.-- (5,9) : A popular Arab rhythm called Agsag-Samai.-- (5,11) : The metric pattern used by Moussorgsky in Pictures at an Exhibition.-- (5,12) : The Venda clapping pattern of a South African children’s song.-- (5,16) : The Bossa-Nova rhythm necklace of Brazil.-- (7,8) : A typical rhythm played on the Bendir (frame drum).-- (7,12) : A common West African bell pattern.-- (7,16,14) : A Samba rhythm necklace from Brazil.-- (9,16) : A rhythm necklace used in the Central African Republic.-- (11,24,14) : A rhythm necklace of the Aka Pygmies of Central Africa.-- (13,24,5) : Another rhythm necklace of the Aka Pygmies of the upper Sangha.-@--}-e :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a-e = temporalParam2 _e--_e :: Int -> Int -> Pattern a -> Pattern a-_e n k p = (flip const) <$> (filterValues (== True) $ listToPat $ bjorklund (n,k)) <*> p--e' :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a-e' = temporalParam2 _e'--_e' :: Int -> Int -> Pattern a -> Pattern a-_e' n k p = fastcat $ map (\x -> if x then p else silence) (bjorklund (n,k))---distrib :: [Pattern Int] -> Pattern a -> Pattern a-distrib steps p = do steps' <- sequence steps-                     _distrib steps' p--_distrib :: [Int] -> Pattern a -> Pattern a-_distrib xs p = boolsToPat (foldr (distrib') (replicate (last xs) True) (reverse $ layers xs)) p-  where-    distrib' :: [Bool] -> [Bool] -> [Bool]-    distrib' [] _ = []-    distrib' (_:a) [] = False:(distrib' a [])-    distrib' (True:a) (x:b) = x:(distrib' a b)-    distrib' (False:a) (b) = False:(distrib' a b)-    layers = map bjorklund . (zip<*>tail)-    boolsToPat p p' = (flip const) <$> (filterValues (== True) $ listToPat $ p) <*> p'--{- | `einv` fills in the blanks left by `e`- -- @e 3 8 "x"@ -> @"x ~ ~ x ~ ~ x ~"@-- @einv 3 8 "x"@ -> @"~ x x ~ x x ~ x"@--}-einv :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a-einv = temporalParam2 _einv--_einv :: Int -> Int -> Pattern a -> Pattern a-_einv n k p = (flip const) <$> (filterValues (== False) $ listToPat $ bjorklund (n,k)) <*> p--{- | `efull n k pa pb` stacks @e n k pa@ with @einv n k pb@ -}-efull :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a -> Pattern a-efull n k pa pb = stack [ e n k pa, einv n k pb ]--index :: Real b => b -> Pattern b -> Pattern c -> Pattern c-index sz indexpat pat = spread' (zoom' $ toRational sz) (toRational . (*(1-sz)) <$> indexpat) pat-  where zoom' sz start = zoom (start, start+sz)---- | @prrw f rot (blen, vlen) beatPattern valuePattern@: pattern rotate/replace.-prrw :: (a -> b -> c) -> Int -> (Time, Time) -> Pattern a -> Pattern b -> Pattern c-prrw f rot (blen, vlen) beatPattern valuePattern =-  let-    ecompare (_,e1,_) (_,e2,_) = compare (fst e1) (fst e2)-    beats  = sortBy ecompare $ arc beatPattern (0, blen)-    values = fmap thd' . sortBy ecompare $ arc valuePattern (0, vlen)-    cycles = blen * (fromIntegral $ lcm (length beats) (length values) `div` (length beats))-  in-    _slow cycles $ stack $ zipWith-    (\( _, (start, end), v') v -> (start `rotR`) $ densityGap (1 / (end - start)) $ pure (f v' v))-    (sortBy ecompare $ arc (_density cycles $ beatPattern) (0, blen))-    (drop (rot `mod` length values) $ cycle values)---- | @prr rot (blen, vlen) beatPattern valuePattern@: pattern rotate/replace.-prr :: Int -> (Time, Time) -> Pattern String -> Pattern b -> Pattern b-prr = prrw $ flip const--{-|-@preplace (blen, plen) beats values@ combines the timing of @beats@ with the values-of @values@. Other ways of saying this are:-* sequential convolution-* @values@ quantized to @beats@.--Examples:--@-d1 $ sound $ preplace (1,1) "x [~ x] x x" "bd sn"-d1 $ sound $ preplace (1,1) "x(3,8)" "bd sn"-d1 $ sound $ "x(3,8)" <~> "bd sn"-d1 $ sound "[jvbass jvbass:5]*3" |+| (shape $ "1 1 1 1 1" <~> "0.2 0.9")-@--It is assumed the pattern fits into a single cycle. This works well with-pattern literals, but not always with patterns defined elsewhere. In those cases-use @preplace@ and provide desired pattern lengths:-@-let p = slow 2 $ "x x x"--d1 $ sound $ preplace (2,1) p "bd sn"-@--}-preplace :: (Time, Time) -> Pattern String -> Pattern b -> Pattern b-preplace = preplaceWith $ flip const---- | @prep@ is an alias for preplace.-prep :: (Time, Time) -> Pattern String -> Pattern b -> Pattern b-prep = preplace--preplace1 :: Pattern String -> Pattern b -> Pattern b-preplace1 = preplace (1, 1)--preplaceWith :: (a -> b -> c) -> (Time, Time) -> Pattern a -> Pattern b -> Pattern c-preplaceWith f (blen, plen) = prrw f 0 (blen, plen)--prw :: (a -> b -> c) -> (Time, Time) -> Pattern a -> Pattern b -> Pattern c-prw = preplaceWith--preplaceWith1 :: (a -> b -> c) -> Pattern a -> Pattern b -> Pattern c-preplaceWith1 f = prrw f 0 (1, 1)--prw1 :: (a -> b -> c) -> Pattern a -> Pattern b -> Pattern c-prw1 = preplaceWith1--(<~>) :: Pattern String -> Pattern b -> Pattern b-(<~>) = preplace (1, 1)---- | @protate len rot p@ rotates pattern @p@ by @rot@ beats to the left.--- @len@: length of the pattern, in cycles.--- Example: @d1 $ every 4 (protate 2 (-1)) $ slow 2 $ sound "bd hh hh hh"@-protate :: Time -> Int -> Pattern a -> Pattern a-protate len rot p = prrw (flip const) rot (len, len) p p--prot :: Time -> Int -> Pattern a -> Pattern a-prot = protate--prot1 :: Int -> Pattern a -> Pattern a-prot1 = protate 1--{-| The @<<~@ operator rotates a unit pattern to the left, similar to @<~@,-but by events rather than linear time. The timing of the pattern remains constant:--@-d1 $ (1 <<~) $ sound "bd ~ sn hh"--- will become-d1 $ sound "sn ~ hh bd"-@ -}--(<<~) :: Int -> Pattern a -> Pattern a-(<<~) = protate 1---- | @~>>@ is like @<<~@ but for shifting to the right.-(~>>) :: Int -> Pattern a -> Pattern a-(~>>) = (<<~) . (0-)---- | @pequal cycles p1 p2@: quickly test if @p1@ and @p2@ are the same.-pequal :: Ord a => Time -> Pattern a -> Pattern a -> Bool-pequal cycles p1 p2 = (sort $ arc p1 (0, cycles)) == (sort $ arc p2 (0, cycles))---- | @discretise n p@: 'samples' the pattern @p@ at a rate of @n@--- events per cycle. Useful for turning a continuous pattern into a--- discrete one.-discretise :: Time -> Pattern a -> Pattern a-discretise = _discretise--discretise' :: Pattern Time -> Pattern a -> Pattern a-discretise' n p = (density n $ atom (id)) <*> p--_discretise :: Time -> Pattern a -> Pattern a-_discretise n p = (_density n $ atom (id)) <*> p---- | @randcat ps@: does a @slowcat@ on the list of patterns @ps@ but--- randomises the order in which they are played.-randcat :: [Pattern a] -> Pattern a-randcat ps = spread' (rotL) (_discretise 1 $ ((%1) . fromIntegral) <$> (irand (length ps) :: Pattern Int)) (slowcat ps)---- @fromNote p@: converts a pattern of human-readable pitch names--- into pitch numbers. For example, @"cs2"@ will be parsed as C Sharp--- in the 2nd octave with the result of @11@, and @"b-3"@ as--- @-25@. Pitches can be decorated using:------    * s = Sharp, a half-step above (@"gs-1"@)---    * f = Flat, a half-step below (@"gf-1"@)---    * n = Natural, no decoration (@"g-1" and "gn-1"@ are equivalent)---    * ss = Double sharp, a whole step above (@"gss-1"@)---    * ff = Double flat, a whole step below (@"gff-1"@)------ Note that TidalCycles now assumes that middle C is represented by--- the value 0, rather than the previous value of 60. This function--- is similar to previously available functions @tom@ and @toMIDI@,--- but the default octave is now 0 rather than 5.-{---definition moved to Parse.hs ..--toMIDI :: Pattern String -> Pattern Int-toMIDI p = fromJust <$> (filterValues (isJust) (noteLookup <$> p))-  where-    noteLookup :: String -> Maybe Int-    noteLookup [] = Nothing-    noteLookup s | not (last s `elem` ['0' .. '9']) = noteLookup (s ++ "0")-                 | not (isLetter (s !! 1)) = noteLookup((head s):'n':(tail s))-                 | otherwise = parse s-    parse x = (\a b c -> a+b+c) <$> pc x <*> sym x <*> Just(12*digitToInt (last x))-    pc x = lookup (head x) [('c',0),('d',2),('e',4),('f',5),('g',7),('a',9),('b',11)]-    sym x = lookup (init (tail x)) [("s",1),("f",-1),("n",0),("ss",2),("ff",-2)]--}---- @tom p@: Alias for @toMIDI@.--- tom = toMIDI---{- | The `fit` function takes a pattern of integer numbers, which are used to select values from the given list. What makes this a bit strange is that only a given number of values are selected each cycle. For example:--@-d1 $ sound (fit 3 ["bd", "sn", "arpy", "arpy:1", "casio"] "0 [~ 1] 2 1")-@--The above fits three samples into the pattern, i.e. for the first cycle this will be `"bd"`, `"sn"` and `"arpy"`, giving the result `"bd [~ sn] arpy sn"` (note that we start counting at zero, so that `0` picks the first value). The following cycle the *next* three values in the list will be picked, i.e. `"arpy:1"`, `"casio"` and `"bd"`, giving the pattern `"arpy:1 [~ casio] bd casio"` (note that the list wraps round here).---}-fit :: Int -> [a] -> Pattern Int -> Pattern a-fit perCycle xs p = (xs !!!) <$> (Pattern $ \a -> map ((\e -> (mapThd' (+ (cyclePos perCycle e)) e))) (arc p a))-  where cyclePos perCycle e = perCycle * (floor $ eventStart e)--permstep :: RealFrac b => Int -> [a] -> Pattern b -> Pattern a-permstep steps things p = unwrap $ (\n -> listToPat $ concatMap (\x -> replicate (fst x) (snd x)) $ zip (ps !! (floor (n * (fromIntegral $ (length ps - 1))))) things) <$> (_discretise 1 p)-      where ps = permsort (length things) steps-            deviance avg xs = sum $ map (abs . (avg-) . fromIntegral) xs-            permsort n total = map fst $ sortBy (comparing snd) $ map (\x -> (x,deviance (fromIntegral total / (fromIntegral n :: Double)) x)) $ perms n total-            perms 0 _ = []-            perms 1 n = [[n]]-            perms n total = concatMap (\x -> map (x:) $ perms (n-1) (total-x)) [1 .. (total-(n-1))]---- | @struct a b@: structures pattern @b@ in terms of @a@.-struct :: Pattern String -> Pattern a -> Pattern a-struct ps pv = (flip const) <$> ps <*> pv----- | @substruct a b@: similar to @struct@, but each event in pattern @a@ gets replaced with pattern @b@, compressed to fit the timespan of the event.-substruct :: Pattern String -> Pattern b -> Pattern b-substruct s p = Pattern $ f-  where f a = concatMap (\a' -> arc (compressTo a' p) a') $ (map fst' $ arc s a)--compressTo :: Arc -> Pattern a -> Pattern a-compressTo (s,e) p = compress (cyclePos s, e-(sam s)) p--randArcs :: Int -> Pattern [Arc]-randArcs n =-  do rs <- mapM (\x -> (pure $ (toRational x)/(toRational n)) <~ choose [1,2,3]) [0 .. (n-1)]-     let rats = map toRational rs-         total = sum rats-         pairs = pairUp $ accumulate $ map ((/total)) rats-     return $ pairs-       where pairUp [] = []-             pairUp xs = (0,head xs):(pairUp' xs)-             pairUp' [] = []-             pairUp' (_:[]) = []-             pairUp' (a:_:[]) = [(a,1)]-             pairUp' (a:b:xs) = (a,b):(pairUp' (b:xs))--randStruct :: Int -> Pattern Int-randStruct n = splitQueries $ Pattern f-  where f (s,e) = mapSnds' fromJust $ filter (\(_,x,_) -> isJust x) $ as-          where as = map (\(n, (s',e')) -> ((s' + sam s, e' + sam s),-                                           subArc (s,e) (s' + sam s, e' + sam s),-                                           n-                                          )-                         ) $ enumerate $ thd' $ head $ arc (randArcs n) (sam s, nextSam s)--substruct' :: Pattern Int -> Pattern a -> Pattern a-substruct' s p = Pattern $ \a -> concatMap (\(a', _, i) -> arc (compressTo a' (inside (pure $ 1/toRational(length (arc s (sam (fst a), nextSam (fst a))))) (rotR (toRational i)) p)) a') (arc s a)---- | @stripe n p@: repeats pattern @p@, @n@ times per cycle. So--- similar to @fast@, but with random durations. The repetitions will--- be continguous (touching, but not overlapping) and the durations--- will add up to a single cycle. @n@ can be supplied as a pattern of--- integers.-stripe :: Pattern Int -> Pattern a -> Pattern a-stripe = temporalParam _stripe--_stripe :: Int -> Pattern a -> Pattern a-_stripe = substruct' . randStruct---- | @slowstripe n p@: The same as @stripe@, but the result is also--- @n@ times slower, so that the mean average duration of the stripes--- is exactly one cycle, and every @n@th stripe starts on a cycle--- boundary (in indian classical terms, the @sam@).-slowstripe :: Pattern Int -> Pattern a -> Pattern a-slowstripe n = slow (toRational <$> n) . stripe n---- Lindenmayer patterns, these go well with the step sequencer--- general rule parser (strings map to strings)-parseLMRule :: String -> [(String,String)]-parseLMRule s = map (splitOn ':') (commaSplit s)-  where splitOn sep str = splitAt (fromJust $ elemIndex sep str)-                            $ filter (/= sep) str-        commaSplit s = map T.unpack $ T.splitOn (T.pack ",") $ T.pack s---- specific parser for step sequencer (chars map to string)--- ruleset in form "a:b,b:ab"-parseLMRule' :: String -> [(Char, String)]-parseLMRule' str = map fixer $ parseLMRule str-  where fixer (c,r) = (head c, r)--{- | returns the `n`th iteration of a [Lindenmayer System](https://en.wikipedia.org/wiki/L-system) with given start sequence.--for example:--@-lindenmayer 1 "a:b,b:ab" "ab" -> "bab"-@--}-lindenmayer :: Int -> String -> String -> String-lindenmayer _ _ [] = []-lindenmayer 1 r (c:cs) = (fromMaybe [c] $ lookup c $ parseLMRule' r)-                         ++ (lindenmayer 1 r cs)-lindenmayer n r s = iterate (lindenmayer 1 r) s !! n--{- | @lindenmayerI@ converts the resulting string into a a list of integers-with @fromIntegral@ applied (so they can be used seamlessly where floats or-rationals are required) -}-lindenmayerI n r s = fmap fromIntegral $ fmap digitToInt $ lindenmayer n r s---- support for fit'-unwrap' :: Pattern (Pattern a) -> Pattern a-unwrap' pp = Pattern $ \a -> arc (stack $ map scalep (arc pp a)) a-  where scalep ev = compress (fst' ev) $ thd' ev--{-|-Removes events from second pattern that don't start during an event from first.--Consider this, kind of messy rhythm without any rests.--@-d1 $ sound (slowcat ["sn*8", "[cp*4 bd*4, hc*5]"]) # n (run 8)-@--If we apply a mask to it--@-d1 $ s (mask ("1 1 1 ~ 1 1 ~ 1" :: Pattern Bool)-  (slowcat ["sn*8", "[cp*4 bd*4, bass*5]"] ))-  # n (run 8)-@--Due to the use of `slowcat` here, the same mask is first applied to `"sn*8"` and in the next cycle to `"[cp*4 bd*4, hc*5]".--You could achieve the same effect by adding rests within the `slowcat` patterns, but mask allows you to do this more easily. It kind of keeps the rhythmic structure and you can change the used samples independently, e.g.--@-d1 $ s (mask ("1 ~ 1 ~ 1 1 ~ 1" :: Pattern Bool)-  (slowcat ["can*8", "[cp*4 sn*4, jvbass*16]"] ))-  # n (run 8)-@--Detail: It is currently needed to explicitly _tell_ Tidal that the mask itself is a `Pattern Bool` as it cannot infer this by itself, otherwise it will complain as it does not know how to interpret your input.--}-mask :: Pattern a -> Pattern b -> Pattern b-mask pa pb = Pattern $ \a -> concat [filterOns (subArc a $ eventArc i) (arc pb a) | i <- arc pa a]-     where filterOns Nothing _ = []-           filterOns (Just arc) es = filter (onsetIn arc) es--enclosingArc :: [Arc] -> Arc-enclosingArc [] = (0,1)-enclosingArc as = (minimum (map fst as), maximum (map snd as))--stretch :: Pattern a -> Pattern a-stretch p = splitQueries $ Pattern $ \a@(s,_e) -> arc-              (zoom (enclosingArc $ map eventArc $ arc p (sam s,nextSam s)) p)-              a--{- | `fit'` is a generalization of `fit`, where the list is instead constructed by using another integer pattern to slice up a given pattern.  The first argument is the number of cycles of that latter pattern to use when slicing.  It's easier to understand this with a few examples:--@-d1 $ sound (fit' 1 2 "0 1" "1 0" "bd sn")-@--So what does this do?  The first `1` just tells it to slice up a single cycle of `"bd sn"`. The `2` tells it to select two values each cycle, just like the first argument to `fit`.  The next pattern `"0 1"` is the "from" pattern which tells it how to slice, which in this case means `"0"` maps to `"bd"`, and `"1"` maps to `"sn"`.  The next pattern `"1 0"` is the "to" pattern, which tells it how to rearrange those slices.  So the final result is the pattern `"sn bd"`.--A more useful example might be something like--@-d1 $ fit' 1 4 (run 4) "[0 3*2 2 1 0 3*2 2 [1*8 ~]]/2" $ chop 4 $ (sound "breaks152" # unit "c")-@--which uses `chop` to break a single sample into individual pieces, which `fit'` then puts into a list (using the `run 4` pattern) and reassembles according to the complicated integer pattern.---}-fit' :: Pattern Time -> Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a-fit' cyc n from to p = unwrap' $ fit n (mapMasks n from' p') to-  where mapMasks n from p = [stretch $ mask (filterValues (== i) from) p-                             | i <- [0..n-1]]-        p' = density cyc $ p-        from' = density cyc $ from--{-| @chunk n f p@ treats the given pattern @p@ as having @n@ chunks, and applies the function @f@ to one of those sections per cycle, running from left to right.--@-d1 $ chunk 4 (density 4) $ sound "cp sn arpy [mt lt]"-@--}-chunk :: Integer -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b-chunk n f p = cat [within (i%(fromIntegral n),(i+1)%(fromIntegral n)) f p | i <- [0..n-1]]--{--chunk n f p = do i <- _slow (toRational n) $ run (fromIntegral n)-                 within (i%(fromIntegral n),(i+)1%(fromIntegral n)) f p--}---- deprecated (renamed to chunk)-runWith :: Integer -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b-runWith = chunk--{-| @chunk'@ works much the same as `chunk`, but runs from right to left.--}-chunk' :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b-chunk' n f p = do i <- _slow (toRational n) $ rev $ run (fromIntegral n)-                  within (i%(fromIntegral n),(i+)1%(fromIntegral n)) f p---- deprecated (renamed to chunk')-runWith' :: Integral a => a -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b-runWith' = chunk'--inside :: Pattern Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a-inside n f p = density n $ f (slow n p)--outside :: Pattern Time -> (Pattern a1 -> Pattern a) -> Pattern a1 -> Pattern a-outside n = inside (1/n)--loopFirst :: Pattern a -> Pattern a-loopFirst p = splitQueries $ Pattern f-  where f a@(s,_) = mapSnds' plus $ mapFsts' plus $ arc p (minus a)-          where minus = mapArc (subtract (sam s))-                plus = mapArc (+ (sam s))--timeLoop :: Pattern Time -> Pattern a -> Pattern a-timeLoop n = outside n loopFirst--seqPLoop :: [(Time, Time, Pattern a)] -> Pattern a-seqPLoop ps = timeLoop (pure $ maxT - minT) $ minT `rotL` seqP ps-  where minT = minimum $ map fst' ps-        maxT = maximum $ map snd' ps--{- | @toScale@ lets you turn a pattern of notes within a scale (expressed as a-list) to note numbers.  For example `toScale [0, 4, 7] "0 1 2 3"` will turn-into the pattern `"0 4 7 12"`.  It assumes your scale fits within an octave;-to change this use `toScale' size`.  Example:-`toScale' 24 [0,4,7,10,14,17] (run 8)` turns into `"0 4 7 10 14 17 24 28"`--}-toScale' :: Num a => Int -> [a] -> Pattern Int -> Pattern a-toScale' o s = fmap noteInScale-  where octave x = x `div` length s-        noteInScale x = (s !!! x) + (fromIntegral $ o * octave x)--toScale :: Num a => [a] -> Pattern Int -> Pattern a-toScale = toScale' 12--{- | `swingBy x n` divides a cycle into `n` slices and delays the notes in-the second half of each slice by `x` fraction of a slice . @swing@ is an alias-for `swingBy (1%3)`--}-swingBy :: Pattern Time -> Pattern Time -> Pattern a -> Pattern a-swingBy x n = inside n (within (0.5,1) (x ~>))--swing :: Pattern Time -> Pattern a -> Pattern a-swing = swingBy (pure $ 1%3)--{- | `cycleChoose` is like `choose` but only picks a new item from the list-once each cycle -}-cycleChoose::[a] -> Pattern a-cycleChoose xs = Pattern $ \(s,e) -> [((s,e),(s,e), xs!!(floor $ (dlen xs)*(ctrand s) ))]-  where dlen xs = fromIntegral $ length xs-        ctrand s = (timeToRand :: Time -> Double) $ fromIntegral $ (floor :: Time -> Int) $ sam s--{- | `shuffle n p` evenly divides one cycle of the pattern `p` into `n` parts,-and returns a random permutation of the parts each cycle.  For example,-`shuffle 3 "a b c"` could return `"a b c"`, `"a c b"`, `"b a c"`, `"b c a"`,-`"c a b"`, or `"c b a"`.  But it will **never** return `"a a a"`, because that-is not a permutation of the parts.--}-shuffle::Int -> Pattern a -> Pattern a-shuffle n = fit' 1 n (_run n) (randpat n)-  where randpat n = Pattern $ \(s,e) -> arc (p n $ sam s) (s,e)-        p n c = listToPat $ map snd $ sort $ zip-                  [timeToRand (c+i/n') | i <- [0..n'-1]] [0..n-1]-        n' :: Time-        n' = fromIntegral n--{- | `scramble n p` is like `shuffle` but randomly selects from the parts-of `p` instead of making permutations.-For example, `scramble 3 "a b c"` will randomly select 3 parts from-`"a"` `"b"` and `"c"`, possibly repeating a single part.--}-scramble::Int -> Pattern a -> Pattern a-scramble n = fit' 1 n (_run n) (_density (fromIntegral n) $-  liftA2 (+) (pure 0) $ irand n)--ur :: Time -> Pattern String -> [(String, Pattern a)] -> [(String, Pattern a -> Pattern a)] -> Pattern a-ur t outer_p ps fs = _slow t $ unwrap $ adjust <$> (timedValues $ (getPat . split) <$> outer_p)-  where split s = wordsBy (==':') s-        getPat (s:xs) = (match s, transform xs)-        match s = fromMaybe silence $ lookup s ps'-        ps' = map (fmap (_density t)) ps-        adjust (a, (p, f)) = f a p-        transform (x:_) a = transform' x a-        transform _ _ = id-        transform' str (s,e) p = s `rotR` (inside (pure $ 1/(e-s)) (matchF str) p)-        matchF str = fromMaybe id $ lookup str fs--inhabit :: [(String, Pattern a)] -> Pattern String -> Pattern a-inhabit ps p = unwrap' $ (\s -> fromMaybe silence $ lookup s ps) <$> p--repeatCycles :: Int -> Pattern a -> Pattern a-repeatCycles n p = fastcat (replicate n p)--{- | @spaceOut xs p@ repeats a pattern @p@ at different durations given by the list of time values in @xs@ -}-spaceOut :: [Time] -> Pattern a -> Pattern a-spaceOut xs p = _slow (toRational $ sum xs) $ stack $ map (\a -> compress a p) $ spaceArcs xs-  where markOut :: Time -> [Time] -> [(Time, Time)]-        markOut _ [] = []-        markOut offset (x:xs) = (offset,offset+x):(markOut (offset+x) xs)-        spaceArcs xs = map (\(a,b) -> (a/s,b/s)) $ markOut 0 xs-        s = sum xs---- | @flatpat@ takes a Pattern of lists and pulls the list elements as--- separate Events-flatpat :: Pattern [a] -> Pattern a-flatpat p = Pattern $ \a -> (concatMap (\(b,b',xs) -> map (\x -> (b,b',x)) xs) $ arc p a)---- | @layer@ takes a Pattern of lists and pulls the list elements as--- separate Events-layer :: [a -> Pattern b] -> a -> Pattern b-layer fs p = stack $ map ($ p) fs---- | @breakUp@ finds events that share the same timespan, and spreads them out during that timespan, so for example @breakUp "[bd,sn]"@ gets turned into @"bd sn"@-breakUp :: Pattern a -> Pattern a-breakUp p = Pattern $ \a -> munge $ arc p a-  where munge es = concatMap spreadOut (groupBy (\a b -> fst' a == fst' b) es)-        spreadOut xs = mapMaybe (\(n, x) -> shiftIt n (length xs) x) $ enumerate xs-        shiftIt n d ((s,e), a', v) = do a'' <- subArc (newS, newE) a'-                                        return ((newS, newE), a'', v)-          where newS = s + (dur*(fromIntegral n))-                newE = newS + dur-                dur = (e - s) / (fromIntegral d)---- | @fill@ 'fills in' gaps in one pattern with events from another. For example @fill "bd" "cp ~ cp"@ would result in the equivalent of `"~ bd ~"`. This only finds gaps in a resulting pattern, in other words @"[bd ~, sn]"@ doesn't contain any gaps (because @sn@ covers it all), and @"bd ~ ~ sn"@ only contains a single gap that bridges two steps.-fill :: Pattern a -> Pattern a -> Pattern a-fill p' p = struct (splitQueries $ Pattern (f p)) p'-  where-    f p (s,e) = removeTolerance (s,e) $ invert (s-tolerance, e+tolerance) $ arc p (s-tolerance, e+tolerance)-    invert (s,e) es = map arcToEvent $ foldr remove [(s,e)] (map snd' es)-    remove (s,e) xs = concatMap (remove' (s, e)) xs-    remove' (s,e) (s',e') | s > s' && e < e' = [(s',s),(e,e')] -- inside-                          | s > s' && s < e' = [(s',s)] -- cut off right-                          | e > s' && e < e' = [(e,e')] -- cut off left-                          | s <= s' && e >= e' = [] -- swallow-                          | otherwise = [(s',e')] -- miss-    arcToEvent a = (a,a,"x")-    removeTolerance (s,e) es = concatMap (expand) $ mapSnds' f es-      where f a = concatMap (remove' (e,e+tolerance)) $ remove' (s-tolerance,s) a-            expand (a,xs,c) = map (\x -> (a,x,c)) xs-    tolerance = 0.01---- Repeats each event @n@ times within its arc-ply :: Pattern Int -> Pattern a -> Pattern a-ply = temporalParam _ply--_ply :: Int -> Pattern a -> Pattern a-_ply n p = breakUp $ stack (replicate n p)---- Uses the first (binary) pattern to switch between the following two--- patterns. -sew :: Pattern Bool -> Pattern a -> Pattern a -> Pattern a-sew stitch p1 p2 = overlay (const <$> p1 <*> a) (const <$> p2 <*> b)-  where a = filterValues (id) stitch-        b = filterValues (not . id) stitch

@@ -1,224 +0,0 @@-module Sound.Tidal.Scales where--import Data.Maybe--import Sound.Tidal.Pattern-import Sound.Tidal.Utils-import Control.Applicative---- five notes scales-minPent :: Num a => [a]-minPent = [0,3,5,7,10]-majPent :: Num a => [a]-majPent = [0,2,4,7,9]----  another mode of major pentatonic-ritusen :: Num a => [a]-ritusen = [0,2,5,7,9]---- another mode of major pentatonic-egyptian :: Num a => [a]-egyptian = [0,2,5,7,10]-----kumai :: Num a => [a]-kumai = [0,2,3,7,9]-hirajoshi :: Num a => [a]-hirajoshi = [0,2,3,7,8]-iwato :: Num a => [a]-iwato = [0,1,5,6,10]-chinese :: Num a => [a]-chinese = [0,4,6,7,11]-indian :: Num a => [a]-indian = [0,4,5,7,10]-pelog :: Num a => [a]-pelog = [0,1,3,7,8]-----prometheus :: Num a => [a]-prometheus = [0,2,4,6,11]-scriabin :: Num a => [a]-scriabin = [0,1,4,7,9]---- han chinese pentatonic scales-gong :: Num a => [a]-gong = [0,2,4,7,9]-shang :: Num a => [a]-shang = [0,2,5,7,10]-jiao :: Num a => [a]-jiao = [0,3,5,8,10]-zhi :: Num a => [a]-zhi = [0,2,5,7,9]-yu :: Num a => [a]-yu = [0,3,5,7,10]---- 6 note scales-whole :: Num a => [a]-whole = [0,2,4,6,8,10]-augmented :: Num a => [a]-augmented = [0,3,4,7,8,11]-augmented2 :: Num a => [a]-augmented2 = [0,1,4,5,8,9]---- hexatonic modes with no tritone-hexMajor7 :: Num a => [a]-hexMajor7 = [0,2,4,7,9,11]-hexDorian :: Num a => [a]-hexDorian = [0,2,3,5,7,10]-hexPhrygian :: Num a => [a]-hexPhrygian = [0,1,3,5,8,10]-hexSus :: Num a => [a]-hexSus = [0,2,5,7,9,10]-hexMajor6 :: Num a => [a]-hexMajor6 = [0,2,4,5,7,9]-hexAeolian :: Num a => [a]-hexAeolian = [0,3,5,7,8,10]---- 7 note scales-major :: Num a => [a]-major = [0,2,4,5,7,9,11]-ionian :: Num a => [a]-ionian = [0,2,4,5,7,9,11]-dorian :: Num a => [a]-dorian = [0,2,3,5,7,9,10]-phrygian :: Num a => [a]-phrygian = [0,1,3,5,7,8,10]-lydian :: Num a => [a]-lydian = [0,2,4,6,7,9,11]-mixolydian :: Num a => [a]-mixolydian = [0,2,4,5,7,9,10]-aeolian :: Num a => [a]-aeolian = [0,2,3,5,7,8,10]-minor :: Num a => [a]-minor = [0,2,3,5,7,8,10]-locrian :: Num a => [a]-locrian = [0,1,3,5,6,8,10]-harmonicMinor :: Num a => [a]-harmonicMinor = [0,2,3,5,7,8,11]-harmonicMajor :: Num a => [a]-harmonicMajor = [0,2,4,5,7,8,11]-melodicMinor :: Num a => [a]-melodicMinor = [0,2,3,5,7,9,11]-melodicMinorDesc :: Num a => [a]-melodicMinorDesc = [0,2,3,5,7,8,10]-melodicMajor :: Num a => [a]-melodicMajor = [0,2,4,5,7,8,10]-bartok :: Num a => [a]-bartok = [0,2,4,5,7,8,10]-hindu :: Num a => [a]-hindu = [0,2,4,5,7,8,10]---- raga modes-todi :: Num a => [a]-todi = [0,1,3,6,7,8,11]-purvi :: Num a => [a]-purvi = [0,1,4,6,7,8,11]-marva :: Num a => [a]-marva = [0,1,4,6,7,9,11]-bhairav :: Num a => [a]-bhairav = [0,1,4,5,7,8,11]-ahirbhairav :: Num a => [a]-ahirbhairav = [0,1,4,5,7,9,10]-----superLocrian :: Num a => [a]-superLocrian = [0,1,3,4,6,8,10]-romanianMinor :: Num a => [a]-romanianMinor = [0,2,3,6,7,9,10]-hungarianMinor :: Num a => [a]-hungarianMinor = [0,2,3,6,7,8,11]-neapolitanMinor :: Num a => [a]-neapolitanMinor = [0,1,3,5,7,8,11]-enigmatic :: Num a => [a]-enigmatic = [0,1,4,6,8,10,11]-spanish :: Num a => [a]-spanish = [0,1,4,5,7,8,10]---- modes of whole tones with added note ->-leadingWhole :: Num a => [a]-leadingWhole = [0,2,4,6,8,10,11]-lydianMinor :: Num a => [a]-lydianMinor = [0,2,4,6,7,8,10]-neapolitanMajor :: Num a => [a]-neapolitanMajor = [0,1,3,5,7,9,11]-locrianMajor :: Num a => [a]-locrianMajor = [0,2,4,5,6,8,10]---- 8 note scales-diminished :: Num a => [a]-diminished = [0,1,3,4,6,7,9,10]-diminished2 :: Num a => [a]-diminished2 = [0,2,3,5,6,8,9,11]---- 12 note scales-chromatic :: Num a => [a]-chromatic = [0,1,2,3,4,5,6,7,8,9,10,11]--scaleP :: Num a => Pattern String -> Pattern Int -> Pattern a-scaleP sp p = (\n scaleName -> noteInScale (fromMaybe [0] $ lookup scaleName scaleTable) n) <$> p <*> sp-  where octave s x = x `div` length s-        noteInScale s x = (s !!! x) + (fromIntegral $ 12 * octave s x)--scaleTable :: Num a => [(String, [a])]-scaleTable = [("minPent", minPent),-              ("majPent", majPent),-              ("ritusen", ritusen),-              ("egyptian", egyptian),-              ("kumai", kumai),-              ("hirajoshi", hirajoshi),-              ("iwato", iwato),-              ("chinese", chinese),-              ("indian", indian),-              ("pelog", pelog),-              ("prometheus", prometheus),-              ("scriabin", scriabin),-              ("gong", gong),-              ("shang", shang),-              ("jiao", jiao),-              ("zhi", zhi),-              ("yu", yu),-              ("whole", whole),-              ("augmented", augmented),-              ("augmented2", augmented2),-              ("hexMajor7", hexMajor7),-              ("hexDorian", hexDorian),-              ("hexPhrygian", hexPhrygian),-              ("hexSus", hexSus),-              ("hexMajor6", hexMajor6),-              ("hexAeolian", hexAeolian),-              ("major", major),-              ("ionian", ionian),-              ("dorian", dorian),-              ("phrygian", phrygian),-              ("lydian", lydian),-              ("mixolydian", mixolydian),-              ("aeolian", aeolian),-              ("minor", minor),-              ("locrian", locrian),-              ("harmonicMinor", harmonicMinor),-              ("harmonicMajor", harmonicMajor),-              ("melodicMinor", melodicMinor),-              ("melodicMinorDesc", melodicMinorDesc),-              ("melodicMajor", melodicMajor),-              ("bartok", bartok),-              ("hindu", hindu),-              ("todi", todi),-              ("purvi", purvi),-              ("marva", marva),-              ("bhairav", bhairav),-              ("ahirbhairav", ahirbhairav),-              ("superLocrian", superLocrian),-              ("romanianMinor", romanianMinor),-              ("hungarianMinor", hungarianMinor),-              ("neapolitanMinor", neapolitanMinor),-              ("enigmatic", enigmatic),-              ("spanish", spanish),-              ("leadingWhole", leadingWhole),-              ("lydianMinor", lydianMinor),-              ("neapolitanMajor", neapolitanMajor),-              ("locrianMajor", locrianMajor),-              ("diminished", diminished),-              ("diminished2", diminished2),-              ("chromatic", chromatic)-             ]-

@@ -1,100 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# OPTIONS_GHC -Wall -fno-warn-orphans -fno-warn-name-shadowing #-}--module Sound.Tidal.Sieve where--import Control.Applicative-import Data.Monoid--import Sound.Tidal.Parse-import Sound.Tidal.Pattern-import Sound.Tidal.Strategies-import Sound.Tidal.Time---- The 'Sieve' datatype, which represents a Xenakis sieve.--- (for an overview, see www.mitpressjournals.org/doi/pdf/10.1162/0148926054094396)--data Sieve a = Sieve {sieveAt :: Int -> a}--instance Functor Sieve where-    fmap f s = Sieve $ \i -> f (sieveAt s i)--instance Applicative Sieve where-    pure b = Sieve $ \i -> b-    a <*> b = Sieve $ \i -> (sieveAt a i) (sieveAt b i)---- | The basic notation for and constructor of a boolean 'Sieve' is @m\@\@n@,--- which represents all integers whose modulo with @m@ is equal to @n@-infixl 9 @@ -(@@) :: Int -> Int -> Sieve Bool -m @@ i = Sieve $ \j -> (j `mod` m) == i---- If Haskell's logic operators had been defined on a type class, we could--- declare Sieve to be an instance, but they haven't so here we are---- | @not'@ gives the complement of a sieve-not' :: Applicative f => f Bool -> f Bool-not' = fmap not---- | @#||#@ gives the union (logical OR) of two sieves-infixl 2 #||#-(#||#) :: Applicative f => f Bool -> f Bool -> f Bool-(#||#) = liftA2 (||)---- | @#&&#@ gives the intersection (logical AND) of two sieves-infixl 3 #&&#-(#&&#) :: Applicative f => f Bool -> f Bool -> f Bool-(#&&#) = liftA2 (&&)---- | `#^^#` gives the exclusive disjunction (logical XOR) of two sieves-infixl 2 #^^#-(#^^#) :: Applicative f => f Bool -> f Bool -> f Bool-(#^^#) x y = (x #&&# not' y) #||# (y #&&# not' x)---- | @sieveToList n@ returns a list of the values of the sieve for each--- nonnegative integer less than @n@ --- For example: @sieveToList 10 $ 3\@\@1@ returns --- `[False, True, False, False, True, False, False, True, False, False]`-sieveToList :: Int -> Sieve a -> [a]-sieveToList n s = map (sieveAt s) [0..n-1]---- | @sieveToString n@ represents the sieve as a character string, where--- @-@ represents False and @x@ represents True-sieveToString :: Int -> Sieve Bool -> [Char]-sieveToString n s = map b2c $ sieveToList n s-    where b2c b | b == True = 'x' | otherwise = '-'---- | @sieveToInts n@ returns a list of nonnegative integers less than @n@--- where the sieve is True-sieveToInts :: Int -> Sieve Bool -> [Int]-sieveToInts n s = map snd $ filter fst $ zip (sieveToList n s) [0..n-1]---- | @sieveToPat n@ returns a pattern where the cycle is divided into @n@--- beats, and there is an event whenever the matching beat number is in the--- sieve--- For example: @sieveToPat 8 $ 3\@\@1@ returns @"~ x ~ ~ x ~ ~ x"@-sieveToPat :: Int -> Sieve Bool -> Pattern String-sieveToPat n s = p $ concatMap b2s $ sieveToList n s where-  b2s b | b == True = "x " | otherwise = "~ "---- | @stepSieve n str@ works like 'sieveToPat' but uses @str@ in the pattern--- instead of @x@-stepSieve :: Int -> String -> Sieve Bool -> Pattern String-stepSieve n str sieve = step str (sieveToString n sieve)---- | @slowstepSieve t@ is shorthand for applying @slow t@ to the result of--- `stepSieve`-slowstepSieve :: Pattern Time -> Int -> String -> Sieve Bool -> Pattern String-slowstepSieve t n str sieve = slow t $ stepSieve n str sieve---- | @scaleSieve n@ uses 'sieveToInts' to turn a sieve into a list of--- integers, and then uses that with the @toScale@ function to--- turn a pattern of numbers into a pattern of notes in the scale.--- For example: @scaleSieve 8 (3\@\@1) "0 1 2 1"@ first converts the sieve--- to the scale @[1, 4, 7]@ and then uses that with @toScale@ to return the--- pattern @"1 4 7 4"@-scaleSieve :: Int -> Sieve Bool -> Pattern Int -> Pattern Int-scaleSieve n sieve = toScale (sieveToInts n sieve)--instance Show (Sieve Bool) where -    show = sieveToString 32

@@ -1,39 +0,0 @@-module Sound.Tidal.Simple where--import Sound.Tidal.Context--crunch :: ParamPattern -> ParamPattern-crunch = (# crush 3)--scratch :: ParamPattern -> ParamPattern-scratch = rev . chop 32--louder :: ParamPattern -> ParamPattern-louder = (|*| gain 1.2)--quieter :: ParamPattern -> ParamPattern-quieter = (|*| gain 0.8)--mute :: ParamPattern -> ParamPattern-mute = const silence--jump :: ParamPattern -> ParamPattern-jump = (0.25 <~)--left :: ParamPattern -> ParamPattern-left = (# pan 0)--right :: ParamPattern -> ParamPattern-right = (# pan 1)--higher :: ParamPattern -> ParamPattern-higher = (|*| speed 1.5)--lower :: ParamPattern -> ParamPattern-lower = (|*| speed 0.75)--faster :: ParamPattern -> ParamPattern-faster = hurry 2--slower :: ParamPattern -> ParamPattern-slower = hurry 0.5

@@ -1,421 +0,0 @@-{-# OPTIONS_GHC -XNoMonomorphismRestriction -XOverloadedStrings #-}--module Sound.Tidal.Strategies where--import Data.Ratio-import Control.Applicative-import qualified Data.Map as Map-import qualified Data.Char as Char-import Data.Fixed-import Data.Maybe--import Sound.Tidal.Dirt-import Sound.Tidal.Pattern-import Sound.Tidal.Stream-import Sound.Tidal.Time-import Sound.Tidal.Utils-import Sound.Tidal.Params-import Sound.Tidal.Parse-import Data.List (transpose)--stutter :: Integral i => i -> Time -> Pattern a -> Pattern a-stutter n t p = stack $ map (\i -> (t * (fromIntegral i)) `rotR` p) [0 .. (n-1)]--echo, triple, quad, double :: Time -> Pattern a -> Pattern a-echo   = stutter 2-triple = stutter 3-quad   = stutter 4-double = echo--{- | The `jux` function creates strange stereo effects, by applying a-function to a pattern, but only in the right-hand channel. For-example, the following reverses the pattern on the righthand side:--@-d1 $ slow 32 $ jux (rev) $ striate' 32 (1/16) $ sound "bev"-@--When passing pattern transforms to functions like [jux](#jux) and [every](#every),-it's possible to chain multiple transforms together with `.`, for-example this both reverses and halves the playback speed of the-pattern in the righthand channel:--@-d1 $ slow 32 $ jux ((# speed "0.5") . rev) $ striate' 32 (1/16) $ sound "bev"-@--}-jux = juxBy 1-juxcut f p = stack [p     # pan (pure 0) # cut (pure (-1)),-                    f $ p # pan (pure 1) # cut (pure (-2))-                   ]--juxcut' fs p = stack $ map (\n -> ((fs !! n) p |+| cut (pure $ 1-n)) # pan (pure $ fromIntegral n / fromIntegral l)) [0 .. l-1]-  where l = length fs--{- | In addition to `jux`, `jux'` allows using a list of pattern transform. resulting patterns from each transformation will be spread via pan from left to right.--For example:--@-d1 $ jux' [iter 4, chop 16, id, rev, palindrome] $ sound "bd sn"-@--will put `iter 4` of the pattern to the far left and `palindrome` to the far right. In the center the original pattern will play and mid left mid right the chopped and the reversed version will appear.--One could also write:--@-d1 $ stack [-    iter 4 $ sound "bd sn" # pan "0",-    chop 16 $ sound "bd sn" # pan "0.25",-    sound "bd sn" # pan "0.5",-    rev $ sound "bd sn" # pan "0.75",-    palindrome $ sound "bd sn" # pan "1",-    ]-@---}-jux' fs p = stack $ map (\n -> ((fs !! n) p) |+| pan (pure $ fromIntegral n / fromIntegral l)) [0 .. l-1]-  where l = length fs---- | Multichannel variant of `jux`, _not sure what it does_-jux4 f p = stack [p # pan (pure (5/8)), f $ p # pan (pure (1/8))]--{- |-With `jux`, the original and effected versions of the pattern are-panned hard left and right (i.e., panned at 0 and 1). This can be a-bit much, especially when listening on headphones. The variant `juxBy`-has an additional parameter, which brings the channel closer to the-centre. For example:--@-d1 $ juxBy 0.5 (density 2) $ sound "bd sn:1"-@--In the above, the two versions of the pattern would be panned at 0.25-and 0.75, rather than 0 and 1.--}-juxBy n f p = stack [p |+| pan 0.5 |-| pan (n/2), f $ p |+| pan 0.5 |+| pan (n/2)]--{- | Smash is a combination of `spread` and `striate` - it cuts the samples-into the given number of bits, and then cuts between playing the loop-at different speeds according to the values in the list.--So this:--@-d1 $ smash 3 [2,3,4] $ sound "ho ho:2 ho:3 hc"-@--Is a bit like this:--@-d1 $ spread (slow) [2,3,4] $ striate 3 $ sound "ho ho:2 ho:3 hc"-@--This is quite dancehall:--@-d1 $ (spread' slow "1%4 2 1 3" $ spread (striate) [2,3,4,1] $ sound-"sn:2 sid:3 cp sid:4")-  # speed "[1 2 1 1]/2"-@--}-smash n xs p = slowcat $ map (\n -> slow n p') xs-  where p' = striate n p--{- | an altenative form to `smash` is `smash'` which will use `chop` instead of `striate`.--}-smash' n xs p = slowcat $ map (\n -> slow n p') xs-  where p' = _chop n p---- samples "jvbass [~ latibro] [jvbass [latibro jvbass]]" ((1%2) `rotL` slow 6 "[1 6 8 7 3]")--samples :: Applicative f => f String -> f Int -> f String-samples p p' = pick <$> p <*> p'--samples' :: Applicative f => f String -> f Int -> f String-samples' p p' = (flip pick) <$> p' <*> p--{--scrumple :: Time -> Pattern a -> Pattern a -> Pattern a-scrumple o p p' = p'' -- overlay p (o `rotR` p'')-  where p'' = Pattern $ \a -> concatMap-                              (\((s,d), vs) -> map (\x -> ((s,d),-                                                           snd x-                                                          )-                                                   )-                                                   (arc p' (s,s))-                              ) (arc p a)--}----rev :: Pattern a -> Pattern a---rev p = Pattern $ \a -> concatMap---                        (\a' -> mapFsts mirrorArc $---                                (arc p (mirrorArc a')))---                        (arcCycles a)----spreadf :: [Pattern a -> Pattern b] -> Pattern a -> Pattern b-spreadf ts p = spread ($)--{- | `spin` will "spin" a layer up a pattern the given number of times, with each successive layer offset in time by an additional `1/n` of a cycle, and panned by an additional `1/n`. The result is a pattern that seems to spin around. This function works best on multichannel systems.--@-d1 $ slow 3 $ spin 4 $ sound "drum*3 tabla:4 [arpy:2 ~ arpy] [can:2 can:3]"-@--}-spin :: Pattern Int -> ParamPattern -> ParamPattern-spin = temporalParam _spin--_spin :: Int -> ParamPattern -> ParamPattern-_spin copies p =-  stack $ map (\n -> let offset = toInteger n % toInteger copies in-                     offset `rotL` p-                     # pan (pure $ fromRational offset)-              )-          [0 .. (copies - 1)]--{-stripe :: Arc -> Pattern a -> Pattern a-stripe (stripeS, stripeE) p = slow t $ Pattern $ \a -> concatMap f $ arcCycles a-  where f a = mapFsts (stretch . stripe') $ arc p (stripe' a)-        trunc' (s,e) = (min s ((sam s) + t), min e ((sam s) + t))-        stretch (s,e) = (sam s + ((s - sam s) / t), sam s + ((e - sam s) / t))--}--sawwave4, sinewave4, rand4 :: Pattern Double-sawwave4 = ((*4) <$> sawwave1)-sinewave4 = ((*4) <$> sinewave1)-rand4 = ((*4) <$> rand)--stackwith p ps | null ps = silence-               | otherwise = stack $ map (\(i, p') -> p' # (((fromIntegral i) % l) `rotL` p)) (zip [0 ..] ps)-  where l = fromIntegral $ length ps--{--cross f p p' = Pattern $ \t -> concat [filter flt $ arc p t,-                                       filter (not . flt) $ arc p' t-                                      ]-]  where flt = f . cyclePos . fst . fst--}--{- | `scale` will take a pattern which goes from 0 to 1 (like `sine1`), and scale it to a different range - between the first and second arguments. In the below example, `scale 1 1.5` shifts the range of `sine1` from 0 - 1 to 1 - 1.5.--@-d1 $ jux (iter 4) $ sound "arpy arpy:2*2"-  |+| speed (slow 4 $ scale 1 1.5 sine1)-@--}-scale :: (Functor f, Num b) => b -> b -> f b -> f b-scale from to p = ((+ from) . (* (to-from))) <$> p--{- | `scalex` is an exponential version of `scale`, good for using with-frequencies.  Do *not* use negative numbers or zero as arguments! -}-scalex :: (Functor f, Floating b) => b -> b -> f b -> f b-scalex from to p = exp <$> scale (log from) (log to) p--{- | `chop` granualizes every sample in place as it is played, turning a pattern of samples into a pattern of sample parts. Use an integer value to specify how many granules each sample is chopped into:--@-d1 $ chop 16 $ sound "arpy arp feel*4 arpy*4"-@--Different values of `chop` can yield very different results, depending-on the samples used:---@-d1 $ chop 16 $ sound (samples "arpy*8" (run 16))-d1 $ chop 32 $ sound (samples "arpy*8" (run 16))-d1 $ chop 256 $ sound "bd*4 [sn cp] [hh future]*2 [cp feel]"-@--}--chop :: Pattern Int -> ParamPattern -> ParamPattern-chop = temporalParam _chop--_chop :: Int -> ParamPattern -> ParamPattern-_chop n p = Pattern $ \queryA -> concatMap (f queryA) $ arcCycles queryA-  where f queryA a = concatMap (chopEvent queryA) (arc p a)-        chopEvent (queryS, queryE) (a,_a',v) = map (newEvent v) $ filter (\(_, (s,e)) -> not $ or [e < queryS, s >= queryE]) (enumerate $ chopArc a n)-        newEvent :: ParamMap -> (Int, Arc) -> Event ParamMap-        newEvent v (i, a) = (a,a,Map.insert (param dirt "end") (VF ((fromIntegral $ i+1)/(fromIntegral n))) $ Map.insert (param dirt "begin") (VF ((fromIntegral i)/(fromIntegral n))) v)---{- | `gap` is similar to `chop` in that it granualizes every sample in place as it is played,-but every other grain is silent. Use an integer value to specify how many granules-each sample is chopped into:--@-d1 $ gap 8 $ sound "jvbass"-d1 $ gap 16 $ sound "[jvbass drum:4]"-@-}--gap :: Pattern Int -> ParamPattern -> ParamPattern-gap = temporalParam _gap--_gap :: Int -> ParamPattern -> ParamPattern-_gap n p = Pattern $ \queryA -> concatMap (f queryA) $ arcCycles queryA-     where f queryA a = concatMap (chopEvent queryA) (arc p a)-           chopEvent (queryS, queryE) (a,_a',v) = map (newEvent v) $ filter (\(_, (s,e)) -> not $ or [e < queryS, s >= queryE]) (enumerate $ everyOther $ chopArc a n)-           newEvent :: ParamMap -> (Int, Arc) -> Event ParamMap-           newEvent v (i, a) = (a,a,Map.insert (param dirt "end") (VF ((fromIntegral $ i+1)/(fromIntegral n))) $ Map.insert (param dirt "begin") (VF ((fromIntegral i)/(fromIntegral n))) v)-           everyOther (x:_:xs) = x:everyOther xs-           everyOther xs = xs--chopArc :: Arc -> Int -> [Arc]-chopArc (s, e) n = map (\i -> ((s + (e-s)*(fromIntegral i/fromIntegral n)), s + (e-s)*((fromIntegral $ i+1)/fromIntegral n))) [0 .. n-1]-{--normEv :: Event a -> Event a -> Event a-normEv ev@(_, (s,e), _) ev'@(_, (s',e'), _)-       | not on && not off = [] -- shouldn't happen-       | on && off = splitEv ev'-       | not on && s' > sam s = []-       | not off && e' < nextSam s = [(fst' ev, mapSnd' (mapSnd (min $ nextSam s)) ev, thd' ev)]-  where on = onsetIn (sam s, nextSam s) ev-        off = offsetIn (sam s, nextSam s) ev-        eplitEv--}---mapCycleEvents :: Pattern a -> ([Event a] -> [Event a]) -> Pattern a---mapCycleEvents p f = splitQueries $ Pattern $ \(s,e) -> filter (\ev -> isJust $ subArc (s,e) (eventArc ev)) $ f $ arc p (sam s, nextSam s)----off :: Time -> Pattern a -> Pattern a---off t p = mapCycleEvents p (mapArcs (mapSnd wrappedPlus . mapFst wrappedPlus))---               where wrapAtCycle f t' = sam t' + cyclePos (f t')---                     wrappedPlus = wrapAtCycle (+t)---en :: [(Int, Int)] -> Pattern String -> Pattern String-en ns p = stack $ map (\(i, (k, n)) -> _e k n (samples p (pure i))) $ enumerate ns--{- |-`weave` applies a function smoothly over an array of different patterns. It uses an `OscPattern` to-apply the function at different levels to each pattern, creating a weaving effect.--@-d1 $ weave 3 (shape $ sine1) [sound "bd [sn drum:2*2] bd*2 [sn drum:1]", sound "arpy*8 ~"]-@--}-weave :: Rational -> ParamPattern -> [ParamPattern] -> ParamPattern-weave t p ps = weave' t p (map (\x -> (x #)) ps)---{- | `weave'` is similar in that it blends functions at the same time at different amounts over a pattern:--@-d1 $ weave' 3 (sound "bd [sn drum:2*2] bd*2 [sn drum:1]") [density 2, (# speed "0.5"), chop 16]-@--}-weave' :: Rational -> Pattern a -> [Pattern a -> Pattern a] -> Pattern a-weave' t p fs | l == 0 = silence-              | otherwise = _slow t $ stack $ map (\(i, f) -> (fromIntegral i % l) `rotL` (_density t $ f (_slow t p))) (zip [0 ..] fs)-  where l = fromIntegral $ length fs--{- |-(A function that takes two OscPatterns, and blends them together into-a new OscPattern. An OscPattern is basically a pattern of messages to-a synthesiser.)--Shifts between the two given patterns, using distortion.--Example:--@-d1 $ interlace (sound  "bd sn kurt") (every 3 rev $ sound  "bd sn:2")-@--}-interlace :: ParamPattern -> ParamPattern -> ParamPattern-interlace a b = weave 16 (shape $ ((* 0.9) <$> sinewave1)) [a, b]---- | Step sequencing-step :: String -> String -> Pattern String-step s steps = fastcat $ map f steps-    where f c | c == 'x' = atom s-              | Char.isDigit c = atom $ s ++ ":" ++ [c]-              | otherwise = silence--steps :: [(String, String)] -> Pattern String-steps = stack . map (\(a,b) -> step a b)---- | like `step`, but allows you to specify an array of strings to use for 0,1,2...-step' :: [String] -> String -> Pattern String-step' ss steps = fastcat $ map f steps-    where f c | c == 'x' = atom $ head ss-              | Char.isDigit c = atom $ ss!!(Char.digitToInt c)-              | otherwise = silence--off :: Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-off tp f p = unwrap $ (\tv -> _off tv f p) <$> tp--_off :: Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-_off t f p = superimpose (f . (t `rotR`)) p--offadd :: Num a => Pattern Time -> Pattern a -> Pattern a -> Pattern a-offadd tp pn p = off tp (+pn) p--{- | `up` does a poor man's pitchshift by semitones via `speed`.--You can easily produce melodies from a single sample with up:--@-d1 # up "0 5 4 12" # sound "arpy"-@--This will play the _arpy_ sample four times a cycle in the original pitch, pitched by 5 semitones, by 4 and then by an octave.--}-up :: Pattern Double -> ParamPattern-up = speed . ((1.059466**) <$>)--ghost'' a f p = superimpose (((a*2.5) `rotR`) . f) $ superimpose (((a*1.5) `rotR`) . f) $ p-ghost' a p = ghost'' 0.125 ((|*| gain (pure 0.7)) . (|=| end (pure 0.2)) . (|*| speed (pure 1.25))) p-ghost p = ghost' 0.125 p---slice :: Pattern Int -> Pattern Int -> ParamPattern -> ParamPattern-slice pi pn p = begin b # end e # p-  where b = (\i n -> (div' i n)) <$> pi <*> pn-        e = (\i n -> (div' i n) + (div' 1 n)) <$> pi <*> pn-        div' a b = fromIntegral (a `mod` b) / fromIntegral b--_slice :: Int -> Int -> ParamPattern -> ParamPattern-_slice i n p =-      p-      # begin (pure $ fromIntegral i / fromIntegral n)-      # end (pure $ fromIntegral (i+1) / fromIntegral n)--randslice :: Int -> ParamPattern -> ParamPattern-randslice n p = unwrap $ (\i -> _slice i n p) <$> irand n--{- |-`loopAt` makes a sample fit the given number of cycles. Internally, it-works by setting the `unit` parameter to "c", changing the playback-speed of the sample with the `speed` parameter, and setting setting-the `density` of the pattern to match.--@-d1 $ loopAt 4 $ sound "breaks125"-d1 $ juxBy 0.6 (|*| speed "2") $ slowspread (loopAt) [4,6,2,3] $ chop 12 $ sound "fm:14"-@--}-loopAt :: Pattern Time -> ParamPattern -> ParamPattern-loopAt n p = slow n p |*| speed (fromRational <$> (1/n)) # unit (pure "c")---{- |-   tabby - A more literal weaving than the `weave` function, give number-   of 'threads' per cycle and two patterns, and this function will weave them-   together using a plain (aka 'tabby') weave, with a simple over/under structure- -}-tabby n p p' = stack [maskedWarp n p,-                      maskedWeft n p'-                     ]-  where-    weft n = concatMap (\x -> [[0..n-1],(reverse [0..n-1])]) [0 .. (n `div` 2) - 1]-    warp = transpose . weft-    thread xs n p = _slow (n%1) $ fastcat $ map (\i -> zoom (i%n,(i+1)%n) p) (concat xs)-    weftP n p = thread (weft n) n p-    warpP n p = thread (warp n) n p-    maskedWeft n p = Sound.Tidal.Pattern.mask (every 2 rev $ _density ((n)%2) "~ 1" :: Pattern Int) $ weftP n p-    maskedWarp n p = mask (every 2 rev $ _density ((n)%2) "1 ~" :: Pattern Int) $ warpP n p--hurry :: Pattern Rational -> ParamPattern -> ParamPattern-hurry x = (|*| speed (fromRational <$> x)) . fast x

@@ -1,329 +0,0 @@-{-# LANGUAGE OverloadedStrings, FlexibleInstances, RankNTypes, NoMonomorphismRestriction, DeriveDataTypeable #-}--module Sound.Tidal.Stream where--import Data.Maybe-import Control.Applicative-import Control.Concurrent-import Control.Concurrent.MVar-import Control.Exception as E-import Data.Time (getCurrentTime)-import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)-import Data.Ratio-import Data.Typeable-import Sound.Tidal.Pattern-import qualified Sound.Tidal.Parse as P-import Sound.Tidal.Tempo (Tempo, logicalTime, clockedTick,cps)-import Sound.Tidal.Utils-import qualified Sound.Tidal.Time as T-import System.IO (stderr, hPutStrLn)--import qualified Data.Map.Strict as Map--type ToMessageFunc = Shape -> Tempo -> Int -> (Double, Double, ParamMap) -> Maybe (IO ())--data Backend a = Backend {-  toMessage :: ToMessageFunc,-  flush :: Shape -> Tempo -> Int -> IO ()-  }--data Param = S {name :: String, sDefault :: Maybe String}-           | F {name :: String, fDefault :: Maybe Double}-           | I {name :: String, iDefault :: Maybe Int}-  deriving Typeable--instance Eq Param where-  a == b = name a == name b--instance Ord Param where-  compare a b = compare (name a) (name b)-instance Show Param where-  show p = name p---data Shape = Shape {params :: [Param],-                    latency :: Double,-                    cpsStamp :: Bool}---data Value = VS { svalue :: String } | VF { fvalue :: Double } | VI { ivalue :: Int }-           deriving (Eq,Ord,Typeable)--instance Show Value where-  show (VS s) = s-  show (VF f) = show f-  show (VI i) = show i--class ParamType a where-  fromV :: Value -> Maybe a-  toV :: a -> Value--instance ParamType String where-  fromV (VS s) = Just s-  fromV _ = Nothing-  toV s = VS s--instance ParamType Double where-  fromV (VF f) = Just f-  fromV _ = Nothing-  toV f = VF f--instance ParamType Int where-  fromV (VI i) = Just i-  fromV _ = Nothing-  toV i = VI i--type ParamMap = Map.Map Param Value--type ParamPattern = Pattern ParamMap--ticksPerCycle = 8--defaultValue :: Param -> Value-defaultValue (S _ (Just x)) = VS x-defaultValue (I _ (Just x)) = VI x-defaultValue (F _ (Just x)) = VF x--hasDefault :: Param -> Bool-hasDefault (S _ Nothing) = False-hasDefault (I _ Nothing) = False-hasDefault (F _ Nothing) = False-hasDefault _ = True--defaulted :: Shape -> [Param]-defaulted = filter hasDefault . params--defaultMap :: Shape -> ParamMap-defaultMap s-  = Map.fromList $ map (\x -> (x, defaultValue x)) (defaulted s)--required :: Shape -> [Param]-required = filter (not . hasDefault) . params--hasRequired :: Shape -> ParamMap -> Bool-hasRequired s m = isSubset (required s) (Map.keys m)--isSubset :: (Eq a) => [a] -> [a] -> Bool-isSubset xs ys = all (\x -> elem x ys) xs---doAt t action = do _ <- forkIO $ do-                               now <- getCurrentTime-                               let nowf = realToFrac $ utcTimeToPOSIXSeconds now-                               threadDelay $ floor $ (t - nowf) * 1000000-                               action-                   return ()--logicalOnset' change tick o offset = logicalNow + (logicalPeriod * o) + offset-  where-    tpc = fromIntegral ticksPerCycle-    cycleD = ((fromIntegral tick) / tpc) :: Double-    logicalNow = logicalTime change cycleD-    logicalPeriod = (logicalTime change (cycleD + (1/tpc))) - logicalNow---applyShape' :: Shape -> ParamMap -> Maybe ParamMap-applyShape' s m | hasRequired s m = Just $ Map.union m (defaultMap s)-                | otherwise = Nothing--start :: Backend a -> Shape -> IO (MVar (ParamPattern))-start backend shape-  = do patternM <- newMVar silence-       let ot = (onTick backend shape patternM) :: Tempo -> Int -> IO ()-       forkIO $ clockedTick ticksPerCycle ot-       return patternM---- variant of start where history of patterns is available-state :: Backend a -> Shape -> IO (MVar (ParamPattern, [ParamPattern]))-state backend shape-  = do patternsM <- newMVar (silence, [])-       let ot = (onTick' backend shape patternsM) :: Tempo -> Int -> IO ()-       forkIO $ clockedTick ticksPerCycle ot-       return patternsM--stream :: Backend a -> Shape -> IO (ParamPattern -> IO ())-stream backend shape-  = do patternM <- start backend shape-       return $ \p -> do swapMVar patternM p-                         return ()--streamcallback :: (ParamPattern -> IO ()) -> Backend a -> Shape -> IO (ParamPattern -> IO ())-streamcallback callback backend shape-  = do f <- stream backend shape-       let f' p = do callback p-                     f p-       return f'--onTick :: Backend a -> Shape -> MVar (ParamPattern) -> Tempo -> Int -> IO ()-onTick backend shape patternM change ticks-  = do p <- readMVar patternM-       let ticks' = (fromIntegral ticks) :: Integer-           a = ticks' % ticksPerCycle-           b = (ticks' + 1) % ticksPerCycle-           messages = mapMaybe-                      (toMessage backend shape change ticks)-                      (seqToRelOnsetDeltas (a, b) p)-       E.catch (sequence_ messages) (\msg -> hPutStrLn stderr $ "failed " ++ show (msg :: E.SomeException))-       flush backend shape change ticks-       return ()---- Variant where mutable variable contains list as history of the patterns-onTick' :: Backend a -> Shape -> MVar (ParamPattern, [ParamPattern]) -> Tempo -> Int -> IO ()-onTick' backend shape patternsM change ticks-  = do ps <- readMVar patternsM-       let ticks' = (fromIntegral ticks) :: Integer-           toM = (toMessage backend)-           a = ticks' % ticksPerCycle-           b = (ticks' + 1) % ticksPerCycle-           messages = mapMaybe-                      (toM shape change ticks)-                      (seqToRelOnsetDeltas (a, b) $ fst ps)-       E.catch (sequence_ messages) (\msg -> putStrLn $ "oops " ++ show (msg :: E.SomeException))-       flush backend shape change ticks-       return ()--make :: (a -> Value) -> Shape -> String -> Pattern a -> ParamPattern-make toValue s nm p = fmap (\x -> Map.singleton nParam (defaultV x)) p-  where nParam = param s nm-        defaultV a = toValue a-        --defaultV Nothing = defaultValue nParam--make' :: ParamType a => (a -> Value) -> Param -> Pattern a -> ParamPattern-make' toValue par p = fmap (\x -> Map.singleton par (toValue x)) p--makeP :: ParamType a => Param -> Pattern a -> ParamPattern-makeP par p = coerce par $ fmap (\x -> Map.singleton par (toV x)) p--makeS = make VS--makeF :: Shape -> String -> Pattern Double -> ParamPattern-makeF = make VF--makeI :: Shape -> String -> Pattern Int -> ParamPattern-makeI = make VI--param :: Shape -> String -> Param-param shape n = head $ filter (\x -> name x == n) (params shape)--merge :: ParamPattern -> ParamPattern -> ParamPattern-merge x y = (flip Map.union) <$> x <*> y--infixl 1 |=|-(|=|) :: ParamPattern -> ParamPattern -> ParamPattern-(|=|) = merge--infixl 1 #-(#) = (|=|)--mergeWith op x y = (Map.unionWithKey op) <$> x <*> y--mergeWith-  :: (Ord k, Applicative f) =>-     (k -> a -> a -> a)-     -> f (Map.Map k a) -> f (Map.Map k a) -> f (Map.Map k a)--mergeNumWith intOp floatOp = mergeWith f-  where f (F _ _) (VF a) (VF b) = VF $ floatOp a b-        f (I _ _) (VI a) (VI b) = VI $ intOp a b-        f _ _ b = b--mergePlus = mergeWith f-  where f (F _ _) (VF a) (VF b) = VF $ a + b-        f (I _ _) (VI a) (VI b) = VI $ a + b-        f (S _ _) (VS a) (VS b) = VS $ a ++ b-        f _ _ b = b--infixl 1 |*|-(|*|) :: ParamPattern -> ParamPattern -> ParamPattern-(|*|) = mergeNumWith (*) (*)--infixl 1 |+|-(|+|) :: ParamPattern -> ParamPattern -> ParamPattern-(|+|) = mergePlus--infixl 1 |-|-(|-|) :: ParamPattern -> ParamPattern -> ParamPattern-(|-|) = mergeNumWith (-) (-)--infixl 1 |/|-(|/|) :: ParamPattern -> ParamPattern -> ParamPattern-(|/|) = mergeNumWith (div) (/)--{- | These are shorthand for merging lists of patterns with @#@, @|*|@, @|+|@,-or @|/|@.  Sometimes this saves a little typing and can improve readability-when passing things into other functions.  As an example, instead of writing-@-d1 $ sometimes ((|*| speed "2") . (|*| cutoff "2") . (|*| shape "1.5")) $ sound "arpy*4" # cutoff "350" # shape "0.3"-@-you can write-@-d1 $ sometimes (*** [speed "2", cutoff "2", shape "1.5"]) $ sound "arpy*4" ### [cutoff "350", shape "0.3"]-@--}-(###) = foldl (#)-(***) = foldl (|*|)-(+++) = foldl (|+|)-(///) = foldl (|/|)--setter :: MVar (a, [a]) -> a -> IO ()-setter ds p = do ps <- takeMVar ds-                 putMVar ds $ (p, p:snd ps)-                 return ()--{- | Copies values from one parameter to another. Used by @nToOrbit@ in @Sound.Tidal.Dirt@. -}--copyParam:: Param -> Param -> ParamPattern -> ParamPattern-copyParam fromParam toParam pat = f <$> pat-  where f m = maybe m (updateValue m) (Map.lookup fromParam m)-        updateValue m v = Map.union m (Map.fromList [(toParam,v)])--get :: ParamType a => Param -> ParamPattern -> Pattern a-get param p = filterJust $ fromV <$> (filterJust $ Map.lookup param <$> p)--getI :: Param -> ParamPattern -> Pattern Int-getI = get-getF :: Param -> ParamPattern -> Pattern Double-getF = get-getS :: Param -> ParamPattern -> Pattern String-getS = get--with :: (ParamType a) => Param -> (Pattern a -> Pattern a) -> ParamPattern -> ParamPattern-with param f p = p # (makeP param) ((\x -> f (get param x)) p)-withI :: Param -> (Pattern Int -> Pattern Int) -> ParamPattern -> ParamPattern-withI = with-withF :: Param -> (Pattern Double -> Pattern Double) -> ParamPattern -> ParamPattern-withF = with-withS :: Param -> (Pattern String -> Pattern String) -> ParamPattern -> ParamPattern-withS = with--follow :: (ParamType a, ParamType b) => Param -> Param -> (Pattern a -> Pattern b) -> ParamPattern -> ParamPattern-follow source dest f p = p # (makeP dest $ f (get source p))---- follow :: ParamType a => Param -> (Pattern a -> ParamPattern) -> ParamPattern -> ParamPattern--- follow source dest p = p # (dest $ get source p)--follow' :: ParamType a => Param -> Param -> (Pattern a -> Pattern a) -> ParamPattern -> ParamPattern-follow' source dest f p = p # (makeP dest $ f (get source p))--followI :: Param -> Param -> (Pattern Int -> Pattern Int) -> ParamPattern -> ParamPattern-followI = follow'-followF :: Param -> Param -> (Pattern Double -> Pattern Double) -> ParamPattern -> ParamPattern-followF = follow'-followS :: Param -> Param -> (Pattern String -> Pattern String) -> ParamPattern -> ParamPattern-followS = follow'---- with :: ParamType a => Param -> (Pattern a -> Pattern a) -> ParamPattern -> ParamPattern--- with source f p = p # (makeP source $ f (get source p))-coerce :: Param -> ParamPattern -> ParamPattern-coerce par@(S _ _) p = (Map.update f par) <$> p-  where f (VS s) = Just (VS s)-        f (VI i) = Just (VS $ show i)-        f (VF f) = Just (VS $ show f)-coerce par@(I _ _) p = (Map.update f par) <$> p-  where f (VS s) = Just (VI $ read s)-        f (VI i) = Just (VI i)-        f (VF f) = Just (VI $ floor f)-coerce par@(F _ _) p = (Map.update f par) <$> p-  where f (VS s) = Just (VF $ read s)-        f (VI i) = Just (VF $ fromIntegral i)-        f (VF f) = Just (VF f)