diff --git a/BootTidal.hs b/BootTidal.hs --- a/BootTidal.hs +++ b/BootTidal.hs @@ -5,6 +5,10 @@ import System.IO (hSetEncoding, stdout, utf8) +import qualified Control.Concurrent.MVar as MV +import qualified Sound.Tidal.Tempo as Tempo +import qualified Sound.OSC.FD as O + hSetEncoding stdout utf8 -- total latency = oLatency + cFrameTimespan @@ -29,6 +33,11 @@ all = streamAll tidal resetCycles = streamResetCycles tidal setcps = asap . cps + getcps = do tempo <- MV.readMVar $ sTempoMV tidal + return $ Tempo.cps tempo + getnow = do tempo <- MV.readMVar $ sTempoMV tidal + now <- O.time + return $ fromRational $ Tempo.timeToCycles tempo now xfade i = transition tidal True (Sound.Tidal.Transition.xfadeIn 4) i xfadeIn i t = transition tidal True (Sound.Tidal.Transition.xfadeIn t) i histpan i t = transition tidal True (Sound.Tidal.Transition.histpan t) i diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,30 @@ # TidalCycles log of changes +## 1.7 - IKLECTIK + * Added drum aliases from GM2 percussion spec to `drum` function @lvm + * `getcps` helper function now in BootTidal.hs @yaxu + * `getnow` helper function back in BootTidal.hs (returns current cycle) @bgold-cosmos + * Developments towards tidal api, @yaxu et al + * `coarse` parameter is now floating point @lwlsn + * `irand` parameter now patternable @ndr-brt + * `note` now produces its own type to avoid conflicts between parsing note names and duration shorthands @ndr-brt + * Numerous tidal-parse improvements and additions @dktr0 et al + * `grain` function for combining begin and end (in terms of begin and duration) @khoparzi + * Added missing pB and pR functions @thgrund + * Emacs plugin bugfixes @jwaldmann + * `binaryN` parameters now fully patternable @ndr-brt + * `press` and `pressBy` functions for syncopation @yaxu + * `bite`'s first parameter is now patternable @ndr-brt + * Most SuperDirt control/effect parameters can now be modified while a sound is playing, using 'bus' functions. @telefon + @yaxu + * Sound.Tidal.Params is now generated by a script in bin/generate-params.hs @yaxu + * `qtrigger` is now an alias for `ctrigger`, which now quantises to the _next_ cycle (via ceiling) @thgund / @yaxu + * There is now also `ftrigger` and `rtrigger` for floor (previous) and round (nearest) cycle + * `whenmod`'s first two parameters are now rationals, and patternable. @th-four / @yaxu + * `brand` and `brandBy` for continuous patterns of boolean values @yaxu + * Two-way protocol between Tidal and SuperDirt, initially to receive available busses @telefon / @yaxu + * bipolar waveforms - sine2, square2, tri2, saw2, cosine2 @yaxu + + ## 1.6.1 - We are not DJs * Patternise first parameter of chunk @lwlsn * Patternise fit parameter @bgold-cosmos diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,17 +1,16 @@ -Tidal [![Build Status](https://travis-ci.org/tidalcycles/Tidal.svg)](https://travis-ci.org/tidalcycles/Tidal) +Tidal [![Build Status](https://travis-ci.org/tidalcycles/Tidal.svg?branch=main)](https://travis-ci.org/tidalcycles/Tidal) ===== Language for live coding of pattern -For documentation, mailing list and more info see here: +For documentation, mailing list and more info see here: https://tidalcycles.org/ -You can help speed up Tidal development by sending coffee here: +You can help speed up Tidal development by sending coffee here: https://ko-fi.com/yaxulive# -(c) Alex McLean and contributors, 2019 +(c) Alex McLean and contributors, 2021 -Distributed under the terms of the GNU Public license version 3 (or -later). +Distributed under the terms of the GNU Public license version 3 (or later). diff --git a/src/Sound/Tidal/Bjorklund.hs b/src/Sound/Tidal/Bjorklund.hs --- a/src/Sound/Tidal/Bjorklund.hs +++ b/src/Sound/Tidal/Bjorklund.hs @@ -1,10 +1,26 @@ 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.. +{- + Bjorklund.hs - Euclidean patterns + Copyright (C) 2006-2020, Rohan Drape and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + +-- The below is taken from the hmt library. 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]])) diff --git a/src/Sound/Tidal/Carabiner.hs b/src/Sound/Tidal/Carabiner.hs --- a/src/Sound/Tidal/Carabiner.hs +++ b/src/Sound/Tidal/Carabiner.hs @@ -1,6 +1,24 @@ {-# OPTIONS_GHC -fno-warn-dodgy-imports -fno-warn-name-shadowing #-} module Sound.Tidal.Carabiner where +{- + Carabiner.hs - For syncing with the Link protocol over Carabiner. + Copyright (C) 2020, Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + import Network.Socket hiding (send, sendTo, recv, recvFrom) import Network.Socket.ByteString (send, recv) import qualified Data.ByteString.Char8 as B8 diff --git a/src/Sound/Tidal/Chords.hs b/src/Sound/Tidal/Chords.hs --- a/src/Sound/Tidal/Chords.hs +++ b/src/Sound/Tidal/Chords.hs @@ -1,5 +1,23 @@ module Sound.Tidal.Chords where +{- + Chords.hs - For .. chords + Copyright (C) 2020, Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + import Data.Maybe import Sound.Tidal.Pattern diff --git a/src/Sound/Tidal/Config.hs b/src/Sound/Tidal/Config.hs --- a/src/Sound/Tidal/Config.hs +++ b/src/Sound/Tidal/Config.hs @@ -1,5 +1,22 @@ module Sound.Tidal.Config where +{- + Config.hs - For default Tidal configuration values. + Copyright (C) 2020, Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} data Config = Config {cCtrlListen :: Bool, cCtrlAddr :: String, diff --git a/src/Sound/Tidal/Context.hs b/src/Sound/Tidal/Context.hs --- a/src/Sound/Tidal/Context.hs +++ b/src/Sound/Tidal/Context.hs @@ -1,5 +1,23 @@ module Sound.Tidal.Context (module C) where +{- + Context.hs - For exposing the core TidalCycles libraries + Copyright (C) 2020, Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + import Prelude hiding ((<*), (*>)) import Data.Ratio as C diff --git a/src/Sound/Tidal/Control.hs b/src/Sound/Tidal/Control.hs --- a/src/Sound/Tidal/Control.hs +++ b/src/Sound/Tidal/Control.hs @@ -2,6 +2,26 @@ module Sound.Tidal.Control where +{- + Control.hs - Functions which concern control patterns, which are + patterns of hashmaps, used for synth control values. + + Copyright (C) 2020, Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + import Prelude hiding ((<*), (*>)) import qualified Data.Map.Strict as Map @@ -130,7 +150,7 @@ where offset i = mergePlayRange (fromIntegral i / fromIntegral n, fromIntegral (i+1) / fromIntegral n) <$> p mergePlayRange :: (Double, Double) -> ControlMap -> ControlMap -mergePlayRange (b,e) cm = Map.insert "begin" (VF $ (b*d')+b') $ Map.insert "end" (VF $ (e*d')+b') cm +mergePlayRange (b,e) cm = Map.insert "begin" (VF ((b*d')+b')) $ Map.insert "end" (VF ((e*d')+b')) cm where b' = fromMaybe 0 $ Map.lookup "begin" cm >>= getF e' = fromMaybe 1 $ Map.lookup "end" cm >>= getF d' = e' - b' @@ -261,7 +281,7 @@ # P.end (pure $ fromIntegral (i+1) / fromIntegral n) randslice :: Pattern Int -> ControlPattern -> ControlPattern -randslice = tParam $ \n p -> innerJoin $ (\i -> _slice n i p) <$> irand n +randslice = tParam $ \n p -> innerJoin $ (\i -> _slice n i p) <$> _irand n _splice :: Int -> Pattern Int -> ControlPattern -> Pattern (Map.Map String Value) _splice bits ipat pat = withEvent f (slice (pure bits) ipat pat) # P.unit (pure "c") @@ -377,20 +397,27 @@ msec :: Fractional a => Pattern a -> Pattern a msec p = ((realToFrac . (/1000)) <$> cF 1 "_cps") *| p -_trigger :: Show a => Bool -> a -> Pattern b -> Pattern b -_trigger quant k pat = pat {query = q} +triggerWith :: Show a => (Time -> Time) -> a -> Pattern b -> Pattern b +triggerWith f k pat = pat {query = q} where q st = query ((offset st) ~> pat) st - f | quant = (fromIntegral :: Int -> Rational) . round - | otherwise = id offset st = fromMaybe (pure 0) $ do p <- Map.lookup ctrl (controls st) return $ ((f . fromMaybe 0 . getR) <$> p) ctrl = "_t_" ++ show k trigger :: Show a => a -> Pattern b -> Pattern b -trigger = _trigger False +trigger = triggerWith id +ctrigger :: Show a => a -> Pattern b -> Pattern b +ctrigger = triggerWith $ (fromIntegral :: Int -> Rational) . ceiling + qtrigger :: Show a => a -> Pattern b -> Pattern b -qtrigger = _trigger True +qtrigger = ctrigger + +rtrigger :: Show a => a -> Pattern b -> Pattern b +rtrigger = triggerWith $ (fromIntegral :: Int -> Rational) . round + +ftrigger :: Show a => a -> Pattern b -> Pattern b +ftrigger = triggerWith $ (fromIntegral :: Int -> Rational) . floor qt :: Show a => a -> Pattern b -> Pattern b qt = qtrigger diff --git a/src/Sound/Tidal/Core.hs b/src/Sound/Tidal/Core.hs --- a/src/Sound/Tidal/Core.hs +++ b/src/Sound/Tidal/Core.hs @@ -1,5 +1,23 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, BangPatterns #-} +{- + Core.hs - For functions judged to be 'core' to tidal functionality. + Copyright (C) 2020, Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + module Sound.Tidal.Core where import Prelude hiding ((<*), (*>)) @@ -22,33 +40,77 @@ | s > e = [] | otherwise = [Event (Context []) Nothing (Arc s e) (f (s+((e-s)/2)))] --- | @sine@ returns a 'Pattern' of continuous 'Fractional' values following a +-- | @sine@ - unipolar sinewave. A pattern of continuous values following a -- sinewave with frequency of one cycle, and amplitude from 0 to 1. sine :: Fractional a => Pattern a sine = sig $ \t -> (sin_rat ((pi :: Double) * 2 * fromRational t) + 1) / 2 where sin_rat = fromRational . toRational . sin --- | @cosine@ is a synonym for @0.25 ~> sine@. +-- | @sine2@ - bipolar sinewave. A pattern of continuous values following a +-- sinewave with frequency of one cycle, and amplitude from -1 to 1. +sine2 :: Fractional a => Pattern a +sine2 = sig $ \t -> sin_rat ((pi :: Double) * 2 * fromRational t) + where sin_rat = fromRational . toRational . sin + +-- | @cosine@ - unipolar cosine wave. A pattern of continuous values +-- following a cosine with frequency of one cycle, and amplitude from +-- 0 to 1. Equivalent to `0.25 ~> sine`. cosine :: Fractional a => Pattern a cosine = 0.25 `rotR` sine --- | @saw@ is the equivalent of 'sine' for (ascending) sawtooth waves. +-- | @cosine2@ - bipolar cosine wave. A pattern of continuous values +-- following a cosine with frequency of one cycle, and amplitude from +-- -1 to 1. Equivalent to `0.25 ~> sine2`. +cosine2 :: Fractional a => Pattern a +cosine2 = 0.25 `rotR` sine + +-- | @saw@ - unipolar ascending sawtooth wave. A pattern of continuous values +-- following a sawtooth with frequency of one cycle, and amplitude from +-- 0 to 1. saw :: (Fractional a, Real a) => Pattern a saw = sig $ \t -> mod' (fromRational t) 1 --- | @isaw@ is the equivalent of 'sine' for inverse (descending) sawtooth waves. +-- | @saw2@ - bipolar ascending sawtooth wave. A pattern of continuous values +-- following a sawtooth with frequency of one cycle, and amplitude from +-- -1 to 1. +saw2 :: (Fractional a, Real a) => Pattern a +saw2 = sig $ \t -> (mod' (fromRational t) 1) * 2 - 1 + +-- | @isaw@ like @saw@, but a descending (inverse) sawtooth. isaw :: (Fractional a, Real a) => Pattern a isaw = (1-) <$> saw --- | @tri@ is the equivalent of 'sine' for triangular waves. +-- | @isaw2@ like @saw2@, but a descending (inverse) sawtooth. +isaw2 :: (Fractional a, Real a) => Pattern a +isaw2 = (1-) <$> saw + +-- | @tri@ - unipolar triangle wave. A pattern of continuous values +-- following a triangle wave with frequency of one cycle, and amplitude from +-- 0 to 1. tri :: (Fractional a, Real a) => Pattern a tri = fastAppend saw isaw --- | @square@ is the equivalent of 'sine' for square waves. +-- | @tri2@ - bipolar triangle wave. A pattern of continuous values +-- following a triangle wave with frequency of one cycle, and amplitude from +-- -1 to 1. +tri2 :: (Fractional a, Real a) => Pattern a +tri2 = fastAppend saw isaw + +-- | @square@ - unipolar square wave. A pattern of continuous values +-- following a square wave with frequency of one cycle, and amplitude from +-- 0 to 1. +-- | @square@ is like 'sine', for square waves. square :: (Fractional a) => Pattern a square = sig $ \t -> fromIntegral ((floor $ mod' (fromRational t :: Double) 1 * 2) :: Integer) +-- | @square2@ - bipolar square wave. A pattern of continuous values +-- following a square wave with frequency of one cycle, and amplitude from +-- -1 to 1. +square2 :: (Fractional a) => Pattern a +square2 = sig $ + \t -> fromIntegral ((floor $ mod' (fromRational t :: Double) 1 * 2) * 2 - 1 :: Integer) + -- | @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 @@ -446,6 +508,13 @@ cF_ = _cX_ getF cF0 :: String -> Pattern Double cF0 = _cX 0 getF + +cN :: Note -> String -> Pattern Note +cN d = _cX d getN +cN_ :: String -> Pattern Note +cN_ = _cX_ getN +cN0 :: String -> Pattern Note +cN0 = _cX (Note 0) getN cI :: Int -> String -> Pattern Int cI d = _cX d getI diff --git a/src/Sound/Tidal/EspGrid.hs b/src/Sound/Tidal/EspGrid.hs --- a/src/Sound/Tidal/EspGrid.hs +++ b/src/Sound/Tidal/EspGrid.hs @@ -2,6 +2,24 @@ module Sound.Tidal.EspGrid (tidalEspGridLink,cpsEsp,espgrid) where +{- + EspGrid.hs - Provides ability to sync via the ESP Grid + Copyright (C) 2020, David Ogborn and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + import Control.Concurrent.MVar import Control.Concurrent (forkIO,threadDelay) import Control.Monad (forever) diff --git a/src/Sound/Tidal/Params.hs b/src/Sound/Tidal/Params.hs --- a/src/Sound/Tidal/Params.hs +++ b/src/Sound/Tidal/Params.hs @@ -1,760 +1,2038 @@ module Sound.Tidal.Params where -import qualified Data.Map.Strict as Map - -import Sound.Tidal.Pattern -import Sound.Tidal.Utils -import Data.Maybe (fromMaybe) -import Data.Word (Word8) - --- | group multiple params into one -grp :: [String -> ControlMap] -> Pattern String -> ControlPattern -grp [] _ = empty -grp fs p = splitby <$> p - where splitby name = Map.unions $ map (\(v, f) -> f v) $ zip (split name) fs - split :: String -> [String] - split = wordsBy (==':') - -mF :: String -> String -> ControlMap -mF name v = fromMaybe Map.empty $ do f <- readMaybe v - return $ Map.singleton name (VF f) - -mI :: String -> String -> ControlMap -mI name v = fromMaybe Map.empty $ do i <- readMaybe v - return $ Map.singleton name (VI i) - -mS :: String -> String -> ControlMap -mS name v = Map.singleton name (VS v) - --- | Grouped params - -sound :: Pattern String -> ControlPattern -sound = grp [mS "s", mF "n"] - -s :: Pattern String -> ControlPattern -s = sound - -cc :: Pattern String -> ControlPattern -cc = grp [mF "ccn", mF "ccv"] - -nrpn :: Pattern String -> ControlPattern -nrpn = grp [mI "nrpn", mI "val"] - --- | Singular params - -pF :: String -> Pattern Double -> ControlPattern -pF name = fmap (Map.singleton name . VF) - -pI :: String -> Pattern Int -> ControlPattern -pI name = fmap (Map.singleton name . VI) - -pS :: String -> Pattern String -> ControlPattern -pS name = fmap (Map.singleton name . VS) - -pX :: String -> Pattern [Word8] -> ControlPattern -pX name = fmap (Map.singleton name . VX) - --- | patterns for internal sound routing -toArg :: Pattern String -> ControlPattern -toArg = pS "toArg" - -from :: Pattern Double -> ControlPattern -from = pF "from" - -to :: Pattern Double -> ControlPattern -to = pF "to" - --- | a pattern of numbers that speed up (or slow down) samples while they play. -accelerate :: Pattern Double -> ControlPattern -accelerate = pF "accelerate" - - --- | Amplitude; like @gain@, but linear. -amp :: Pattern Double -> ControlPattern -amp = pF "amp" - --- | 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 :: Pattern Double -> ControlPattern -attack = pF "attack" - --- | a pattern of numbers from 0 to 1. Sets the center frequency of the band-pass filter. -bandf :: Pattern Double -> ControlPattern -bandf = pF "bandf" - --- | a pattern of numbers from 0 to 1. Sets the q-factor of the band-pass filter.y -bandq :: Pattern Double -> ControlPattern -bandq = pF "bandq" - -{- | 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, legato, clhatdecay, crush :: Pattern Double -> ControlPattern -channel, coarse :: Pattern Int -> ControlPattern -begin = pF "begin" --- | choose the physical channel the pattern is sent to, this is super dirt specific -channel = pI "channel" - ---legato controls the amount of overlap between two adjacent synth sounds -legato = pF "legato" - -clhatdecay = pF "clhatdecay" --- | 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 = pI "coarse" --- | bit crushing, a pattern of numbers from 1 (for drastic reduction in bit-depth) to 16 (for barely no reduction). -crush = pF "crush" -{- | -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 :: Pattern Int -> ControlPattern -cut = pI "cut" - --- | a pattern of numbers from 0 to 1. Applies the cutoff frequency of the low-pass filter. -cutoff :: Pattern Double -> ControlPattern -cutoff = pF "cutoff" - -cutoffegint :: Pattern Double -> ControlPattern -cutoffegint = pF "cutoffegint" - -decay :: Pattern Double -> ControlPattern -decay = pF "decay" --- | a pattern of numbers from 0 to 1. Sets the level of the delay signal. -delay :: Pattern Double -> ControlPattern -delay = pF "delay" --- | a pattern of numbers from 0 to 1. Sets the amount of delay feedback. -delayfeedback :: Pattern Double -> ControlPattern -delayfeedback = pF "delayfeedback" --- | a pattern of numbers from 0 to 1. Sets the length of the delay. -delaytime :: Pattern Double -> ControlPattern -delaytime = pF "delaytime" - -detune :: Pattern Double -> ControlPattern -detune = pF "detune" - --- DJ filter -djf :: Pattern Double -> ControlPattern -djf = pF "djf" - --- | when set to `1` will disable all reverb for this pattern. See `room` and `size` for more information about reverb. -dry :: Pattern Double -> ControlPattern -dry = pF "dry" -{- 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 :: Pattern Double -> ControlPattern -end = pF "end" - -freq :: Pattern Double -> ControlPattern -freq = pF "freq" - --- | a pattern of numbers that specify volume. Values less than 1 make --- the sound quieter. Values greater than 1 make the sound louder. For --- the linear equivalent, see @amp@. -gain :: Pattern Double -> ControlPattern -gain = pF "gain" - -gate :: Pattern Double -> ControlPattern -gate = pF "gate" -hatgrain :: Pattern Double -> ControlPattern -hatgrain = pF "hatgrain" --- | a pattern of numbers from 0 to 1. Applies the cutoff frequency of the high-pass filter. -hcutoff :: Pattern Double -> ControlPattern -hcutoff = pF "hcutoff" --- | 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 :: Pattern Double -> ControlPattern -hold = pF "hold" --- | a pattern of numbers from 0 to 1. Applies the resonance of the high-pass filter. -hresonance :: Pattern Double -> ControlPattern -hresonance = pF "hresonance" -kriole :: Pattern Int -> ControlPattern -kriole = pI "kriole" -lagogo :: Pattern Double -> ControlPattern -lagogo = pF "lagogo" -lclap :: Pattern Double -> ControlPattern -lclap = pF "lclap" -lclaves :: Pattern Double -> ControlPattern -lclaves = pF "lclaves" -lclhat :: Pattern Double -> ControlPattern -lclhat = pF "lclhat" -lcrash :: Pattern Double -> ControlPattern -lcrash = pF "lcrash" -leslie :: Pattern Double -> ControlPattern -leslie = pF "leslie" -lrate :: Pattern Double -> ControlPattern -lrate = pF "lrate" -lsize :: Pattern Double -> ControlPattern -lsize = pF "lsize" -lfo :: Pattern Double -> ControlPattern -lfo = pF "lfo" -lfocutoffint :: Pattern Double -> ControlPattern -lfocutoffint = pF "lfocutoffint" -lfodelay :: Pattern Double -> ControlPattern -lfodelay = pF "lfodelay" -lfoint :: Pattern Double -> ControlPattern -lfoint = pF "lfoint" -lfopitchint :: Pattern Double -> ControlPattern -lfopitchint = pF "lfopitchint" -lfoshape :: Pattern Double -> ControlPattern -lfoshape = pF "lfoshape" -lfosync :: Pattern Double -> ControlPattern -lfosync = pF "lfosync" -lhitom :: Pattern Double -> ControlPattern -lhitom = pF "lhitom" -lkick :: Pattern Double -> ControlPattern -lkick = pF "lkick" -llotom :: Pattern Double -> ControlPattern -llotom = pF "llotom" -{- | 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 :: Pattern Double -> ControlPattern -lock = pF "lock" --- | loops the sample (from `begin` to `end`) the specified number of times. -loop :: Pattern Double -> ControlPattern -loop = pF "loop" -lophat :: Pattern Double -> ControlPattern -lophat = pF "lophat" -lsnare :: Pattern Double -> ControlPattern -lsnare = pF "lsnare" --- | specifies the sample or note number to be used -n :: Pattern Double -> ControlPattern -n = pF "n" -note :: Pattern Double -> ControlPattern -note = pF "note" -{- | -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 -> ControlPattern -degree = pF "degree" -mtranspose = pF "mtranspose" -ctranspose = pF "ctranspose" -harmonic = pF "ctranspose" -stepsPerOctave = pF "stepsPerOctave" -octaveRatio = pF "octaveRatio" - - ---Low values will give a more _human_ feeling, high values might result in quite the contrary. - -nudge :: Pattern Double -> ControlPattern -nudge = pF "nudge" -octave :: Pattern Int -> ControlPattern -octave = pI "octave" -offset :: Pattern Double -> ControlPattern -offset = pF "offset" -ophatdecay :: Pattern Double -> ControlPattern -ophatdecay = pF "ophatdecay" -{- | 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 :: Pattern Int -> ControlPattern -orbit = pI "orbit" - -overgain :: Pattern Double -> ControlPattern -overgain = pF "overgain" - -overshape :: Pattern Double -> ControlPattern -overshape = pF "overshape" - --- | a pattern of numbers between 0 and 1, from left to right (assuming stereo), once round a circle (assuming multichannel) -pan :: Pattern Double -> ControlPattern -pan = pF "pan" --- | a pattern of numbers between -inf and inf, which controls how much multichannel output is fanned out (negative is backwards ordering) -panspan :: Pattern Double -> ControlPattern -panspan = pF "span" --- | a pattern of numbers between 0.0 and 1.0, which controls the multichannel spread range (multichannel only) -pansplay :: Pattern Double -> ControlPattern -pansplay = pF "splay" --- | a pattern of numbers between 0.0 and inf, which controls how much each channel is distributed over neighbours (multichannel only) -panwidth :: Pattern Double -> ControlPattern -panwidth = pF "panwidth" --- | 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 :: Pattern Double -> ControlPattern -panorient = pF "orientation" - -pitch1 :: Pattern Double -> ControlPattern -pitch1 = pF "pitch1" -pitch2 :: Pattern Double -> ControlPattern -pitch2 = pF "pitch2" -pitch3 :: Pattern Double -> ControlPattern -pitch3 = pF "pitch3" -portamento :: Pattern Double -> ControlPattern -portamento = pF "portamento" --- | used in SuperDirt softsynths as a control rate or "speed" -rate :: Pattern Double -> ControlPattern -rate = pF "rate" --- | 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 :: Pattern Double -> ControlPattern -release = pF "release" --- | a pattern of numbers from 0 to 1. Specifies the resonance of the low-pass filter. -resonance :: Pattern Double -> ControlPattern -resonance = pF "resonance" --- | a pattern of numbers from 0 to 1. Sets the level of reverb. -room :: Pattern Double -> ControlPattern -room = pF "room" -sagogo :: Pattern Double -> ControlPattern -sagogo = pF "sagogo" -sclap :: Pattern Double -> ControlPattern -sclap = pF "sclap" -sclaves :: Pattern Double -> ControlPattern -sclaves = pF "sclaves" -scrash :: Pattern Double -> ControlPattern -scrash = pF "scrash" -semitone :: Pattern Double -> ControlPattern -semitone = pF "semitone" --- | wave shaping distortion, a pattern of numbers from 0 for no distortion up to 1 for loads of distortion. -shape :: Pattern Double -> ControlPattern -shape = pF "shape" --- | a pattern of numbers from 0 to 1. Sets the perceptual size (reverb time) of the `room` to be used in reverb. -size :: Pattern Double -> ControlPattern -size = pF "size" -slide :: Pattern Double -> ControlPattern -slide = pF "slide" --- | 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 :: Pattern Double -> ControlPattern -speed = pF "speed" -squiz :: Pattern Double -> ControlPattern -squiz = pF "squiz" --- | a pattern of strings. Selects the sample to be played. -s' :: Pattern String -> ControlPattern -s' = pS "s" -stutterdepth :: Pattern Double -> ControlPattern -stutterdepth = pF "stutterdepth" -stuttertime :: Pattern Double -> ControlPattern -stuttertime = pF "stuttertime" -sustain :: Pattern Double -> ControlPattern -sustain = pF "sustain" -tomdecay :: Pattern Double -> ControlPattern -tomdecay = pF "tomdecay" -{- | 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 :: Pattern String -> ControlPattern -unit = pS "unit" -velocity :: Pattern Double -> ControlPattern -velocity = pF "velocity" -vcfegint :: Pattern Double -> ControlPattern -vcfegint = pF "vcfegint" -vcoegint :: Pattern Double -> ControlPattern -vcoegint = pF "vcoegint" -voice :: Pattern Double -> ControlPattern -voice = pF "voice" --- | 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 :: Pattern String -> ControlPattern -vowel = pS "vowel" - -voweli :: Pattern Int -> ControlPattern -voweli = pI "vowel" - -waveloss :: Pattern Double -> ControlPattern -waveloss = pF "waveloss" - --- MIDI-specific params - -dur :: Pattern Double -> ControlPattern -dur = pF "dur" -modwheel :: Pattern Double -> ControlPattern -modwheel = pF "modwheel" -expression :: Pattern Double -> ControlPattern -expression = pF "expression" -sustainpedal :: Pattern Double -> ControlPattern -sustainpedal = pF "sustainpedal" - --- Tremolo Audio DSP effect | params are "tremolorate" and "tremolodepth" -tremolorate, tremolodepth :: Pattern Double -> ControlPattern -tremolorate = pF "tremolorate" -tremolodepth = pF "tremolodepth" - --- Phaser Audio DSP effect | params are "phaserrate" and "phaserdepth" -phaserrate, phaserdepth :: Pattern Double -> ControlPattern -phaserrate = pF "phaserrate" -phaserdepth = pF "phaserdepth" - --- More SuperDirt effects --- frequency shifter -fshift, fshiftphase, fshiftnote :: Pattern Double -> ControlPattern -fshift = pF "fshift" -fshiftphase = pF "fshiftphase" -fshiftnote = pF "fshiftnote" --- triode (tube distortion) -triode :: Pattern Double -> ControlPattern -triode = pF "triode" --- krush (like Sonic Pi's shape/bass enhancer) -krush, kcutoff :: Pattern Double -> ControlPattern -krush = pF "krush" -kcutoff = pF "kcutoff" --- octer (like Sonic Pi's octaver effect) -octer, octersub, octersubsub :: Pattern Double -> ControlPattern -octer = pF "octer" -octersub = pF "octersub" -octersubsub = pF "octersubsub" --- ring modulation -ring, ringf, ringdf :: Pattern Double -> ControlPattern -ring = pF "ring" -ringf = pF "ringf" -ringdf = pF "ringdf" --- noisy fuzzy distortion -distort :: Pattern Double -> ControlPattern -distort = pF "distort" - --- Spectral freeze -freeze :: Pattern Double -> ControlPattern -freeze = pF "freeze" - --- Spectral delay -xsdelay :: Pattern Double -> ControlPattern -xsdelay = pF "xsdelay" - -tsdelay :: Pattern Double -> ControlPattern -tsdelay = pF "tsdelay" - --- Spectral conform -real :: Pattern Double -> ControlPattern -real = pF "real" - -imag :: Pattern Double -> ControlPattern -imag = pF "imag" - --- Spectral enhance -enhance :: Pattern Double -> ControlPattern -enhance = pF "enhance" - -partials :: Pattern Double -> ControlPattern -partials = pF "partials" - --- Spectral comb -comb :: Pattern Double -> ControlPattern -comb = pF "comb" - --- Spectral smear -smear :: Pattern Double -> ControlPattern -smear = pF "smear" - --- Spectral scramble -scram :: Pattern Double -> ControlPattern -scram = pF "scram" - --- Spectral binshift -binshift :: Pattern Double -> ControlPattern -binshift = pF "binshift" - --- High pass sort of spectral filter -hbrick :: Pattern Double -> ControlPattern -hbrick = pF "hbrick" - --- Low pass sort of spectral filter -lbrick :: Pattern Double -> ControlPattern -lbrick = pF "lbrick" - --- aliases -att, bpf, bpq, chdecay, ctf, ctfg, delayfb, dfb, delayt, dt, det, gat, hg, hpf, hpq, lag, lbd, lch, lcl, lcp, lcr, lfoc, lfoi - , lfop, lht, llt, loh, lpf, lpq, lsn, ohdecay, phasdp, phasr, pit1, pit2, pit3, por, rel, sz, sag, scl, scp - , scr, sld, std, stt, sus, tdecay, tremdp, tremr, vcf, vco, voi - :: Pattern Double -> ControlPattern -att = attack -bpf = bandf -bpq = bandq -chdecay = clhatdecay -ctf = cutoff -ctfg = cutoffegint -delayfb = delayfeedback -dfb = delayfeedback -delayt = delaytime -dt = delaytime -det = detune -gat = gate -hg = hatgrain -hpf = hcutoff -hpq = hresonance -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 -lpq = resonance -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 -> ControlPattern -midinote = note . (subtract 60 <$>) - -drum :: Pattern String -> ControlPattern -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 :: Pattern [Word8] -> ControlPattern -array = pX "array" -midichan :: Pattern Double -> ControlPattern -midichan = pF "midichan" -control :: Pattern Double -> ControlPattern -control = pF "control" - -ccn :: Pattern Double -> ControlPattern -ccn = pF "ccn" -ccv :: Pattern Double -> ControlPattern -ccv = pF "ccv" - -polyTouch :: Pattern Double -> ControlPattern -polyTouch = pF "polyTouch" - -midibend :: Pattern Double -> ControlPattern -midibend = pF "midibend" - -miditouch :: Pattern Double -> ControlPattern -miditouch = pF "miditouch" - -nrpnn :: Pattern Int -> ControlPattern -nrpnn = pI "nrpn" -nrpnv :: Pattern Int -> ControlPattern -nrpnv = pI "val" - -ctlNum :: Pattern Double -> ControlPattern -ctlNum = pF "ctlNum" - -frameRate :: Pattern Double -> ControlPattern -frameRate = pF "frameRate" -frames :: Pattern Double -> ControlPattern -frames = pF "frames" -hours :: Pattern Double -> ControlPattern -hours = pF "hours" - -midicmd :: Pattern String -> ControlPattern -midicmd = pS "midicmd" -command :: Pattern String -> ControlPattern -command = midicmd - -minutes :: Pattern Double -> ControlPattern -minutes = pF "minutes" -progNum :: Pattern Double -> ControlPattern -progNum = pF "progNum" -seconds :: Pattern Double -> ControlPattern -seconds = pF "seconds" -songPtr :: Pattern Double -> ControlPattern -songPtr = pF "songPtr" -uid :: Pattern Double -> ControlPattern -uid = pF "uid" -val :: Pattern Double -> ControlPattern -val = pF "val" - -{- | `up` is now an alias of `note`. -} -up :: Pattern Double -> ControlPattern -up = note - -cps :: Pattern Double -> ControlPattern -cps = pF "cps" - --- generic names for mapping to e.g. midi controls -button0 :: Pattern Double -> ControlPattern -button0 = pF "button0" -button1 :: Pattern Double -> ControlPattern -button1 = pF "button1" -button2 :: Pattern Double -> ControlPattern -button2 = pF "button2" -button3 :: Pattern Double -> ControlPattern -button3 = pF "button3" -button4 :: Pattern Double -> ControlPattern -button4 = pF "button4" -button5 :: Pattern Double -> ControlPattern -button5 = pF "button5" -button6 :: Pattern Double -> ControlPattern -button6 = pF "button6" -button7 :: Pattern Double -> ControlPattern -button7 = pF "button7" -button8 :: Pattern Double -> ControlPattern -button8 = pF "button8" -button9 :: Pattern Double -> ControlPattern -button9 = pF "button9" -button10 :: Pattern Double -> ControlPattern -button10 = pF "button10" -button11 :: Pattern Double -> ControlPattern -button11 = pF "button11" -button12 :: Pattern Double -> ControlPattern -button12 = pF "button12" -button13 :: Pattern Double -> ControlPattern -button13 = pF "button13" -button14 :: Pattern Double -> ControlPattern -button14 = pF "button14" -button15 :: Pattern Double -> ControlPattern -button15 = pF "button15" -button16 :: Pattern Double -> ControlPattern -button16 = pF "button16" -button17 :: Pattern Double -> ControlPattern -button17 = pF "button17" -button18 :: Pattern Double -> ControlPattern -button18 = pF "button18" -button19 :: Pattern Double -> ControlPattern -button19 = pF "button19" -button20 :: Pattern Double -> ControlPattern -button20 = pF "button20" -button21 :: Pattern Double -> ControlPattern -button21 = pF "button21" -button22 :: Pattern Double -> ControlPattern -button22 = pF "button22" -button23 :: Pattern Double -> ControlPattern -button23 = pF "button23" -button24 :: Pattern Double -> ControlPattern -button24 = pF "button24" -button25 :: Pattern Double -> ControlPattern -button25 = pF "button25" -button26 :: Pattern Double -> ControlPattern -button26 = pF "button26" -button27 :: Pattern Double -> ControlPattern -button27 = pF "button27" -button28 :: Pattern Double -> ControlPattern -button28 = pF "button28" -button29 :: Pattern Double -> ControlPattern -button29 = pF "button29" -button30 :: Pattern Double -> ControlPattern -button30 = pF "button30" -button31 :: Pattern Double -> ControlPattern -button31 = pF "button31" - -slider0 :: Pattern Double -> ControlPattern -slider0 = pF "slider0" -slider1 :: Pattern Double -> ControlPattern -slider1 = pF "slider1" -slider2 :: Pattern Double -> ControlPattern -slider2 = pF "slider2" -slider3 :: Pattern Double -> ControlPattern -slider3 = pF "slider3" -slider4 :: Pattern Double -> ControlPattern -slider4 = pF "slider4" -slider5 :: Pattern Double -> ControlPattern -slider5 = pF "slider5" -slider6 :: Pattern Double -> ControlPattern -slider6 = pF "slider6" -slider7 :: Pattern Double -> ControlPattern -slider7 = pF "slider7" -slider8 :: Pattern Double -> ControlPattern -slider8 = pF "slider8" -slider9 :: Pattern Double -> ControlPattern -slider9 = pF "slider9" -slider10 :: Pattern Double -> ControlPattern -slider10 = pF "slider10" -slider11 :: Pattern Double -> ControlPattern -slider11 = pF "slider11" -slider12 :: Pattern Double -> ControlPattern -slider12 = pF "slider12" -slider13 :: Pattern Double -> ControlPattern -slider13 = pF "slider13" -slider14 :: Pattern Double -> ControlPattern -slider14 = pF "slider14" -slider15 :: Pattern Double -> ControlPattern -slider15 = pF "slider15" -slider16 :: Pattern Double -> ControlPattern -slider16 = pF "slider16" -slider17 :: Pattern Double -> ControlPattern -slider17 = pF "slider17" -slider18 :: Pattern Double -> ControlPattern -slider18 = pF "slider18" -slider19 :: Pattern Double -> ControlPattern -slider19 = pF "slider19" -slider20 :: Pattern Double -> ControlPattern -slider20 = pF "slider20" -slider21 :: Pattern Double -> ControlPattern -slider21 = pF "slider21" -slider22 :: Pattern Double -> ControlPattern -slider22 = pF "slider22" -slider23 :: Pattern Double -> ControlPattern -slider23 = pF "slider23" -slider24 :: Pattern Double -> ControlPattern -slider24 = pF "slider24" -slider25 :: Pattern Double -> ControlPattern -slider25 = pF "slider25" -slider26 :: Pattern Double -> ControlPattern -slider26 = pF "slider26" -slider27 :: Pattern Double -> ControlPattern -slider27 = pF "slider27" -slider28 :: Pattern Double -> ControlPattern -slider28 = pF "slider28" -slider29 :: Pattern Double -> ControlPattern -slider29 = pF "slider29" -slider30 :: Pattern Double -> ControlPattern -slider30 = pF "slider30" -slider31 :: Pattern Double -> ControlPattern -slider31 = pF "slider31" +-- **Please note**, this file is generated by bin/generate-params.hs +-- Submit any pull requests against that file and/or params-header.hs +-- in the same folder, thanks. + +{- + Params.hs - Provides the basic control patterns available to TidalCycles by default + Copyright (C) 2021, Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + +import qualified Data.Map.Strict as Map + +import Sound.Tidal.Pattern +import Sound.Tidal.Core ((#)) +import Sound.Tidal.Utils +import Data.Maybe (fromMaybe) +import Data.Word (Word8) + +-- | group multiple params into one +grp :: [String -> ControlMap] -> Pattern String -> ControlPattern +grp [] _ = empty +grp fs p = splitby <$> p + where splitby name = Map.unions $ map (\(v, f) -> f v) $ zip (split name) fs + split :: String -> [String] + split = wordsBy (==':') + +mF :: String -> String -> ControlMap +mF name v = fromMaybe Map.empty $ do f <- readMaybe v + return $ Map.singleton name (VF f) + +mI :: String -> String -> ControlMap +mI name v = fromMaybe Map.empty $ do i <- readMaybe v + return $ Map.singleton name (VI i) + +mS :: String -> String -> ControlMap +mS name v = Map.singleton name (VS v) + +-- | Param makers + +pF :: String -> Pattern Double -> ControlPattern +pF name = fmap (Map.singleton name . VF) + +pI :: String -> Pattern Int -> ControlPattern +pI name = fmap (Map.singleton name . VI) + +pB :: String -> Pattern Bool -> ControlPattern +pB name = fmap (Map.singleton name . VB) + +pR :: String -> Pattern Rational -> ControlPattern +pR name = fmap (Map.singleton name . VR) + +pN :: String -> Pattern Note -> ControlPattern +pN name = fmap (Map.singleton name . VN) + +pS :: String -> Pattern String -> ControlPattern +pS name = fmap (Map.singleton name . VS) + +pX :: String -> Pattern [Word8] -> ControlPattern +pX name = fmap (Map.singleton name . VX) + +-- | Grouped params + +sound :: Pattern String -> ControlPattern +sound = grp [mS "s", mF "n"] + +cc :: Pattern String -> ControlPattern +cc = grp [mF "ccn", mF "ccv"] + +nrpn :: Pattern String -> ControlPattern +nrpn = grp [mI "nrpn", mI "val"] + +grain' :: Pattern String -> ControlPattern +grain' = grp [mF "begin", mF "end"] + +midinote :: Pattern Note -> ControlPattern +midinote = note . (subtract 60 <$>) + +drum :: Pattern String -> ControlPattern +drum = n . (subtract 60 . drumN <$>) + +drumN :: Num a => String -> a +drumN "hq" = 27 +drumN "sl" = 28 +drumN "ps" = 29 +drumN "pl" = 30 +drumN "st" = 31 +drumN "sq" = 32 +drumN "ml" = 33 +drumN "mb" = 34 +drumN "ab" = 35 +drumN "bd" = 36 +drumN "rm" = 37 +drumN "sn" = 38 +drumN "cp" = 39 +drumN "es" = 40 +drumN "lf" = 41 +drumN "ch" = 42 +drumN "lt" = 43 +drumN "hh" = 44 +drumN "ft" = 45 +drumN "oh" = 46 +drumN "mt" = 47 +drumN "hm" = 48 +drumN "cr" = 49 +drumN "ht" = 50 +drumN "ri" = 51 +drumN "cy" = 52 +drumN "be" = 53 +drumN "ta" = 54 +drumN "sc" = 55 +drumN "cb" = 56 +drumN "cs" = 57 +drumN "vi" = 58 +drumN "rc" = 59 +drumN "hb" = 60 +drumN "lb" = 61 +drumN "mh" = 62 +drumN "hc" = 63 +drumN "lc" = 64 +drumN "he" = 65 +drumN "le" = 66 +drumN "ag" = 67 +drumN "la" = 68 +drumN "ca" = 69 +drumN "ma" = 70 +drumN "sw" = 71 +drumN "lw" = 72 +drumN "sg" = 73 +drumN "lg" = 74 +drumN "cl" = 75 +drumN "hi" = 76 +drumN "li" = 77 +drumN "mc" = 78 +drumN "oc" = 79 +drumN "tr" = 80 +drumN "ot" = 81 +drumN "sh" = 82 +drumN "jb" = 83 +drumN "bt" = 84 +drumN "ct" = 85 +drumN "ms" = 86 +drumN "os" = 87 +drumN _ = 0 + +-- Generated params + +-- | a pattern of numbers that speed up (or slow down) samples while they play. +accelerate :: Pattern Double -> ControlPattern +accelerate = pF "accelerate" +acceleratebus :: Pattern Int -> Pattern Double -> ControlPattern +acceleratebus busid pat = (pF "accelerate" pat) # (pI "^accelerate" busid) +acceleraterecv :: Pattern Int -> ControlPattern +acceleraterecv busid = pI "^accelerate" busid + +-- | like @gain@, but linear. +amp :: Pattern Double -> ControlPattern +amp = pF "amp" +ampbus :: Pattern Int -> Pattern Double -> ControlPattern +ampbus busid pat = (pF "amp" pat) # (pI "^amp" busid) +amprecv :: Pattern Int -> ControlPattern +amprecv busid = pI "^amp" busid + +-- | +array :: Pattern [Word8] -> ControlPattern +array = pX "array" +arraybus :: Pattern Int -> Pattern [Word8] -> ControlPattern +arraybus busid pat = (pX "array" pat) # (pI "^array" busid) +arrayrecv :: Pattern Int -> ControlPattern +arrayrecv busid = pI "^array" busid + +-- | a pattern of numbers to specify the attack time (in seconds) of an envelope applied to each sample. +attack :: Pattern Double -> ControlPattern +attack = pF "attack" +attackbus :: Pattern Int -> Pattern Double -> ControlPattern +attackbus busid pat = (pF "attack" pat) # (pI "^attack" busid) +attackrecv :: Pattern Int -> ControlPattern +attackrecv busid = pI "^attack" busid + +-- | a pattern of numbers from 0 to 1. Sets the center frequency of the band-pass filter. +bandf :: Pattern Double -> ControlPattern +bandf = pF "bandf" +bandfbus :: Pattern Int -> Pattern Double -> ControlPattern +bandfbus busid pat = (pF "bandf" pat) # (pI "^bandf" busid) +bandfrecv :: Pattern Int -> ControlPattern +bandfrecv busid = pI "^bandf" busid + +-- | a pattern of anumbers from 0 to 1. Sets the q-factor of the band-pass filter. +bandq :: Pattern Double -> ControlPattern +bandq = pF "bandq" +bandqbus :: Pattern Int -> Pattern Double -> ControlPattern +bandqbus busid pat = (pF "bandq" pat) # (pI "^bandq" busid) +bandqrecv :: Pattern Int -> ControlPattern +bandqrecv busid = pI "^bandq" busid + +-- | 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. +begin :: Pattern Double -> ControlPattern +begin = pF "begin" +beginbus :: Pattern Int -> Pattern Double -> ControlPattern +beginbus busid pat = (pF "begin" pat) # (pI "^begin" busid) +beginrecv :: Pattern Int -> ControlPattern +beginrecv busid = pI "^begin" busid + +-- | Spectral binshift +binshift :: Pattern Double -> ControlPattern +binshift = pF "binshift" +binshiftbus :: Pattern Int -> Pattern Double -> ControlPattern +binshiftbus busid pat = (pF "binshift" pat) # (pI "^binshift" busid) +binshiftrecv :: Pattern Int -> ControlPattern +binshiftrecv busid = pI "^binshift" busid + +-- | +button0 :: Pattern Double -> ControlPattern +button0 = pF "button0" +button0bus :: Pattern Int -> Pattern Double -> ControlPattern +button0bus busid pat = (pF "button0" pat) # (pI "^button0" busid) +button0recv :: Pattern Int -> ControlPattern +button0recv busid = pI "^button0" busid + +-- | +button1 :: Pattern Double -> ControlPattern +button1 = pF "button1" +button1bus :: Pattern Int -> Pattern Double -> ControlPattern +button1bus busid pat = (pF "button1" pat) # (pI "^button1" busid) +button1recv :: Pattern Int -> ControlPattern +button1recv busid = pI "^button1" busid + +-- | +button10 :: Pattern Double -> ControlPattern +button10 = pF "button10" +button10bus :: Pattern Int -> Pattern Double -> ControlPattern +button10bus busid pat = (pF "button10" pat) # (pI "^button10" busid) +button10recv :: Pattern Int -> ControlPattern +button10recv busid = pI "^button10" busid + +-- | +button11 :: Pattern Double -> ControlPattern +button11 = pF "button11" +button11bus :: Pattern Int -> Pattern Double -> ControlPattern +button11bus busid pat = (pF "button11" pat) # (pI "^button11" busid) +button11recv :: Pattern Int -> ControlPattern +button11recv busid = pI "^button11" busid + +-- | +button12 :: Pattern Double -> ControlPattern +button12 = pF "button12" +button12bus :: Pattern Int -> Pattern Double -> ControlPattern +button12bus busid pat = (pF "button12" pat) # (pI "^button12" busid) +button12recv :: Pattern Int -> ControlPattern +button12recv busid = pI "^button12" busid + +-- | +button13 :: Pattern Double -> ControlPattern +button13 = pF "button13" +button13bus :: Pattern Int -> Pattern Double -> ControlPattern +button13bus busid pat = (pF "button13" pat) # (pI "^button13" busid) +button13recv :: Pattern Int -> ControlPattern +button13recv busid = pI "^button13" busid + +-- | +button14 :: Pattern Double -> ControlPattern +button14 = pF "button14" +button14bus :: Pattern Int -> Pattern Double -> ControlPattern +button14bus busid pat = (pF "button14" pat) # (pI "^button14" busid) +button14recv :: Pattern Int -> ControlPattern +button14recv busid = pI "^button14" busid + +-- | +button15 :: Pattern Double -> ControlPattern +button15 = pF "button15" +button15bus :: Pattern Int -> Pattern Double -> ControlPattern +button15bus busid pat = (pF "button15" pat) # (pI "^button15" busid) +button15recv :: Pattern Int -> ControlPattern +button15recv busid = pI "^button15" busid + +-- | +button2 :: Pattern Double -> ControlPattern +button2 = pF "button2" +button2bus :: Pattern Int -> Pattern Double -> ControlPattern +button2bus busid pat = (pF "button2" pat) # (pI "^button2" busid) +button2recv :: Pattern Int -> ControlPattern +button2recv busid = pI "^button2" busid + +-- | +button3 :: Pattern Double -> ControlPattern +button3 = pF "button3" +button3bus :: Pattern Int -> Pattern Double -> ControlPattern +button3bus busid pat = (pF "button3" pat) # (pI "^button3" busid) +button3recv :: Pattern Int -> ControlPattern +button3recv busid = pI "^button3" busid + +-- | +button4 :: Pattern Double -> ControlPattern +button4 = pF "button4" +button4bus :: Pattern Int -> Pattern Double -> ControlPattern +button4bus busid pat = (pF "button4" pat) # (pI "^button4" busid) +button4recv :: Pattern Int -> ControlPattern +button4recv busid = pI "^button4" busid + +-- | +button5 :: Pattern Double -> ControlPattern +button5 = pF "button5" +button5bus :: Pattern Int -> Pattern Double -> ControlPattern +button5bus busid pat = (pF "button5" pat) # (pI "^button5" busid) +button5recv :: Pattern Int -> ControlPattern +button5recv busid = pI "^button5" busid + +-- | +button6 :: Pattern Double -> ControlPattern +button6 = pF "button6" +button6bus :: Pattern Int -> Pattern Double -> ControlPattern +button6bus busid pat = (pF "button6" pat) # (pI "^button6" busid) +button6recv :: Pattern Int -> ControlPattern +button6recv busid = pI "^button6" busid + +-- | +button7 :: Pattern Double -> ControlPattern +button7 = pF "button7" +button7bus :: Pattern Int -> Pattern Double -> ControlPattern +button7bus busid pat = (pF "button7" pat) # (pI "^button7" busid) +button7recv :: Pattern Int -> ControlPattern +button7recv busid = pI "^button7" busid + +-- | +button8 :: Pattern Double -> ControlPattern +button8 = pF "button8" +button8bus :: Pattern Int -> Pattern Double -> ControlPattern +button8bus busid pat = (pF "button8" pat) # (pI "^button8" busid) +button8recv :: Pattern Int -> ControlPattern +button8recv busid = pI "^button8" busid + +-- | +button9 :: Pattern Double -> ControlPattern +button9 = pF "button9" +button9bus :: Pattern Int -> Pattern Double -> ControlPattern +button9bus busid pat = (pF "button9" pat) # (pI "^button9" busid) +button9recv :: Pattern Int -> ControlPattern +button9recv busid = pI "^button9" busid + +-- | +ccn :: Pattern Double -> ControlPattern +ccn = pF "ccn" +ccnbus :: Pattern Int -> Pattern Double -> ControlPattern +ccnbus busid pat = (pF "ccn" pat) # (pI "^ccn" busid) +ccnrecv :: Pattern Int -> ControlPattern +ccnrecv busid = pI "^ccn" busid + +-- | +ccv :: Pattern Double -> ControlPattern +ccv = pF "ccv" +ccvbus :: Pattern Int -> Pattern Double -> ControlPattern +ccvbus busid pat = (pF "ccv" pat) # (pI "^ccv" busid) +ccvrecv :: Pattern Int -> ControlPattern +ccvrecv busid = pI "^ccv" busid + +-- | choose the channel the pattern is sent to in superdirt +channel :: Pattern Int -> ControlPattern +channel = pI "channel" +channelbus :: Pattern Int -> Pattern Int -> ControlPattern +channelbus _ _ = error $ "Control parameter 'channel' can't be sent to a bus." + +-- | +clhatdecay :: Pattern Double -> ControlPattern +clhatdecay = pF "clhatdecay" +clhatdecaybus :: Pattern Int -> Pattern Double -> ControlPattern +clhatdecaybus busid pat = (pF "clhatdecay" pat) # (pI "^clhatdecay" busid) +clhatdecayrecv :: Pattern Int -> ControlPattern +clhatdecayrecv busid = pI "^clhatdecay" busid + +-- | 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 :: Pattern Double -> ControlPattern +coarse = pF "coarse" +coarsebus :: Pattern Int -> Pattern Double -> ControlPattern +coarsebus busid pat = (pF "coarse" pat) # (pI "^coarse" busid) +coarserecv :: Pattern Int -> ControlPattern +coarserecv busid = pI "^coarse" busid + +-- | Spectral comb +comb :: Pattern Double -> ControlPattern +comb = pF "comb" +combbus :: Pattern Int -> Pattern Double -> ControlPattern +combbus busid pat = (pF "comb" pat) # (pI "^comb" busid) +combrecv :: Pattern Int -> ControlPattern +combrecv busid = pI "^comb" busid + +-- | +control :: Pattern Double -> ControlPattern +control = pF "control" +controlbus :: Pattern Int -> Pattern Double -> ControlPattern +controlbus busid pat = (pF "control" pat) # (pI "^control" busid) +controlrecv :: Pattern Int -> ControlPattern +controlrecv busid = pI "^control" busid + +-- | +cps :: Pattern Double -> ControlPattern +cps = pF "cps" +cpsbus :: Pattern Int -> Pattern Double -> ControlPattern +cpsbus busid pat = (pF "cps" pat) # (pI "^cps" busid) +cpsrecv :: Pattern Int -> ControlPattern +cpsrecv busid = pI "^cps" busid + +-- | bit crushing, a pattern of numbers from 1 (for drastic reduction in bit-depth) to 16 (for barely no reduction). +crush :: Pattern Double -> ControlPattern +crush = pF "crush" +crushbus :: Pattern Int -> Pattern Double -> ControlPattern +crushbus busid pat = (pF "crush" pat) # (pI "^crush" busid) +crushrecv :: Pattern Int -> ControlPattern +crushrecv busid = pI "^crush" busid + +-- | +ctlNum :: Pattern Double -> ControlPattern +ctlNum = pF "ctlNum" +ctlNumbus :: Pattern Int -> Pattern Double -> ControlPattern +ctlNumbus busid pat = (pF "ctlNum" pat) # (pI "^ctlNum" busid) +ctlNumrecv :: Pattern Int -> ControlPattern +ctlNumrecv busid = pI "^ctlNum" busid + +-- | +ctranspose :: Pattern Double -> ControlPattern +ctranspose = pF "ctranspose" +ctransposebus :: Pattern Int -> Pattern Double -> ControlPattern +ctransposebus busid pat = (pF "ctranspose" pat) # (pI "^ctranspose" busid) +ctransposerecv :: Pattern Int -> ControlPattern +ctransposerecv busid = pI "^ctranspose" busid + +-- | 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. +cut :: Pattern Int -> ControlPattern +cut = pI "cut" +cutbus :: Pattern Int -> Pattern Int -> ControlPattern +cutbus busid pat = (pI "cut" pat) # (pI "^cut" busid) +cutrecv :: Pattern Int -> ControlPattern +cutrecv busid = pI "^cut" busid + +-- | a pattern of numbers from 0 to 1. Applies the cutoff frequency of the low-pass filter. +cutoff :: Pattern Double -> ControlPattern +cutoff = pF "cutoff" +cutoffbus :: Pattern Int -> Pattern Double -> ControlPattern +cutoffbus busid pat = (pF "cutoff" pat) # (pI "^cutoff" busid) +cutoffrecv :: Pattern Int -> ControlPattern +cutoffrecv busid = pI "^cutoff" busid + +-- | +cutoffegint :: Pattern Double -> ControlPattern +cutoffegint = pF "cutoffegint" +cutoffegintbus :: Pattern Int -> Pattern Double -> ControlPattern +cutoffegintbus busid pat = (pF "cutoffegint" pat) # (pI "^cutoffegint" busid) +cutoffegintrecv :: Pattern Int -> ControlPattern +cutoffegintrecv busid = pI "^cutoffegint" busid + +-- | +decay :: Pattern Double -> ControlPattern +decay = pF "decay" +decaybus :: Pattern Int -> Pattern Double -> ControlPattern +decaybus busid pat = (pF "decay" pat) # (pI "^decay" busid) +decayrecv :: Pattern Int -> ControlPattern +decayrecv busid = pI "^decay" busid + +-- | +degree :: Pattern Double -> ControlPattern +degree = pF "degree" +degreebus :: Pattern Int -> Pattern Double -> ControlPattern +degreebus busid pat = (pF "degree" pat) # (pI "^degree" busid) +degreerecv :: Pattern Int -> ControlPattern +degreerecv busid = pI "^degree" busid + +-- | a pattern of numbers from 0 to 1. Sets the level of the delay signal. +delay :: Pattern Double -> ControlPattern +delay = pF "delay" +delaybus :: Pattern Int -> Pattern Double -> ControlPattern +delaybus busid pat = (pF "delay" pat) # (pI "^delay" busid) +delayrecv :: Pattern Int -> ControlPattern +delayrecv busid = pI "^delay" busid + +-- | a pattern of numbers from 0 to 1. Sets the amount of delay feedback. +delayfeedback :: Pattern Double -> ControlPattern +delayfeedback = pF "delayfeedback" +delayfeedbackbus :: Pattern Int -> Pattern Double -> ControlPattern +delayfeedbackbus busid pat = (pF "delayfeedback" pat) # (pI "^delayfeedback" busid) +delayfeedbackrecv :: Pattern Int -> ControlPattern +delayfeedbackrecv busid = pI "^delayfeedback" busid + +-- | a pattern of numbers from 0 to 1. Sets the length of the delay. +delaytime :: Pattern Double -> ControlPattern +delaytime = pF "delaytime" +delaytimebus :: Pattern Int -> Pattern Double -> ControlPattern +delaytimebus busid pat = (pF "delaytime" pat) # (pI "^delaytime" busid) +delaytimerecv :: Pattern Int -> ControlPattern +delaytimerecv busid = pI "^delaytime" busid + +-- | +detune :: Pattern Double -> ControlPattern +detune = pF "detune" +detunebus :: Pattern Int -> Pattern Double -> ControlPattern +detunebus busid pat = (pF "detune" pat) # (pI "^detune" busid) +detunerecv :: Pattern Int -> ControlPattern +detunerecv busid = pI "^detune" busid + +-- | noisy fuzzy distortion +distort :: Pattern Double -> ControlPattern +distort = pF "distort" +distortbus :: Pattern Int -> Pattern Double -> ControlPattern +distortbus busid pat = (pF "distort" pat) # (pI "^distort" busid) +distortrecv :: Pattern Int -> ControlPattern +distortrecv busid = pI "^distort" busid + +-- | DJ filter, below 0.5 is low pass filter, above is high pass filter. +djf :: Pattern Double -> ControlPattern +djf = pF "djf" +djfbus :: Pattern Int -> Pattern Double -> ControlPattern +djfbus busid pat = (pF "djf" pat) # (pI "^djf" busid) +djfrecv :: Pattern Int -> ControlPattern +djfrecv busid = pI "^djf" busid + +-- | when set to `1` will disable all reverb for this pattern. See `room` and `size` for more information about reverb. +dry :: Pattern Double -> ControlPattern +dry = pF "dry" +drybus :: Pattern Int -> Pattern Double -> ControlPattern +drybus busid pat = (pF "dry" pat) # (pI "^dry" busid) +dryrecv :: Pattern Int -> ControlPattern +dryrecv busid = pI "^dry" busid + +-- | +dur :: Pattern Double -> ControlPattern +dur = pF "dur" +durbus :: Pattern Int -> Pattern Double -> ControlPattern +durbus busid pat = (pF "dur" pat) # (pI "^dur" busid) +durrecv :: Pattern Int -> ControlPattern +durrecv busid = pI "^dur" busid + +-- | 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 :: Pattern Double -> ControlPattern +end = pF "end" +endbus :: Pattern Int -> Pattern Double -> ControlPattern +endbus _ _ = error $ "Control parameter 'end' can't be sent to a bus." + +-- | Spectral enhance +enhance :: Pattern Double -> ControlPattern +enhance = pF "enhance" +enhancebus :: Pattern Int -> Pattern Double -> ControlPattern +enhancebus busid pat = (pF "enhance" pat) # (pI "^enhance" busid) +enhancerecv :: Pattern Int -> ControlPattern +enhancerecv busid = pI "^enhance" busid + +-- | +expression :: Pattern Double -> ControlPattern +expression = pF "expression" +expressionbus :: Pattern Int -> Pattern Double -> ControlPattern +expressionbus busid pat = (pF "expression" pat) # (pI "^expression" busid) +expressionrecv :: Pattern Int -> ControlPattern +expressionrecv busid = pI "^expression" busid + +-- | +frameRate :: Pattern Double -> ControlPattern +frameRate = pF "frameRate" +frameRatebus :: Pattern Int -> Pattern Double -> ControlPattern +frameRatebus busid pat = (pF "frameRate" pat) # (pI "^frameRate" busid) +frameRaterecv :: Pattern Int -> ControlPattern +frameRaterecv busid = pI "^frameRate" busid + +-- | +frames :: Pattern Double -> ControlPattern +frames = pF "frames" +framesbus :: Pattern Int -> Pattern Double -> ControlPattern +framesbus busid pat = (pF "frames" pat) # (pI "^frames" busid) +framesrecv :: Pattern Int -> ControlPattern +framesrecv busid = pI "^frames" busid + +-- | Spectral freeze +freeze :: Pattern Double -> ControlPattern +freeze = pF "freeze" +freezebus :: Pattern Int -> Pattern Double -> ControlPattern +freezebus busid pat = (pF "freeze" pat) # (pI "^freeze" busid) +freezerecv :: Pattern Int -> ControlPattern +freezerecv busid = pI "^freeze" busid + +-- | +freq :: Pattern Double -> ControlPattern +freq = pF "freq" +freqbus :: Pattern Int -> Pattern Double -> ControlPattern +freqbus busid pat = (pF "freq" pat) # (pI "^freq" busid) +freqrecv :: Pattern Int -> ControlPattern +freqrecv busid = pI "^freq" busid + +-- | for internal sound routing +from :: Pattern Double -> ControlPattern +from = pF "from" +frombus :: Pattern Int -> Pattern Double -> ControlPattern +frombus busid pat = (pF "from" pat) # (pI "^from" busid) +fromrecv :: Pattern Int -> ControlPattern +fromrecv busid = pI "^from" busid + +-- | frequency shifter +fshift :: Pattern Double -> ControlPattern +fshift = pF "fshift" +fshiftbus :: Pattern Int -> Pattern Double -> ControlPattern +fshiftbus busid pat = (pF "fshift" pat) # (pI "^fshift" busid) +fshiftrecv :: Pattern Int -> ControlPattern +fshiftrecv busid = pI "^fshift" busid + +-- | frequency shifter +fshiftnote :: Pattern Double -> ControlPattern +fshiftnote = pF "fshiftnote" +fshiftnotebus :: Pattern Int -> Pattern Double -> ControlPattern +fshiftnotebus busid pat = (pF "fshiftnote" pat) # (pI "^fshiftnote" busid) +fshiftnoterecv :: Pattern Int -> ControlPattern +fshiftnoterecv busid = pI "^fshiftnote" busid + +-- | frequency shifter +fshiftphase :: Pattern Double -> ControlPattern +fshiftphase = pF "fshiftphase" +fshiftphasebus :: Pattern Int -> Pattern Double -> ControlPattern +fshiftphasebus busid pat = (pF "fshiftphase" pat) # (pI "^fshiftphase" busid) +fshiftphaserecv :: Pattern Int -> ControlPattern +fshiftphaserecv busid = pI "^fshiftphase" busid + +-- | a pattern of numbers that specify volume. Values less than 1 make the sound quieter. Values greater than 1 make the sound louder. For the linear equivalent, see @amp@. +gain :: Pattern Double -> ControlPattern +gain = pF "gain" +gainbus :: Pattern Int -> Pattern Double -> ControlPattern +gainbus _ _ = error $ "Control parameter 'gain' can't be sent to a bus." + +-- | +gate :: Pattern Double -> ControlPattern +gate = pF "gate" +gatebus :: Pattern Int -> Pattern Double -> ControlPattern +gatebus busid pat = (pF "gate" pat) # (pI "^gate" busid) +gaterecv :: Pattern Int -> ControlPattern +gaterecv busid = pI "^gate" busid + +-- | +harmonic :: Pattern Double -> ControlPattern +harmonic = pF "harmonic" +harmonicbus :: Pattern Int -> Pattern Double -> ControlPattern +harmonicbus busid pat = (pF "harmonic" pat) # (pI "^harmonic" busid) +harmonicrecv :: Pattern Int -> ControlPattern +harmonicrecv busid = pI "^harmonic" busid + +-- | +hatgrain :: Pattern Double -> ControlPattern +hatgrain = pF "hatgrain" +hatgrainbus :: Pattern Int -> Pattern Double -> ControlPattern +hatgrainbus busid pat = (pF "hatgrain" pat) # (pI "^hatgrain" busid) +hatgrainrecv :: Pattern Int -> ControlPattern +hatgrainrecv busid = pI "^hatgrain" busid + +-- | High pass sort of spectral filter +hbrick :: Pattern Double -> ControlPattern +hbrick = pF "hbrick" +hbrickbus :: Pattern Int -> Pattern Double -> ControlPattern +hbrickbus busid pat = (pF "hbrick" pat) # (pI "^hbrick" busid) +hbrickrecv :: Pattern Int -> ControlPattern +hbrickrecv busid = pI "^hbrick" busid + +-- | a pattern of numbers from 0 to 1. Applies the cutoff frequency of the high-pass filter. Also has alias @hpf@ +hcutoff :: Pattern Double -> ControlPattern +hcutoff = pF "hcutoff" +hcutoffbus :: Pattern Int -> Pattern Double -> ControlPattern +hcutoffbus busid pat = (pF "hcutoff" pat) # (pI "^hcutoff" busid) +hcutoffrecv :: Pattern Int -> ControlPattern +hcutoffrecv busid = pI "^hcutoff" busid + +-- | 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 :: Pattern Double -> ControlPattern +hold = pF "hold" +holdbus :: Pattern Int -> Pattern Double -> ControlPattern +holdbus busid pat = (pF "hold" pat) # (pI "^hold" busid) +holdrecv :: Pattern Int -> ControlPattern +holdrecv busid = pI "^hold" busid + +-- | +hours :: Pattern Double -> ControlPattern +hours = pF "hours" +hoursbus :: Pattern Int -> Pattern Double -> ControlPattern +hoursbus busid pat = (pF "hours" pat) # (pI "^hours" busid) +hoursrecv :: Pattern Int -> ControlPattern +hoursrecv busid = pI "^hours" busid + +-- | a pattern of numbers from 0 to 1. Applies the resonance of the high-pass filter. Has alias @hpq@ +hresonance :: Pattern Double -> ControlPattern +hresonance = pF "hresonance" +hresonancebus :: Pattern Int -> Pattern Double -> ControlPattern +hresonancebus busid pat = (pF "hresonance" pat) # (pI "^hresonance" busid) +hresonancerecv :: Pattern Int -> ControlPattern +hresonancerecv busid = pI "^hresonance" busid + +-- | +imag :: Pattern Double -> ControlPattern +imag = pF "imag" +imagbus :: Pattern Int -> Pattern Double -> ControlPattern +imagbus busid pat = (pF "imag" pat) # (pI "^imag" busid) +imagrecv :: Pattern Int -> ControlPattern +imagrecv busid = pI "^imag" busid + +-- | +kcutoff :: Pattern Double -> ControlPattern +kcutoff = pF "kcutoff" +kcutoffbus :: Pattern Int -> Pattern Double -> ControlPattern +kcutoffbus busid pat = (pF "kcutoff" pat) # (pI "^kcutoff" busid) +kcutoffrecv :: Pattern Int -> ControlPattern +kcutoffrecv busid = pI "^kcutoff" busid + +-- | shape/bass enhancer +krush :: Pattern Double -> ControlPattern +krush = pF "krush" +krushbus :: Pattern Int -> Pattern Double -> ControlPattern +krushbus busid pat = (pF "krush" pat) # (pI "^krush" busid) +krushrecv :: Pattern Int -> ControlPattern +krushrecv busid = pI "^krush" busid + +-- | +lagogo :: Pattern Double -> ControlPattern +lagogo = pF "lagogo" +lagogobus :: Pattern Int -> Pattern Double -> ControlPattern +lagogobus busid pat = (pF "lagogo" pat) # (pI "^lagogo" busid) +lagogorecv :: Pattern Int -> ControlPattern +lagogorecv busid = pI "^lagogo" busid + +-- | Low pass sort of spectral filter +lbrick :: Pattern Double -> ControlPattern +lbrick = pF "lbrick" +lbrickbus :: Pattern Int -> Pattern Double -> ControlPattern +lbrickbus busid pat = (pF "lbrick" pat) # (pI "^lbrick" busid) +lbrickrecv :: Pattern Int -> ControlPattern +lbrickrecv busid = pI "^lbrick" busid + +-- | +lclap :: Pattern Double -> ControlPattern +lclap = pF "lclap" +lclapbus :: Pattern Int -> Pattern Double -> ControlPattern +lclapbus busid pat = (pF "lclap" pat) # (pI "^lclap" busid) +lclaprecv :: Pattern Int -> ControlPattern +lclaprecv busid = pI "^lclap" busid + +-- | +lclaves :: Pattern Double -> ControlPattern +lclaves = pF "lclaves" +lclavesbus :: Pattern Int -> Pattern Double -> ControlPattern +lclavesbus busid pat = (pF "lclaves" pat) # (pI "^lclaves" busid) +lclavesrecv :: Pattern Int -> ControlPattern +lclavesrecv busid = pI "^lclaves" busid + +-- | +lclhat :: Pattern Double -> ControlPattern +lclhat = pF "lclhat" +lclhatbus :: Pattern Int -> Pattern Double -> ControlPattern +lclhatbus busid pat = (pF "lclhat" pat) # (pI "^lclhat" busid) +lclhatrecv :: Pattern Int -> ControlPattern +lclhatrecv busid = pI "^lclhat" busid + +-- | +lcrash :: Pattern Double -> ControlPattern +lcrash = pF "lcrash" +lcrashbus :: Pattern Int -> Pattern Double -> ControlPattern +lcrashbus busid pat = (pF "lcrash" pat) # (pI "^lcrash" busid) +lcrashrecv :: Pattern Int -> ControlPattern +lcrashrecv busid = pI "^lcrash" busid + +-- | controls the amount of overlap between two adjacent sounds +legato :: Pattern Double -> ControlPattern +legato = pF "legato" +legatobus :: Pattern Int -> Pattern Double -> ControlPattern +legatobus _ _ = error $ "Control parameter 'legato' can't be sent to a bus." + +-- | +leslie :: Pattern Double -> ControlPattern +leslie = pF "leslie" +lesliebus :: Pattern Int -> Pattern Double -> ControlPattern +lesliebus busid pat = (pF "leslie" pat) # (pI "^leslie" busid) +leslierecv :: Pattern Int -> ControlPattern +leslierecv busid = pI "^leslie" busid + +-- | +lfo :: Pattern Double -> ControlPattern +lfo = pF "lfo" +lfobus :: Pattern Int -> Pattern Double -> ControlPattern +lfobus busid pat = (pF "lfo" pat) # (pI "^lfo" busid) +lforecv :: Pattern Int -> ControlPattern +lforecv busid = pI "^lfo" busid + +-- | +lfocutoffint :: Pattern Double -> ControlPattern +lfocutoffint = pF "lfocutoffint" +lfocutoffintbus :: Pattern Int -> Pattern Double -> ControlPattern +lfocutoffintbus busid pat = (pF "lfocutoffint" pat) # (pI "^lfocutoffint" busid) +lfocutoffintrecv :: Pattern Int -> ControlPattern +lfocutoffintrecv busid = pI "^lfocutoffint" busid + +-- | +lfodelay :: Pattern Double -> ControlPattern +lfodelay = pF "lfodelay" +lfodelaybus :: Pattern Int -> Pattern Double -> ControlPattern +lfodelaybus busid pat = (pF "lfodelay" pat) # (pI "^lfodelay" busid) +lfodelayrecv :: Pattern Int -> ControlPattern +lfodelayrecv busid = pI "^lfodelay" busid + +-- | +lfoint :: Pattern Double -> ControlPattern +lfoint = pF "lfoint" +lfointbus :: Pattern Int -> Pattern Double -> ControlPattern +lfointbus busid pat = (pF "lfoint" pat) # (pI "^lfoint" busid) +lfointrecv :: Pattern Int -> ControlPattern +lfointrecv busid = pI "^lfoint" busid + +-- | +lfopitchint :: Pattern Double -> ControlPattern +lfopitchint = pF "lfopitchint" +lfopitchintbus :: Pattern Int -> Pattern Double -> ControlPattern +lfopitchintbus busid pat = (pF "lfopitchint" pat) # (pI "^lfopitchint" busid) +lfopitchintrecv :: Pattern Int -> ControlPattern +lfopitchintrecv busid = pI "^lfopitchint" busid + +-- | +lfoshape :: Pattern Double -> ControlPattern +lfoshape = pF "lfoshape" +lfoshapebus :: Pattern Int -> Pattern Double -> ControlPattern +lfoshapebus busid pat = (pF "lfoshape" pat) # (pI "^lfoshape" busid) +lfoshaperecv :: Pattern Int -> ControlPattern +lfoshaperecv busid = pI "^lfoshape" busid + +-- | +lfosync :: Pattern Double -> ControlPattern +lfosync = pF "lfosync" +lfosyncbus :: Pattern Int -> Pattern Double -> ControlPattern +lfosyncbus busid pat = (pF "lfosync" pat) # (pI "^lfosync" busid) +lfosyncrecv :: Pattern Int -> ControlPattern +lfosyncrecv busid = pI "^lfosync" busid + +-- | +lhitom :: Pattern Double -> ControlPattern +lhitom = pF "lhitom" +lhitombus :: Pattern Int -> Pattern Double -> ControlPattern +lhitombus busid pat = (pF "lhitom" pat) # (pI "^lhitom" busid) +lhitomrecv :: Pattern Int -> ControlPattern +lhitomrecv busid = pI "^lhitom" busid + +-- | +lkick :: Pattern Double -> ControlPattern +lkick = pF "lkick" +lkickbus :: Pattern Int -> Pattern Double -> ControlPattern +lkickbus busid pat = (pF "lkick" pat) # (pI "^lkick" busid) +lkickrecv :: Pattern Int -> ControlPattern +lkickrecv busid = pI "^lkick" busid + +-- | +llotom :: Pattern Double -> ControlPattern +llotom = pF "llotom" +llotombus :: Pattern Int -> Pattern Double -> ControlPattern +llotombus busid pat = (pF "llotom" pat) # (pI "^llotom" busid) +llotomrecv :: Pattern Int -> ControlPattern +llotomrecv busid = pI "^llotom" busid + +-- | 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 :: Pattern Double -> ControlPattern +lock = pF "lock" +lockbus :: Pattern Int -> Pattern Double -> ControlPattern +lockbus busid pat = (pF "lock" pat) # (pI "^lock" busid) +lockrecv :: Pattern Int -> ControlPattern +lockrecv busid = pI "^lock" busid + +-- | loops the sample (from `begin` to `end`) the specified number of times. +loop :: Pattern Double -> ControlPattern +loop = pF "loop" +loopbus :: Pattern Int -> Pattern Double -> ControlPattern +loopbus _ _ = error $ "Control parameter 'loop' can't be sent to a bus." + +-- | +lophat :: Pattern Double -> ControlPattern +lophat = pF "lophat" +lophatbus :: Pattern Int -> Pattern Double -> ControlPattern +lophatbus busid pat = (pF "lophat" pat) # (pI "^lophat" busid) +lophatrecv :: Pattern Int -> ControlPattern +lophatrecv busid = pI "^lophat" busid + +-- | +lrate :: Pattern Double -> ControlPattern +lrate = pF "lrate" +lratebus :: Pattern Int -> Pattern Double -> ControlPattern +lratebus busid pat = (pF "lrate" pat) # (pI "^lrate" busid) +lraterecv :: Pattern Int -> ControlPattern +lraterecv busid = pI "^lrate" busid + +-- | +lsize :: Pattern Double -> ControlPattern +lsize = pF "lsize" +lsizebus :: Pattern Int -> Pattern Double -> ControlPattern +lsizebus busid pat = (pF "lsize" pat) # (pI "^lsize" busid) +lsizerecv :: Pattern Int -> ControlPattern +lsizerecv busid = pI "^lsize" busid + +-- | +lsnare :: Pattern Double -> ControlPattern +lsnare = pF "lsnare" +lsnarebus :: Pattern Int -> Pattern Double -> ControlPattern +lsnarebus busid pat = (pF "lsnare" pat) # (pI "^lsnare" busid) +lsnarerecv :: Pattern Int -> ControlPattern +lsnarerecv busid = pI "^lsnare" busid + +-- | +midibend :: Pattern Double -> ControlPattern +midibend = pF "midibend" +midibendbus :: Pattern Int -> Pattern Double -> ControlPattern +midibendbus busid pat = (pF "midibend" pat) # (pI "^midibend" busid) +midibendrecv :: Pattern Int -> ControlPattern +midibendrecv busid = pI "^midibend" busid + +-- | +midichan :: Pattern Double -> ControlPattern +midichan = pF "midichan" +midichanbus :: Pattern Int -> Pattern Double -> ControlPattern +midichanbus busid pat = (pF "midichan" pat) # (pI "^midichan" busid) +midichanrecv :: Pattern Int -> ControlPattern +midichanrecv busid = pI "^midichan" busid + +-- | +midicmd :: Pattern String -> ControlPattern +midicmd = pS "midicmd" +midicmdbus :: Pattern Int -> Pattern String -> ControlPattern +midicmdbus busid pat = (pS "midicmd" pat) # (pI "^midicmd" busid) +midicmdrecv :: Pattern Int -> ControlPattern +midicmdrecv busid = pI "^midicmd" busid + +-- | +miditouch :: Pattern Double -> ControlPattern +miditouch = pF "miditouch" +miditouchbus :: Pattern Int -> Pattern Double -> ControlPattern +miditouchbus busid pat = (pF "miditouch" pat) # (pI "^miditouch" busid) +miditouchrecv :: Pattern Int -> ControlPattern +miditouchrecv busid = pI "^miditouch" busid + +-- | +minutes :: Pattern Double -> ControlPattern +minutes = pF "minutes" +minutesbus :: Pattern Int -> Pattern Double -> ControlPattern +minutesbus busid pat = (pF "minutes" pat) # (pI "^minutes" busid) +minutesrecv :: Pattern Int -> ControlPattern +minutesrecv busid = pI "^minutes" busid + +-- | +modwheel :: Pattern Double -> ControlPattern +modwheel = pF "modwheel" +modwheelbus :: Pattern Int -> Pattern Double -> ControlPattern +modwheelbus busid pat = (pF "modwheel" pat) # (pI "^modwheel" busid) +modwheelrecv :: Pattern Int -> ControlPattern +modwheelrecv busid = pI "^modwheel" busid + +-- | +mtranspose :: Pattern Double -> ControlPattern +mtranspose = pF "mtranspose" +mtransposebus :: Pattern Int -> Pattern Double -> ControlPattern +mtransposebus busid pat = (pF "mtranspose" pat) # (pI "^mtranspose" busid) +mtransposerecv :: Pattern Int -> ControlPattern +mtransposerecv busid = pI "^mtranspose" busid + +-- | The note or sample number to choose for a synth or sampleset +n :: Pattern Note -> ControlPattern +n = pN "n" +nbus :: Pattern Int -> Pattern Note -> ControlPattern +nbus _ _ = error $ "Control parameter 'n' can't be sent to a bus." + +-- | The note or pitch to play a sound or synth with +note :: Pattern Note -> ControlPattern +note = pN "note" +notebus :: Pattern Int -> Pattern Note -> ControlPattern +notebus _ _ = error $ "Control parameter 'note' can't be sent to a bus." + +-- | +nrpnn :: Pattern Int -> ControlPattern +nrpnn = pI "nrpnn" +nrpnnbus :: Pattern Int -> Pattern Int -> ControlPattern +nrpnnbus busid pat = (pI "nrpnn" pat) # (pI "^nrpnn" busid) +nrpnnrecv :: Pattern Int -> ControlPattern +nrpnnrecv busid = pI "^nrpnn" busid + +-- | +nrpnv :: Pattern Int -> ControlPattern +nrpnv = pI "nrpnv" +nrpnvbus :: Pattern Int -> Pattern Int -> ControlPattern +nrpnvbus busid pat = (pI "nrpnv" pat) # (pI "^nrpnv" busid) +nrpnvrecv :: Pattern Int -> ControlPattern +nrpnvrecv busid = pI "^nrpnv" busid + +-- | Nudges events into the future by the specified number of seconds. Negative numbers work up to a point as well (due to internal latency) +nudge :: Pattern Double -> ControlPattern +nudge = pF "nudge" +nudgebus :: Pattern Int -> Pattern Double -> ControlPattern +nudgebus busid pat = (pF "nudge" pat) # (pI "^nudge" busid) +nudgerecv :: Pattern Int -> ControlPattern +nudgerecv busid = pI "^nudge" busid + +-- | +octave :: Pattern Int -> ControlPattern +octave = pI "octave" +octavebus :: Pattern Int -> Pattern Int -> ControlPattern +octavebus _ _ = error $ "Control parameter 'octave' can't be sent to a bus." + +-- | +octaveR :: Pattern Double -> ControlPattern +octaveR = pF "octaveR" +octaveRbus :: Pattern Int -> Pattern Double -> ControlPattern +octaveRbus busid pat = (pF "octaveR" pat) # (pI "^octaveR" busid) +octaveRrecv :: Pattern Int -> ControlPattern +octaveRrecv busid = pI "^octaveR" busid + +-- | octaver effect +octer :: Pattern Double -> ControlPattern +octer = pF "octer" +octerbus :: Pattern Int -> Pattern Double -> ControlPattern +octerbus busid pat = (pF "octer" pat) # (pI "^octer" busid) +octerrecv :: Pattern Int -> ControlPattern +octerrecv busid = pI "^octer" busid + +-- | octaver effect +octersub :: Pattern Double -> ControlPattern +octersub = pF "octersub" +octersubbus :: Pattern Int -> Pattern Double -> ControlPattern +octersubbus busid pat = (pF "octersub" pat) # (pI "^octersub" busid) +octersubrecv :: Pattern Int -> ControlPattern +octersubrecv busid = pI "^octersub" busid + +-- | octaver effect +octersubsub :: Pattern Double -> ControlPattern +octersubsub = pF "octersubsub" +octersubsubbus :: Pattern Int -> Pattern Double -> ControlPattern +octersubsubbus busid pat = (pF "octersubsub" pat) # (pI "^octersubsub" busid) +octersubsubrecv :: Pattern Int -> ControlPattern +octersubsubrecv busid = pI "^octersubsub" busid + +-- | +offset :: Pattern Double -> ControlPattern +offset = pF "offset" +offsetbus :: Pattern Int -> Pattern Double -> ControlPattern +offsetbus _ _ = error $ "Control parameter 'offset' can't be sent to a bus." + +-- | +ophatdecay :: Pattern Double -> ControlPattern +ophatdecay = pF "ophatdecay" +ophatdecaybus :: Pattern Int -> Pattern Double -> ControlPattern +ophatdecaybus busid pat = (pF "ophatdecay" pat) # (pI "^ophatdecay" busid) +ophatdecayrecv :: Pattern Int -> ControlPattern +ophatdecayrecv busid = pI "^ophatdecay" busid + +-- | 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 :: Pattern Int -> ControlPattern +orbit = pI "orbit" +orbitbus :: Pattern Int -> Pattern Int -> ControlPattern +orbitbus busid pat = (pI "orbit" pat) # (pI "^orbit" busid) +orbitrecv :: Pattern Int -> ControlPattern +orbitrecv busid = pI "^orbit" busid + +-- | +overgain :: Pattern Double -> ControlPattern +overgain = pF "overgain" +overgainbus :: Pattern Int -> Pattern Double -> ControlPattern +overgainbus _ _ = error $ "Control parameter 'overgain' can't be sent to a bus." + +-- | +overshape :: Pattern Double -> ControlPattern +overshape = pF "overshape" +overshapebus :: Pattern Int -> Pattern Double -> ControlPattern +overshapebus busid pat = (pF "overshape" pat) # (pI "^overshape" busid) +overshaperecv :: Pattern Int -> ControlPattern +overshaperecv busid = pI "^overshape" busid + +-- | a pattern of numbers between 0 and 1, from left to right (assuming stereo), once round a circle (assuming multichannel) +pan :: Pattern Double -> ControlPattern +pan = pF "pan" +panbus :: Pattern Int -> Pattern Double -> ControlPattern +panbus busid pat = (pF "pan" pat) # (pI "^pan" busid) +panrecv :: Pattern Int -> ControlPattern +panrecv busid = pI "^pan" busid + +-- | 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 :: Pattern Double -> ControlPattern +panorient = pF "panorient" +panorientbus :: Pattern Int -> Pattern Double -> ControlPattern +panorientbus busid pat = (pF "panorient" pat) # (pI "^panorient" busid) +panorientrecv :: Pattern Int -> ControlPattern +panorientrecv busid = pI "^panorient" busid + +-- | a pattern of numbers between -inf and inf, which controls how much multichannel output is fanned out (negative is backwards ordering) +panspan :: Pattern Double -> ControlPattern +panspan = pF "panspan" +panspanbus :: Pattern Int -> Pattern Double -> ControlPattern +panspanbus busid pat = (pF "panspan" pat) # (pI "^panspan" busid) +panspanrecv :: Pattern Int -> ControlPattern +panspanrecv busid = pI "^panspan" busid + +-- | a pattern of numbers between 0.0 and 1.0, which controls the multichannel spread range (multichannel only) +pansplay :: Pattern Double -> ControlPattern +pansplay = pF "pansplay" +pansplaybus :: Pattern Int -> Pattern Double -> ControlPattern +pansplaybus busid pat = (pF "pansplay" pat) # (pI "^pansplay" busid) +pansplayrecv :: Pattern Int -> ControlPattern +pansplayrecv busid = pI "^pansplay" busid + +-- | a pattern of numbers between 0.0 and inf, which controls how much each channel is distributed over neighbours (multichannel only) +panwidth :: Pattern Double -> ControlPattern +panwidth = pF "panwidth" +panwidthbus :: Pattern Int -> Pattern Double -> ControlPattern +panwidthbus busid pat = (pF "panwidth" pat) # (pI "^panwidth" busid) +panwidthrecv :: Pattern Int -> ControlPattern +panwidthrecv busid = pI "^panwidth" busid + +-- | +partials :: Pattern Double -> ControlPattern +partials = pF "partials" +partialsbus :: Pattern Int -> Pattern Double -> ControlPattern +partialsbus busid pat = (pF "partials" pat) # (pI "^partials" busid) +partialsrecv :: Pattern Int -> ControlPattern +partialsrecv busid = pI "^partials" busid + +-- | Phaser Audio DSP effect | params are 'phaserrate' and 'phaserdepth' +phaserdepth :: Pattern Double -> ControlPattern +phaserdepth = pF "phaserdepth" +phaserdepthbus :: Pattern Int -> Pattern Double -> ControlPattern +phaserdepthbus busid pat = (pF "phaserdepth" pat) # (pI "^phaserdepth" busid) +phaserdepthrecv :: Pattern Int -> ControlPattern +phaserdepthrecv busid = pI "^phaserdepth" busid + +-- | Phaser Audio DSP effect | params are 'phaserrate' and 'phaserdepth' +phaserrate :: Pattern Double -> ControlPattern +phaserrate = pF "phaserrate" +phaserratebus :: Pattern Int -> Pattern Double -> ControlPattern +phaserratebus busid pat = (pF "phaserrate" pat) # (pI "^phaserrate" busid) +phaserraterecv :: Pattern Int -> ControlPattern +phaserraterecv busid = pI "^phaserrate" busid + +-- | +pitch1 :: Pattern Double -> ControlPattern +pitch1 = pF "pitch1" +pitch1bus :: Pattern Int -> Pattern Double -> ControlPattern +pitch1bus busid pat = (pF "pitch1" pat) # (pI "^pitch1" busid) +pitch1recv :: Pattern Int -> ControlPattern +pitch1recv busid = pI "^pitch1" busid + +-- | +pitch2 :: Pattern Double -> ControlPattern +pitch2 = pF "pitch2" +pitch2bus :: Pattern Int -> Pattern Double -> ControlPattern +pitch2bus busid pat = (pF "pitch2" pat) # (pI "^pitch2" busid) +pitch2recv :: Pattern Int -> ControlPattern +pitch2recv busid = pI "^pitch2" busid + +-- | +pitch3 :: Pattern Double -> ControlPattern +pitch3 = pF "pitch3" +pitch3bus :: Pattern Int -> Pattern Double -> ControlPattern +pitch3bus busid pat = (pF "pitch3" pat) # (pI "^pitch3" busid) +pitch3recv :: Pattern Int -> ControlPattern +pitch3recv busid = pI "^pitch3" busid + +-- | +polyTouch :: Pattern Double -> ControlPattern +polyTouch = pF "polyTouch" +polyTouchbus :: Pattern Int -> Pattern Double -> ControlPattern +polyTouchbus busid pat = (pF "polyTouch" pat) # (pI "^polyTouch" busid) +polyTouchrecv :: Pattern Int -> ControlPattern +polyTouchrecv busid = pI "^polyTouch" busid + +-- | +portamento :: Pattern Double -> ControlPattern +portamento = pF "portamento" +portamentobus :: Pattern Int -> Pattern Double -> ControlPattern +portamentobus busid pat = (pF "portamento" pat) # (pI "^portamento" busid) +portamentorecv :: Pattern Int -> ControlPattern +portamentorecv busid = pI "^portamento" busid + +-- | +progNum :: Pattern Double -> ControlPattern +progNum = pF "progNum" +progNumbus :: Pattern Int -> Pattern Double -> ControlPattern +progNumbus busid pat = (pF "progNum" pat) # (pI "^progNum" busid) +progNumrecv :: Pattern Int -> ControlPattern +progNumrecv busid = pI "^progNum" busid + +-- | used in SuperDirt softsynths as a control rate or 'speed' +rate :: Pattern Double -> ControlPattern +rate = pF "rate" +ratebus :: Pattern Int -> Pattern Double -> ControlPattern +ratebus busid pat = (pF "rate" pat) # (pI "^rate" busid) +raterecv :: Pattern Int -> ControlPattern +raterecv busid = pI "^rate" busid + +-- | Spectral conform +real :: Pattern Double -> ControlPattern +real = pF "real" +realbus :: Pattern Int -> Pattern Double -> ControlPattern +realbus busid pat = (pF "real" pat) # (pI "^real" busid) +realrecv :: Pattern Int -> ControlPattern +realrecv busid = pI "^real" busid + +-- | a pattern of numbers to specify the release time (in seconds) of an envelope applied to each sample. +release :: Pattern Double -> ControlPattern +release = pF "release" +releasebus :: Pattern Int -> Pattern Double -> ControlPattern +releasebus busid pat = (pF "release" pat) # (pI "^release" busid) +releaserecv :: Pattern Int -> ControlPattern +releaserecv busid = pI "^release" busid + +-- | a pattern of numbers from 0 to 1. Specifies the resonance of the low-pass filter. +resonance :: Pattern Double -> ControlPattern +resonance = pF "resonance" +resonancebus :: Pattern Int -> Pattern Double -> ControlPattern +resonancebus busid pat = (pF "resonance" pat) # (pI "^resonance" busid) +resonancerecv :: Pattern Int -> ControlPattern +resonancerecv busid = pI "^resonance" busid + +-- | ring modulation +ring :: Pattern Double -> ControlPattern +ring = pF "ring" +ringbus :: Pattern Int -> Pattern Double -> ControlPattern +ringbus busid pat = (pF "ring" pat) # (pI "^ring" busid) +ringrecv :: Pattern Int -> ControlPattern +ringrecv busid = pI "^ring" busid + +-- | ring modulation +ringdf :: Pattern Double -> ControlPattern +ringdf = pF "ringdf" +ringdfbus :: Pattern Int -> Pattern Double -> ControlPattern +ringdfbus busid pat = (pF "ringdf" pat) # (pI "^ringdf" busid) +ringdfrecv :: Pattern Int -> ControlPattern +ringdfrecv busid = pI "^ringdf" busid + +-- | ring modulation +ringf :: Pattern Double -> ControlPattern +ringf = pF "ringf" +ringfbus :: Pattern Int -> Pattern Double -> ControlPattern +ringfbus busid pat = (pF "ringf" pat) # (pI "^ringf" busid) +ringfrecv :: Pattern Int -> ControlPattern +ringfrecv busid = pI "^ringf" busid + +-- | a pattern of numbers from 0 to 1. Sets the level of reverb. +room :: Pattern Double -> ControlPattern +room = pF "room" +roombus :: Pattern Int -> Pattern Double -> ControlPattern +roombus busid pat = (pF "room" pat) # (pI "^room" busid) +roomrecv :: Pattern Int -> ControlPattern +roomrecv busid = pI "^room" busid + +-- | +sagogo :: Pattern Double -> ControlPattern +sagogo = pF "sagogo" +sagogobus :: Pattern Int -> Pattern Double -> ControlPattern +sagogobus busid pat = (pF "sagogo" pat) # (pI "^sagogo" busid) +sagogorecv :: Pattern Int -> ControlPattern +sagogorecv busid = pI "^sagogo" busid + +-- | +sclap :: Pattern Double -> ControlPattern +sclap = pF "sclap" +sclapbus :: Pattern Int -> Pattern Double -> ControlPattern +sclapbus busid pat = (pF "sclap" pat) # (pI "^sclap" busid) +sclaprecv :: Pattern Int -> ControlPattern +sclaprecv busid = pI "^sclap" busid + +-- | +sclaves :: Pattern Double -> ControlPattern +sclaves = pF "sclaves" +sclavesbus :: Pattern Int -> Pattern Double -> ControlPattern +sclavesbus busid pat = (pF "sclaves" pat) # (pI "^sclaves" busid) +sclavesrecv :: Pattern Int -> ControlPattern +sclavesrecv busid = pI "^sclaves" busid + +-- | Spectral scramble +scram :: Pattern Double -> ControlPattern +scram = pF "scram" +scrambus :: Pattern Int -> Pattern Double -> ControlPattern +scrambus busid pat = (pF "scram" pat) # (pI "^scram" busid) +scramrecv :: Pattern Int -> ControlPattern +scramrecv busid = pI "^scram" busid + +-- | +scrash :: Pattern Double -> ControlPattern +scrash = pF "scrash" +scrashbus :: Pattern Int -> Pattern Double -> ControlPattern +scrashbus busid pat = (pF "scrash" pat) # (pI "^scrash" busid) +scrashrecv :: Pattern Int -> ControlPattern +scrashrecv busid = pI "^scrash" busid + +-- | +seconds :: Pattern Double -> ControlPattern +seconds = pF "seconds" +secondsbus :: Pattern Int -> Pattern Double -> ControlPattern +secondsbus busid pat = (pF "seconds" pat) # (pI "^seconds" busid) +secondsrecv :: Pattern Int -> ControlPattern +secondsrecv busid = pI "^seconds" busid + +-- | +semitone :: Pattern Double -> ControlPattern +semitone = pF "semitone" +semitonebus :: Pattern Int -> Pattern Double -> ControlPattern +semitonebus busid pat = (pF "semitone" pat) # (pI "^semitone" busid) +semitonerecv :: Pattern Int -> ControlPattern +semitonerecv busid = pI "^semitone" busid + +-- | wave shaping distortion, a pattern of numbers from 0 for no distortion up to 1 for loads of distortion. +shape :: Pattern Double -> ControlPattern +shape = pF "shape" +shapebus :: Pattern Int -> Pattern Double -> ControlPattern +shapebus busid pat = (pF "shape" pat) # (pI "^shape" busid) +shaperecv :: Pattern Int -> ControlPattern +shaperecv busid = pI "^shape" busid + +-- | a pattern of numbers from 0 to 1. Sets the perceptual size (reverb time) of the `room` to be used in reverb. +size :: Pattern Double -> ControlPattern +size = pF "size" +sizebus :: Pattern Int -> Pattern Double -> ControlPattern +sizebus busid pat = (pF "size" pat) # (pI "^size" busid) +sizerecv :: Pattern Int -> ControlPattern +sizerecv busid = pI "^size" busid + +-- | +slide :: Pattern Double -> ControlPattern +slide = pF "slide" +slidebus :: Pattern Int -> Pattern Double -> ControlPattern +slidebus busid pat = (pF "slide" pat) # (pI "^slide" busid) +sliderecv :: Pattern Int -> ControlPattern +sliderecv busid = pI "^slide" busid + +-- | +slider0 :: Pattern Double -> ControlPattern +slider0 = pF "slider0" +slider0bus :: Pattern Int -> Pattern Double -> ControlPattern +slider0bus busid pat = (pF "slider0" pat) # (pI "^slider0" busid) +slider0recv :: Pattern Int -> ControlPattern +slider0recv busid = pI "^slider0" busid + +-- | +slider1 :: Pattern Double -> ControlPattern +slider1 = pF "slider1" +slider1bus :: Pattern Int -> Pattern Double -> ControlPattern +slider1bus busid pat = (pF "slider1" pat) # (pI "^slider1" busid) +slider1recv :: Pattern Int -> ControlPattern +slider1recv busid = pI "^slider1" busid + +-- | +slider10 :: Pattern Double -> ControlPattern +slider10 = pF "slider10" +slider10bus :: Pattern Int -> Pattern Double -> ControlPattern +slider10bus busid pat = (pF "slider10" pat) # (pI "^slider10" busid) +slider10recv :: Pattern Int -> ControlPattern +slider10recv busid = pI "^slider10" busid + +-- | +slider11 :: Pattern Double -> ControlPattern +slider11 = pF "slider11" +slider11bus :: Pattern Int -> Pattern Double -> ControlPattern +slider11bus busid pat = (pF "slider11" pat) # (pI "^slider11" busid) +slider11recv :: Pattern Int -> ControlPattern +slider11recv busid = pI "^slider11" busid + +-- | +slider12 :: Pattern Double -> ControlPattern +slider12 = pF "slider12" +slider12bus :: Pattern Int -> Pattern Double -> ControlPattern +slider12bus busid pat = (pF "slider12" pat) # (pI "^slider12" busid) +slider12recv :: Pattern Int -> ControlPattern +slider12recv busid = pI "^slider12" busid + +-- | +slider13 :: Pattern Double -> ControlPattern +slider13 = pF "slider13" +slider13bus :: Pattern Int -> Pattern Double -> ControlPattern +slider13bus busid pat = (pF "slider13" pat) # (pI "^slider13" busid) +slider13recv :: Pattern Int -> ControlPattern +slider13recv busid = pI "^slider13" busid + +-- | +slider14 :: Pattern Double -> ControlPattern +slider14 = pF "slider14" +slider14bus :: Pattern Int -> Pattern Double -> ControlPattern +slider14bus busid pat = (pF "slider14" pat) # (pI "^slider14" busid) +slider14recv :: Pattern Int -> ControlPattern +slider14recv busid = pI "^slider14" busid + +-- | +slider15 :: Pattern Double -> ControlPattern +slider15 = pF "slider15" +slider15bus :: Pattern Int -> Pattern Double -> ControlPattern +slider15bus busid pat = (pF "slider15" pat) # (pI "^slider15" busid) +slider15recv :: Pattern Int -> ControlPattern +slider15recv busid = pI "^slider15" busid + +-- | +slider2 :: Pattern Double -> ControlPattern +slider2 = pF "slider2" +slider2bus :: Pattern Int -> Pattern Double -> ControlPattern +slider2bus busid pat = (pF "slider2" pat) # (pI "^slider2" busid) +slider2recv :: Pattern Int -> ControlPattern +slider2recv busid = pI "^slider2" busid + +-- | +slider3 :: Pattern Double -> ControlPattern +slider3 = pF "slider3" +slider3bus :: Pattern Int -> Pattern Double -> ControlPattern +slider3bus busid pat = (pF "slider3" pat) # (pI "^slider3" busid) +slider3recv :: Pattern Int -> ControlPattern +slider3recv busid = pI "^slider3" busid + +-- | +slider4 :: Pattern Double -> ControlPattern +slider4 = pF "slider4" +slider4bus :: Pattern Int -> Pattern Double -> ControlPattern +slider4bus busid pat = (pF "slider4" pat) # (pI "^slider4" busid) +slider4recv :: Pattern Int -> ControlPattern +slider4recv busid = pI "^slider4" busid + +-- | +slider5 :: Pattern Double -> ControlPattern +slider5 = pF "slider5" +slider5bus :: Pattern Int -> Pattern Double -> ControlPattern +slider5bus busid pat = (pF "slider5" pat) # (pI "^slider5" busid) +slider5recv :: Pattern Int -> ControlPattern +slider5recv busid = pI "^slider5" busid + +-- | +slider6 :: Pattern Double -> ControlPattern +slider6 = pF "slider6" +slider6bus :: Pattern Int -> Pattern Double -> ControlPattern +slider6bus busid pat = (pF "slider6" pat) # (pI "^slider6" busid) +slider6recv :: Pattern Int -> ControlPattern +slider6recv busid = pI "^slider6" busid + +-- | +slider7 :: Pattern Double -> ControlPattern +slider7 = pF "slider7" +slider7bus :: Pattern Int -> Pattern Double -> ControlPattern +slider7bus busid pat = (pF "slider7" pat) # (pI "^slider7" busid) +slider7recv :: Pattern Int -> ControlPattern +slider7recv busid = pI "^slider7" busid + +-- | +slider8 :: Pattern Double -> ControlPattern +slider8 = pF "slider8" +slider8bus :: Pattern Int -> Pattern Double -> ControlPattern +slider8bus busid pat = (pF "slider8" pat) # (pI "^slider8" busid) +slider8recv :: Pattern Int -> ControlPattern +slider8recv busid = pI "^slider8" busid + +-- | +slider9 :: Pattern Double -> ControlPattern +slider9 = pF "slider9" +slider9bus :: Pattern Int -> Pattern Double -> ControlPattern +slider9bus busid pat = (pF "slider9" pat) # (pI "^slider9" busid) +slider9recv :: Pattern Int -> ControlPattern +slider9recv busid = pI "^slider9" busid + +-- | Spectral smear +smear :: Pattern Double -> ControlPattern +smear = pF "smear" +smearbus :: Pattern Int -> Pattern Double -> ControlPattern +smearbus busid pat = (pF "smear" pat) # (pI "^smear" busid) +smearrecv :: Pattern Int -> ControlPattern +smearrecv busid = pI "^smear" busid + +-- | +songPtr :: Pattern Double -> ControlPattern +songPtr = pF "songPtr" +songPtrbus :: Pattern Int -> Pattern Double -> ControlPattern +songPtrbus busid pat = (pF "songPtr" pat) # (pI "^songPtr" busid) +songPtrrecv :: Pattern Int -> ControlPattern +songPtrrecv busid = pI "^songPtr" busid + +-- | 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 :: Pattern Double -> ControlPattern +speed = pF "speed" +speedbus :: Pattern Int -> Pattern Double -> ControlPattern +speedbus _ _ = error $ "Control parameter 'speed' can't be sent to a bus." + +-- | +squiz :: Pattern Double -> ControlPattern +squiz = pF "squiz" +squizbus :: Pattern Int -> Pattern Double -> ControlPattern +squizbus busid pat = (pF "squiz" pat) # (pI "^squiz" busid) +squizrecv :: Pattern Int -> ControlPattern +squizrecv busid = pI "^squiz" busid + +-- | +stepsPerOctave :: Pattern Double -> ControlPattern +stepsPerOctave = pF "stepsPerOctave" +stepsPerOctavebus :: Pattern Int -> Pattern Double -> ControlPattern +stepsPerOctavebus busid pat = (pF "stepsPerOctave" pat) # (pI "^stepsPerOctave" busid) +stepsPerOctaverecv :: Pattern Int -> ControlPattern +stepsPerOctaverecv busid = pI "^stepsPerOctave" busid + +-- | +stutterdepth :: Pattern Double -> ControlPattern +stutterdepth = pF "stutterdepth" +stutterdepthbus :: Pattern Int -> Pattern Double -> ControlPattern +stutterdepthbus busid pat = (pF "stutterdepth" pat) # (pI "^stutterdepth" busid) +stutterdepthrecv :: Pattern Int -> ControlPattern +stutterdepthrecv busid = pI "^stutterdepth" busid + +-- | +stuttertime :: Pattern Double -> ControlPattern +stuttertime = pF "stuttertime" +stuttertimebus :: Pattern Int -> Pattern Double -> ControlPattern +stuttertimebus busid pat = (pF "stuttertime" pat) # (pI "^stuttertime" busid) +stuttertimerecv :: Pattern Int -> ControlPattern +stuttertimerecv busid = pI "^stuttertime" busid + +-- | +sustain :: Pattern Double -> ControlPattern +sustain = pF "sustain" +sustainbus :: Pattern Int -> Pattern Double -> ControlPattern +sustainbus _ _ = error $ "Control parameter 'sustain' can't be sent to a bus." + +-- | +sustainpedal :: Pattern Double -> ControlPattern +sustainpedal = pF "sustainpedal" +sustainpedalbus :: Pattern Int -> Pattern Double -> ControlPattern +sustainpedalbus busid pat = (pF "sustainpedal" pat) # (pI "^sustainpedal" busid) +sustainpedalrecv :: Pattern Int -> ControlPattern +sustainpedalrecv busid = pI "^sustainpedal" busid + +-- | for internal sound routing +to :: Pattern Double -> ControlPattern +to = pF "to" +tobus :: Pattern Int -> Pattern Double -> ControlPattern +tobus busid pat = (pF "to" pat) # (pI "^to" busid) +torecv :: Pattern Int -> ControlPattern +torecv busid = pI "^to" busid + +-- | for internal sound routing +toArg :: Pattern String -> ControlPattern +toArg = pS "toArg" +toArgbus :: Pattern Int -> Pattern String -> ControlPattern +toArgbus busid pat = (pS "toArg" pat) # (pI "^toArg" busid) +toArgrecv :: Pattern Int -> ControlPattern +toArgrecv busid = pI "^toArg" busid + +-- | +tomdecay :: Pattern Double -> ControlPattern +tomdecay = pF "tomdecay" +tomdecaybus :: Pattern Int -> Pattern Double -> ControlPattern +tomdecaybus busid pat = (pF "tomdecay" pat) # (pI "^tomdecay" busid) +tomdecayrecv :: Pattern Int -> ControlPattern +tomdecayrecv busid = pI "^tomdecay" busid + +-- | Tremolo Audio DSP effect | params are 'tremolorate' and 'tremolodepth' +tremolodepth :: Pattern Double -> ControlPattern +tremolodepth = pF "tremolodepth" +tremolodepthbus :: Pattern Int -> Pattern Double -> ControlPattern +tremolodepthbus busid pat = (pF "tremolodepth" pat) # (pI "^tremolodepth" busid) +tremolodepthrecv :: Pattern Int -> ControlPattern +tremolodepthrecv busid = pI "^tremolodepth" busid + +-- | Tremolo Audio DSP effect | params are 'tremolorate' and 'tremolodepth' +tremolorate :: Pattern Double -> ControlPattern +tremolorate = pF "tremolorate" +tremoloratebus :: Pattern Int -> Pattern Double -> ControlPattern +tremoloratebus busid pat = (pF "tremolorate" pat) # (pI "^tremolorate" busid) +tremoloraterecv :: Pattern Int -> ControlPattern +tremoloraterecv busid = pI "^tremolorate" busid + +-- | tube distortion +triode :: Pattern Double -> ControlPattern +triode = pF "triode" +triodebus :: Pattern Int -> Pattern Double -> ControlPattern +triodebus busid pat = (pF "triode" pat) # (pI "^triode" busid) +trioderecv :: Pattern Int -> ControlPattern +trioderecv busid = pI "^triode" busid + +-- | +tsdelay :: Pattern Double -> ControlPattern +tsdelay = pF "tsdelay" +tsdelaybus :: Pattern Int -> Pattern Double -> ControlPattern +tsdelaybus busid pat = (pF "tsdelay" pat) # (pI "^tsdelay" busid) +tsdelayrecv :: Pattern Int -> ControlPattern +tsdelayrecv busid = pI "^tsdelay" busid + +-- | +uid :: Pattern Double -> ControlPattern +uid = pF "uid" +uidbus :: Pattern Int -> Pattern Double -> ControlPattern +uidbus busid pat = (pF "uid" pat) # (pI "^uid" busid) +uidrecv :: Pattern Int -> ControlPattern +uidrecv busid = pI "^uid" busid + +-- | 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 :: Pattern String -> ControlPattern +unit = pS "unit" +unitbus :: Pattern Int -> Pattern String -> ControlPattern +unitbus _ _ = error $ "Control parameter 'unit' can't be sent to a bus." + +-- | +val :: Pattern Double -> ControlPattern +val = pF "val" +valbus :: Pattern Int -> Pattern Double -> ControlPattern +valbus busid pat = (pF "val" pat) # (pI "^val" busid) +valrecv :: Pattern Int -> ControlPattern +valrecv busid = pI "^val" busid + +-- | +vcfegint :: Pattern Double -> ControlPattern +vcfegint = pF "vcfegint" +vcfegintbus :: Pattern Int -> Pattern Double -> ControlPattern +vcfegintbus busid pat = (pF "vcfegint" pat) # (pI "^vcfegint" busid) +vcfegintrecv :: Pattern Int -> ControlPattern +vcfegintrecv busid = pI "^vcfegint" busid + +-- | +vcoegint :: Pattern Double -> ControlPattern +vcoegint = pF "vcoegint" +vcoegintbus :: Pattern Int -> Pattern Double -> ControlPattern +vcoegintbus busid pat = (pF "vcoegint" pat) # (pI "^vcoegint" busid) +vcoegintrecv :: Pattern Int -> ControlPattern +vcoegintrecv busid = pI "^vcoegint" busid + +-- | +velocity :: Pattern Double -> ControlPattern +velocity = pF "velocity" +velocitybus :: Pattern Int -> Pattern Double -> ControlPattern +velocitybus busid pat = (pF "velocity" pat) # (pI "^velocity" busid) +velocityrecv :: Pattern Int -> ControlPattern +velocityrecv busid = pI "^velocity" busid + +-- | +voice :: Pattern Double -> ControlPattern +voice = pF "voice" +voicebus :: Pattern Int -> Pattern Double -> ControlPattern +voicebus busid pat = (pF "voice" pat) # (pI "^voice" busid) +voicerecv :: Pattern Int -> ControlPattern +voicerecv busid = pI "^voice" busid + +-- | 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 :: Pattern String -> ControlPattern +vowel = pS "vowel" +vowelbus :: Pattern Int -> Pattern String -> ControlPattern +vowelbus busid pat = (pS "vowel" pat) # (pI "^vowel" busid) +vowelrecv :: Pattern Int -> ControlPattern +vowelrecv busid = pI "^vowel" busid + +-- | +waveloss :: Pattern Double -> ControlPattern +waveloss = pF "waveloss" +wavelossbus :: Pattern Int -> Pattern Double -> ControlPattern +wavelossbus busid pat = (pF "waveloss" pat) # (pI "^waveloss" busid) +wavelossrecv :: Pattern Int -> ControlPattern +wavelossrecv busid = pI "^waveloss" busid + +-- | +xsdelay :: Pattern Double -> ControlPattern +xsdelay = pF "xsdelay" +xsdelaybus :: Pattern Int -> Pattern Double -> ControlPattern +xsdelaybus busid pat = (pF "xsdelay" pat) # (pI "^xsdelay" busid) +xsdelayrecv :: Pattern Int -> ControlPattern +xsdelayrecv busid = pI "^xsdelay" busid + + + +-- aliases + +voi :: Pattern Double -> ControlPattern +voi = voice +voibus :: Pattern Int -> Pattern Double -> ControlPattern +voibus = voicebus +voirecv :: Pattern Int -> ControlPattern +voirecv = voicerecv + +vco :: Pattern Double -> ControlPattern +vco = vcoegint +vcobus :: Pattern Int -> Pattern Double -> ControlPattern +vcobus = vcoegintbus +vcorecv :: Pattern Int -> ControlPattern +vcorecv = vcoegintrecv + +vcf :: Pattern Double -> ControlPattern +vcf = vcfegint +vcfbus :: Pattern Int -> Pattern Double -> ControlPattern +vcfbus = vcfegintbus +vcfrecv :: Pattern Int -> ControlPattern +vcfrecv = vcfegintrecv + +up :: Pattern Note -> ControlPattern +up = note + +tremr :: Pattern Double -> ControlPattern +tremr = tremolorate +tremrbus :: Pattern Int -> Pattern Double -> ControlPattern +tremrbus = tremoloratebus +tremrrecv :: Pattern Int -> ControlPattern +tremrrecv = tremoloraterecv + +tremdp :: Pattern Double -> ControlPattern +tremdp = tremolodepth +tremdpbus :: Pattern Int -> Pattern Double -> ControlPattern +tremdpbus = tremolodepthbus +tremdprecv :: Pattern Int -> ControlPattern +tremdprecv = tremolodepthrecv + +tdecay :: Pattern Double -> ControlPattern +tdecay = tomdecay +tdecaybus :: Pattern Int -> Pattern Double -> ControlPattern +tdecaybus = tomdecaybus +tdecayrecv :: Pattern Int -> ControlPattern +tdecayrecv = tomdecayrecv + +sz :: Pattern Double -> ControlPattern +sz = size +szbus :: Pattern Int -> Pattern Double -> ControlPattern +szbus = sizebus +szrecv :: Pattern Int -> ControlPattern +szrecv = sizerecv + +sus :: Pattern Double -> ControlPattern +sus = sustain + +stt :: Pattern Double -> ControlPattern +stt = stuttertime +sttbus :: Pattern Int -> Pattern Double -> ControlPattern +sttbus = stuttertimebus +sttrecv :: Pattern Int -> ControlPattern +sttrecv = stuttertimerecv + +std :: Pattern Double -> ControlPattern +std = stutterdepth +stdbus :: Pattern Int -> Pattern Double -> ControlPattern +stdbus = stutterdepthbus +stdrecv :: Pattern Int -> ControlPattern +stdrecv = stutterdepthrecv + +sld :: Pattern Double -> ControlPattern +sld = slide +sldbus :: Pattern Int -> Pattern Double -> ControlPattern +sldbus = slidebus +sldrecv :: Pattern Int -> ControlPattern +sldrecv = sliderecv + +scr :: Pattern Double -> ControlPattern +scr = scrash +scrbus :: Pattern Int -> Pattern Double -> ControlPattern +scrbus = scrashbus +scrrecv :: Pattern Int -> ControlPattern +scrrecv = scrashrecv + +scp :: Pattern Double -> ControlPattern +scp = sclap +scpbus :: Pattern Int -> Pattern Double -> ControlPattern +scpbus = sclapbus +scprecv :: Pattern Int -> ControlPattern +scprecv = sclaprecv + +scl :: Pattern Double -> ControlPattern +scl = sclaves +sclbus :: Pattern Int -> Pattern Double -> ControlPattern +sclbus = sclavesbus +sclrecv :: Pattern Int -> ControlPattern +sclrecv = sclavesrecv + +sag :: Pattern Double -> ControlPattern +sag = sagogo +sagbus :: Pattern Int -> Pattern Double -> ControlPattern +sagbus = sagogobus +sagrecv :: Pattern Int -> ControlPattern +sagrecv = sagogorecv + +s :: Pattern String -> ControlPattern +s = sound + +rel :: Pattern Double -> ControlPattern +rel = release +relbus :: Pattern Int -> Pattern Double -> ControlPattern +relbus = releasebus +relrecv :: Pattern Int -> ControlPattern +relrecv = releaserecv + +por :: Pattern Double -> ControlPattern +por = portamento +porbus :: Pattern Int -> Pattern Double -> ControlPattern +porbus = portamentobus +porrecv :: Pattern Int -> ControlPattern +porrecv = portamentorecv + +pit3 :: Pattern Double -> ControlPattern +pit3 = pitch3 +pit3bus :: Pattern Int -> Pattern Double -> ControlPattern +pit3bus = pitch3bus +pit3recv :: Pattern Int -> ControlPattern +pit3recv = pitch3recv + +pit2 :: Pattern Double -> ControlPattern +pit2 = pitch2 +pit2bus :: Pattern Int -> Pattern Double -> ControlPattern +pit2bus = pitch2bus +pit2recv :: Pattern Int -> ControlPattern +pit2recv = pitch2recv + +pit1 :: Pattern Double -> ControlPattern +pit1 = pitch1 +pit1bus :: Pattern Int -> Pattern Double -> ControlPattern +pit1bus = pitch1bus +pit1recv :: Pattern Int -> ControlPattern +pit1recv = pitch1recv + +phasr :: Pattern Double -> ControlPattern +phasr = phaserrate +phasrbus :: Pattern Int -> Pattern Double -> ControlPattern +phasrbus = phaserratebus +phasrrecv :: Pattern Int -> ControlPattern +phasrrecv = phaserraterecv + +phasdp :: Pattern Double -> ControlPattern +phasdp = phaserdepth +phasdpbus :: Pattern Int -> Pattern Double -> ControlPattern +phasdpbus = phaserdepthbus +phasdprecv :: Pattern Int -> ControlPattern +phasdprecv = phaserdepthrecv + +ohdecay :: Pattern Double -> ControlPattern +ohdecay = ophatdecay +ohdecaybus :: Pattern Int -> Pattern Double -> ControlPattern +ohdecaybus = ophatdecaybus +ohdecayrecv :: Pattern Int -> ControlPattern +ohdecayrecv = ophatdecayrecv + +lsn :: Pattern Double -> ControlPattern +lsn = lsnare +lsnbus :: Pattern Int -> Pattern Double -> ControlPattern +lsnbus = lsnarebus +lsnrecv :: Pattern Int -> ControlPattern +lsnrecv = lsnarerecv + +lpq :: Pattern Double -> ControlPattern +lpq = resonance +lpqbus :: Pattern Int -> Pattern Double -> ControlPattern +lpqbus = resonancebus +lpqrecv :: Pattern Int -> ControlPattern +lpqrecv = resonancerecv + +lpf :: Pattern Double -> ControlPattern +lpf = cutoff +lpfbus :: Pattern Int -> Pattern Double -> ControlPattern +lpfbus = cutoffbus +lpfrecv :: Pattern Int -> ControlPattern +lpfrecv = cutoffrecv + +loh :: Pattern Double -> ControlPattern +loh = lophat +lohbus :: Pattern Int -> Pattern Double -> ControlPattern +lohbus = lophatbus +lohrecv :: Pattern Int -> ControlPattern +lohrecv = lophatrecv + +llt :: Pattern Double -> ControlPattern +llt = llotom +lltbus :: Pattern Int -> Pattern Double -> ControlPattern +lltbus = llotombus +lltrecv :: Pattern Int -> ControlPattern +lltrecv = llotomrecv + +lht :: Pattern Double -> ControlPattern +lht = lhitom +lhtbus :: Pattern Int -> Pattern Double -> ControlPattern +lhtbus = lhitombus +lhtrecv :: Pattern Int -> ControlPattern +lhtrecv = lhitomrecv + +lfop :: Pattern Double -> ControlPattern +lfop = lfopitchint +lfopbus :: Pattern Int -> Pattern Double -> ControlPattern +lfopbus = lfopitchintbus +lfoprecv :: Pattern Int -> ControlPattern +lfoprecv = lfopitchintrecv + +lfoi :: Pattern Double -> ControlPattern +lfoi = lfoint +lfoibus :: Pattern Int -> Pattern Double -> ControlPattern +lfoibus = lfointbus +lfoirecv :: Pattern Int -> ControlPattern +lfoirecv = lfointrecv + +lfoc :: Pattern Double -> ControlPattern +lfoc = lfocutoffint +lfocbus :: Pattern Int -> Pattern Double -> ControlPattern +lfocbus = lfocutoffintbus +lfocrecv :: Pattern Int -> ControlPattern +lfocrecv = lfocutoffintrecv + +lcr :: Pattern Double -> ControlPattern +lcr = lcrash +lcrbus :: Pattern Int -> Pattern Double -> ControlPattern +lcrbus = lcrashbus +lcrrecv :: Pattern Int -> ControlPattern +lcrrecv = lcrashrecv + +lcp :: Pattern Double -> ControlPattern +lcp = lclap +lcpbus :: Pattern Int -> Pattern Double -> ControlPattern +lcpbus = lclapbus +lcprecv :: Pattern Int -> ControlPattern +lcprecv = lclaprecv + +lcl :: Pattern Double -> ControlPattern +lcl = lclaves +lclbus :: Pattern Int -> Pattern Double -> ControlPattern +lclbus = lclavesbus +lclrecv :: Pattern Int -> ControlPattern +lclrecv = lclavesrecv + +lch :: Pattern Double -> ControlPattern +lch = lclhat +lchbus :: Pattern Int -> Pattern Double -> ControlPattern +lchbus = lclhatbus +lchrecv :: Pattern Int -> ControlPattern +lchrecv = lclhatrecv + +lbd :: Pattern Double -> ControlPattern +lbd = lkick +lbdbus :: Pattern Int -> Pattern Double -> ControlPattern +lbdbus = lkickbus +lbdrecv :: Pattern Int -> ControlPattern +lbdrecv = lkickrecv + +lag :: Pattern Double -> ControlPattern +lag = lagogo +lagbus :: Pattern Int -> Pattern Double -> ControlPattern +lagbus = lagogobus +lagrecv :: Pattern Int -> ControlPattern +lagrecv = lagogorecv + +hpq :: Pattern Double -> ControlPattern +hpq = hresonance +hpqbus :: Pattern Int -> Pattern Double -> ControlPattern +hpqbus = hresonancebus +hpqrecv :: Pattern Int -> ControlPattern +hpqrecv = hresonancerecv + +hpf :: Pattern Double -> ControlPattern +hpf = hcutoff +hpfbus :: Pattern Int -> Pattern Double -> ControlPattern +hpfbus = hcutoffbus +hpfrecv :: Pattern Int -> ControlPattern +hpfrecv = hcutoffrecv + +hg :: Pattern Double -> ControlPattern +hg = hatgrain +hgbus :: Pattern Int -> Pattern Double -> ControlPattern +hgbus = hatgrainbus +hgrecv :: Pattern Int -> ControlPattern +hgrecv = hatgrainrecv + +gat :: Pattern Double -> ControlPattern +gat = gate +gatbus :: Pattern Int -> Pattern Double -> ControlPattern +gatbus = gatebus +gatrecv :: Pattern Int -> ControlPattern +gatrecv = gaterecv + +dt :: Pattern Double -> ControlPattern +dt = delaytime +dtbus :: Pattern Int -> Pattern Double -> ControlPattern +dtbus = delaytimebus +dtrecv :: Pattern Int -> ControlPattern +dtrecv = delaytimerecv + +dfb :: Pattern Double -> ControlPattern +dfb = delayfeedback +dfbbus :: Pattern Int -> Pattern Double -> ControlPattern +dfbbus = delayfeedbackbus +dfbrecv :: Pattern Int -> ControlPattern +dfbrecv = delayfeedbackrecv + +det :: Pattern Double -> ControlPattern +det = detune +detbus :: Pattern Int -> Pattern Double -> ControlPattern +detbus = detunebus +detrecv :: Pattern Int -> ControlPattern +detrecv = detunerecv + +delayt :: Pattern Double -> ControlPattern +delayt = delaytime +delaytbus :: Pattern Int -> Pattern Double -> ControlPattern +delaytbus = delaytimebus +delaytrecv :: Pattern Int -> ControlPattern +delaytrecv = delaytimerecv + +delayfb :: Pattern Double -> ControlPattern +delayfb = delayfeedback +delayfbbus :: Pattern Int -> Pattern Double -> ControlPattern +delayfbbus = delayfeedbackbus +delayfbrecv :: Pattern Int -> ControlPattern +delayfbrecv = delayfeedbackrecv + +ctfg :: Pattern Double -> ControlPattern +ctfg = cutoffegint +ctfgbus :: Pattern Int -> Pattern Double -> ControlPattern +ctfgbus = cutoffegintbus +ctfgrecv :: Pattern Int -> ControlPattern +ctfgrecv = cutoffegintrecv + +ctf :: Pattern Double -> ControlPattern +ctf = cutoff +ctfbus :: Pattern Int -> Pattern Double -> ControlPattern +ctfbus = cutoffbus +ctfrecv :: Pattern Int -> ControlPattern +ctfrecv = cutoffrecv + +chdecay :: Pattern Double -> ControlPattern +chdecay = clhatdecay +chdecaybus :: Pattern Int -> Pattern Double -> ControlPattern +chdecaybus = clhatdecaybus +chdecayrecv :: Pattern Int -> ControlPattern +chdecayrecv = clhatdecayrecv + +bpq :: Pattern Double -> ControlPattern +bpq = bandq +bpqbus :: Pattern Int -> Pattern Double -> ControlPattern +bpqbus = bandqbus +bpqrecv :: Pattern Int -> ControlPattern +bpqrecv = bandqrecv + +bpf :: Pattern Double -> ControlPattern +bpf = bandf +bpfbus :: Pattern Int -> Pattern Double -> ControlPattern +bpfbus = bandfbus +bpfrecv :: Pattern Int -> ControlPattern +bpfrecv = bandfrecv + +att :: Pattern Double -> ControlPattern +att = attack +attbus :: Pattern Int -> Pattern Double -> ControlPattern +attbus = attackbus +attrecv :: Pattern Int -> ControlPattern +attrecv = attackrecv diff --git a/src/Sound/Tidal/ParseBP.hs b/src/Sound/Tidal/ParseBP.hs --- a/src/Sound/Tidal/ParseBP.hs +++ b/src/Sound/Tidal/ParseBP.hs @@ -1,14 +1,34 @@ -{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, CPP #-} +{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, CPP, DeriveFunctor #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans -fno-warn-unused-do-bind #-} module Sound.Tidal.ParseBP where +{- + ParseBP.hs - Parser for Tidal's "mini-notation", inspired by + Bernard Bel's BP2 (Bol Processor 2) system. + Copyright (C) 2020, Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + import Control.Applicative ((<$>), (<*>), pure) import qualified Control.Exception as E import Data.Colour import Data.Colour.Names import Data.Functor.Identity (Identity) +import Data.List (intercalate) import Data.Maybe import Data.Ratio import Data.Typeable (Typeable) @@ -55,18 +75,48 @@ | TPat_Repeat Int (TPat a) | TPat_EnumFromTo (TPat a) (TPat a) | TPat_Var String - deriving (Show) + deriving (Show, Functor) +tShowList :: (Show a) => [TPat a] -> String +tShowList vs = "[" ++ (intercalate "," $ map tShow vs) ++ "]" + +tShow :: (Show a) => TPat a -> String +tShow (TPat_Atom _ v) = "pure " ++ show v +tShow (TPat_Fast t v) = "fast " ++ show t ++ " $ " ++ tShow v +tShow (TPat_Slow t v) = "slow " ++ show t ++ " $ " ++ tShow v +-- TODO - should be _degradeByUsing, but needs a simplified version.. +tShow (TPat_DegradeBy _ r v) = "degradeBy " ++ show r ++ " $ " ++ tShow v +-- TODO - ditto +tShow (TPat_CycleChoose _ vs) = "cycleChoose " ++ tShowList vs + +tShow (TPat_Euclid a b c v) = "doEuclid (" ++ intercalate ") (" (map tShow [a,b,c]) ++ ") $ " ++ tShow v +tShow (TPat_Stack vs) = "stack " ++ tShowList vs + +tShow (TPat_Polyrhythm mSteprate vs) = "stack [" ++ (intercalate ", " (map adjust_speed pats)) ++ "]" + where adjust_speed (sz, pat) = "(fast (" ++ (steprate ++ "/" ++ (show sz)) ++ ") $ " ++ pat ++ ")" + steprate :: String + steprate = maybe base_first tShow mSteprate + base_first | null pats = "0" + | otherwise = show $ fst $ head pats + pats = map steps_tpat vs + +tShow (TPat_Seq vs) = snd $ steps_seq vs + +tShow TPat_Silence = "silence" +tShow (TPat_EnumFromTo a b) = "unwrap $ fromTo <$> (" ++ tShow a ++ ") <*> (" ++ tShow b ++ ")" +tShow (TPat_Var s) = "getControl " ++ s +tShow a = "can't happen? " ++ show a + + toPat :: (Parseable a, Enumerable a) => TPat a -> Pattern a toPat = \case TPat_Atom (Just loc) x -> setContext (Context [loc]) $ pure x TPat_Atom Nothing x -> pure x TPat_Fast t x -> fast (toPat t) $ toPat x TPat_Slow t x -> slow (toPat t) $ toPat x - TPat_DegradeBy seed amt x -> _degradeByUsing (rotL (0.0001 * (fromIntegral seed)) rand) amt $ toPat x - TPat_CycleChoose seed xs -> unwrap $ segment 1 $ chooseBy (rotL (0.0001 * (fromIntegral seed)) rand) $ map toPat xs - TPat_Euclid n k s thing -> - doEuclid (toPat n) (toPat k) (toPat s) (toPat thing) + TPat_DegradeBy seed amt x -> _degradeByUsing (rotL (0.0001 * fromIntegral seed) rand) amt $ toPat x + TPat_CycleChoose seed xs -> unwrap $ segment 1 $ chooseBy (rotL (0.0001 * fromIntegral seed) rand) $ map toPat xs + TPat_Euclid n k s thing -> doEuclid (toPat n) (toPat k) (toPat s) (toPat thing) TPat_Stack xs -> stack $ map toPat xs TPat_Silence -> silence TPat_EnumFromTo a b -> unwrap $ fromTo <$> toPat a <*> toPat b @@ -75,7 +125,7 @@ where adjust_speed (sz, pat) = fast ((/sz) <$> steprate) pat pats = map resolve_tpat ps steprate :: Pattern Rational - steprate = fromMaybe base_first (toPat <$> mSteprate) + steprate = (maybe base_first toPat mSteprate) base_first | null pats = pure 0 | otherwise = pure $ fst $ head pats TPat_Seq xs -> snd $ resolve_seq xs @@ -97,14 +147,22 @@ resolve_size ((TPat_Repeat n p):ps) = replicate n (1,p) ++ (resolve_size ps) resolve_size (p:ps) = (1,p):(resolve_size ps) -{- -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 --} +steps_tpat :: (Show a) => TPat a -> (Rational, String) +steps_tpat (TPat_Seq xs) = steps_seq xs +steps_tpat a = (1, tShow a) + +steps_seq :: (Show a) => [TPat a] -> (Rational, String) +steps_seq xs = (total_size, "timeCat [" ++ (intercalate "," $ map (\(r,s) -> "(" ++ show r ++ ", " ++ s ++ ")") sized_pats) ++ "]") + where sized_pats = steps_size xs + total_size = sum $ map fst sized_pats + +steps_size :: Show a => [TPat a] -> [(Rational, String)] +steps_size [] = [] +steps_size ((TPat_Elongate r p):ps) = (r, tShow p):(steps_size ps) +steps_size ((TPat_Repeat n p):ps) = replicate n (1, tShow p) ++ (steps_size ps) +steps_size (p:ps) = (1,tShow p):(steps_size ps) + parseBP :: (Enumerable a, Parseable a) => String -> Either ParseError (Pattern a) parseBP s = toPat <$> parseTPat s @@ -120,7 +178,7 @@ parseTPat = parseRhythm tPatParser cP :: (Enumerable a, Parseable a) => String -> Pattern a -cP s = innerJoin $ parseBP_E <$> (_cX_ getS s) +cP s = innerJoin $ parseBP_E <$> _cX_ getS s class Parseable a where tPatParser :: MyParser (TPat a) @@ -148,7 +206,16 @@ instance Enumerable Double where fromTo = enumFromTo' fromThenTo = enumFromThenTo' + +instance Parseable Note where + tPatParser = pNote + doEuclid = euclidOff + getControl = cN_ +instance Enumerable Note where + fromTo = enumFromTo' + fromThenTo = enumFromThenTo' + instance Parseable String where tPatParser = pVocable doEuclid = euclidOff @@ -179,7 +246,7 @@ instance Parseable Integer where tPatParser = pIntegral doEuclid = euclidOff - getControl = (fmap fromIntegral) . cI_ + getControl = fmap fromIntegral . cI_ instance Enumerable Integer where fromTo = enumFromTo' @@ -198,8 +265,7 @@ enumFromTo' a b | a > b = fastFromList $ reverse $ enumFromTo b a | otherwise = fastFromList $ enumFromTo a b -enumFromThenTo' - :: (Ord a, Enum a, Num a) => a -> a -> a -> Pattern a +enumFromThenTo' :: (Ord a, Enum a, Num a) => a -> a -> a -> Pattern a enumFromThenTo' a b c | a > c = fastFromList $ reverse $ enumFromThenTo c (c + (a-b)) a | otherwise = fastFromList $ enumFromThenTo a b c @@ -216,9 +282,6 @@ instance (Enumerable a, Parseable a) => IsString (Pattern a) where fromString = parseBP_E ---instance (Parseable a, Pattern p) => IsString (p a) where --- fromString = p :: String -> p a - lexer :: P.GenTokenParser String u Data.Functor.Identity.Identity lexer = P.makeTokenParser haskellDef @@ -270,27 +333,17 @@ return TPat_Silence pSequence :: Parseable a => MyParser (TPat a) -> GenParser Char Int (TPat a) -pSequence f = do spaces -- TODO is this needed? - -- d <- pFast - s <- many $ do a <- pPart f +pSequence f = do s <- many $ do a <- pPart f spaces do try $ symbol ".." b <- pPart f return $ TPat_EnumFromTo a b - <|> do rs <- many1 $ do oneOf "@_" - r <- ((subtract 1) <$> pRatio) <|> return 1 - spaces - return $ r - return $ TPat_Elongate (1 + sum rs) a - <|> do es <- many1 $ do char '!' - n <- (((subtract 1) . read) <$> many1 digit) <|> return 1 - spaces - return n - return $ TPat_Repeat (1 + sum es) a + <|> pElongate a + <|> pRepeat a <|> return a <|> do symbol "." return TPat_Foot - return $ resolve_feet s + pRand $ resolve_feet s where resolve_feet ps | length ss > 1 = TPat_Seq $ map TPat_Seq ss | otherwise = TPat_Seq ps where ss = splitFeet ps @@ -302,7 +355,20 @@ takeFoot (TPat_Foot:pats'') = ([], pats'') takeFoot (pat:pats'') = (\(a,b) -> (pat:a,b)) $ takeFoot pats'' +pRepeat :: TPat a -> MyParser (TPat a) +pRepeat a = do es <- many1 $ do char '!' + n <- (subtract 1 . read <$> many1 digit) <|> return 1 + spaces + return n + return $ TPat_Repeat (1 + sum es) a +pElongate :: TPat a -> MyParser (TPat a) +pElongate a = do rs <- many1 $ do oneOf "@_" + r <- (subtract 1 <$> pRatio) <|> return 1 + spaces + return r + return $ TPat_Elongate (1 + sum rs) a + pSingle :: MyParser (TPat a) -> MyParser (TPat a) pSingle f = f >>= pRand >>= pMult @@ -312,9 +378,7 @@ return $ TPat_Var name pPart :: Parseable a => MyParser (TPat a) -> MyParser (TPat a) -pPart f = do pt <- (pSingle f <|> pPolyIn f <|> pPolyOut f <|> pVar) >>= pE >>= pRand - spaces -- TODO is this needed? - return pt +pPart f = (pSingle f <|> pPolyIn f <|> pPolyOut f <|> pVar) >>= pE >>= pRand newSeed :: MyParser Int newSeed = do seed <- Text.Parsec.Prim.getState @@ -327,17 +391,14 @@ pMult x where stackTail s = do symbol "," ss <- pSequence f `sepBy` symbol "," - spaces -- TODO needed? return $ TPat_Stack (s:ss) chooseTail s = do symbol "|" ss <- pSequence f `sepBy` symbol "|" - spaces -- TODO needed? seed <- newSeed return $ TPat_CycleChoose seed (s:ss) pPolyOut :: Parseable a => MyParser (TPat a) -> MyParser (TPat a) pPolyOut f = do ss <- braces (pSequence f `sepBy` symbol ",") - spaces -- TODO needed? base <- do char '%' r <- pSequence pRational "rational number" return $ Just r @@ -345,10 +406,8 @@ pMult $ TPat_Polyrhythm base ss <|> do ss <- angles (pSequence f `sepBy` symbol ",") - spaces -- TODO needed/wanted? pMult $ TPat_Polyrhythm (Just $ TPat_Atom Nothing 1) ss - pCharNum :: MyParser Char pCharNum = (letter <|> oneOf "0123456789") "letter or number" @@ -367,22 +426,24 @@ return $ addPos tpat pVocable :: MyParser (TPat String) -pVocable = wrapPos $ (TPat_Atom Nothing) <$> pString +pVocable = wrapPos $ TPat_Atom Nothing <$> pString pChar :: MyParser (TPat Char) -pChar = wrapPos $ (TPat_Atom Nothing) <$> pCharNum +pChar = wrapPos $ TPat_Atom Nothing <$> pCharNum pDouble :: MyParser (TPat Double) -pDouble = wrapPos $ do f <- choice [intOrFloat, parseNote] "float" - do c <- parseChord - return $ TPat_Stack $ map ((TPat_Atom Nothing) . (+f)) c +pDouble = wrapPos $ do f <- choice [intOrFloat, pRatioChar, parseNote] "float" + do TPat_Stack . map (TPat_Atom Nothing . (+ f)) <$> parseChord <|> return (TPat_Atom Nothing f) <|> - do c <- parseChord - return $ TPat_Stack $ map (TPat_Atom Nothing) c - <|> - do r <- pRatioChar - return $ TPat_Atom Nothing r + do TPat_Stack . map (TPat_Atom Nothing) <$> parseChord + +pNote :: MyParser (TPat Note) +pNote = wrapPos $ fmap (fmap Note) $ do f <- choice [intOrFloat, parseNote] "float" + do TPat_Stack . map (TPat_Atom Nothing . (+ f)) <$> parseChord + <|> return (TPat_Atom Nothing f) + <|> do TPat_Stack . map (TPat_Atom Nothing) <$> parseChord + <|> do TPat_Atom Nothing <$> pRatioChar pBool :: MyParser (TPat Bool) pBool = wrapPos $ do oneOf "t1" @@ -403,12 +464,10 @@ pIntegral :: Integral a => MyParser (TPat a) pIntegral = wrapPos $ do i <- parseIntNote - do c <- parseChord - return $ TPat_Stack $ map ((TPat_Atom Nothing) . (+i)) c + do TPat_Stack . map (TPat_Atom Nothing . (+i)) <$> parseChord <|> return (TPat_Atom Nothing i) <|> - do c <- parseChord - return $ TPat_Stack $ map (TPat_Atom Nothing) c + do TPat_Stack . map (TPat_Atom Nothing) <$> parseChord parseChord :: (Enum a, Num a) => MyParser [a] parseChord = do char '\'' @@ -504,28 +563,27 @@ return (toRational ((read $ show n ++ "." ++ frac) :: Double)) <|> return (n%1) - c <- (pRatioChar <|> return 1) + c <- pRatioChar <|> return 1 return $ applySign s (result * c) <|> pRatioChar pRatioChar :: Fractional a => MyParser a pRatioChar = do char 'w' - return $ 1 + return 1 <|> do char 'h' - return $ 0.5 + return 0.5 <|> do char 'q' - return $ 0.25 + return 0.25 <|> do char 'e' - return $ 0.125 + return 0.125 <|> do char 's' - return $ 0.0625 + return 0.0625 <|> do char 't' - return $ 1/3 + return (1/3) <|> do char 'f' - return $ 0.2 + return 0.2 <|> do char 'x' - return $ 1/6 + return (1/6) pRational :: MyParser (TPat Rational) -pRational = wrapPos $ (TPat_Atom Nothing) <$> pRatio - +pRational = wrapPos $ TPat_Atom Nothing <$> pRatio diff --git a/src/Sound/Tidal/Pattern.hs b/src/Sound/Tidal/Pattern.hs --- a/src/Sound/Tidal/Pattern.hs +++ b/src/Sound/Tidal/Pattern.hs @@ -1,29 +1,50 @@ {-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TypeSynonymInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +{- + Pattern.hs - core representation of Tidal patterns + Copyright (C) 2020 Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + module Sound.Tidal.Pattern where import Prelude hiding ((<*), (*>)) import Control.Applicative (liftA2) ---import Data.Bifunctor (Bifunctor(..)) import Data.Data (Data) -- toConstr import GHC.Generics import Data.List (delete, findIndex, sort) import qualified Data.Map.Strict as Map import Data.Maybe (isJust, fromJust, catMaybes, mapMaybe) import Data.Typeable (Typeable) -import Control.DeepSeq (NFData(rnf)) +import Control.DeepSeq (NFData) import Data.Word (Word8) - ------------------------------------------------------------------------ -- * Types -- | Time is rational -type Time = Rational +type Time = Rational +-- | Note is Double, but with a different parsing +newtype Note = Note { unNote :: Double } deriving (Typeable, Data, Generic, Eq, Ord, Show, Enum, Num, Fractional, Floating, Real) +instance NFData Note + -- | The 'sam' (start of cycle) for the given time value sam :: Time -> Time sam = fromIntegral . (floor :: Time -> Int) @@ -253,13 +274,14 @@ data Pattern a = Pattern {query :: Query a} deriving Generic -data Value = VS { svalue :: String } - | VF { fvalue :: Double } +data Value = VS { svalue :: String } + | VF { fvalue :: Double } + | VN { nvalue :: Note } | VR { rvalue :: Rational } - | VI { ivalue :: Int } - | VB { bvalue :: Bool } - | VX { xvalue :: [Word8] } -- Used for OSC 'blobs' - deriving (Typeable,Data, Generic) + | VI { ivalue :: Int } + | VB { bvalue :: Bool } + | VX { xvalue :: [Word8] } -- Used for OSC 'blobs' + deriving (Typeable, Data, Generic) class Valuable a where toValue :: a -> Value @@ -267,7 +289,7 @@ instance NFData Value instance Valuable String where - toValue = VS + toValue a = VS a instance Valuable Double where toValue a = VF a instance Valuable Rational where @@ -284,16 +306,17 @@ (VB x) == (VB y) = x == y (VF x) == (VF y) = x == y (VI x) == (VI y) = x == y + (VN x) == (VN y) = x == y (VR x) == (VR y) = x == y (VX x) == (VX y) = x == y - (VF x) == (VI y) = x == (fromIntegral y) - (VI y) == (VF x) = x == (fromIntegral y) + (VF x) == (VI y) = x == fromIntegral y + (VI y) == (VF x) = x == fromIntegral y - (VF x) == (VR y) = (toRational x) == y - (VR y) == (VF x) = (toRational x) == y - (VI x) == (VR y) = (toRational x) == y - (VR y) == (VI x) = (toRational x) == y + (VF x) == (VR y) = toRational x == y + (VR y) == (VF x) = toRational x == y + (VI x) == (VR y) = toRational x == y + (VR y) == (VI x) = toRational x == y _ == _ = False @@ -301,15 +324,18 @@ compare (VS x) (VS y) = compare x y compare (VB x) (VB y) = compare x y compare (VF x) (VF y) = compare x y + compare (VN x) (VN y) = compare (unNote x) (unNote y) compare (VI x) (VI y) = compare x y compare (VR x) (VR y) = compare x y compare (VX x) (VX y) = compare x y + compare (VS _) _ = LT compare _ (VS _) = GT compare (VB _) _ = LT compare _ (VB _) = GT compare (VX _) _ = LT compare _ (VX _) = GT + compare (VF x) (VI y) = compare x (fromIntegral y) compare (VI x) (VF y) = compare (fromIntegral x) y @@ -319,6 +345,16 @@ compare (VF x) (VR y) = compare x (fromRational y) compare (VR x) (VF y) = compare (fromRational x) y + compare (VN x) (VI y) = compare x (fromIntegral y) + compare (VI x) (VN y) = compare (fromIntegral x) y + + compare (VN x) (VR y) = compare (unNote x) (fromRational y) + compare (VR x) (VN y) = compare (fromRational x) (unNote y) + + compare (VF x) (VN y) = compare x (unNote y) + compare (VN x) (VF y) = compare (unNote x) y + + type StateMap = Map.Map String (Pattern Value) type ControlMap = Map.Map String Value type ControlPattern = Pattern ControlMap @@ -574,13 +610,13 @@ negate = (applyFIS negate negate id <$>) (+) = Map.unionWith (fNum2 (+) (+)) (*) = Map.unionWith (fNum2 (*) (*)) - fromInteger i = Map.singleton "n" $ VI $ fromInteger i + fromInteger i = Map.singleton "n" $ VI (fromInteger i) signum = (applyFIS signum signum id <$>) abs = (applyFIS abs abs id <$>) instance Fractional ControlMap where recip = fmap (applyFIS recip id id) - fromRational = Map.singleton "speed" . VF . fromRational + fromRational r = Map.singleton "speed" $ VF (fromRational r) ------------------------------------------------------------------------ -- * Internal functions @@ -621,6 +657,11 @@ withEvent :: (Event a -> Event b) -> Pattern a -> Pattern b withEvent f p = p {query = map f . query p} +-- | @withEvent f p@ returns a new @Pattern@ with each value mapped over +-- function @f@. +withValue :: (a -> b) -> Pattern a -> Pattern b +withValue f pat = withEvent (fmap f) pat + -- | @withEvent f p@ returns a new @Pattern@ with f applied to the resulting list of events for each query -- function @f@. withEvents :: ([Event a] -> [Event b]) -> Pattern a -> Pattern b @@ -633,18 +674,20 @@ -- | Apply one of three functions to a Value, depending on its type applyFIS :: (Double -> Double) -> (Int -> Int) -> (String -> String) -> Value -> Value -applyFIS f _ _ (VF f') = VF $ f f' -applyFIS _ f _ (VI i ) = VI $ f i -applyFIS _ _ f (VS s ) = VS $ f s +applyFIS f _ _ (VF f') = VF (f f') +applyFIS f _ _ (VN (Note f')) = VN (Note $ f f') +applyFIS _ f _ (VI i) = VI (f i) +applyFIS _ _ f (VS s) = VS (f s) applyFIS _ _ _ v = v --- | Apply one of two functions to a Value, depending on its type (int +-- | Apply one of two functions to a pair of Values, depending on their types (int -- or float; strings and rationals are ignored) fNum2 :: (Int -> Int -> Int) -> (Double -> Double -> Double) -> Value -> Value -> Value -fNum2 fInt _ (VI a) (VI b) = VI $ fInt a b -fNum2 _ fFloat (VF a) (VF b) = VF $ fFloat a b -fNum2 _ fFloat (VI a) (VF b) = VF $ fFloat (fromIntegral a) b -fNum2 _ fFloat (VF a) (VI b) = VF $ fFloat a (fromIntegral b) +fNum2 fInt _ (VI a) (VI b) = VI (fInt a b) +fNum2 _ fFloat (VF a) (VF b) = VF (fFloat a b) +fNum2 _ fFloat (VN (Note a)) (VN (Note b)) = VN (Note $ fFloat a b) +fNum2 _ fFloat (VI a) (VF b) = VF (fFloat (fromIntegral a) b) +fNum2 _ fFloat (VF a) (VI b) = VF (fFloat a (fromIntegral b)) fNum2 _ _ x _ = x getI :: Value -> Maybe Int @@ -659,6 +702,12 @@ getF (VI x) = Just $ fromIntegral x getF _ = Nothing +getN :: Value -> Maybe Note +getN (VF f) = Just $ Note f +getN (VR x) = Just $ Note $ fromRational x +getN (VI x) = Just $ Note $ fromIntegral x +getN _ = Nothing + getS :: Value -> Maybe String getS (VS s) = Just s getS _ = Nothing @@ -672,6 +721,30 @@ getR (VF x) = Just $ toRational x getR (VI x) = Just $ toRational x getR _ = Nothing + + +_extract :: (Value -> Maybe a) -> String -> ControlPattern -> Pattern a +_extract f name pat = filterJust $ withValue (\v -> (Map.lookup name v >>= f)) pat + +-- | Extract a pattern of integer values by from a control pattern, given the name of the control +extractI :: String -> ControlPattern -> Pattern Int +extractI = _extract getI + +-- | Extract a pattern of floating point values by from a control pattern, given the name of the control +extractF :: String -> ControlPattern -> Pattern Double +extractF = _extract getF + +-- | Extract a pattern of string values by from a control pattern, given the name of the control +extractS :: String -> ControlPattern -> Pattern String +extractS = _extract getS + +-- | Extract a pattern of boolean values by from a control pattern, given the name of the control +extractB :: String -> ControlPattern -> Pattern Bool +extractB = _extract getB + +-- | Extract a pattern of rational values by from a control pattern, given the name of the control +extractR :: String -> ControlPattern -> Pattern Rational +extractR = _extract getR getBlob :: Value -> Maybe [Word8] getBlob (VX xs) = Just xs diff --git a/src/Sound/Tidal/Scales.hs b/src/Sound/Tidal/Scales.hs --- a/src/Sound/Tidal/Scales.hs +++ b/src/Sound/Tidal/Scales.hs @@ -1,5 +1,23 @@ module Sound.Tidal.Scales (scale, scaleList, scaleTable, getScale) where +{- + Scale.hs - Scales for TidalCycles + Copyright (C) 2020, lvm (Mauro) and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + import Prelude hiding ((<*), (*>)) import Data.Maybe import Sound.Tidal.Pattern diff --git a/src/Sound/Tidal/Show.hs b/src/Sound/Tidal/Show.hs --- a/src/Sound/Tidal/Show.hs +++ b/src/Sound/Tidal/Show.hs @@ -1,8 +1,27 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Sound.Tidal.Show (show, showAll, draw, drawLine, drawLineSz) where +module Sound.Tidal.Show (show, showAll, draw, drawLine, drawLineSz, stepcount) where + +{- + Show.hs - Library for visualising Tidal patterns as text + Copyright (C) 2020, Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + import Sound.Tidal.Pattern import Data.List (intercalate, sortOn) @@ -45,11 +64,12 @@ show (Context cs) = show cs instance Show Value where - show (VS s) = ('"':s) ++ "\"" - show (VI i) = show i - show (VF f) = show f ++ "f" - show (VR r) = show r ++ "r" - show (VB b) = show b + show (VS s) = ('"':s) ++ "\"" + show (VI i) = show i + show (VF f) = show f ++ "f" + show (VN n) = show n ++ "n" + show (VR r) = show r ++ "r" + show (VB b) = show b show (VX xs) = show xs instance {-# OVERLAPPING #-} Show ControlMap where diff --git a/src/Sound/Tidal/Simple.hs b/src/Sound/Tidal/Simple.hs --- a/src/Sound/Tidal/Simple.hs +++ b/src/Sound/Tidal/Simple.hs @@ -1,6 +1,24 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +{- + Simple.hs - Things for making Tidal extra-simple to use, originally made for 8 year olds. + Copyright (C) 2020, Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + module Sound.Tidal.Simple where import Sound.Tidal.Control (chop, hurry) diff --git a/src/Sound/Tidal/Stream.hs b/src/Sound/Tidal/Stream.hs --- a/src/Sound/Tidal/Stream.hs +++ b/src/Sound/Tidal/Stream.hs @@ -4,35 +4,52 @@ module Sound.Tidal.Stream where +{- + Stream.hs - Tidal's thingie for turning patterns into OSC streams + Copyright (C) 2020, Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + import Control.Applicative ((<|>)) import Control.Concurrent.MVar import Control.Concurrent -import Control.Monad (forM_) +import Control.Monad (forM_, when) import qualified Data.Map.Strict as Map -import Data.Maybe (fromJust, fromMaybe, catMaybes) +import Data.Maybe (fromJust, fromMaybe, catMaybes, isJust) import qualified Control.Exception as E --- import Control.Monad.Reader --- import Control.Monad.Except --- import qualified Data.Bifunctor as BF --- import qualified Data.Bool as B --- import qualified Data.Char as C import System.IO (hPutStrLn, stderr) import qualified Sound.OSC.FD as O +import qualified Network.Socket as N import Sound.Tidal.Config import Sound.Tidal.Core (stack, silence) import Sound.Tidal.Pattern import qualified Sound.Tidal.Tempo as T +import Sound.Tidal.Utils ((!!!)) -- import qualified Sound.OSC.Datum as O import Data.List (sortOn) import System.Random (getStdRandom, randomR) import Sound.Tidal.Show () +import Data.Word (Word8) data Stream = Stream {sConfig :: Config, + sBusses :: MVar [Int], sInput :: MVar StateMap, -- sOutput :: MVar ControlPattern, - sListenTid :: Maybe ThreadId, + sListen :: Maybe O.UDP, sPMapMV :: MVar PlayMap, sTempoMV :: MVar T.Tempo, sGlobalFMV :: MVar (ControlPattern -> ControlPattern), @@ -43,7 +60,9 @@ data Cx = Cx {cxTarget :: Target, cxUDP :: O.UDP, - cxOSCs :: [OSC] + cxOSCs :: [OSC], + cxAddr :: N.AddrInfo, + cxBusAddr :: Maybe N.AddrInfo } deriving (Show) @@ -51,7 +70,6 @@ | MessageStamp deriving (Eq, Show) - data Schedule = Pre StampStyle | Live deriving (Eq, Show) @@ -59,19 +77,22 @@ data Target = Target {oName :: String, oAddress :: String, oPort :: Int, + oBusPort :: Maybe Int, oLatency :: Double, oWindow :: Maybe Arc, - oSchedule :: Schedule + oSchedule :: Schedule, + oHandshake :: Bool } deriving Show -data Args = Named {required :: [String]} +data Args = Named {requiredArgs :: [String]} | ArgList [(String, Maybe Value)] deriving Show data OSC = OSC {path :: String, args :: Args } + | OSCContext {path :: String} deriving Show data PlayState = PlayState {pattern :: ControlPattern, @@ -83,95 +104,149 @@ type PlayMap = Map.Map PatId PlayState + +sDefault :: String -> Maybe Value +sDefault x = Just $ VS x +fDefault :: Double -> Maybe Value +fDefault x = Just $ VF x +rDefault :: Rational -> Maybe Value +rDefault x = Just $ VR x +iDefault :: Int -> Maybe Value +iDefault x = Just $ VI x +bDefault :: Bool -> Maybe Value +bDefault x = Just $ VB x +xDefault :: [Word8] -> Maybe Value +xDefault x = Just $ VX x + +required :: Maybe Value +required = Nothing + superdirtTarget :: Target superdirtTarget = Target {oName = "SuperDirt", oAddress = "127.0.0.1", oPort = 57120, + oBusPort = Just 57110, oLatency = 0.2, oWindow = Nothing, - oSchedule = Pre BundleStamp + oSchedule = Pre BundleStamp, + oHandshake = True } superdirtShape :: OSC -superdirtShape = OSC "/play2" $ Named {required = ["s"]} +superdirtShape = OSC "/dirt/play" $ Named {requiredArgs = ["s"]} dirtTarget :: Target dirtTarget = Target {oName = "Dirt", oAddress = "127.0.0.1", oPort = 7771, + oBusPort = Nothing, oLatency = 0.02, oWindow = Nothing, - oSchedule = Pre MessageStamp + oSchedule = Pre MessageStamp, + oHandshake = False } dirtShape :: OSC -dirtShape = OSC "/play" $ ArgList [("sec", Just $ VI 0), - ("usec", Just $ VI 0), - ("cps", Just $ VF 0), - ("s", Nothing), - ("offset", Just $ VF 0), - ("begin", Just $ VF 0), - ("end", Just $ VF 1), - ("speed", Just $ VF 1), - ("pan", Just $ VF 0.5), - ("velocity", Just $ VF 0.5), - ("vowel", Just $ VS ""), - ("cutoff", Just $ VF 0), - ("resonance", Just $ VF 0), - ("accelerate", Just $ VF 0), - ("shape", Just $ VF 0), - ("kriole", Just $ VI 0), - ("gain", Just $ VF 1), - ("cut", Just $ VI 0), - ("delay", Just $ VF 0), - ("delaytime", Just $ VF (-1)), - ("delayfeedback", Just $ VF (-1)), - ("crush", Just $ VF 0), - ("coarse", Just $ VI 0), - ("hcutoff", Just $ VF 0), - ("hresonance", Just $ VF 0), - ("bandf", Just $ VF 0), - ("bandq", Just $ VF 0), - ("unit", Just $ VS "rate"), - ("loop", Just $ VF 0), - ("n", Just $ VF 0), - ("attack", Just $ VF (-1)), - ("hold", Just $ VF 0), - ("release", Just $ VF (-1)), - ("orbit", Just $ VI 0), - ("id", Just $ VI 0) +dirtShape = OSC "/play" $ ArgList [("sec", iDefault 0), + ("usec", iDefault 0), + ("cps", fDefault 0), + ("s", required), + ("offset", fDefault 0), + ("begin", fDefault 0), + ("end", fDefault 1), + ("speed", fDefault 1), + ("pan", fDefault 0.5), + ("velocity", fDefault 0.5), + ("vowel", sDefault ""), + ("cutoff", fDefault 0), + ("resonance", fDefault 0), + ("accelerate", fDefault 0), + ("shape", fDefault 0), + ("kriole", iDefault 0), + ("gain", fDefault 1), + ("cut", iDefault 0), + ("delay", fDefault 0), + ("delaytime", fDefault (-1)), + ("delayfeedback", fDefault (-1)), + ("crush", fDefault 0), + ("coarse", iDefault 0), + ("hcutoff", fDefault 0), + ("hresonance", fDefault 0), + ("bandf", fDefault 0), + ("bandq", fDefault 0), + ("unit", sDefault "rate"), + ("loop", fDefault 0), + ("n", fDefault 0), + ("attack", fDefault (-1)), + ("hold", fDefault 0), + ("release", fDefault (-1)), + ("orbit", iDefault 0), + ("id", iDefault 0) ] startStream :: Config -> [(Target, [OSC])] -> IO Stream startStream config oscmap - = do cxs <- mapM (\(target, os) -> do u <- O.openUDP (oAddress target) (oPort target) - return $ Cx {cxUDP = u, cxTarget = target, cxOSCs = os} - ) oscmap - - sMapMV <- newMVar Map.empty + = do sMapMV <- newMVar Map.empty pMapMV <- newMVar Map.empty + bussesMV <- newMVar [] globalFMV <- newMVar id - listenTid <- ctrlListen sMapMV config tempoMV <- newEmptyMVar + listen <- openListener config + cxs <- mapM (\(target, os) -> do remote_addr <- resolve (oAddress target) (show $ oPort target) + remote_bus_addr <- if isJust $ oBusPort target + then Just <$> resolve (oAddress target) (show $ fromJust $ oBusPort target) + else return Nothing + u <- O.openUDP (oAddress target) (oPort target) + let cx = Cx {cxUDP = u, cxAddr = remote_addr, cxBusAddr = remote_bus_addr, cxTarget = target, cxOSCs = os} + when (oHandshake target) $ + if (isJust listen) + then + do -- send it _from_ the udp socket we're listening to, so the + -- replies go back there + sendO False listen cx $ O.Message "/dirt/handshake" [] + else + hPutStrLn stderr "Can't handshake with SuperCollider without control port." + return cx + ) oscmap let stream = Stream {sConfig = config, + sBusses = bussesMV, sInput = sMapMV, - sListenTid = listenTid, + sListen = listen, sPMapMV = pMapMV, sTempoMV = tempoMV, sGlobalFMV = globalFMV, sCxs = cxs } _ <- T.clocked config tempoMV $ onTick stream + _ <- forkIO $ ctrlResponder stream return stream +sendO :: Bool -> (Maybe O.UDP) -> Cx -> O.Message -> IO () +sendO isBusMsg (Just listen) cx msg = O.sendTo listen (O.Packet_Message msg) (N.addrAddress addr) + where addr | isBusMsg && isJust (cxBusAddr cx) = fromJust $ cxBusAddr cx + | otherwise = cxAddr cx +sendO _ Nothing cx msg = O.sendMessage (cxUDP cx) msg + +sendBndl :: Bool -> (Maybe O.UDP) -> Cx -> O.Bundle -> IO () +sendBndl isBusMsg (Just listen) cx bndl = O.sendTo listen (O.Packet_Bundle bndl) (N.addrAddress addr) + where addr | isBusMsg && isJust (cxBusAddr cx) = fromJust $ cxBusAddr cx + | otherwise = cxAddr cx +sendBndl _ Nothing cx bndl = O.sendBundle (cxUDP cx) bndl + +resolve :: String -> String -> IO N.AddrInfo +resolve host port = do let hints = N.defaultHints { N.addrSocketType = N.Stream } + addr:_ <- N.getAddrInfo (Just hints) (Just host) (Just port) + return addr + startTidal :: Target -> Config -> IO Stream startTidal target config = startStream config [(target, [superdirtShape])] startMulti :: [Target] -> Config -> IO () -startMulti _ _ = putStrLn $ "startMulti has been removed, please check the latest documentation on tidalcycles.org" +startMulti _ _ = hPutStrLn stderr $ "startMulti has been removed, please check the latest documentation on tidalcycles.org" toDatum :: Value -> O.Datum toDatum (VF x) = O.float x +toDatum (VN x) = O.float x toDatum (VI x) = O.int32 x toDatum (VS x) = O.string x toDatum (VR x) = O.float $ ((fromRational x) :: Double) @@ -180,13 +255,14 @@ toDatum (VX xs) = O.Blob $ O.blob_pack xs toData :: OSC -> Event ControlMap -> Maybe [O.Datum] -toData (OSC {args = ArgList as}) e = fmap (fmap toDatum) $ sequence $ map (\(n,v) -> Map.lookup n (value e) <|> v) as +toData (OSC {args = ArgList as}) e = fmap (fmap (toDatum)) $ sequence $ map (\(n,v) -> Map.lookup n (value e) <|> v) as toData (OSC {args = Named rqrd}) e | hasRequired rqrd = Just $ concatMap (\(n,v) -> [O.string n, toDatum v]) $ Map.toList $ value e | otherwise = Nothing where hasRequired [] = True hasRequired xs = null $ filter (not . (`elem` ks)) xs ks = Map.keys (value e) +toData _ _ = Nothing substitutePath :: String -> ControlMap -> Maybe String substitutePath str cm = parse str @@ -206,6 +282,7 @@ simpleShow (VS str) = str simpleShow (VI i) = show i simpleShow (VF f) = show f + simpleShow (VN n) = show n simpleShow (VR r) = show r simpleShow (VB b) = show b simpleShow (VX xs) = show xs @@ -222,28 +299,66 @@ else not (mute pState) ) $ Map.elems pMap -toOSC :: Double -> Event ControlMap -> T.Tempo -> OSC -> Maybe (Double, O.Message) -toOSC latency e tempo osc = do vs <- toData osc addExtra - mungedPath <- substitutePath (path osc) (value e) - return (ts, O.Message mungedPath vs) - where on = sched tempo $ start $ wholeOrPart e +toOSC :: Double -> [Int] -> Event ControlMap -> T.Tempo -> OSC -> [(Double, Bool, O.Message)] +toOSC latency busses e tempo osc@(OSC _ _) + = catMaybes (playmsg:busmsgs) + where (playmap, busmap) = Map.partitionWithKey (\k _ -> null k || head k /= '^') $ value e + -- swap in bus ids where needed + playmap' = Map.union (Map.mapKeys tail $ Map.map (\(VI i) -> VS ('c':(show $ toBus i))) busmap) playmap + addExtra = Map.union playmap' extra + playmsg | eventHasOnset e = do vs <- toData osc (e {value = addExtra}) + mungedPath <- substitutePath (path osc) playmap' + return (ts, + False, -- bus message ? + O.Message mungedPath vs + ) + | otherwise = Nothing + toBus n | null busses = n + | otherwise = busses !!! n + busmsgs = map + (\(('^':k), (VI b)) -> do v <- Map.lookup k playmap + return $ (tsPart, + True, -- bus message ? + O.Message "/c_set" [O.int32 b, toDatum v] + ) + ) + (Map.toList busmap) + onPart = sched tempo $ start $ part e + on = sched tempo $ start $ wholeOrPart e off = sched tempo $ stop $ wholeOrPart e delta = off - on -- If there is already cps in the event, the union will preserve that. - addExtra = (\v -> (Map.union v extra)) <$> e - extra = Map.fromList [("cps", (VF $ T.cps tempo)), + extra = Map.fromList [("cps", (VF (T.cps tempo))), ("delta", VF delta), - ("cycle", VF (fromRational $ start $ wholeOrPart e)) - ] + ("cycle", VF (fromRational $ start $ wholeOrPart e)) + ] + nudge = fromJust $ getF $ fromMaybe (VF 0) $ Map.lookup "nudge" $ playmap ts = on + nudge + latency - nudge = fromJust $ getF $ fromMaybe (VF 0) $ Map.lookup "nudge" $ value e + tsPart = onPart + nudge + latency +toOSC latency _ e tempo (OSCContext oscpath) + = map cToM $ contextPosition $ context e + where cToM :: ((Int,Int),(Int,Int)) -> (Double, Bool, O.Message) + cToM ((x, y), (x',y')) = (ts, + False, -- bus message ? + O.Message oscpath $ (O.float delta):(O.float cyc):(map O.int32 [x,y,x',y']) + ) + on = sched tempo $ start $ wholeOrPart e + off = sched tempo $ stop $ wholeOrPart e + delta = off - on + cyc :: Double + cyc = fromRational $ start $ wholeOrPart e + nudge = fromJust $ getF $ fromMaybe (VF 0) $ Map.lookup "nudge" $ value e + ts = on + nudge + latency + doCps :: MVar T.Tempo -> (Double, Maybe Value) -> IO () -doCps tempoMV (d, Just (VF cps)) = do _ <- forkIO $ do threadDelay $ floor $ d * 1000000 - -- hack to stop things from stopping ! - _ <- T.setCps tempoMV (max 0.00001 cps) - return () - return () +doCps tempoMV (d, Just (VF cps)) = + do _ <- forkIO $ do threadDelay $ floor $ d * 1000000 + -- hack to stop things from stopping ! + -- TODO is this still needed? + _ <- T.setCps tempoMV (max 0.00001 cps) + return () + return () doCps _ _ = return () onTick :: Stream -> T.State -> IO () @@ -254,8 +369,9 @@ processCps t [] = ([], t) -- If an event has a tempo change, that affects the following events.. processCps t (e:evs) = (((t', e):es'), t'') - where cps' = do x <- Map.lookup "cps" $ value e - getF x + where cps' | eventHasOnset e = do x <- Map.lookup "cps" $ value e + getF x + | otherwise = Nothing t' = (maybe t (\newCps -> T.changeTempo' t newCps (eventPartStart e)) cps') (es', t'') = processCps t' evs @@ -298,13 +414,14 @@ doTick :: Bool -> Stream -> T.State -> IO () doTick fake stream st = E.handle (\ (e :: E.SomeException) -> do - putStrLn $ "Failed to Stream.doTick: " ++ show e - putStrLn $ "Return to previous pattern." + hPutStrLn stderr $ "Failed to Stream.doTick: " ++ show e + hPutStrLn stderr $ "Return to previous pattern." setPreviousPatternOrSilence stream ) $ modifyMVar_ (sTempoMV stream) $ \ tempo -> do pMap <- readMVar (sPMapMV stream) sMap <- readMVar (sInput stream) + busses <- readMVar (sBusses stream) sGlobalF <- readMVar (sGlobalFMV stream) -- putStrLn $ show st let config = sConfig stream @@ -316,28 +433,28 @@ | otherwise = patstack frameEnd = snd $ T.nowTimespan st -- add cps to state - sMap' = Map.insert "_cps" (pure $ VF $ T.cps tempo) sMap - filterOns = filter eventHasOnset + sMap' = Map.insert "_cps" (pure $ VF (T.cps tempo)) sMap + --filterOns = filter eventHasOnset extraLatency | fake = 0 | otherwise = cFrameTimespan config + T.nudged tempo --filterOns | cSendParts config = id -- | otherwise = filter eventHasOnset - es = sortOn (start . part) $ filterOns $ query pat (State {arc = T.nowArc st, - controls = sMap' - } - ) + es = sortOn (start . part) $ query pat (State {arc = T.nowArc st, + controls = sMap' + } + ) -- TODO onset is calculated in toOSC as well.. on e tempo'' = (sched tempo'' $ start $ wholeOrPart e) - (tes, tempo') = processCps tempo es - forM_ cxs $ \cx@(Cx target _ oscs) -> do + (tes, tempo') = processCps tempo $ es + forM_ cxs $ \cx@(Cx target _ oscs _ _) -> do let latency = oLatency target + extraLatency ms = concatMap (\(t, e) -> if (fake || (on e t) < frameEnd) - then catMaybes $ map (toOSC latency e t) oscs + then concatMap (toOSC latency busses e t) oscs else [] ) tes - forM_ ms $ \ m -> send cx m `E.catch` \ (e :: E.SomeException) -> do - putStrLn $ "Failed to send. Is the '" ++ oName target ++ "' target running? " ++ show e + forM_ ms $ \ m -> send (sListen stream) cx m `E.catch` \ (e :: E.SomeException) -> do + hPutStrLn stderr $ "Failed to send. Is the '" ++ oName target ++ "' target running? " ++ show e tempo' `seq` return tempo' @@ -350,13 +467,13 @@ _ -> pMap { pattern = silence, history = [silence] } ) -send :: Cx -> (Double, O.Message) -> IO () -send cx (time, m) - | oSchedule target == Pre BundleStamp = O.sendBundle u $ O.Bundle time [m] - | oSchedule target == Pre MessageStamp = O.sendMessage u $ addtime m +send :: Maybe O.UDP -> Cx -> (Double, Bool, O.Message) -> IO () +send listen cx (time, isBusMsg, m) + | oSchedule target == Pre BundleStamp = sendBndl isBusMsg listen cx $ O.Bundle time [m] + | oSchedule target == Pre MessageStamp = sendO isBusMsg listen cx $ addtime m | otherwise = do _ <- forkIO $ do now <- O.time threadDelay $ floor $ (time - now) * 1000000 - O.sendMessage u m + sendO isBusMsg listen cx m return () where addtime (O.Message mpath params) = O.Message mpath ((O.int32 sec):((O.int32 usec):params)) ut = O.ntpr_to_ut time @@ -364,9 +481,7 @@ sec = floor ut usec :: Int usec = floor $ 1000000 * (ut - (fromIntegral sec)) - u = cxUDP cx target = cxTarget cx - -- latency target = oLatency target + cFrameTimespan config + T.nudged tempo sched :: T.Tempo -> Rational -> Double sched tempo c = ((fromRational $ c - (T.atCycle tempo)) / T.cps tempo) @@ -478,36 +593,45 @@ streamSetR :: Stream -> String -> Pattern Rational -> IO () streamSetR = streamSet -ctrlListen :: MVar StateMap -> Config -> IO (Maybe ThreadId) -ctrlListen sMapMV c - | cCtrlListen c = do putStrLn $ "Listening for controls on " ++ cCtrlAddr c ++ ":" ++ show (cCtrlPort c) - catchAny run (\_ -> do putStrLn $ "Control listen failed. Perhaps there's already another tidal instance listening on that port?" - return Nothing +openListener :: Config -> IO (Maybe O.UDP) +openListener c + | cCtrlListen c = do hPutStrLn stderr $ "Listening for controls on " ++ cCtrlAddr c ++ ":" ++ show (cCtrlPort c) + catchAny run (\_ -> if (cCtrlPort c) == 0 + then error "Failed to listen to any port." + else do hPutStrLn stderr "Failed to open that port. Trying another." + u <- openListener (c {cCtrlPort = 0}) + return u ) | otherwise = return Nothing where run = do sock <- O.udpServer (cCtrlAddr c) (cCtrlPort c) - tid <- forkIO $ loop sock - return $ Just tid - loop sock = do ms <- O.recvMessages sock - mapM_ act ms - loop sock + return $ Just sock + catchAny :: IO a -> (E.SomeException -> IO a) -> IO a + catchAny = E.catch + +ctrlResponder :: Stream -> IO () +ctrlResponder (stream@(Stream {sListen = Just sock})) = do ms <- O.recvMessages sock + mapM_ act ms + ctrlResponder stream + where + act (O.Message "/dirt/hello" _) = return () + act (O.Message "/dirt/handshake/reply" xs) = do _ <- swapMVar (sBusses stream) $ bufferIndices xs + return () + where + bufferIndices [] = [] + bufferIndices (x:xs') | x == (O.ASCII_String $ O.ascii "&controlBusIndices") = catMaybes $ takeWhile isJust $ map O.datum_integral xs' + | otherwise = bufferIndices xs' act (O.Message x (O.Int32 k:v:[])) = act (O.Message x [O.string $ show k,v]) act (O.Message _ (O.ASCII_String k:v@(O.Float _):[])) - = add (O.ascii_to_string k) (VF $ fromJust $ O.datum_floating v) + = add (O.ascii_to_string k) (VF (fromJust $ O.datum_floating v)) act (O.Message _ (O.ASCII_String k:O.ASCII_String v:[])) - = add (O.ascii_to_string k) (VS $ O.ascii_to_string v) + = add (O.ascii_to_string k) (VS (O.ascii_to_string v)) act (O.Message _ (O.ASCII_String k:O.Int32 v:[])) - = add (O.ascii_to_string k) (VI $ fromIntegral v) - act m = putStrLn $ "Unhandled OSC: " ++ show m + = add (O.ascii_to_string k) (VI (fromIntegral v)) + act m = hPutStrLn stderr $ "Unhandled OSC: " ++ show m add :: String -> Value -> IO () - add k v = do sMap <- takeMVar sMapMV - putMVar sMapMV $ Map.insert k (pure v) sMap + add k v = do sMap <- takeMVar (sInput stream) + putMVar (sInput stream) $ Map.insert k (pure v) sMap return () - catchAny :: IO a -> (E.SomeException -> IO a) -> IO a - catchAny = E.catch - - - - +ctrlResponder _ = return () diff --git a/src/Sound/Tidal/Tempo.hs b/src/Sound/Tidal/Tempo.hs --- a/src/Sound/Tidal/Tempo.hs +++ b/src/Sound/Tidal/Tempo.hs @@ -14,6 +14,24 @@ import Sound.Tidal.Config import Sound.Tidal.Utils (writeError) +{- + Tempo.hs - Tidal's scheduler + Copyright (C) 2020, Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + instance Show O.UDP where show _ = "-unshowable-" diff --git a/src/Sound/Tidal/Transition.hs b/src/Sound/Tidal/Transition.hs --- a/src/Sound/Tidal/Transition.hs +++ b/src/Sound/Tidal/Transition.hs @@ -19,6 +19,24 @@ import Sound.Tidal.UI (fadeOutFrom, fadeInFrom) import Sound.Tidal.Utils (enumerate) +{- + Transition.hs - A library for handling transitions between patterns + Copyright (C) 2020, Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + -- Evaluation of pat is forced so exceptions are picked up here, before replacing the existing pattern. -- the "historyFlag" determines if the new pattern should be placed on the history stack or not transition :: Show a => Stream -> Bool -> (Time -> [ControlPattern] -> ControlPattern) -> a -> ControlPattern -> IO () diff --git a/src/Sound/Tidal/UI.hs b/src/Sound/Tidal/UI.hs --- a/src/Sound/Tidal/UI.hs +++ b/src/Sound/Tidal/UI.hs @@ -2,15 +2,30 @@ module Sound.Tidal.UI where +{- + UI.hs - Tidal's main 'user interface' functions, for transforming + patterns, building on the Core ones. + Copyright (C) 2020, Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + import Prelude hiding ((<*), (*>)) import Data.Char (digitToInt, isDigit, ord) import Data.Bits (testBit, Bits, xor, shiftL, shiftR) --- import System.Random (randoms, mkStdGen) --- import Control.Monad.ST --- import Control.Monad.Primitive (PrimState, PrimMonad) --- import qualified Data.Vector as V --- import Data.Word (Word32) +import Data.Fixed (mod') import Data.Ratio ((%)) import Data.List (sort, sortOn, findIndices, elemIndex, groupBy, transpose, intercalate, findIndex) import Data.Maybe (isJust, fromJust, fromMaybe, mapMaybe) @@ -93,6 +108,17 @@ rand :: Fractional a => Pattern a rand = Pattern (\(State a@(Arc s e) _) -> [Event (Context []) Nothing a (realToFrac $ (timeToRand ((e + s)/2) :: Double))]) +-- | Boolean rand - a continuous stream of true/false values, with a 50/50 chance. +brand :: Pattern Bool +brand = _brandBy 0.5 + +-- | Boolean rand with probability as input, e.g. brandBy 0.25 is 25% chance of being true. +brandBy :: Pattern Double -> Pattern Bool +brandBy probpat = innerJoin $ (\prob -> _brandBy prob) <$> probpat + +_brandBy :: Double -> Pattern Bool +_brandBy prob = fmap (< prob) rand + {- | 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: @@ -100,9 +126,12 @@ d1 $ segment 4 $ n (irand 5) # sound "drum" @ -} -irand :: Num a => Int -> Pattern a -irand i = fromIntegral . (floor :: Double -> Int) . (* fromIntegral i) <$> rand +irand :: Num a => Pattern Int -> Pattern a +irand = (>>= _irand) +_irand :: Num a => Int -> Pattern a +_irand i = fromIntegral . (floor :: Double -> Int) . (* fromIntegral i) <$> rand + {- | 1D Perlin (smooth) noise, works like rand but smoothly moves between random values each cycle. `perlinWith` takes a pattern as the RNG's "input" instead of automatically using the cycle count. @@ -203,7 +232,6 @@ @ -} - degradeBy :: Pattern Double -> Pattern a -> Pattern a degradeBy = tParam _degradeBy @@ -242,28 +270,46 @@ @ -} sometimesBy :: Pattern Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a -sometimesBy x f p = overlay (degradeBy x p) (unDegradeBy x $ f p) +sometimesBy x f pat = overlay (degradeBy x pat) (f $ unDegradeBy x pat) +sometimesBy' :: Pattern Double -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a +sometimesBy' x f pat = overlay (degradeBy x pat) (unDegradeBy x $ f pat) + -- | @sometimes@ is an alias for sometimesBy 0.5. sometimes :: (Pattern a -> Pattern a) -> Pattern a -> Pattern a sometimes = 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 +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 +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 +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 +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 @@ -312,8 +358,6 @@ degrade :: Pattern a -> Pattern a degrade = _degradeBy 0.5 - - {- | (The above means that `brak` is a function from patterns of any type, to a pattern of the same type.) @@ -454,7 +498,6 @@ 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 @@ -500,8 +543,6 @@ spreadr :: (t -> t1 -> Pattern b) -> [t] -> t1 -> Pattern b spreadr = spreadChoose - - {-| 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. @ @@ -540,9 +581,13 @@ 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.Core.when (\t -> (t `mod` a) >= b ) +whenmod :: Pattern Time -> Pattern Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a +whenmod a b f pat = innerJoin $ (\a' b' -> _whenmod a' b' f pat) <$> a <*> b +_whenmod :: Time -> Time -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a +_whenmod a b = Sound.Tidal.Core.whenT (\t -> ((t `mod'` a) >= b )) + + {- | @ superimpose f p = stack [p, f p] @@ -639,7 +684,6 @@ @ -} - within' :: (Time, Time) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a within' a@(s, e) f p = stack [ filterWhen (\t -> cyclePos t >= s && cyclePos t < e) $ compress a $ f $ zoom a p @@ -699,28 +743,13 @@ _euclid :: Int -> Int -> Pattern a -> Pattern a _euclid n k a = fastcat $ fmap (bool silence a) $ bjorklund (n,k) --- _euclid :: Int -> Int -> Pattern a -> Pattern a --- _euclid n k p = flip const <$> filterValues (== True) (fastFromList $ bjorklund (n,k)) <*> p - {- | `euclidfull n k pa pb` stacks @e n k pa@ with @einv n k pb@ -} euclidFull :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a -> Pattern a ---euclidFull pn pk pa pb = innerJoin $ (\n k -> _euclidFull n k pa pb) <$> pn <*> pk euclidFull n k pa pb = stack [ euclid n k pa, euclidInv n k pb ] _euclidBool :: Int -> Int -> Pattern Bool _euclidBool n k = fastFromList $ bjorklund (n,k) -{-_euclidFull :: Int -> Int -> Pattern a -> Pattern a -> Pattern a - _euclidFull n k p p' = pickbool <$> _euclidBool n k <*> p <*> p' - where pickbool True a _ = a - pickbool False _ b = b --} - - - --- euclid' :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a --- euclid' = tParam2 _euclidq' - _euclid' :: Int -> Int -> Pattern a -> Pattern a _euclid' n k p = fastcat $ map (\x -> if x then p else silence) (bjorklund (n,k)) @@ -766,7 +795,6 @@ euclidInv = tParam2 _euclidInv _euclidInv :: Int -> Int -> Pattern a -> Pattern a ---_euclidInv n k p = flip const <$> filterValues (== False) (fastFromList $ bjorklund (n,k)) <*> p _euclidInv n k a = fastcat $ fmap (bool a silence) $ bjorklund (n,k) index :: Real b => b -> Pattern b -> Pattern c -> Pattern c @@ -918,7 +946,7 @@ -- | @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 (_segment 1 $ (%1) . fromIntegral <$> (irand (length ps) :: Pattern Int)) (slowcat ps) +randcat ps = spread' rotL (_segment 1 $ (%1) . fromIntegral <$> (_irand (length ps) :: Pattern Int)) (slowcat ps) wrandcat :: [(Pattern a, Double)] -> Pattern a wrandcat ps = unwrap $ wchooseBy (segment 1 rand) ps @@ -973,7 +1001,8 @@ where pos e = perCycle * floor (start $ part e) fit :: Pattern Int -> [a] -> Pattern Int -> Pattern a -fit pi xs p = (tParam ( \i x@(xs,p) -> _fit i xs p )) pi (xs,p) +fit pint xs p = (tParam func) pint (xs,p) + where func = \i @_(xs',p') -> _fit i xs' p' permstep :: RealFrac b => Int -> [a] -> Pattern b -> Pattern a permstep nSteps things p = unwrap $ (\n -> fastFromList $ concatMap (\x -> replicate (fst x) (snd x)) $ zip (ps !! floor (n * fromIntegral (length ps - 1))) things) <$> _segment 1 p @@ -991,7 +1020,6 @@ struct ps pv = filterJust $ (\a b -> if a then Just b else Nothing ) <$> 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 Bool -> Pattern b -> Pattern b substruct s p = p {query = f} where f st = @@ -1148,18 +1176,9 @@ # n (run 8) @ -} - mask :: Pattern Bool -> Pattern a -> Pattern a mask b p = const <$> p <* (filterValues id b) -{- -mask :: Pattern Bool -> Pattern b -> Pattern b --- TODO - should that be part or whole? -mask pa pb = pb {query = \st -> concat [filterOns (subArc (arc st) $ part i) (query pb st) | i <- query pa st]} - where filterOns Nothing _ = [] - filterOns (Just a) es = filter (onsetIn a) es --} - -- | TODO: refactor towards union enclosingArc :: [Arc] -> Arc enclosingArc [] = Arc 0 1 @@ -1208,13 +1227,6 @@ chunk :: Pattern Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b chunk npat f p = innerJoin $ (\n -> _chunk n f p) <$> npat - - -{- -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 :: Int -> (Pattern b -> Pattern b) -> Pattern b -> Pattern b runWith = _chunk @@ -1229,17 +1241,6 @@ chunk' :: Integral a1 => Pattern a1 -> (Pattern a2 -> Pattern a2) -> Pattern a2 -> Pattern a2 chunk' npat f p = innerJoin $ (\n -> _chunk' n f p) <$> npat - --- 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) @@ -1323,7 +1324,7 @@ scramble = tParam _scramble _scramble :: Int -> Pattern a -> Pattern a -_scramble n = _rearrangeWith (_segment (fromIntegral n) $ irand n) n +_scramble n = _rearrangeWith (_segment (fromIntegral n) $ _irand n) n randrun :: Int -> Pattern Int randrun 0 = silence @@ -1453,11 +1454,11 @@ -} -- Repeats each event @n@ times within its arc -ply :: Pattern Int -> Pattern a -> Pattern a +ply :: Pattern Rational -> Pattern a -> Pattern a ply = tParam _ply -_ply :: Int -> Pattern a -> Pattern a -_ply n p = arpeggiate $ stack (replicate n p) +_ply :: Rational -> Pattern a -> Pattern a +_ply n pat = squeezeJoin $ (_fast n . pure) <$> pat -- Like ply, but applies a function each time. The applications are compounded. plyWith :: (Ord t, Num t) => Pattern t -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a @@ -1468,6 +1469,17 @@ where compound n | n <= 1 = p | otherwise = overlay p (f $ compound $ n-1) +-- | Syncopates a rhythm, shifting each event halfway into its arc (aka timespan), e.g. @"a b [c d] e"@ becomes the equivalent of @"[~ a] [~ b] [[~ c] [~ d]] [~ e]"@ +press :: Pattern a -> Pattern a +press = _pressBy 0.5 + +-- | Like @press@, but allows you to specify the amount in which each event is shifted. @pressBy 0.5@ is the same as @press@, while @pressBy (1/3)@ shifts each event by a third of its arc. +pressBy :: Pattern Time -> Pattern a -> Pattern a +pressBy = tParam _pressBy + +_pressBy :: Time -> Pattern a -> Pattern a +_pressBy r pat = squeezeJoin $ (compressTo (r,1) . pure) <$> pat + -- | Uses the first (binary) pattern to switch between the following -- two patterns. The resulting structure comes from the source patterns, not the -- binary pattern. See also @stitch@. @@ -1628,7 +1640,6 @@ |+ speed (slow 4 $ range 1 1.5 sine1) @ -} - range :: Num a => Pattern a -> Pattern a -> Pattern a -> Pattern a range fromP toP p = (\from to v -> ((v * (to-from)) + from)) <$> fromP *> toP *> p @@ -1722,8 +1733,6 @@ -- For example in @contrast (n "1") (# crush 3) (# vowel "a") $ n "0 1" # s "bd sn" # speed 3@, -- the first event will have the vowel effect applied and the second -- will have the crush applied. - - contrast :: (ControlPattern -> ControlPattern) -> (ControlPattern -> ControlPattern) -> ControlPattern -> ControlPattern -> ControlPattern contrast = contrastBy (==) @@ -1750,6 +1759,7 @@ contrastRange = contrastBy f where f (VI s, VI e) (VI v) = v >= s && v <= e f (VF s, VF e) (VF v) = v >= s && v <= e + f (VN s, VN e) (VN v) = v >= s && v <= e f (VS s, VS e) (VS v) = v == s && v == e f _ _ = False @@ -1884,9 +1894,11 @@ slices a pattern `pat` into `n` pieces, then uses the `ipat` pattern of integers to index into those slices. So `bite 4 "0 2*2" (run 8)` is the same as `"[0 1] [4 5]*2"`. -} +bite :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a +bite npat ipat pat = innerJoin $ (\n -> _bite n ipat pat) <$> npat -bite :: Int -> Pattern Int -> Pattern a -> Pattern a -bite n ipat pat = squeezeJoin $ zoompat <$> ipat +_bite :: Int -> Pattern Int -> Pattern a -> Pattern a +_bite n ipat pat = squeezeJoin $ zoompat <$> ipat where zoompat i = zoom (i'/(fromIntegral n), (i'+1)/(fromIntegral n)) pat where i' = fromIntegral $ i `mod` n @@ -1896,7 +1908,6 @@ squeeze _ [] = silence squeeze ipat pats = squeezeJoin $ (pats !!!) <$> ipat - squeezeJoinUp :: Pattern (ControlPattern) -> ControlPattern squeezeJoinUp pp = pp {query = q} where q st = concatMap (f st) (query (filterDigital pp) st) @@ -1925,11 +1936,19 @@ _binary :: Data.Bits.Bits b => Int -> b -> Pattern Bool _binary n num = listToPat $ __binary n num -binaryN :: Int -> Pattern Int -> Pattern Bool -binaryN n p = squeezeJoin $ _binary n <$> p +_binaryN :: Int -> Pattern Int -> Pattern Bool +_binaryN n p = squeezeJoin $ _binary n <$> p +binaryN :: Pattern Int -> Pattern Int -> Pattern Bool +binaryN n p = tParam _binaryN n p + binary :: Pattern Int -> Pattern Bool binary = binaryN 8 ascii :: Pattern String -> Pattern Bool ascii p = squeezeJoin $ (listToPat . concatMap (__binary 8 . ord)) <$> p + +grain :: Pattern Double -> Pattern Double -> ControlPattern +grain s w = P.begin b # P.end e + where b = s + e = s + w diff --git a/src/Sound/Tidal/Utils.hs b/src/Sound/Tidal/Utils.hs --- a/src/Sound/Tidal/Utils.hs +++ b/src/Sound/Tidal/Utils.hs @@ -1,5 +1,23 @@ module Sound.Tidal.Utils where +{- + Utils.hs - A library of handy Haskell utility functions + Copyright (C) 2020, Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + import Data.List (delete) import System.IO (hPutStrLn, stderr) @@ -95,3 +113,8 @@ inside column line ('"':xs) = '"':')':(outside (column+1) line xs) inside _ line ('\n':xs) = '\n':(inside 0 (line+1) xs) inside column line (x:xs) = x:(inside (column+1) line xs) + + +matchMaybe :: Maybe a -> Maybe a -> Maybe a +matchMaybe Nothing y = y +matchMaybe x _ = x diff --git a/src/Sound/Tidal/Version.hs b/src/Sound/Tidal/Version.hs --- a/src/Sound/Tidal/Version.hs +++ b/src/Sound/Tidal/Version.hs @@ -1,4 +1,22 @@ module Sound.Tidal.Version where +{- + Version.hs - For giving the current tidal version. + Copyright (C) 2020, Alex McLean and contributors + + This library is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this library. If not, see . +-} + tidal_version :: String -tidal_version = "1.6.1" +tidal_version = "1.7" diff --git a/test/Sound/Tidal/ExceptionsTest.hs b/test/Sound/Tidal/ExceptionsTest.hs --- a/test/Sound/Tidal/ExceptionsTest.hs +++ b/test/Sound/Tidal/ExceptionsTest.hs @@ -2,22 +2,13 @@ module Sound.Tidal.ExceptionsTest where -import TestUtils import Test.Microspec import Control.Exception import Control.DeepSeq import Data.Typeable (typeOf) import Prelude hiding ((<*), (*>)) -import qualified Data.Map.Strict as Map - --- import Sound.Tidal.Pattern -import Sound.Tidal.Control -import Sound.Tidal.Core -import Sound.Tidal.Params -import Sound.Tidal.ParseBP import Sound.Tidal.Pattern -import Sound.Tidal.UI run :: Microspec () run = @@ -42,10 +33,12 @@ Test.Microspec.assert $ p e where -- a string repsentation of the expected exception's type + {- exceptionType = (show . typeOf . instanceOf) p where instanceOf :: Selector a -> a instanceOf _ = error "Test.Hspec.Expectations.shouldThrow: broken Typeable instance" + -} -- | -- A @Selector@ is a predicate; it can simultaneously constrain the type and diff --git a/test/Sound/Tidal/ParamsTest.hs b/test/Sound/Tidal/ParamsTest.hs new file mode 100644 --- /dev/null +++ b/test/Sound/Tidal/ParamsTest.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Sound.Tidal.ParamsTest where + +import Test.Microspec +import TestUtils +import Sound.Tidal.Core +import Sound.Tidal.Params +import Sound.Tidal.Pattern + +run :: Microspec () +run = + describe "Sound.Tidal.Params" $ do + describe "VF params" $ do + it "should parse fractional ratio" $ do + compareP (Arc 0 1) + (sound "bd" # delay "e") + (sound "bd" # delay (1/8)) + + it "should parse correctly floating point number" $ do + compareP (Arc 0 1) + (sound "bd" # delay "0.5") + (sound "bd" # delay (1/2)) + + describe "VN params" $ do + it "should parse note value" $ do + compareP (Arc 0 1) + (sound "bd" # note "e") + (sound "bd" # note 4) + + it "should parse n value" $ do + compareP (Arc 0 1) + (sound "bd" # n "e") + (sound "bd" # n 4) + + it "should parse correctly floating point number" $ do + compareP (Arc 0 1) + (sound "bd" # note "0.5") + (sound "bd" # note (1/2)) + diff --git a/test/Sound/Tidal/ParseTest.hs b/test/Sound/Tidal/ParseTest.hs --- a/test/Sound/Tidal/ParseTest.hs +++ b/test/Sound/Tidal/ParseTest.hs @@ -63,6 +63,14 @@ compareP (Arc 0 1) ("0.4 0.5? 0.6" :: Pattern Double) (fastcat[0.4, degradeByDefault 0.5, 0.6]) + it "can handle ? on replicated value" $ do + compareP (Arc 0 1) + ("a!8?" :: Pattern String) + ("[a!8]?" :: Pattern String) + it "can handle ? on streched value" $ do + compareP (Arc 0 1) + ("a*4@0.25?" :: Pattern String) + ("[a*4@0.25]?" :: Pattern String) it "can stretch with @" $ do comparePD (Arc 0 1) ("a@2 b" :: Pattern String) diff --git a/test/Sound/Tidal/PatternTest.hs b/test/Sound/Tidal/PatternTest.hs --- a/test/Sound/Tidal/PatternTest.hs +++ b/test/Sound/Tidal/PatternTest.hs @@ -458,24 +458,24 @@ describe "applyFIS" $ do it "apply Float function when value of type VF" $ do let res = applyFIS (+1) (+1) (++ "1") (VF 1) - property $ (VF $ 2.0) === res + property $ (VF 2.0) === res it "apply Int function when value of type VI" $ do let res = applyFIS (+1) (+1) (++ "1") (VI 1) - property $ (VI $ 2) === res + property $ (VI 2) === res it "apply String function when value of type VS" $ do let res = applyFIS (+1) (+1) (++ "1") (VS "1") - property $ (VS $ "11") === res + property $ (VS "11") === res describe "fNum2" $ do it "apply Int function for two Int values" $ do let res = fNum2 (+) (+) (VI 2) (VI 3) - property $ (VI $ 5) === res + property $ (VI 5) === res it "apply float function when given two float values" $ do let res = fNum2 (+) (+) (VF 2) (VF 3) - property $ (VF $ 5.0) === res + property $ (VF 5.0) === res it "apply float function when one float and one int value given" $ do let res = fNum2 (+) (+) (VF 2) (VI 3) - property $ (VF $ 5.0) === res + property $ (VF 5.0) === res describe "getI" $ do it "get Just value when Int value is supplied" $ do @@ -484,7 +484,7 @@ it "get floored value when float value is supplied" $ do let res = getI (VF 3.5) property $ (Just 3) === res - it "get Nothing if String value is supplied" $ do + it "get if String value is supplied" $ do let res = getI (VS "3") property $ Nothing === res diff --git a/test/Sound/Tidal/StreamTest.hs b/test/Sound/Tidal/StreamTest.hs new file mode 100644 --- /dev/null +++ b/test/Sound/Tidal/StreamTest.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Sound.Tidal.StreamTest where + +import Test.Microspec +import Sound.Tidal.Stream +import Sound.Tidal.Pattern +import qualified Sound.OSC.FD as O + +run :: Microspec () +run = + describe "Sound.Tidal.Stream" $ do + describe "toDatum" $ do + it "should convert VN to osc float" $ do + toDatum (VN (Note 3.5)) `shouldBe` O.float (3.5 :: Double) + diff --git a/test/Sound/Tidal/UITest.hs b/test/Sound/Tidal/UITest.hs --- a/test/Sound/Tidal/UITest.hs +++ b/test/Sound/Tidal/UITest.hs @@ -62,14 +62,6 @@ in compareP overTimeSpan testMe expectedResult - it "does nothing when set at 0% probability -- const" $ do - let - overTimeSpan = (Arc 0 2) - testMe = sometimesBy 0 (const $ s "cp") (s "bd*8") - expectedResult = s "bd*8" - in - compareP overTimeSpan testMe expectedResult - it "applies the 'rev' function when set at 100% probability" $ do let overTimeSpan = (Arc 0 1) @@ -78,6 +70,15 @@ in compareP overTimeSpan testMe expectedResult + describe "sometimesBy'" $ do + it "does nothing when set at 0% probability -- using const" $ do + let + overTimeSpan = (Arc 0 2) + testMe = sometimesBy' 0 (const $ s "cp") (s "bd*8") + expectedResult = s "bd*8" + in + compareP overTimeSpan testMe expectedResult + describe "rand" $ do it "generates a (pseudo-)random number between zero & one" $ do it "at the start of a cycle" $ @@ -89,6 +90,17 @@ (queryArc rand (Arc 0.75 0.75)) `shouldBe` [Event (Context []) Nothing (Arc 0.75 0.75) (0.20052618719637394 :: Float)] + describe "irand" $ do + it "generates a (pseudo-random) integer between zero & i" $ do + it "at the start of a cycle" $ + (queryArc (irand 10) (Arc 0 0)) `shouldBe` [Event (Context []) Nothing (Arc 0 0) (0 :: Int)] + it "at 1/4 of a cycle" $ + (queryArc (irand 10) (Arc 0.25 0.25)) `shouldBe` [Event (Context []) Nothing (Arc 0.25 0.25) (6 :: Int)] + it "is patternable" $ + (queryArc (irand "10 2") (Arc 0 1)) `shouldBe` [ + Event (Context [((1,1),(4,1))]) Nothing (Arc 0 0.5) (6 :: Int), Event (Context [((4,1),(5,1))]) Nothing (Arc 0.5 1) (0 :: Int) + ] + describe "range" $ do describe "scales a pattern to the supplied range" $ do describe "from 3 to 4" $ do @@ -137,6 +149,25 @@ (rot (1) "a ~ [b [c ~ d]] [e ]" :: Pattern String) ( "b ~ [c [d ~ e]] [ a]" :: Pattern String) + describe "ply" $ do + it "can ply chords" $ do + compareP (Arc 0 1) + (ply 3 "[0,1] [3,4,5] 6") + ("[0,1]*3 [3,4,5]*3 6*3" :: Pattern Int) + it "can pattern the ply factor" $ do + compareP (Arc 0 1) + (ply "3 4 5" "[0,1] [3,4,5] 6") + ("[0,1]*3 [3,4,5]*4 6*5" :: Pattern Int) + describe "press" $ do + it "can syncopate a pattern" $ do + compareP (Arc 0 1) + (press "a b [c d] e") + ("[~ a] [~ b] [[~ c] [~ d]] [~ e]" :: Pattern String) + describe "pressBy" $ do + it "can syncopate a pattern by a given amount" $ do + compareP (Arc 0 1) + (pressBy (1/3) "a b [~ c]") + ("[~ a@2] [~ b@2] [~ [~ c@2]]" :: Pattern String) describe "fix" $ do it "can apply functions conditionally" $ do compareP (Arc 0 1) @@ -174,7 +205,7 @@ describe "contrastRange" $ do it "matches using a pattern of ranges" $ do compareP (Arc 0 1) - (contrastRange (# crush 3) (# crush 0) (pure $ Map.singleton "n" $ (VF 0, VF 3)) $ s "bd" >| n "1 4") + (contrastRange (# crush 3) (# crush 0) (pure $ Map.singleton "n" $ (VN 0, VN 3)) $ s "bd" >| n "1 4") (s "bd" >| n "1 4" >| crush "3 0") describe "euclidFull" $ do @@ -253,6 +284,10 @@ compareP (Arc 0 4) (bite 4 "0 2*2" (Sound.Tidal.Core.run 8)) ("[0 1] [4 5]*2" :: Pattern Int) + it "can slice a pattern into patternable bits number" $ do + compareP (Arc 0 4) + (bite "8 4" "0 2*2" (Sound.Tidal.Core.run 8)) + ("[0] [4 5]*2" :: Pattern Int) describe "chooseBy" $ do it "chooses from elements based on closest scaled double value" $ do @@ -278,7 +313,6 @@ (arpeggiate $ "[0,0]*2") ("0 0 0 0" :: Pattern Int) - describe "chunk" $ do it "can chunk a rev pattern" $ do compareP (Arc 0 4) @@ -288,3 +322,19 @@ compareP (Arc 0 4) (chunk 2 (fast 2) $ "a b" :: Pattern String) (slow 2 $ "a b b _ a _ a b" :: Pattern String) + + describe "binary" $ do + it "converts a number to a pattern of boolean" $ do + compareP (Arc 0 1) + (binary "128") + ("t f f f f f f f" :: Pattern Bool) + + describe "binaryN" $ do + it "convert a number to a pattern of boolean of specified length" $ do + compareP (Arc 0 1) + (binaryN 4 "8") + ("t f f f" :: Pattern Bool) + it "convert a number to a pattern of boolean of specified patternable length" $ do + compareP (Arc 0 2) + (binaryN "<4 8>" "8") + (cat ["t f f f", "f f f f t f f f"] :: Pattern Bool) diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -3,10 +3,12 @@ import Test.Microspec import Sound.Tidal.CoreTest +import Sound.Tidal.ParamsTest import Sound.Tidal.ParseTest import Sound.Tidal.PatternTest import Sound.Tidal.ControlTest import Sound.Tidal.ScalesTest +import Sound.Tidal.StreamTest import Sound.Tidal.UITest import Sound.Tidal.UtilsTest import Sound.Tidal.ExceptionsTest @@ -15,9 +17,11 @@ main = microspec $ do Sound.Tidal.CoreTest.run Sound.Tidal.ParseTest.run + Sound.Tidal.ParamsTest.run Sound.Tidal.PatternTest.run Sound.Tidal.ControlTest.run Sound.Tidal.ScalesTest.run + Sound.Tidal.StreamTest.run Sound.Tidal.UITest.run Sound.Tidal.UtilsTest.run Sound.Tidal.ExceptionsTest.run diff --git a/tidal.cabal b/tidal.cabal --- a/tidal.cabal +++ b/tidal.cabal @@ -1,5 +1,5 @@ name: tidal -version: 1.6.1 +version: 1.7 synopsis: Pattern language for improvised music -- description: homepage: http://tidalcycles.org/ @@ -26,6 +26,8 @@ default-language: Haskell2010 + autogen-modules: Paths_tidal + Exposed-modules: Sound.Tidal.Bjorklund Sound.Tidal.Carabiner Sound.Tidal.Chords @@ -48,6 +50,7 @@ Sound.Tidal.EspGrid -- Sound.Tidal.Light -- Sound.Tidal.TH + Paths_tidal Build-depends: base >=4.8 && <5 , containers < 0.7 @@ -59,7 +62,7 @@ , vector < 0.13 , bifunctors < 5.6 , transformers >= 0.5 && < 0.5.7 - , bytestring < 0.11 + , bytestring < 0.12 , clock < 0.9 , deepseq >= 1.1.0.0 , primitive < 0.8 @@ -78,9 +81,11 @@ ghc-options: -Wall other-modules: Sound.Tidal.ControlTest Sound.Tidal.CoreTest + Sound.Tidal.ParamsTest Sound.Tidal.ParseTest Sound.Tidal.PatternTest Sound.Tidal.ScalesTest + Sound.Tidal.StreamTest Sound.Tidal.UITest Sound.Tidal.UtilsTest Sound.Tidal.ExceptionsTest @@ -88,6 +93,7 @@ build-depends: base ==4.* , microspec >= 0.2.0.1 + , hosc >= 0.17 && < 0.19 , containers , parsec , tidal @@ -115,7 +121,7 @@ base == 4.* , criterion , tidal - ghc-options: -Wall -O2 + ghc-options: -Wall default-language: Haskell2010 @@ -129,7 +135,7 @@ base == 4.* , weigh , tidal - ghc-options: -Wall -O2 + ghc-options: -Wall default-language: Haskell2010 diff --git a/tidal.el b/tidal.el --- a/tidal.el +++ b/tidal.el @@ -66,7 +66,7 @@ ("separator" . "\\") )) ((or (string-equal system-type "darwin") (string-equal system-type "gnu/linux")) - '(("path" . "ghc-pkg field tidal data-dir") + '(("path" . "echo -n data-dir: && ghc -e 'import Paths_tidal' -e 'getDataDir>>=putStr'") ("separator" . "/") )) ) @@ -118,7 +118,6 @@ (interactive) (when (comint-check-proc tidal-buffer) (delete-other-windows) - (split-window-vertically) (with-current-buffer tidal-buffer (let ((window (display-buffer (current-buffer)))) (goto-char (point-max))