{-# Language LambdaCase #-}
-- | Creating Function Tables (Buffers)
module Csound.Tab (
    -- | If you are not familliar with Csound's conventions
    -- you are pobably not aware of the fact that for efficiency reasons Csound requires that table size is equal
    -- to power of 2 or power of two plus one which stands for guard point (you do need guard point if your intention is to read the
    -- table once but you don't need the guard point if you read the table in many cycles, then the guard point is the the first point of your table).
    Tab, noTab,

    -- * Table querries

    nsamp, ftlen, ftsr, ftchnls, ftcps, tabDur,

    -- * Table granularity
    TabFi, fineFi, coarseFi,

    -- * Fill table with numbers
    doubles,

    -- * Create new tables to write/update data

    newTab, newGlobalTab, tabSizeSeconds, tabSizePower2, tabSizeSecondsPower2,

    -- * Read from files
    WavChn(..), Mp3Chn(..),
    wavs, wavAll, wavLeft, wavRight, mp3s, mp3Left, mp3Right, mp3m,
    readNumFile, readTrajectoryFile, readPvocex, readMultichannel,

    -- * (In)Harmonic series
    PartialStrength, PartialNumber, PartialPhase, PartialDC,
    sines, sines3, sines2, sines1, sines4, buzzes, bwSines, bwOddSines,
    mixOnTab, mixTabs,
    tabSines1, tabSines2,

    -- * Wavelets
    waveletTab, rescaleWaveletTab,

    -- ** Special cases
    sine, cosine, sigmoid, sigmoidRise, sigmoidFall, tanhSigmoid,
    triTab, sawTab, sqrTab, pwTab,
    tanhTab, rescaleTanhTab, expTab, rescaleExpTab, soneTab, rescaleSoneTab,
    fareyTab,

    -- * Interpolants
    -- | All funtions have the same shape of arguments:
    --
    -- > fun [a, n1, b, n2, c, ...]
    --
    -- where
    --
    -- * a, b, c .. - are ordinate values
    --
    -- * n1, n2 .. - are lengths of the segments relative to the total number of the points in the table
    --
    -- Csounders, Heads up! all segment lengths are relative to the total sum of the segments.
    -- You don't need to make the sum equal to the number of points in the table. Segment's lengths will be resized
    -- automatically. For example if we want to define a curve that rises to 1 over 25\% of the table and then falls down to zero
    -- we can define it like this:
    --
    -- > lins [0, 0.25, 1, 0.75, 0]
    --
    -- or
    --
    -- > lins [0, 25, 1, 75, 0]
    --
    -- or
    --
    -- > lins [0, 1, 1, 3, 0]
    --
    -- all these expressions are equivalent.
    consts, lins, cubes, exps, splines, startEnds, tabseg, bpLins, bpExps,
    -- ** Equally spaced interpolants
    econsts, elins, ecubes, eexps, esplines, estartEnds, etabseg,

    -- * Polynomials
    polys, chebs1, chebs2, bessels,

    -- * Random values

    -- ** Distributions
    uniDist, linDist, triDist, expDist, biexpDist, gaussDist,
    cauchyDist, pcauchyDist, betaDist, weibullDist, poissonDist,
    tabDist,
    -- *** Distributions with levels
    uniDist', linDist', triDist', expDist', biexpDist', gaussDist',
    cauchyDist', pcauchyDist', betaDist', weibullDist', poissonDist',

    -- ** Rand values and ranges
    randDist, rangeDist,


    -- * Windows
    winHamming, winHanning,  winBartlett, winBlackman,
    winHarris, winGauss, winKaiser, winRectangle, winSync,

    -- * Padsynth
    padsynth, PadsynthSpec(..), PadsynthShape(..), defPadsynthSpec,

    -- * Harmonics
    tabHarmonics,

    -- * Normalize table
    normTab, NormTabSpec(..), scaleTab,

    -- * Low level Csound definition.
    gen,

    -- * Modify tables
    skipNorm, forceNorm, setSize, setDegree, guardPoint, gp,

    -- ** Handy shortcuts
    -- | handy shortcuts for the function 'setDegree'.
    lllofi, llofi, lofi, midfi, hifi, hhifi, hhhifi,

    -- * Identifiers for GEN-routines

    -- | Low level Csound integer identifiers for tables. These names can be used in the function 'Csound.Base.fineFi'
    idWavs, idMp3s, idDoubles, idSines, idSines3, idSines2,
    idPartials, idSines4, idBuzzes, idConsts, idLins, idCubes,
    idExps, idSplines, idStartEnds,  idPolys, idChebs1, idChebs2, idBessels, idWins,
    idPadsynth, idTanh, idExp, idSone, idFarey, idWave,

    -- * Tabular opcodes
    sec2rel,

    -- * Tables of tables
    TabList, tabList, fromTabList, fromTabListD,

    -- * Mic table functions
    tablewa, tablew, readTab, readTable, readTable3, readTablei,

    -- ** Table Reading with Dynamic Selection
    tableikt, tablekt, tablexkt,

    -- ** random generators from tables
    cuserrnd, duserrnd

    -- * Appendix (original GEN identifiers lookup)
    -- | We can find the CE name of the GEN routine by it's integer id.
    --
    -- * GEN01 — wavs, wavLeft, wavRight --  Transfers data from a soundfile into a function table.
    -- * GEN02 — doubles -- Transfers data from immediate pfields into a function table.
    -- * GEN03 — polys --  Generates a stored function table by evaluating a polynomial.
    -- * GEN04 — normTab -- Generates a normalizing function.
    -- * GEN05 — exps -- Constructs functions from segments of exponential curves.
    -- * GEN06 — cubes -- Generates a function comprised of segments of cubic polynomials.
    -- * GEN07 — lins -- Constructs functions from segments of straight lines.
    -- * GEN08 — splines -- Generate a piecewise cubic spline curve.
    -- * GEN09 — sines2, sines3 -- Generate composite waveforms made up of weighted sums of simple sinusoids.
    -- * GEN10 — sines -- Generate composite waveforms made up of weighted sums of simple sinusoids.
    -- * GEN11 — buzzes -- Generates an additive set of cosine partials.
    -- * GEN12 — bessels -- Generates the log of a modified Bessel function of the second kind.
    -- * GEN13 — chebs1 -- Stores a polynomial whose coefficients derive from the Chebyshev polynomials of the first kind.
    -- * GEN14 — chebs2 -- Stores a polynomial whose coefficients derive from Chebyshevs of the second kind.
    -- * GEN15 — (not implemented yet) -- Creates two tables of stored polynomial functions.
    -- * GEN16 — startEnds -- Creates a table from a starting value to an ending value.
    -- * GEN17 — consts -- Creates a step function from given x-y pairs.
    -- * GEN18 — tabseg -- Writes composite waveforms made up of pre-existing waveforms.
    -- * GEN19 — sines4 -- Generate composite waveforms made up of weighted sums of simple sinusoids.
    -- * GEN20 — wins -- Generates functions of different windows.
    -- * GEN21 — dist, uniDist, linDist, triDist, expDist, biexpDist, gaussDist, cauchyDist, pcauchyDist, betaDist, weibullDist, poissonDist -- Generates tables of different random distributions.
    -- * GEN23 — readNumFile -- Reads numeric values from a text file.
    -- * GEN24 — readNumTab --  Reads numeric values from another allocated function-table and rescales them.
    -- * GEN25 — bpExps --  Construct functions from segments of exponential curves in breakpoint fashion.
    -- * GEN27 — bpLins -- Construct functions from segments of straight lines in breakpoint fashion.
    -- * GEN28 — readTrajectoryFile -- Reads a text file which contains a time-tagged trajectory.
    -- * GEN30 — tabHarmonics -- Generates harmonic partials by analyzing an existing table.
    -- * GEN31 — mixOnTab -- Mixes any waveform specified in an existing table.
    -- * GEN32 — mixTabs -- Mixes any waveform, resampled with either FFT or linear interpolation.
    -- * GEN33 — mixSines1 -- Generate composite waveforms by mixing simple sinusoids.
    -- * GEN34 — mixSines2 -- Generate composite waveforms by mixing simple sinusoids.
    -- * GEN40 — tabDist -- Generates a random distribution using a distribution histogram.
    -- * GEN41 — randDist -- Generates a random list of numerical pairs.
    -- * GEN42 — rangeDist Generates a random distribution of discrete ranges of values.
    -- * GEN43 — readPvocex -- Loads a PVOCEX file containing a PV analysis.
    -- * GEN49 — mp3s -- Transfers data from an MP3 soundfile into a function table.
    -- * GEN51 — (see module Csound.Tuning) This subroutine fills a table with a fully customized micro-tuning scale, in the manner of Csound opcodes cpstun, cpstuni and cpstmid.
    -- * GEN52 —  readMultichannel -- Creates an interleaved multichannel table from the specified source tables, in the format expected by the ftconv opcode.
    -- * GENtanh — tanhTab, rescaleTanhTab Generate a table with values on the tanh function.
    -- * GENexp — expTab, rescaleExpTab Generate a table with values on the exp function.
    -- * GENsone — soneTab Generate a table with values of the sone function.
    -- * GENquadbezier — (not implemented yet) Generate a table with values from a quadratic Bézier function.
    -- * GENfarey — fareyTab -- Fills a table with the Farey Sequence Fn of the integer n.
    -- * GENwave — waveletTab -- Generates a compactly supported wavelet function.
    -- * GENpadsynth — pdsynth, bwSines Generate a sample table using the padsynth algorithm.
) where

import Control.Arrow(second)
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader
import Csound.Dynamic hiding (int, when1, whens, genId, pn)

import Data.Default
import Csound.Typed
import Data.Maybe

-- | The default table. It's rendered to @(-1)@ in the Csound.
noTab :: Tab
noTab :: Tab
noTab = E -> Tab
forall a. Val a => E -> a
fromE (-E
1)

{-
-- | Creates a new table. The Tab could be used while the instrument
-- is playing. When the instrument is retriggered the new tab is allocated.
--
-- > newTab size
newTab :: D -> SE Tab
newTab size = ftgentmp 0 0 size 7 0 [size, 0]

-- | Creates a new global table.
-- It's generated only once. It's persisted between instrument calls.
--
-- > newGlobalTab identifier size
newGlobalTab :: D -> SE Tab
newGlobalTab size = do
    identifier <- getNextGlobalGenId
    ref <- newGlobalRef (0 :: D)
    tabId <- ftgenonce 0 (int identifier) size 7 0 [size, 0]
    writeRef ref (fromGE $ toGE tabId)
    fmap (fromGE . toGE) $ readRef ref
-}

-- | Calculates the number of samples needed to store the given amount of seconds.
-- It multiplies the value by the current sample rate.
tabSizeSeconds :: D -> D
tabSizeSeconds :: D -> D
tabSizeSeconds D
x = D
x D -> D -> D
forall a. Num a => a -> a -> a
* D
getSampleRate

-- | Calculates the closest power of two value for a given size.
tabSizePower2 :: D -> D
tabSizePower2 :: D -> D
tabSizePower2 D
x = D
2 D -> D -> D
forall a. Floating a => a -> a -> a
** (D -> D
forall a. SigOrD a => a -> a
ceil' (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ D -> D -> D
forall a. Floating a => a -> a -> a
logBase D
2 D
x)

-- | Calculates the closest power of two value in samples for a given size in seconds.
tabSizeSecondsPower2 :: D -> D
tabSizeSecondsPower2 :: D -> D
tabSizeSecondsPower2 = D -> D
tabSizePower2 (D -> D) -> (D -> D) -> D -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> D
tabSizeSeconds

data WavChn = WavLeft | WavRight | WavAll
    deriving (Int -> WavChn -> ShowS
[WavChn] -> ShowS
WavChn -> String
(Int -> WavChn -> ShowS)
-> (WavChn -> String) -> ([WavChn] -> ShowS) -> Show WavChn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WavChn] -> ShowS
$cshowList :: [WavChn] -> ShowS
show :: WavChn -> String
$cshow :: WavChn -> String
showsPrec :: Int -> WavChn -> ShowS
$cshowsPrec :: Int -> WavChn -> ShowS
Show, WavChn -> WavChn -> Bool
(WavChn -> WavChn -> Bool)
-> (WavChn -> WavChn -> Bool) -> Eq WavChn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WavChn -> WavChn -> Bool
$c/= :: WavChn -> WavChn -> Bool
== :: WavChn -> WavChn -> Bool
$c== :: WavChn -> WavChn -> Bool
Eq)


instance Default WavChn where
    def :: WavChn
def = WavChn
WavAll

fromWavChn :: WavChn -> Int
fromWavChn :: WavChn -> Int
fromWavChn WavChn
x = case WavChn
x of
    WavChn
WavAll   -> Int
0
    WavChn
WavLeft  -> Int
1
    WavChn
WavRight -> Int
2

-- | Loads wav or aiff file to table
--
-- > wavs fileName skipTime channel
--
-- skipTime specifies from what second it should read the file.
--
-- with channel argument we can read left, right or both channels.
wavs :: String -> Double -> WavChn -> Tab
wavs :: String -> Double -> WavChn -> Tab
wavs String
filename Double
skiptime WavChn
channel = TabSize -> Int -> TabArgs -> Tab
preTab (Int -> TabSize
SizePlain Int
0) Int
idWavs
    (String -> [Double] -> TabArgs
FileAccess String
filename [Double
skiptime, Double
format, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ WavChn -> Int
fromWavChn WavChn
channel])
    where format :: Double
format = Double
0

data Mp3Chn = Mp3Mono | Mp3Stereo | Mp3Left | Mp3Right | Mp3All
    deriving (Int -> Mp3Chn -> ShowS
[Mp3Chn] -> ShowS
Mp3Chn -> String
(Int -> Mp3Chn -> ShowS)
-> (Mp3Chn -> String) -> ([Mp3Chn] -> ShowS) -> Show Mp3Chn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mp3Chn] -> ShowS
$cshowList :: [Mp3Chn] -> ShowS
show :: Mp3Chn -> String
$cshow :: Mp3Chn -> String
showsPrec :: Int -> Mp3Chn -> ShowS
$cshowsPrec :: Int -> Mp3Chn -> ShowS
Show, Mp3Chn -> Mp3Chn -> Bool
(Mp3Chn -> Mp3Chn -> Bool)
-> (Mp3Chn -> Mp3Chn -> Bool) -> Eq Mp3Chn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mp3Chn -> Mp3Chn -> Bool
$c/= :: Mp3Chn -> Mp3Chn -> Bool
== :: Mp3Chn -> Mp3Chn -> Bool
$c== :: Mp3Chn -> Mp3Chn -> Bool
Eq)

fromMp3Chn :: Mp3Chn -> Int
fromMp3Chn :: Mp3Chn -> Int
fromMp3Chn Mp3Chn
x = case Mp3Chn
x of
    Mp3Chn
Mp3Mono     -> Int
1
    Mp3Chn
Mp3Stereo   -> Int
2
    Mp3Chn
Mp3Left     -> Int
3
    Mp3Chn
Mp3Right    -> Int
4
    Mp3Chn
Mp3All      -> Int
0

instance Default Mp3Chn where
    def :: Mp3Chn
def = Mp3Chn
Mp3All

-- | Load lossless stereo file to table.
wavAll :: String -> Tab
wavAll :: String -> Tab
wavAll String
name = String -> Double -> WavChn -> Tab
wavs String
name Double
0 WavChn
WavAll

-- | Reads left channel of audio-file
wavLeft :: String -> Tab
wavLeft :: String -> Tab
wavLeft String
file = String -> Double -> WavChn -> Tab
wavs String
file Double
0 WavChn
WavLeft

-- | Reads right channel of audio-file
wavRight :: String -> Tab
wavRight :: String -> Tab
wavRight String
file = String -> Double -> WavChn -> Tab
wavs String
file Double
0 WavChn
WavRight

-- | Loads mp3 file to table:
--
-- > mp3s fileName skipTime format
--
-- skipTime specifies from what second it should read the file.
--
-- format is: 1 - for mono files, 2 - for stereo files, 3 - for left channel of stereo file,
-- 4 for right channel of stereo file
mp3s :: String -> Double -> Mp3Chn -> Tab
mp3s :: String -> Double -> Mp3Chn -> Tab
mp3s String
filename Double
skiptime Mp3Chn
channel = TabSize -> Int -> TabArgs -> Tab
preTab (Int -> TabSize
SizePlain Int
0) Int
idMp3s
    (String -> [Double] -> TabArgs
FileAccess String
filename [Double
skiptime, Double
format])
    where format :: Double
format = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Mp3Chn -> Int
fromMp3Chn Mp3Chn
channel

-- | Reads left channel of mp3-file
mp3Left :: String -> Tab
mp3Left :: String -> Tab
mp3Left String
file = String -> Double -> Mp3Chn -> Tab
mp3s String
file Double
0 Mp3Chn
Mp3Left

-- | Reads right channel of mp3-file
mp3Right :: String -> Tab
mp3Right :: String -> Tab
mp3Right String
file = String -> Double -> Mp3Chn -> Tab
mp3s String
file Double
0 Mp3Chn
Mp3Right

-- | Reads mono of mp3-file
mp3m :: String -> Tab
mp3m :: String -> Tab
mp3m String
file = String -> Double -> Mp3Chn -> Tab
mp3s String
file Double
0 Mp3Chn
Mp3Mono

interp :: Int -> [Double] -> Tab
interp :: Int -> [Double] -> Tab
interp Int
genId [Double]
as = TabSize -> Int -> TabArgs -> Tab
preTab TabSize
forall a. Default a => a
def Int
genId ([Double] -> TabArgs
relativeArgs [Double]
as)

plains :: Int -> [Double] -> Tab
plains :: Int -> [Double] -> Tab
plains Int
genId [Double]
as = TabSize -> Int -> TabArgs -> Tab
preTab TabSize
forall a. Default a => a
def Int
genId (Reader Int [Double] -> TabArgs
ArgsPlain (Reader Int [Double] -> TabArgs) -> Reader Int [Double] -> TabArgs
forall a b. (a -> b) -> a -> b
$ [Double] -> Reader Int [Double]
forall (m :: * -> *) a. Monad m => a -> m a
return [Double]
as)

insertOnes :: [Double] -> [Double]
insertOnes :: [Double] -> [Double]
insertOnes [Double]
xs = case [Double]
xs of
    [] -> []
    Double
a:[] -> [Double
a]
    Double
a:[Double]
as -> Double
a Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: Double
1 Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double] -> [Double]
insertOnes [Double]
as

findTableSize :: Int -> Int
findTableSize :: Int -> Int
findTableSize Int
n
    | Int -> Bool
isPowerOfTwo Int
n        = Int
n
    | Int -> Bool
isPowerOfTwo (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)  = Int
n
    | Bool
otherwise             = -Int
n

isPowerOfTwo :: Int -> Bool
isPowerOfTwo :: Int -> Bool
isPowerOfTwo Int
a
    | [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
zeroes   = Bool
False
    | Bool
otherwise     = (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ( Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) [Int]
zeroes
    where zeroes :: [Int]
zeroes = (Int -> Int) -> [Int] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (\Int
x -> Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
x Int
2) Int
a

-- loadFile :: Int -> String -> Double -> Tab

-- | Table contains all provided values
-- (table is extended to contain all values and to be of the power of 2 or the power of two plus one).
-- (by default it skips normalization).
doubles :: [Double] -> Tab
doubles :: [Double] -> Tab
doubles [Double]
as = Tab -> Tab
skipNorm (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ Int -> Tab -> Tab
setSize (Int -> Int
findTableSize Int
n) (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ Int -> [Double] -> Tab
plains Int
idDoubles [Double]
as
    where n :: Int
n = [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
as

-- | Segments of the exponential curves.
--
-- > exps [a, n1, b, n2, c, ...]
--
-- where
--
-- * @a, b, c, ...@ are ordinate values
--
-- * @n1, n2, ...@  are lengths of the segments relative to the total number of the points in the table
exps :: [Double] -> Tab
exps :: [Double] -> Tab
exps = Int -> [Double] -> Tab
interp Int
idExps

-- | Equally spaced segments of exponential curves.
--
-- > eexps [a, b, c, ...]
--
-- is the same as
--
-- > exps [a, 1, b, 1, c, ...]
eexps :: [Double] -> Tab
eexps :: [Double] -> Tab
eexps = [Double] -> Tab
exps ([Double] -> Tab) -> ([Double] -> [Double]) -> [Double] -> Tab
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> [Double]
insertOnes

-- | Segments of cubic polynomials.
--
-- > cubes [a, n1, b, n2, c, ...]
--
-- where
--
-- * a, b, c .. - are ordinate values
--
-- * @n1, n2, ...@  are lengths of the segments relative to the total number of the points in the table
cubes :: [Double] -> Tab
cubes :: [Double] -> Tab
cubes = Int -> [Double] -> Tab
interp Int
idCubes

-- | Equally spaced segments of cubic polynomials.
--
-- > ecubes [a, b, c, ...]
--
-- is the same as
--
-- > cubes [a, 1, b, 1, c, ...]
ecubes :: [Double] -> Tab
ecubes :: [Double] -> Tab
ecubes = [Double] -> Tab
cubes ([Double] -> Tab) -> ([Double] -> [Double]) -> [Double] -> Tab
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> [Double]
insertOnes

-- | Segments of straight lines.
--
-- > lins [a, n1, b, n2, c, ...]
--
-- where
--
-- * a, b, c .. - are ordinate values
--
-- * @n1, n2, ...@  are lengths of the segments relative to the total number of the points in the table
lins :: [Double] -> Tab
lins :: [Double] -> Tab
lins = Int -> [Double] -> Tab
interp Int
idLins

-- | Equally spaced segments of straight lines.
--
-- > elins [a, b, c, ...]
--
-- is the same as
--
-- > lins [a, 1, b, 1, c, ...]
elins :: [Double] -> Tab
elins :: [Double] -> Tab
elins = [Double] -> Tab
lins ([Double] -> Tab) -> ([Double] -> [Double]) -> [Double] -> Tab
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> [Double]
insertOnes

-- | Cubic spline curve.
--
-- > splines [a, n1, b, n2, c, ...]
--
-- where
--
-- * a, b, c .. - are ordinate values
--
-- * @n1, n2, ...@  are lengths of the segments relative to the total number of the points in the table
splines :: [Double] -> Tab
splines :: [Double] -> Tab
splines = Int -> [Double] -> Tab
interp Int
idSplines

-- | Equally spaced spline curve.
--
-- > esplines [a, b, c, ...]
--
-- is the same as
--
-- > splines [a, 1, b, 1, c, ...]
esplines :: [Double] -> Tab
esplines :: [Double] -> Tab
esplines = [Double] -> Tab
splines ([Double] -> Tab) -> ([Double] -> [Double]) -> [Double] -> Tab
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> [Double]
insertOnes

-- | Constant segments (sample and hold).
--
-- > consts [a, n1, b, n2, c, ...]
--
-- where
--
-- * a, b, c .. - are ordinate values
--
-- * @n1, n2, ...@  are lengths of the segments relative to the total number of the points in the table
consts :: [Double] -> Tab
consts :: [Double] -> Tab
consts = Int -> [Double] -> Tab
interp Int
idConsts

-- | Equally spaced constant segments.
--
-- > econsts [a, b, c, ...]
--
-- is the same as
--
-- > consts [a, 1, b, 1, c, ...]
econsts :: [Double] -> Tab
econsts :: [Double] -> Tab
econsts = [Double] -> Tab
consts ([Double] -> Tab) -> ([Double] -> [Double]) -> [Double] -> Tab
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> [Double]
insertOnes

-- | Creates a table from a starting value to an ending value.
--
-- > startEnds [val1, dur1, type1, val2, dur2, type2, val3, ... typeX, valN]
--
-- * val1, val2 ... -- end points of the segments
--
-- * dur1, dur2 ... -- durations of the segments
--
-- * type1, type2 ... -- if 0, a straight line is produced. If non-zero, then it creates the following curve, for dur steps:
--
-- > beg + (end - beg) * (1 - exp( i*type)) / (1 - exp(type * dur))
--
-- * beg, end - end points of the segment
--
-- * dur - duration of the segment
startEnds :: [Double] -> Tab
startEnds :: [Double] -> Tab
startEnds [Double]
as = TabSize -> Int -> TabArgs -> Tab
preTab TabSize
forall a. Default a => a
def Int
idStartEnds ([Double] -> TabArgs
relativeArgsGen16 [Double]
as)

-- | Equally spaced interpolation for the function @startEnds@
--
-- > estartEnds [val1, type1, val2, typ2, ...]
--
-- is the same as
--
-- > estartEnds [val1, 1, type1, val2, 1, type2, ...]
estartEnds :: [Double] -> Tab
estartEnds :: [Double] -> Tab
estartEnds = [Double] -> Tab
startEnds ([Double] -> Tab) -> ([Double] -> [Double]) -> [Double] -> Tab
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> [Double]
forall a. Num a => [a] -> [a]
insertOnes16
    where
        insertOnes16 :: [a] -> [a]
insertOnes16 [a]
xs = case [a]
xs of
            a
a:a
b:[a]
as  -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
insertOnes16 [a]
as
            [a]
_       -> [a]
xs


-- | Linear segments in breakpoint fashion:
--
-- > bpLins [x1, y1, x2, y2, ..., xN, yN]
--
-- csound docs: <http://www.csounds.com/manual/html/GEN27.html>
--
-- All x1, x2, .. should belong to the interval [0, 1]. The actual values are rescaled to fit the table size.
bpLins :: [Double] -> Tab
bpLins :: [Double] -> Tab
bpLins [Double]
xs = TabSize -> Int -> TabArgs -> Tab
preTab TabSize
forall a. Default a => a
def Int
idLinsBreakPoints (TabArgs -> Tab) -> TabArgs -> Tab
forall a b. (a -> b) -> a -> b
$ [Double] -> TabArgs
bpRelativeArgs [Double]
xs


-- | Exponential segments in breakpoint fashion:
--
-- > bpExps [x1, y1, x2, y2, ..., xN, yN]
--
-- csound docs: <http://www.csounds.com/manual/html/GEN25.html>
--
-- All x1, x2, .. should belong to the interval [0, 1]. The actual values are rescaled to fit the table size.
bpExps :: [Double] -> Tab
bpExps :: [Double] -> Tab
bpExps [Double]
xs = TabSize -> Int -> TabArgs -> Tab
preTab TabSize
forall a. Default a => a
def Int
idExpsBreakPoints (TabArgs -> Tab) -> TabArgs -> Tab
forall a b. (a -> b) -> a -> b
$ [Double] -> TabArgs
bpRelativeArgs [Double]
xs


type PartialNumber = Double
type PartialStrength = Double
type PartialPhase = Double
type PartialDC = Double

-- | Series of harmonic partials:
--
-- > sine = sines [1]
--
-- > saw = sines $ fmap (1 / ) [1 .. 10]
--
-- > square = sines $ fmap (1 / ) [1, 3 .. 11]
--
-- > triangle = sines $ zipWith (\a b -> a / (b ** 2)) (cycle [1, -1]) [1, 3 .. 11]
sines :: [PartialStrength] -> Tab
sines :: [Double] -> Tab
sines = Int -> [Double] -> Tab
plains Int
idSines

-- | Just like 'Csound.Tab.sines2' but partial strength is set to one.
sines1 :: [PartialNumber] -> Tab
sines1 :: [Double] -> Tab
sines1 [Double]
xs = [(Double, Double)] -> Tab
sines2 ([(Double, Double)] -> Tab) -> [(Double, Double)] -> Tab
forall a b. (a -> b) -> a -> b
$ [Double] -> [Double] -> [(Double, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
xs (Double -> [Double]
forall a. a -> [a]
repeat Double
1)

-- | Just like 'Csound.Tab.sines3' but phases are set to zero.
sines2 :: [(PartialNumber, PartialStrength)] -> Tab
sines2 :: [(Double, Double)] -> Tab
sines2 [(Double, Double)]
xs = [(Double, Double, Double)] -> Tab
sines3 [(Double
num, Double
strength, Double
0) | (Double
num, Double
strength) <- [(Double, Double)]
xs]

-- | Specifies series of possibly inharmonic partials.
sines3 :: [(PartialNumber, PartialStrength, PartialPhase)] -> Tab
sines3 :: [(Double, Double, Double)] -> Tab
sines3 [(Double, Double, Double)]
xs = Int -> [Double] -> Tab
plains Int
idSines3 [Double
a | (Double
pn, Double
strength, Double
phs) <- [(Double, Double, Double)]
xs, Double
a <- [Double
pn, Double
strength, Double
phs]]

-- | Specifies series of possibly inharmonic partials with direct current.
sines4 :: [(PartialNumber, PartialStrength, PartialPhase, PartialDC)] -> Tab
sines4 :: [(Double, Double, Double, Double)] -> Tab
sines4 [(Double, Double, Double, Double)]
xs = Int -> [Double] -> Tab
plains Int
idSines4 [Double
a | (Double
pn, Double
strength, Double
phs, Double
dc) <- [(Double, Double, Double, Double)]
xs, Double
a <- [Double
pn, Double
strength, Double
phs, Double
dc]]

-- | Sines with bandwidth (simplified padsynth generator)
--
-- bwSines harmonics bandwidth
bwSines :: [Double] -> Double -> Tab
bwSines :: [Double] -> Double -> Tab
bwSines [Double]
harmonics Double
bandwidth = PadsynthSpec -> Tab
padsynth (Double -> [Double] -> PadsynthSpec
defPadsynthSpec Double
bandwidth [Double]
harmonics)

-- | Sines with bandwidth (simplified padsynth generator). Only odd harmonics are present
--
-- bwOddSines harmonics bandwidth
bwOddSines :: [Double] -> Double -> Tab
bwOddSines :: [Double] -> Double -> Tab
bwOddSines [Double]
harmonics Double
bandwidth = PadsynthSpec -> Tab
padsynth ((Double -> [Double] -> PadsynthSpec
defPadsynthSpec Double
bandwidth [Double]
harmonics) { padsynthHarmonicStretch :: Double
padsynthHarmonicStretch = Double
2 })


-- | Table for pure sine wave.
sine :: Tab
sine :: Tab
sine = [Double] -> Tab
sines [Double
1]

-- | Table for pure cosine wave.
cosine :: Tab
cosine :: Tab
cosine = Double -> [Double] -> Tab
buzzes Double
1 []

-- | Table for sigmoid wave.
sigmoid :: Tab
sigmoid :: Tab
sigmoid = [(Double, Double, Double, Double)] -> Tab
sines4 [(Double
0.5, Double
0.5, Double
270, Double
0.5)]

-- | Table for sigmoid rise wave.
sigmoidRise :: Tab
sigmoidRise :: Tab
sigmoidRise = Tab -> Tab
guardPoint (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ [(Double, Double, Double, Double)] -> Tab
sines4 [(Double
0.5, Double
1, Double
270, Double
1)]

-- | Table for sigmoid fall wave.
sigmoidFall :: Tab
sigmoidFall :: Tab
sigmoidFall = Tab -> Tab
guardPoint (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ [(Double, Double, Double, Double)] -> Tab
sines4 [(Double
0.5, Double
1, Double
90, Double
1)]

-- | Creates tanh sigmoid. The argument is the radius of teh sigmoid.
tanhSigmoid :: Double -> Tab
tanhSigmoid :: Double -> Tab
tanhSigmoid Double
x = [Double] -> Tab
esplines ((Double -> Double) -> [Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Double
forall a. Floating a => a -> a
tanh [-Double
x, (-Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
0.5) .. Double
x])

-- | Generates values similar to the opcode 'Csound.Opcode.Basic.buzz'.
--
-- > buzzes numberOfHarmonics [lowestHarmonic, coefficientOfAttenuation]
--
-- With @buzzes n [l, r]@ you get @n@ harmonics from @l@ that are attenuated by the factor of @r@
-- on each step.
buzzes :: Double -> [Double] -> Tab
buzzes :: Double -> [Double] -> Tab
buzzes Double
nh [Double]
opts = Int -> [Double] -> Tab
plains Int
idBuzzes (Double
nh Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
2 [Double]
opts)

-- | Modified Bessel function of the second kind, order 0 (for amplitude modulated FM).
--
-- > bessels xint
--
-- the function is defined within the interval @[0, xint]@.
bessels :: Double -> Tab
bessels :: Double -> Tab
bessels Double
xint = Int -> [Double] -> Tab
plains Int
idBessels [Double
xint]

-- | Polynomials.
--
-- > polys xl xr [c0, c1, c2, ..]
--
-- where
--
-- * xl, xr - left and right values of the interval over wich polynomial is defined
--
-- * [c0, c1, c2, ...] -- coefficients of the polynomial
--
-- > c0 + c1 * x + c2 * x * x + ...
polys :: Double -> Double -> [Double] -> Tab
polys :: Double -> Double -> [Double] -> Tab
polys Double
x0 Double
x1 [Double]
cs = Int -> [Double] -> Tab
plains Int
idPolys (Double
x0Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
:Double
x1Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
:[Double]
cs)

-- | Chebyshev polynomials of the first kind.
--
-- > polys xl xr [h0, h1, h2, ..]
--
-- where
--
-- * xl, xr - left and right values of the interval over wich polynomial is defined
--
-- * [h0, h1, h2, ...] -- relative strength of the partials
chebs1 :: Double -> Double -> [Double] -> Tab
chebs1 :: Double -> Double -> [Double] -> Tab
chebs1 Double
xint Double
xamp [Double]
hs = Int -> [Double] -> Tab
plains Int
idChebs1 (Double
xint Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: Double
xamp Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double]
hs)

-- | Chebyshev polynomials of the second kind.
--
-- > polys xl xr [h0, h1, h2, ..]
--
-- where
--
-- * xl, xr - left and right values of the interval over wich polynomial is defined
--
-- * [h0, h1, h2, ...] -- relative strength of the partials
chebs2 :: Double -> Double -> [Double] -> Tab
chebs2 :: Double -> Double -> [Double] -> Tab
chebs2 Double
xint Double
xamp [Double]
hs = Int -> [Double] -> Tab
plains Int
idChebs2 (Double
xint Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: Double
xamp Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double]
hs)

-- | The Hamming window. The peak equals to 1.
winHamming :: Tab
winHamming :: Tab
winHamming      = WinType -> [Double] -> Tab
wins WinType
Hamming [Double
1]

-- | The Hanning window. The peak equals to 1.
winHanning :: Tab
winHanning :: Tab
winHanning      = WinType -> [Double] -> Tab
wins WinType
Hanning [Double
1]

-- | The Bartlett window. The peak equals to 1.
winBartlett :: Tab
winBartlett :: Tab
winBartlett     = WinType -> [Double] -> Tab
wins WinType
Bartlett [Double
1]


-- | The Blackman window. The peak equals to 1.
winBlackman :: Tab
winBlackman :: Tab
winBlackman     = WinType -> [Double] -> Tab
wins WinType
Blackman [Double
1]

-- | The Harris window. The peak equals to 1.
winHarris :: Tab
winHarris :: Tab
winHarris       = WinType -> [Double] -> Tab
wins WinType
Harris [Double
1]

-- | The Rectangle window. The peak equals to 1.
winRectangle :: Tab
winRectangle :: Tab
winRectangle    = WinType -> [Double] -> Tab
wins WinType
Rectangle [Double
1]

-- | The Sync window. The peak equals to 1.
winSync :: Tab
winSync :: Tab
winSync         = WinType -> [Double] -> Tab
wins WinType
Sync [Double
1]

-- | This creates a function that contains a Gaussian window with a maximum value of 1.
-- The extra argument specifies how broad the window is, as the standard deviation of the curve;
-- in this example the s.d. is 2. The default value is 1.
--
-- > winGauss 2
winGauss :: Double -> Tab
winGauss :: Double -> Tab
winGauss Double
a = WinType -> [Double] -> Tab
wins WinType
Gaussian [Double
1, Double
a]

-- | This creates a function that contains a Kaiser window with a maximum value of 1.
-- The extra argument specifies how "open" the window is, for example a value of 0 results
-- in a rectangular window and a value of 10 in a Hamming like window.
--
-- > winKaiser openness
winKaiser :: Double -> Tab
winKaiser :: Double -> Tab
winKaiser Double
openness = WinType -> [Double] -> Tab
wins WinType
Kaiser [Double
1, Double
openness]

data WinType
    = Hamming | Hanning | Bartlett | Blackman
    | Harris | Gaussian | Kaiser | Rectangle | Sync

winTypeId :: WinType -> Double
winTypeId :: WinType -> Double
winTypeId WinType
x = case WinType
x of
    WinType
Hamming     -> Double
1
    WinType
Hanning     -> Double
2
    WinType
Bartlett    -> Double
3
    WinType
Blackman    -> Double
4
    WinType
Harris      -> Double
5
    WinType
Gaussian    -> Double
6
    WinType
Kaiser      -> Double
7
    WinType
Rectangle   -> Double
8
    WinType
Sync        -> Double
9

wins :: WinType -> [Double] -> Tab
wins :: WinType -> [Double] -> Tab
wins WinType
ty [Double]
params = Int -> [Double] -> Tab
gen Int
idWins (WinType -> Double
winTypeId WinType
ty Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double]
params)

-- | Padsynth parameters.
--
-- see for details: <http://csound.github.io/docs/manual/GENpadsynth.html>
data PadsynthSpec = PadsynthSpec
    { PadsynthSpec -> Double
padsynthFundamental     :: Double
    , PadsynthSpec -> Double
padsynthBandwidth       :: Double
    , PadsynthSpec -> Double
padsynthPartialScale    :: Double
    , PadsynthSpec -> Double
padsynthHarmonicStretch :: Double
    , PadsynthSpec -> PadsynthShape
padsynthShape           :: PadsynthShape
    , PadsynthSpec -> Double
padsynthShapeParameter  :: Double
    , PadsynthSpec -> [Double]
padsynthHarmonics       :: [Double]
    } deriving (Int -> PadsynthSpec -> ShowS
[PadsynthSpec] -> ShowS
PadsynthSpec -> String
(Int -> PadsynthSpec -> ShowS)
-> (PadsynthSpec -> String)
-> ([PadsynthSpec] -> ShowS)
-> Show PadsynthSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PadsynthSpec] -> ShowS
$cshowList :: [PadsynthSpec] -> ShowS
show :: PadsynthSpec -> String
$cshow :: PadsynthSpec -> String
showsPrec :: Int -> PadsynthSpec -> ShowS
$cshowsPrec :: Int -> PadsynthSpec -> ShowS
Show, PadsynthSpec -> PadsynthSpec -> Bool
(PadsynthSpec -> PadsynthSpec -> Bool)
-> (PadsynthSpec -> PadsynthSpec -> Bool) -> Eq PadsynthSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PadsynthSpec -> PadsynthSpec -> Bool
$c/= :: PadsynthSpec -> PadsynthSpec -> Bool
== :: PadsynthSpec -> PadsynthSpec -> Bool
$c== :: PadsynthSpec -> PadsynthSpec -> Bool
Eq)

data PadsynthShape = GaussShape | SquareShape | ExpShape
    deriving (Int -> PadsynthShape -> ShowS
[PadsynthShape] -> ShowS
PadsynthShape -> String
(Int -> PadsynthShape -> ShowS)
-> (PadsynthShape -> String)
-> ([PadsynthShape] -> ShowS)
-> Show PadsynthShape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PadsynthShape] -> ShowS
$cshowList :: [PadsynthShape] -> ShowS
show :: PadsynthShape -> String
$cshow :: PadsynthShape -> String
showsPrec :: Int -> PadsynthShape -> ShowS
$cshowsPrec :: Int -> PadsynthShape -> ShowS
Show, PadsynthShape -> PadsynthShape -> Bool
(PadsynthShape -> PadsynthShape -> Bool)
-> (PadsynthShape -> PadsynthShape -> Bool) -> Eq PadsynthShape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PadsynthShape -> PadsynthShape -> Bool
$c/= :: PadsynthShape -> PadsynthShape -> Bool
== :: PadsynthShape -> PadsynthShape -> Bool
$c== :: PadsynthShape -> PadsynthShape -> Bool
Eq, Eq PadsynthShape
Eq PadsynthShape
-> (PadsynthShape -> PadsynthShape -> Ordering)
-> (PadsynthShape -> PadsynthShape -> Bool)
-> (PadsynthShape -> PadsynthShape -> Bool)
-> (PadsynthShape -> PadsynthShape -> Bool)
-> (PadsynthShape -> PadsynthShape -> Bool)
-> (PadsynthShape -> PadsynthShape -> PadsynthShape)
-> (PadsynthShape -> PadsynthShape -> PadsynthShape)
-> Ord PadsynthShape
PadsynthShape -> PadsynthShape -> Bool
PadsynthShape -> PadsynthShape -> Ordering
PadsynthShape -> PadsynthShape -> PadsynthShape
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PadsynthShape -> PadsynthShape -> PadsynthShape
$cmin :: PadsynthShape -> PadsynthShape -> PadsynthShape
max :: PadsynthShape -> PadsynthShape -> PadsynthShape
$cmax :: PadsynthShape -> PadsynthShape -> PadsynthShape
>= :: PadsynthShape -> PadsynthShape -> Bool
$c>= :: PadsynthShape -> PadsynthShape -> Bool
> :: PadsynthShape -> PadsynthShape -> Bool
$c> :: PadsynthShape -> PadsynthShape -> Bool
<= :: PadsynthShape -> PadsynthShape -> Bool
$c<= :: PadsynthShape -> PadsynthShape -> Bool
< :: PadsynthShape -> PadsynthShape -> Bool
$c< :: PadsynthShape -> PadsynthShape -> Bool
compare :: PadsynthShape -> PadsynthShape -> Ordering
$ccompare :: PadsynthShape -> PadsynthShape -> Ordering
$cp1Ord :: Eq PadsynthShape
Ord, Int -> PadsynthShape
PadsynthShape -> Int
PadsynthShape -> [PadsynthShape]
PadsynthShape -> PadsynthShape
PadsynthShape -> PadsynthShape -> [PadsynthShape]
PadsynthShape -> PadsynthShape -> PadsynthShape -> [PadsynthShape]
(PadsynthShape -> PadsynthShape)
-> (PadsynthShape -> PadsynthShape)
-> (Int -> PadsynthShape)
-> (PadsynthShape -> Int)
-> (PadsynthShape -> [PadsynthShape])
-> (PadsynthShape -> PadsynthShape -> [PadsynthShape])
-> (PadsynthShape -> PadsynthShape -> [PadsynthShape])
-> (PadsynthShape
    -> PadsynthShape -> PadsynthShape -> [PadsynthShape])
-> Enum PadsynthShape
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PadsynthShape -> PadsynthShape -> PadsynthShape -> [PadsynthShape]
$cenumFromThenTo :: PadsynthShape -> PadsynthShape -> PadsynthShape -> [PadsynthShape]
enumFromTo :: PadsynthShape -> PadsynthShape -> [PadsynthShape]
$cenumFromTo :: PadsynthShape -> PadsynthShape -> [PadsynthShape]
enumFromThen :: PadsynthShape -> PadsynthShape -> [PadsynthShape]
$cenumFromThen :: PadsynthShape -> PadsynthShape -> [PadsynthShape]
enumFrom :: PadsynthShape -> [PadsynthShape]
$cenumFrom :: PadsynthShape -> [PadsynthShape]
fromEnum :: PadsynthShape -> Int
$cfromEnum :: PadsynthShape -> Int
toEnum :: Int -> PadsynthShape
$ctoEnum :: Int -> PadsynthShape
pred :: PadsynthShape -> PadsynthShape
$cpred :: PadsynthShape -> PadsynthShape
succ :: PadsynthShape -> PadsynthShape
$csucc :: PadsynthShape -> PadsynthShape
Enum)

padsynthShapeId :: PadsynthShape -> Double
padsynthShapeId :: PadsynthShape -> Double
padsynthShapeId PadsynthShape
shape = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (PadsynthShape -> Int
forall a. Enum a => a -> Int
fromEnum PadsynthShape
shape)

-- | Specs for padsynth algorithm:
--
-- > defPadsynthSpec partialBandwidth harmonics
--
-- * partialBandwidth -- bandwidth of the first partial.
--
-- * harmonics -- the list of amplitudes for harmonics.
defPadsynthSpec :: Double -> [Double] -> PadsynthSpec
defPadsynthSpec :: Double -> [Double] -> PadsynthSpec
defPadsynthSpec Double
partialBW [Double]
harmonics = Double
-> Double
-> Double
-> Double
-> PadsynthShape
-> Double
-> [Double]
-> PadsynthSpec
PadsynthSpec Double
261.625565 Double
partialBW Double
1 Double
1 PadsynthShape
GaussShape Double
1 [Double]
harmonics

-- | Creates tables for the padsynth algorithm (described at <http://www.paulnasca.com/algorithms-created-by-me>).
-- The table size should be very big the default is 18 power of 2.
--
-- csound docs: <http://csound.github.io/docs/manual/GENpadsynth.html>
padsynth :: PadsynthSpec -> Tab
padsynth :: PadsynthSpec -> Tab
padsynth (PadsynthSpec Double
fundamentalFreq Double
partialBW Double
partialScale Double
harmonicStretch PadsynthShape
shape Double
shapeParameter [Double]
harmonics) =
    String -> [Double] -> Tab
plainStringTab String
idPadsynth ([Double
fundamentalFreq, Double
partialBW, Double
partialScale, Double
harmonicStretch, PadsynthShape -> Double
padsynthShapeId PadsynthShape
shape, Double
shapeParameter] [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ [Double]
harmonics)

                                    -- 261.625565     25.0         1.0             1.0             2.0                 1.0             1.0 0.5 0.0 0.2

plainStringTab :: String -> [Double] -> Tab
plainStringTab :: String -> [Double] -> Tab
plainStringTab String
genId [Double]
as = TabSize -> String -> TabArgs -> Tab
preStringTab TabSize
forall a. Default a => a
def String
genId (Reader Int [Double] -> TabArgs
ArgsPlain (Reader Int [Double] -> TabArgs) -> Reader Int [Double] -> TabArgs
forall a b. (a -> b) -> a -> b
$ [Double] -> Reader Int [Double]
forall (m :: * -> *) a. Monad m => a -> m a
return [Double]
as)

-- | Creates a table of doubles (It's f-table in Csound).
-- Arguments are:
--
-- * identificator of the GEN routine
--
-- * GEN routine arguments
--
-- All tables are created at 0 and memory is never released.
gen :: Int -> [Double] -> Tab
gen :: Int -> [Double] -> Tab
gen Int
genId [Double]
args = TabSize -> Int -> TabArgs -> Tab
preTab TabSize
forall a. Default a => a
def Int
genId (Reader Int [Double] -> TabArgs
ArgsPlain (Reader Int [Double] -> TabArgs) -> Reader Int [Double] -> TabArgs
forall a b. (a -> b) -> a -> b
$ [Double] -> Reader Int [Double]
forall (m :: * -> *) a. Monad m => a -> m a
return [Double]
args)

-- | Adds guard point to the table size (details of the interpolation schemes: you do need guard point if your intention is to read the
-- table once but you don't need the guard point if you read table in many cycles, the guard point is the the first point of your table).
guardPoint :: Tab -> Tab
guardPoint :: Tab -> Tab
guardPoint = (TabSize -> TabSize) -> Tab -> Tab
updateTabSize ((TabSize -> TabSize) -> Tab -> Tab)
-> (TabSize -> TabSize) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ \TabSize
x -> case TabSize
x of
    SizePlain Int
n -> Int -> TabSize
SizePlain (Int -> TabSize) -> Int -> TabSize
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall p. Integral p => p -> p
plainGuardPoint Int
n
    TabSize
a -> TabSize
a{ hasGuardPoint :: Bool
hasGuardPoint = Bool
True }
    where plainGuardPoint :: p -> p
plainGuardPoint p
n
            | p -> Bool
forall a. Integral a => a -> Bool
even p
n    = p
n p -> p -> p
forall a. Num a => a -> a -> a
+ p
1
            | Bool
otherwise = p
n

-- | Shortcut for 'Csound.Tab.guardPoint'.
gp :: Tab -> Tab
gp :: Tab -> Tab
gp = Tab -> Tab
guardPoint

-- | Sets an absolute size value. As you can do it in the Csound files.
setSize :: Int -> Tab -> Tab
setSize :: Int -> Tab -> Tab
setSize Int
n = (TabSize -> TabSize) -> Tab -> Tab
updateTabSize ((TabSize -> TabSize) -> Tab -> Tab)
-> (TabSize -> TabSize) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ TabSize -> TabSize -> TabSize
forall a b. a -> b -> a
const (Int -> TabSize
SizePlain Int
n)

-- | Sets the relative size value. You can set the base value in the options
-- (see 'Csound.Base.tabResolution' at 'Csound.Base.CsdOptions', with tabResolution you can easily change table sizes for all your tables).
-- Here zero means the base value. 1 is the base value multiplied by 2, 2 is the base value multiplied by 4
-- and so on. Negative values mean division by the specified degree.
setDegree :: Int -> Tab -> Tab
setDegree :: Int -> Tab -> Tab
setDegree Int
degree = (TabSize -> TabSize) -> Tab -> Tab
updateTabSize ((TabSize -> TabSize) -> Tab -> Tab)
-> (TabSize -> TabSize) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ \TabSize
x -> case TabSize
x of
    SizePlain Int
n -> Int -> TabSize
SizePlain Int
n
    TabSize
a -> TabSize
a{ sizeDegree :: Int
sizeDegree = Int
degree }

-- | Sets degrees from -3 to 3.
lllofi, llofi, lofi, midfi, hifi, hhifi, hhhifi :: Tab -> Tab

lllofi :: Tab -> Tab
lllofi  = Int -> Tab -> Tab
setDegree (-Int
3)
llofi :: Tab -> Tab
llofi   = Int -> Tab -> Tab
setDegree (-Int
2)
lofi :: Tab -> Tab
lofi    = Int -> Tab -> Tab
setDegree (-Int
1)
midfi :: Tab -> Tab
midfi   = Int -> Tab -> Tab
setDegree Int
0
hifi :: Tab -> Tab
hifi    = Int -> Tab -> Tab
setDegree Int
1
hhifi :: Tab -> Tab
hhifi   = Int -> Tab -> Tab
setDegree Int
2
hhhifi :: Tab -> Tab
hhhifi  = Int -> Tab -> Tab
setDegree Int
3

-- | Writes tables in sequential locations.
--
-- This opcode writes to a table in sequential locations to and from an a-rate
-- variable. Some thought is required before using it. It has at least two major,
-- and quite different, applications which are discussed below.
--
-- > kstart tablewa kfn, asig, koff
--
-- csound docs: <http://www.csounds.com/manual/html/tablewa.html>
tablewa ::  Tab -> Sig -> Sig -> SE Sig
tablewa :: Tab -> Sig -> Sig -> SE Sig
tablewa Tab
b1 Sig
b2 Sig
b3 = (E -> Sig) -> SE E -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GE E -> Sig
Sig (GE E -> Sig) -> (E -> GE E) -> E -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E -> GE E
forall (m :: * -> *) a. Monad m => a -> m a
return) (SE E -> SE Sig) -> SE E -> SE Sig
forall a b. (a -> b) -> a -> b
$ Dep E -> SE E
forall a. Dep a -> SE a
SE (Dep E -> SE E) -> Dep E -> SE E
forall a b. (a -> b) -> a -> b
$ (E -> Dep E
forall (m :: * -> *). Monad m => E -> DepT m E
depT (E -> Dep E) -> Dep E -> Dep E
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep E) -> Dep E -> Dep E
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E
f (E -> E -> E -> E) -> GE E -> GE (E -> E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tab -> GE E
unTab Tab
b1 GE (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b2 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b3
    where f :: E -> E -> E -> E
f E
a1 E
a2 E
a3 = String -> Spec1 -> [E] -> E
opcs String
"tablewa" [(Rate
Kr,[Rate
Kr,Rate
Ar,Rate
Kr])] [E
a1,E
a2,E
a3]


-- | Transforms phasor that is defined in seconds to relative phasor that ranges in 0 to 1.
sec2rel :: Tab -> Sig -> Sig
sec2rel :: Tab -> Sig -> Sig
sec2rel Tab
tab Sig
x = Sig
x Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Tab -> D
ftlen Tab
tab D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
getSampleRate)

-- | Table length in seconds for files that are read with GEN01
-- (which a re read with functions like wavs, wavTab, wavLeft, wavRight).
tabDur :: Tab -> D
tabDur :: Tab -> D
tabDur Tab
t = Tab -> D
ftlen Tab
t D -> D -> D
forall a. Fractional a => a -> a -> a
/ (Tab -> D
ftsr Tab
t D -> D -> D
forall a. Num a => a -> a -> a
* Tab -> D
ftchnls Tab
t)

---------------------------------------------------

-- | Generates harmonic partials by analyzing an existing table.
--
-- > tabHarmonics src minh maxh [ref_sr] [interp]
--
-- * src -- source ftable. It should be primitive ie constructed not with "ftgen" family of opcodes.
--
-- * minh -- lowest harmonic number
--
-- * maxh -- maxh -- highest harmonic number
--
-- * ref_sr (optional) -- maxh is scaled by (sr / ref_sr). The default value of ref_sr is sr. If ref_sr is zero or negative, it is now ignored.
--
-- * interp (optional) -- if non-zero, allows changing the amplitude of the lowest and highest harmonic partial depending on the fractional part of minh and maxh. For example, if maxh is 11.3 then the 12th harmonic partial is added with 0.3 amplitude. This parameter is zero by default.
--
-- GEN30 for Csound: <http://www.csounds.com/manual/html/GEN30.html>
--
tabHarmonics :: Tab -> Double -> Double -> Maybe Double -> Maybe Double -> Tab
tabHarmonics :: Tab -> Double -> Double -> Maybe Double -> Maybe Double -> Tab
tabHarmonics Tab
tab Double
minh Double
maxh Maybe Double
mrefSr Maybe Double
mInterp = GE Tab -> Tab
forall a. Val a => GE a -> a
hideGE (GE Tab -> Tab) -> GE Tab -> Tab
forall a b. (a -> b) -> a -> b
$ do
    Int
idx <- Tab -> GE Int
renderTab Tab
tab
    Tab -> GE Tab
forall (m :: * -> *) a. Monad m => a -> m a
return (Tab -> GE Tab) -> Tab -> GE Tab
forall a b. (a -> b) -> a -> b
$ TabSize -> Int -> TabArgs -> Tab
preTab TabSize
forall a. Default a => a
def Int
idTabHarmonics (Reader Int [Double] -> TabArgs
ArgsPlain (Reader Int [Double] -> TabArgs) -> Reader Int [Double] -> TabArgs
forall a b. (a -> b) -> a -> b
$ [Double] -> Reader Int [Double]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe Double] -> [Double]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Double] -> [Double]) -> [Maybe Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ (Double -> Maybe Double) -> [Double] -> [Maybe Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Maybe Double
forall a. a -> Maybe a
Just [Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx, Double
minh, Double
maxh] [Maybe Double] -> [Maybe Double] -> [Maybe Double]
forall a. [a] -> [a] -> [a]
++ [Maybe Double
mrefSr, Maybe Double
mInterp]))

---------------------------------
-- mixing tabs GEN31 GEN32

-- | It's just like sines3 but inplace of pure sinewave it uses supplied in the first argument shape.
--
-- mixOnTab srcTable [(partialNumber, partialStrength, partialPahse)]
--
-- phahse is in range [0, 1]
mixOnTab :: Tab -> [(PartialNumber, PartialStrength, PartialPhase)] -> Tab
mixOnTab :: Tab -> [(Double, Double, Double)] -> Tab
mixOnTab Tab
tab [(Double, Double, Double)]
xs = GE Tab -> Tab
forall a. Val a => GE a -> a
hideGE (GE Tab -> Tab) -> GE Tab -> Tab
forall a b. (a -> b) -> a -> b
$ do
    Int
idx <- Tab -> GE Int
renderTab Tab
tab
    Tab -> GE Tab
forall (m :: * -> *) a. Monad m => a -> m a
return (Tab -> GE Tab) -> Tab -> GE Tab
forall a b. (a -> b) -> a -> b
$ Int -> [Double] -> Tab
plains Int
idMixOnTab ([Double] -> Tab) -> [Double] -> Tab
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double
a | (Double
pn, Double
strength, Double
phs) <- [(Double, Double, Double)]
xs, Double
a <- [Double
pn, Double
strength, Double
phs]]

-- | It's like @mixOnTab@ but it's more generic since we can mix not only one shape.
-- But we can specify shape for each harmonic.
mixTabs  :: [(Tab, PartialNumber, PartialStrength, PartialPhase)] -> Tab
mixTabs :: [(Tab, Double, Double, Double)] -> Tab
mixTabs [(Tab, Double, Double, Double)]
xs = GE Tab -> Tab
forall a. Val a => GE a -> a
hideGE (GE Tab -> Tab) -> GE Tab -> Tab
forall a b. (a -> b) -> a -> b
$ do
    [Double]
args <- [GE Double] -> GE [Double]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [GE Double
a | (Tab
tab, Double
pn, Double
strength, Double
phs) <- [(Tab, Double, Double, Double)]
xs, GE Double
a <- ((Int -> Double) -> GE Int -> GE Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GE Int -> GE Double) -> GE Int -> GE Double
forall a b. (a -> b) -> a -> b
$ Tab -> GE Int
renderTab Tab
tab) GE Double -> [GE Double] -> [GE Double]
forall a. a -> [a] -> [a]
: (Double -> GE Double) -> [Double] -> [GE Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> GE Double
forall (m :: * -> *) a. Monad m => a -> m a
return [Double
pn, Double
strength, Double
phs]]
    Tab -> GE Tab
forall (m :: * -> *) a. Monad m => a -> m a
return (Tab -> GE Tab) -> Tab -> GE Tab
forall a b. (a -> b) -> a -> b
$ Int -> [Double] -> Tab
plains Int
idMixTabs [Double]
args

-- | Normalizing table
--
-- Csound GEN04: <http://www.csounds.com/manual/html/GEN04.html>
normTab :: NormTabSpec -> Tab -> Tab
normTab :: NormTabSpec -> Tab -> Tab
normTab NormTabSpec
spec Tab
tab = GE Tab -> Tab
forall a. Val a => GE a -> a
hideGE (GE Tab -> Tab) -> GE Tab -> Tab
forall a b. (a -> b) -> a -> b
$ do
    Int
idx <- Tab -> GE Int
renderTab Tab
tab
    Tab -> GE Tab
forall (m :: * -> *) a. Monad m => a -> m a
return (Tab -> GE Tab) -> Tab -> GE Tab
forall a b. (a -> b) -> a -> b
$ Int -> [Double] -> Tab
plains Int
idNormTab ([Double] -> Tab) -> [Double] -> Tab
forall a b. (a -> b) -> a -> b
$ (Int -> Double) -> [Int] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int
idx, NormTabSpec -> Int
forall p. Num p => NormTabSpec -> p
fromNormTabSpec NormTabSpec
spec]
    where
        fromNormTabSpec :: NormTabSpec -> p
fromNormTabSpec NormTabSpec
x = case NormTabSpec
x of
            NormTabSpec
ScanLeftToRight -> p
0
            NormTabSpec
ScanFromMiddle  -> p
1

data NormTabSpec = ScanLeftToRight | ScanFromMiddle

-- | Creates a new table wich contains all values from the source table rescaled to the given interval.
--
-- > scaleTab (minValue, maxValue) sourceTab
scaleTab :: (Double, Double) -> Tab -> Tab
scaleTab :: (Double, Double) -> Tab -> Tab
scaleTab (Double
minVal, Double
maxVal) Tab
tab = GE Tab -> Tab
forall a. Val a => GE a -> a
hideGE (GE Tab -> Tab) -> GE Tab -> Tab
forall a b. (a -> b) -> a -> b
$ do
    Int
tabId <- Tab -> GE Int
renderTab Tab
tab
    Tab -> GE Tab
forall (m :: * -> *) a. Monad m => a -> m a
return (Tab -> GE Tab) -> Tab -> GE Tab
forall a b. (a -> b) -> a -> b
$ Tab -> Tab
skipNorm (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ Int -> [Double] -> Tab
gen Int
idReadNumTab [Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tabId, Double
minVal, Double
maxVal]

----------------------------------------------------

-- | tabseg  -- Writes composite waveforms made up of pre-existing waveforms.
--
-- tabseg [(tab, amplitude, duration)]
--
-- Csound GEN18: <http://www.csounds.com/manual/html/GEN18.html>
--
-- Butnotice the difference with Csound we specify start and finish of writing but
-- here we only specify the relative length of segments. Segments are arranged so
-- that the start f next segment comes right after the end of the prev segment.
tabseg :: [(Tab, PartialStrength, Double)] -> Tab
tabseg :: [(Tab, Double, Double)] -> Tab
tabseg [(Tab, Double, Double)]
xs = GE Tab -> Tab
forall a. Val a => GE a -> a
hideGE (GE Tab -> Tab) -> GE Tab -> Tab
forall a b. (a -> b) -> a -> b
$ do
    [Int]
tabIds <- (Tab -> GE Int) -> [Tab] -> GE [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Tab -> GE Int
renderTab [Tab]
tabs
    Tab -> GE Tab
forall (m :: * -> *) a. Monad m => a -> m a
return (Tab -> GE Tab) -> Tab -> GE Tab
forall a b. (a -> b) -> a -> b
$ TabSize -> Int -> TabArgs -> Tab
preTab TabSize
forall a. Default a => a
def Int
idLinTab (TabArgs -> Tab) -> TabArgs -> Tab
forall a b. (a -> b) -> a -> b
$ [Int] -> TabArgs
forall a. Integral a => [a] -> TabArgs
mkArgs [Int]
tabIds
    where
        ([Tab]
tabs, [Double]
amps, [Double]
durs) = [(Tab, Double, Double)] -> ([Tab], [Double], [Double])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(Tab, Double, Double)]
xs
        segments :: a -> [(Double, Double)]
segments a
n = ((Double, Double) -> (Double, Double))
-> [(Double, Double)] -> [(Double, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Double) -> (Double, Double) -> (Double, Double)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Double -> Double) -> (Double, Double) -> (Double, Double))
-> (Double -> Double) -> (Double, Double) -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ \Double
x -> Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) ([(Double, Double)] -> [(Double, Double)])
-> [(Double, Double)] -> [(Double, Double)]
forall a b. (a -> b) -> a -> b
$ [(Double, Double)] -> [(Double, Double)]
forall a. [a] -> [a]
tail ([(Double, Double)] -> [(Double, Double)])
-> [(Double, Double)] -> [(Double, Double)]
forall a b. (a -> b) -> a -> b
$ ((Double, Double) -> Double -> (Double, Double))
-> (Double, Double) -> [Double] -> [(Double, Double)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\(Double
_, Double
b) Double
x -> (Double
b, Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x)) (Double
0, Double
0) ([Double] -> [(Double, Double)]) -> [Double] -> [(Double, Double)]
forall a b. (a -> b) -> a -> b
$ a -> [Double] -> [Double]
forall (t :: * -> *) b a.
(Functor t, Foldable t, RealFrac b, Integral a) =>
a -> t b -> t Double
mkRelative a
n [Double]
durs
        mkArgs :: [a] -> TabArgs
mkArgs [a]
ids = Reader Int [Double] -> TabArgs
ArgsPlain (Reader Int [Double] -> TabArgs) -> Reader Int [Double] -> TabArgs
forall a b. (a -> b) -> a -> b
$ (Int -> [Double]) -> Reader Int [Double]
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader ((Int -> [Double]) -> Reader Int [Double])
-> (Int -> [Double]) -> Reader Int [Double]
forall a b. (a -> b) -> a -> b
$ \Int
size -> [[Double]] -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Double]] -> [Double]) -> [[Double]] -> [Double]
forall a b. (a -> b) -> a -> b
$ (a -> Double -> (Double, Double) -> [Double])
-> [a] -> [Double] -> [(Double, Double)] -> [[Double]]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\a
tabId Double
amp (Double
start, Double
finish) -> [a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
tabId, Double
amp, Double
start, Double
finish]) [a]
ids [Double]
amps (Int -> [(Double, Double)]
forall a. Integral a => a -> [(Double, Double)]
segments Int
size)

etabseg :: [(Tab, PartialStrength)] -> Tab
etabseg :: [(Tab, Double)] -> Tab
etabseg = [(Tab, Double, Double)] -> Tab
tabseg ([(Tab, Double, Double)] -> Tab)
-> ([(Tab, Double)] -> [(Tab, Double, Double)])
-> [(Tab, Double)]
-> Tab
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Tab, Double) -> (Tab, Double, Double))
-> [(Tab, Double)] -> [(Tab, Double, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Tab
tab, Double
amp) -> (Tab
tab, Double
amp, Double
1))

--------------------------------------------------
-- distributions


{- Csound Docs, distribution types

    1 = Uniform (positive numbers only)

    2 = Linear (positive numbers only)

    3 = Triangular (positive and negative numbers)

    4 = Exponential (positive numbers only)

    5 = Biexponential (positive and negative numbers)

    6 = Gaussian (positive and negative numbers)

    7 = Cauchy (positive and negative numbers)

    8 = Positive Cauchy (positive numbers only)

    9 = Beta (positive numbers only)

    10 = Weibull (positive numbers only)

    11 = Poisson (positive numbers only)
-}

gen21 :: Int -> [Double] -> Tab
gen21 :: Int -> [Double] -> Tab
gen21 Int
typeId [Double]
aux = Int -> [Double] -> Tab
gen Int
idRandDists ([Double] -> Tab) -> [Double] -> Tab
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
typeId Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double]
aux

dist :: Int -> Tab
dist :: Int -> Tab
dist Int
n = Int -> [Double] -> Tab
gen21 Int
n []

-- | Uniform (positive numbers only)
uniDist :: Tab
uniDist :: Tab
uniDist = Int -> Tab
dist Int
1

-- | Linear (positive numbers only)
linDist :: Tab
linDist :: Tab
linDist = Int -> Tab
dist Int
2

-- | Triangular (positive and negative numbers)
triDist :: Tab
triDist :: Tab
triDist = Int -> Tab
dist Int
3

-- | Exponential (positive numbers only)
expDist :: Tab
expDist :: Tab
expDist = Int -> Tab
dist Int
4

-- | Biexponential (positive and negative numbers)
biexpDist :: Tab
biexpDist :: Tab
biexpDist = Int -> Tab
dist Int
5

-- | Gaussian (positive and negative numbers)
gaussDist :: Tab
gaussDist :: Tab
gaussDist = Int -> Tab
dist Int
6

-- | Cauchy (positive and negative numbers)
cauchyDist :: Tab
cauchyDist :: Tab
cauchyDist = Int -> Tab
dist Int
7

-- | Positive Cauchy (positive numbers only)
pcauchyDist :: Tab
pcauchyDist :: Tab
pcauchyDist = Int -> Tab
dist Int
8

-- | Beta (positive numbers only)
--
-- > betaDist alpha beta
--
-- * @alpha@ -- alpha value. If kalpha is smaller than one, smaller values favor values near 0.
--
-- * @beta@ -- beta value. If kbeta is smaller than one, smaller values favor values near krange.
betaDist :: Double -> Double -> Tab
betaDist :: Double -> Double -> Tab
betaDist Double
arg1 Double
arg2 = Int -> [Double] -> Tab
gen21 Int
9 [Double
1, Double
arg1, Double
arg2]

-- | Weibull (positive numbers only)
--
-- * tau -- if greater than one, numbers near ksigma are favored. If smaller than one, small values are favored. If t equals 1, the distribution is exponential. Outputs only positive numbers.
weibullDist :: Double -> Tab
weibullDist :: Double -> Tab
weibullDist Double
arg1 = Int -> [Double] -> Tab
gen21 Int
10 [Double
1, Double
arg1]

-- | Poisson (positive numbers only)
poissonDist :: Tab
poissonDist :: Tab
poissonDist = Int -> Tab
dist Int
11

-- with level

dist' :: Int -> Double -> Tab
dist' :: Int -> Double -> Tab
dist' Int
n Double
level = Int -> [Double] -> Tab
gen21 Int
n [Double
level]

uniDist' :: Double -> Tab
uniDist' :: Double -> Tab
uniDist' = Int -> Double -> Tab
dist' Int
1

linDist' :: Double -> Tab
linDist' :: Double -> Tab
linDist' = Int -> Double -> Tab
dist' Int
2

triDist' :: Double -> Tab
triDist' :: Double -> Tab
triDist' = Int -> Double -> Tab
dist' Int
3

expDist' :: Double -> Tab
expDist' :: Double -> Tab
expDist' = Int -> Double -> Tab
dist' Int
4

biexpDist' :: Double -> Tab
biexpDist' :: Double -> Tab
biexpDist' = Int -> Double -> Tab
dist' Int
5

gaussDist' :: Double -> Tab
gaussDist' :: Double -> Tab
gaussDist' = Int -> Double -> Tab
dist' Int
6

cauchyDist' :: Double -> Tab
cauchyDist' :: Double -> Tab
cauchyDist' = Int -> Double -> Tab
dist' Int
7

pcauchyDist' :: Double -> Tab
pcauchyDist' :: Double -> Tab
pcauchyDist' = Int -> Double -> Tab
dist' Int
8

betaDist' :: Double -> Double -> Double -> Tab
betaDist' :: Double -> Double -> Double -> Tab
betaDist' Double
level Double
arg1 Double
arg2 = Int -> [Double] -> Tab
gen21 Int
9 [Double
level, Double
arg1, Double
arg2]

weibullDist' :: Double -> Double -> Tab
weibullDist' :: Double -> Double -> Tab
weibullDist' Double
level Double
arg1 = Int -> [Double] -> Tab
gen21 Int
10 [Double
level, Double
arg1]

poissonDist' :: Double -> Tab
poissonDist' :: Double -> Tab
poissonDist' = Int -> Double -> Tab
dist' Int
11

-- GEN40

-- | Generates a random distribution using a distribution histogram (GEN40).
--
-- Csound docs: <http://www.csounds.com/manual/html/GEN40.html>
tabDist :: Tab -> Tab
tabDist :: Tab -> Tab
tabDist Tab
src = GE Tab -> Tab
forall a. Val a => GE a -> a
hideGE (GE Tab -> Tab) -> GE Tab -> Tab
forall a b. (a -> b) -> a -> b
$ do
    Int
tabId <- Tab -> GE Int
renderTab Tab
src
    Tab -> GE Tab
forall (m :: * -> *) a. Monad m => a -> m a
return (Tab -> GE Tab) -> Tab -> GE Tab
forall a b. (a -> b) -> a -> b
$ Int -> [Double] -> Tab
gen Int
idRandHist [Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tabId]

-- | randDist — Generates a random list of numerical pairs (GEN41).
--
-- > randDist  [value1, prob1, value2, prob2, value3, prob3 ... valueN, probN]
--
-- The first number of each pair is a value, and the second is the probability of that value to
-- be chosen by a random algorithm. Even if any number can be assigned to the probability element of each pair,
-- it is suggested to give it a percent value, in order to make it clearer for the user.
--
-- This subroutine is designed to be used together with duserrnd and urd opcodes (see duserrnd for more information).
randDist :: [Double] -> Tab
randDist :: [Double] -> Tab
randDist [Double]
xs = Tab -> Tab
skipNorm (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ Int -> [Double] -> Tab
gen Int
idRandPairs [Double]
xs


-- | rangeDist — Generates a random distribution of discrete ranges of values (GEN42).
--
-- The first number of each group is a the minimum value of the
-- range, the second is the maximum value and the third is the probability
-- of that an element belonging to that range of values can be chosen by
-- a random algorithm. Probabilities for a range should be a fraction of 1,
-- and the sum of the probabilities for all the ranges should total 1.0.
--
-- This subroutine is designed to be used together with duserrnd and urd opcodes (see duserrnd for more information).
-- Since both duserrnd and urd do not use any interpolation, it is suggested to give a size reasonably big.
rangeDist :: [Double] -> Tab
rangeDist :: [Double] -> Tab
rangeDist [Double]
xs = Tab -> Tab
skipNorm (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ Int -> [Double] -> Tab
gen Int
idRandRanges [Double]
xs

------------------------------------------------------

-- | Reads numbers from file (GEN23)
--
-- csound doc: <http://www.csounds.com/manual/html/GEN23.html>
readNumFile :: String -> Tab
readNumFile :: String -> Tab
readNumFile String
filename = Tab -> Tab
skipNorm (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ TabSize -> Int -> TabArgs -> Tab
preTab TabSize
forall a. Default a => a
def Int
idReadNumFile (TabArgs -> Tab) -> TabArgs -> Tab
forall a b. (a -> b) -> a -> b
$ String -> [Double] -> TabArgs
FileAccess String
filename []

-- | Reads trajectory from file (GEN28)
--
-- csound doc: <http://www.csounds.com/manual/html/GEN28.html>
readTrajectoryFile :: String -> Tab
readTrajectoryFile :: String -> Tab
readTrajectoryFile String
filename = Tab -> Tab
skipNorm (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ TabSize -> Int -> TabArgs -> Tab
preTab TabSize
forall a. Default a => a
def Int
idReadTrajectoryFile (TabArgs -> Tab) -> TabArgs -> Tab
forall a b. (a -> b) -> a -> b
$ String -> [Double] -> TabArgs
FileAccess String
filename []

-- | Reads PVOCEX files (GEN43)
--
-- csound doc: <http://www.csounds.com/manual/html/GEN43.html>
readPvocex :: String -> Int -> Tab
readPvocex :: String -> Int -> Tab
readPvocex String
filename Int
channel = TabSize -> Int -> TabArgs -> Tab
preTab TabSize
forall a. Default a => a
def Int
idPvocex (TabArgs -> Tab) -> TabArgs -> Tab
forall a b. (a -> b) -> a -> b
$ String -> [Double] -> TabArgs
FileAccess String
filename [Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
channel]

-- | readMultichannel — Creates an interleaved multichannel table from the specified source tables, in the format expected by the ftconv opcode (GEN52).
--
-- > f # time size 52 nchannels fsrc1 offset1 srcchnls1 [fsrc2 offset2 srcchnls2 ... fsrcN offsetN srcchnlsN]
--
-- csound doc: <http://www.csounds.com/manual/html/GEN52.html>
readMultichannel :: Int -> [(Tab, Int, Int)] -> Tab
readMultichannel :: Int -> [(Tab, Int, Int)] -> Tab
readMultichannel Int
n [(Tab, Int, Int)]
args = GE Tab -> Tab
forall a. Val a => GE a -> a
hideGE (GE Tab -> Tab) -> GE Tab -> Tab
forall a b. (a -> b) -> a -> b
$ do
    [Int]
idSrcs <- (Tab -> GE Int) -> [Tab] -> GE [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Tab -> GE Int
renderTab [Tab]
fsrcs
    Tab -> GE Tab
forall (m :: * -> *) a. Monad m => a -> m a
return (Tab -> GE Tab) -> Tab -> GE Tab
forall a b. (a -> b) -> a -> b
$ Tab -> Tab
skipNorm (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ Int -> [Double] -> Tab
gen Int
idMultichannel ([Double] -> Tab) -> [Double] -> Tab
forall a b. (a -> b) -> a -> b
$ (Int -> Double) -> [Int] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Double]) -> [Int] -> [Double]
forall a b. (a -> b) -> a -> b
$ Int
n Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ([[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int -> [Int]) -> [Int] -> [Int] -> [Int] -> [[Int]]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\Int
a Int
b Int
c -> [Int
a, Int
b, Int
c]) [Int]
idSrcs [Int]
offsets [Int]
chnls)
    where
        ([Tab]
fsrcs, [Int]
offsets, [Int]
chnls) = [(Tab, Int, Int)] -> ([Tab], [Int], [Int])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(Tab, Int, Int)]
args

------------------------------------------------------

-- | Csound's GEN33 — Generate composite waveforms by mixing simple sinusoids.
--
-- > tabSines1 srcTab nh scl [fmode]
--
-- Csound docs: <http://www.csounds.com/manual/html/GEN33.html>
tabSines1 :: Tab -> Double -> Double -> Maybe Double -> Tab
tabSines1 :: Tab -> Double -> Double -> Maybe Double -> Tab
tabSines1 = Int -> Tab -> Double -> Double -> Maybe Double -> Tab
tabSinesBy Int
idMixSines2

-- | Csound's GEN34 — Generate composite waveforms by mixing simple sinusoids.
--
-- > tabSines2 srcTab nh scl [fmode]
--
-- Csound docs: <http://www.csounds.com/manual/html/GEN3.html>
tabSines2 :: Tab -> Double -> Double -> Maybe Double -> Tab
tabSines2 :: Tab -> Double -> Double -> Maybe Double -> Tab
tabSines2 = Int -> Tab -> Double -> Double -> Maybe Double -> Tab
tabSinesBy Int
idMixSines2

tabSinesBy :: Int -> Tab -> Double -> Double -> Maybe Double -> Tab
tabSinesBy :: Int -> Tab -> Double -> Double -> Maybe Double -> Tab
tabSinesBy Int
genId Tab
tab Double
nh Double
amp Maybe Double
fmode = GE Tab -> Tab
forall a. Val a => GE a -> a
hideGE (GE Tab -> Tab) -> GE Tab -> Tab
forall a b. (a -> b) -> a -> b
$ do
    Int
tabId <- Tab -> GE Int
renderTab Tab
tab
    Tab -> GE Tab
forall (m :: * -> *) a. Monad m => a -> m a
return (Tab -> GE Tab) -> Tab -> GE Tab
forall a b. (a -> b) -> a -> b
$ TabSize -> Int -> TabArgs -> Tab
preTab TabSize
forall a. Default a => a
def Int
genId (TabArgs -> Tab) -> TabArgs -> Tab
forall a b. (a -> b) -> a -> b
$ Reader Int [Double] -> TabArgs
ArgsPlain (Reader Int [Double] -> TabArgs) -> Reader Int [Double] -> TabArgs
forall a b. (a -> b) -> a -> b
$ [Double] -> Reader Int [Double]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Double] -> Reader Int [Double])
-> [Double] -> Reader Int [Double]
forall a b. (a -> b) -> a -> b
$ [Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tabId, Double
nh, Double
amp] [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ ([Double] -> (Double -> [Double]) -> Maybe Double -> [Double]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Double -> [Double]
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Double
fmode)

-------------------
-- wavelets

-- | "wave" — Generates a compactly supported wavelet function.
--
-- > waveletTab srcTab seq
--
-- Csound docs: <http://www.csounds.com/manual/html/GENwave.html>
waveletTab :: Tab -> Int -> Tab
waveletTab :: Tab -> Int -> Tab
waveletTab = Int -> Tab -> Int -> Tab
waveletTabBy Int
0

-- | "wave" — Generates a compactly supported wavelet function. The result table is rescaled.
--
-- > waveletTab srcTab seq
--
-- Csound docs: <http://www.csounds.com/manual/html/GENwave.html>
rescaleWaveletTab :: Tab -> Int -> Tab
rescaleWaveletTab :: Tab -> Int -> Tab
rescaleWaveletTab = Int -> Tab -> Int -> Tab
waveletTabBy Int
1

waveletTabBy :: Int -> Tab -> Int -> Tab
waveletTabBy :: Int -> Tab -> Int -> Tab
waveletTabBy Int
rescaleFlag Tab
srcTab Int
sq = GE Tab -> Tab
forall a. Val a => GE a -> a
hideGE (GE Tab -> Tab) -> GE Tab -> Tab
forall a b. (a -> b) -> a -> b
$ do
    Int
tabId <- Tab -> GE Int
renderTab Tab
srcTab
    Tab -> GE Tab
forall (m :: * -> *) a. Monad m => a -> m a
return (Tab -> GE Tab) -> Tab -> GE Tab
forall a b. (a -> b) -> a -> b
$ String -> [Double] -> Tab
plainStringTab String
idWave ([Double] -> Tab) -> [Double] -> Tab
forall a b. (a -> b) -> a -> b
$ (Int -> Double) -> [Int] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int
tabId, Int
sq, Int
rescaleFlag]

-------------------
-- specific tabs

-- | Linear segments that form a singl cycle of triangle wave.
triTab :: Tab
triTab :: Tab
triTab = [Double] -> Tab
elins [Double
0, Double
1, Double
0, -Double
1, Double
0]

-- | Linear segments that form a single cycle of sawtooth wave.
sawTab :: Tab
sawTab :: Tab
sawTab = [Double] -> Tab
elins [Double
1, -Double
1]

-- | Linear segments that form a single cycle of square wave.
sqrTab :: Tab
sqrTab :: Tab
sqrTab = [Double] -> Tab
lins [Double
1, Double
0.5, Double
1, Double
0.01, -Double
1, Double
0.5, -Double
1, Double
0.01, Double
1]

-- | Pulse-width wave formed with linear segments. Duty cycle rages from 0 to 1. 0.5 is a square wave.
pwTab :: Double -> Tab
pwTab :: Double -> Tab
pwTab Double
duty = [Double] -> Tab
lins [Double
1, Double
duty, Double
1, Double
0.01, -Double
1, Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
duty, -Double
1, Double
0.01, Double
1]

-- | Tab with tanh from the given interval.
--
-- > tanhTab (start, end)
tanhTab :: (Double, Double) -> Tab
tanhTab :: (Double, Double) -> Tab
tanhTab (Double
start, Double
end) = String -> [Double] -> Tab
plainStringTab String
idTanh [Double
start, Double
end, Double
0]

-- | Tab with tanh from the given interval. The table is rescaled.
--
-- > rescaleTanhTab (start, end)
rescaleTanhTab :: (Double, Double) -> Tab
rescaleTanhTab :: (Double, Double) -> Tab
rescaleTanhTab (Double
start, Double
end) = String -> [Double] -> Tab
plainStringTab String
idTanh [Double
start, Double
end, Double
1]

-- | Tab with exponential from the given interval.
--
-- > expTab (start, end)
expTab :: (Double, Double) -> Tab
expTab :: (Double, Double) -> Tab
expTab (Double
start, Double
end) = String -> [Double] -> Tab
plainStringTab String
idExp [Double
start, Double
end, Double
0]

-- | Tab with exponential from the given interval. The table is rescaled.
--
-- > rescaleExpTab (start, end)
rescaleExpTab :: (Double, Double) -> Tab
rescaleExpTab :: (Double, Double) -> Tab
rescaleExpTab (Double
start, Double
end) = String -> [Double] -> Tab
plainStringTab String
idExp [Double
start, Double
end, Double
1]

-- | Tab with sone from the given interval.
--
-- > soneTab (start, end) equalpoint
--
-- * start, end -- first and last value to be stored. The points stored are uniformly spaced between these to the table size.
--
-- * equalpoint -- the point on the curve when the input and output values are equal.
soneTab :: (Double, Double) -> Double -> Tab
soneTab :: (Double, Double) -> Double -> Tab
soneTab (Double
start, Double
end) Double
equalpoint = String -> [Double] -> Tab
plainStringTab String
idSone [Double
start, Double
end, Double
equalpoint, Double
0]


-- | Tab with sone from the given interval.
--
-- > soneTab (start, end) equalpoint
--
-- * start, end -- first and last value to be stored. The points stored are uniformly spaced between these to the table size.
--
-- * equalpoint -- the point on the curve when the input and output values are equal.
rescaleSoneTab :: (Double, Double) -> Double -> Tab
rescaleSoneTab :: (Double, Double) -> Double -> Tab
rescaleSoneTab (Double
start, Double
end) Double
equalpoint = String -> [Double] -> Tab
plainStringTab String
idSone [Double
start, Double
end, Double
equalpoint, Double
0]

-- | "farey" — Fills a table with the Farey Sequence Fn of the integer n.
--
-- see details in Csound doc: <http://www.csounds.com/manual/html/GENfarey.html>
--
-- Notice that the arguments are reversed (in the haskell mindset)
--
-- > fareyTab mode num
--
-- num -- the integer n for generating Farey Sequence Fn
--
-- mode -- integer to trigger a specific output to be written into the table:
--
-- * 0 -- outputs floating point numbers representing the elements of Fn.
--
-- * 1 -- outputs delta values of successive elements of Fn, useful for generating note durations for example.
--
-- * 2 -- outputs only the denominators of the integer ratios, useful for indexing other tables or instruments for example.
--
-- * 3 -- same as mode 2 but with normalised output.
--
-- * 4 -- same as mode 0 but with 1 added to each number, useful for generating tables for tuning opcodes, for example cps2pch.
fareyTab :: Int -> Int -> Tab
fareyTab :: Int -> Int -> Tab
fareyTab Int
mode Int
num = String -> [Double] -> Tab
plainStringTab String
idFarey ([Double] -> Tab) -> [Double] -> Tab
forall a b. (a -> b) -> a -> b
$ (Int -> Double) -> [Int] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int
num, Int
mode]

---------------------------------------------------

-- |
-- tablew — Change the contents of existing function tables.
--
-- This opcode operates on existing function tables, changing their contents.
-- tablew is for writing at k- or at a-rates, with the table number being
-- specified at init time. Using tablew with i-rate signal and index values
-- is allowed, but the specified data will always be written to the function
-- table at k-rate, not during the initialization pass. The valid combinations
-- of variable types are shown by the first letter of the variable names.
--
-- > tablew asig, andx, ifn [, ixmode] [, ixoff] [, iwgmode]
-- > tablew isig, indx, ifn [, ixmode] [, ixoff] [, iwgmode]
-- > tablew ksig, kndx, ifn [, ixmode] [, ixoff] [, iwgmode]
--
-- csound doc: <http://www.csounds.com/manual/html/tablew.html>
tablew ::  Sig -> Sig -> Tab -> SE ()
tablew :: Sig -> Sig -> Tab -> SE ()
tablew Sig
b1 Sig
b2 Tab
b3 = Dep () -> SE ()
forall a. Dep a -> SE a
SE (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ (E -> Dep ()
forall (m :: * -> *). Monad m => E -> DepT m ()
depT_ (E -> Dep ()) -> Dep E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep ()) -> Dep E -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E
f (E -> E -> E -> E) -> GE E -> GE (E -> E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig -> GE E
unSig Sig
b1 GE (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b2 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b3
    where f :: E -> E -> E -> E
f E
a1 E
a2 E
a3 = String -> Spec1 -> [E] -> E
opcs String
"tablew" [(Rate
Xr,[Rate
Xr,Rate
Xr,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir])] [E
a1,E
a2,E
a3]


-- |
-- Notice that this function is the same as @tab@, but it wraps the output in the SE-monad.
-- So you can use the @tab@ if your table is read-only and you can use @readTab@ if
-- you want to update the table and the order of read/write operation is important.
--
-- Fast table opcodes.
--
-- Fast table opcodes. Faster than
--     table and
--     tablew because don't
--     allow wrap-around and limit and don't check index validity. Have
--     been implemented in order to provide fast access to
--     arrays. Support non-power of two tables (can be generated by any
--     GEN function by giving a negative length value).
--
-- > kr  tab  kndx, ifn[, ixmode]
-- > ar  tab  xndx, ifn[, ixmode]
--
-- csound doc: <http://www.csounds.com/manual/html/tab.html>
readTab ::  Sig -> Tab -> SE Sig
readTab :: Sig -> Tab -> SE Sig
readTab Sig
b1 Tab
b2 = (E -> Sig) -> SE E -> SE Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( GE E -> Sig
Sig (GE E -> Sig) -> (E -> GE E) -> E -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E -> GE E
forall (m :: * -> *) a. Monad m => a -> m a
return) (SE E -> SE Sig) -> SE E -> SE Sig
forall a b. (a -> b) -> a -> b
$ Dep E -> SE E
forall a. Dep a -> SE a
SE (Dep E -> SE E) -> Dep E -> SE E
forall a b. (a -> b) -> a -> b
$ (E -> Dep E
forall (m :: * -> *). Monad m => E -> DepT m E
depT (E -> Dep E) -> Dep E -> Dep E
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep E) -> Dep E -> Dep E
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig -> GE E
unSig Sig
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b2
    where f :: E -> E -> E
f E
a1 E
a2 = String -> Spec1 -> [E] -> E
opcs String
"tab" [(Rate
Kr,[Rate
Kr,Rate
Ir,Rate
Ir]),(Rate
Ar,[Rate
Xr,Rate
Ir,Rate
Ir])] [E
a1,E
a2]



-- |
-- Notice that this function is the same as @table@, but it wraps the output in the SE-monad.
-- So you can use the @table@ if your table is read-only and you can use @readTable@ if
-- you want to update the table and the order of read/write operation is important.
--
-- Accesses table values by direct indexing.
--
-- > ares  table  andx, ifn [, ixmode] [, ixoff] [, iwrap]
-- > ires  table  indx, ifn [, ixmode] [, ixoff] [, iwrap]
-- > kres  table  kndx, ifn [, ixmode] [, ixoff] [, iwrap]
--
-- csound doc: <http://www.csounds.com/manual/html/table.html>
readTable :: SigOrD a => a -> Tab -> SE a
readTable :: a -> Tab -> SE a
readTable a
b1 Tab
b2 = (E -> a) -> SE E -> SE a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GE E -> a
forall a. Val a => GE E -> a
fromGE (GE E -> a) -> (E -> GE E) -> E -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E -> GE E
forall (m :: * -> *) a. Monad m => a -> m a
return) (SE E -> SE a) -> SE E -> SE a
forall a b. (a -> b) -> a -> b
$ Dep E -> SE E
forall a. Dep a -> SE a
SE (Dep E -> SE E) -> Dep E -> SE E
forall a b. (a -> b) -> a -> b
$ (E -> Dep E
forall (m :: * -> *). Monad m => E -> DepT m E
depT (E -> Dep E) -> Dep E -> Dep E
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep E) -> Dep E -> Dep E
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> GE E
forall a. Val a => a -> GE E
toGE a
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b2
    where f :: E -> E -> E
f E
a1 E
a2 = String -> Spec1 -> [E] -> E
opcs String
"table" [(Rate
Ar,[Rate
Ar,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir])
                                 ,(Rate
Ir,[Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir])
                                 ,(Rate
Kr,[Rate
Kr,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir])] [E
a1,E
a2]

-- |
-- Notice that this function is the same as @tablei@, but it wraps the output in the SE-monad.
-- So you can use the @tablei@ if your table is read-only and you can use @readTablei@ if
-- you want to update the table and the order of read/write operation is important.
--
-- Accesses table values by direct indexing with cubic interpolation.
--
-- > ares  table3  andx, ifn [, ixmode] [, ixoff] [, iwrap]
-- > ires  table3  indx, ifn [, ixmode] [, ixoff] [, iwrap]
-- > kres  table3  kndx, ifn [, ixmode] [, ixoff] [, iwrap]
--
-- csound doc: <http://www.csounds.com/manual/html/table3.html>
readTable3 :: SigOrD a => a -> Tab -> SE a
readTable3 :: a -> Tab -> SE a
readTable3 a
b1 Tab
b2 = (E -> a) -> SE E -> SE a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GE E -> a
forall a. Val a => GE E -> a
fromGE (GE E -> a) -> (E -> GE E) -> E -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E -> GE E
forall (m :: * -> *) a. Monad m => a -> m a
return) (SE E -> SE a) -> SE E -> SE a
forall a b. (a -> b) -> a -> b
$ Dep E -> SE E
forall a. Dep a -> SE a
SE (Dep E -> SE E) -> Dep E -> SE E
forall a b. (a -> b) -> a -> b
$ (E -> Dep E
forall (m :: * -> *). Monad m => E -> DepT m E
depT (E -> Dep E) -> Dep E -> Dep E
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep E) -> Dep E -> Dep E
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> GE E
forall a. Val a => a -> GE E
toGE a
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b2
    where f :: E -> E -> E
f E
a1 E
a2 = String -> Spec1 -> [E] -> E
opcs String
"table3" [(Rate
Ar,[Rate
Ar,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir])
                                  ,(Rate
Ir,[Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir])
                                  ,(Rate
Kr,[Rate
Kr,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir])] [E
a1,E
a2]

-- |
-- Notice that this function is the same as @table3@, but it wraps the output in the SE-monad.
-- So you can use the @table3@ if your table is read-only and you can use @readTable3@ if
-- you want to update the table and the order of read/write operation is important.
--
-- Accesses table values by direct indexing with linear interpolation.
--
-- > ares  tablei  andx, ifn [, ixmode] [, ixoff] [, iwrap]
-- > ires  tablei  indx, ifn [, ixmode] [, ixoff] [, iwrap]
-- > kres  tablei  kndx, ifn [, ixmode] [, ixoff] [, iwrap]
--
-- csound doc: <http://www.csounds.com/manual/html/tablei.html>
readTablei :: SigOrD a => a -> Tab -> SE a
readTablei :: a -> Tab -> SE a
readTablei a
b1 Tab
b2 = (E -> a) -> SE E -> SE a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GE E -> a
forall a. Val a => GE E -> a
fromGE (GE E -> a) -> (E -> GE E) -> E -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E -> GE E
forall (m :: * -> *) a. Monad m => a -> m a
return) (SE E -> SE a) -> SE E -> SE a
forall a b. (a -> b) -> a -> b
$ Dep E -> SE E
forall a. Dep a -> SE a
SE (Dep E -> SE E) -> Dep E -> SE E
forall a b. (a -> b) -> a -> b
$ (E -> Dep E
forall (m :: * -> *). Monad m => E -> DepT m E
depT (E -> Dep E) -> Dep E -> Dep E
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep E) -> Dep E -> Dep E
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> GE E
forall a. Val a => a -> GE E
toGE a
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b2
    where f :: E -> E -> E
f E
a1 E
a2 = String -> Spec1 -> [E] -> E
opcs String
"tablei" [(Rate
Ar,[Rate
Ar,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir])
                                  ,(Rate
Ir,[Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir])
                                  ,(Rate
Kr,[Rate
Kr,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir])] [E
a1,E
a2]

-- |
-- tableikt — Provides k-rate control over table numbers.
--
-- k-rate control over table numbers. Function tables are read with linear interpolation.
-- The standard Csound opcode tablei, when producing a k- or a-rate result, can only use an init-time variable to select the table number. tableikt accepts k-rate control as well as i-time. In all other respects they are similar to the original opcodes.
--
-- > ares tableikt xndx, kfn [, ixmode] [, ixoff] [, iwrap]
-- > kres tableikt kndx, kfn [, ixmode] [, ixoff] [, iwrap]
--
-- csound doc: <http://www.csounds.com/manual/html/tableikt.html>
tableikt ::  Sig -> Tab -> Sig
tableikt :: Sig -> Tab -> Sig
tableikt Sig
b1 Tab
b2 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig -> GE E
unSig Sig
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b2
    where f :: E -> E -> E
f E
a1 E
a2 = String -> Spec1 -> [E] -> E
opcs String
"tableikt" [(Rate
Ar,[Rate
Xr,Rate
Kr,Rate
Ir,Rate
Ir,Rate
Ir]),(Rate
Kr,[Rate
Xr,Rate
Kr,Rate
Ir,Rate
Ir,Rate
Ir])] [E
a1,E
a2]

-- |
-- tablekt — Provides k-rate control over table numbers.
--
-- k-rate control over table numbers. Function tables are read with linear interpolation.
-- The standard Csound opcode table when producing a k- or a-rate result, can only use an init-time variable to select the table number. tablekt accepts k-rate control as well as i-time. In all other respects they are similar to the original opcodes.
--
-- > ares tablekt xndx, kfn [, ixmode] [, ixoff] [, iwrap]
-- > kres tablekt kndx, kfn [, ixmode] [, ixoff] [, iwrap]
--
-- csound doc: <http://www.csounds.com/manual/html/tablekt.html>
tablekt ::  Sig -> Tab -> Sig
tablekt :: Sig -> Tab -> Sig
tablekt Sig
b1 Tab
b2 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig -> GE E
unSig Sig
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b2
    where f :: E -> E -> E
f E
a1 E
a2 = String -> Spec1 -> [E] -> E
opcs String
"tablekt" [(Rate
Ar,[Rate
Xr,Rate
Kr,Rate
Ir,Rate
Ir,Rate
Ir]),(Rate
Kr,[Rate
Xr,Rate
Kr,Rate
Ir,Rate
Ir,Rate
Ir])] [E
a1,E
a2]


-- |
-- tablexkt — Reads function tables with linear, cubic, or sinc interpolation.
--
-- > ares tablexkt xndx, kfn, kwarp, iwsize [, ixmode] [, ixoff] [, iwrap]
--
-- csound doc: <http://www.csounds.com/manual/html/tablexkt.html>
tablexkt ::  Sig -> Tab -> Sig -> D -> Sig
tablexkt :: Sig -> Tab -> Sig -> D -> Sig
tablexkt Sig
b1 Tab
b2 Sig
b3 D
b4 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E -> E
f (E -> E -> E -> E -> E) -> GE E -> GE (E -> E -> E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig -> GE E
unSig Sig
b1 GE (E -> E -> E -> E) -> GE E -> GE (E -> E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b2 GE (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b3 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b4
    where f :: E -> E -> E -> E -> E
f E
a1 E
a2 E
a3 E
a4 = String -> Spec1 -> [E] -> E
opcs String
"tablexkt" [(Rate
Ar,[Rate
Xr,Rate
Kr,Rate
Kr,Rate
Ir,Rate
Ir,Rate
Ir,Rate
Ir])] [E
a1,E
a2,E
a3,E
a4]

----------------------------------------------------------------
-- duserrnd and cuserrnd

-- | cuserrnd — Continuous USER-defined-distribution RaNDom generator.
--
-- Continuous USER-defined-distribution RaNDom generator.
--
-- > aout cuserrnd kmin, kmax, ktableNum
-- > iout cuserrnd imin, imax, itableNum
-- > kout cuserrnd kmin, kmax, ktableNum
--
-- csound doc: <http://www.csounds.com/manual/html/cuserrnd.html>
--
-- the tab should be done with tabDist, randDist or rangeDist
cuserrnd :: SigOrD a => a -> a -> Tab -> SE a
cuserrnd :: a -> a -> Tab -> SE a
cuserrnd a
b1 a
b2 Tab
b3 = (E -> a) -> SE E -> SE a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GE E -> a
forall a. Val a => GE E -> a
fromGE (GE E -> a) -> (E -> GE E) -> E -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E -> GE E
forall (m :: * -> *) a. Monad m => a -> m a
return) (SE E -> SE a) -> SE E -> SE a
forall a b. (a -> b) -> a -> b
$ Dep E -> SE E
forall a. Dep a -> SE a
SE (Dep E -> SE E) -> Dep E -> SE E
forall a b. (a -> b) -> a -> b
$ (E -> Dep E
forall (m :: * -> *). Monad m => E -> DepT m E
depT (E -> Dep E) -> Dep E -> Dep E
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep E) -> Dep E -> Dep E
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E
f (E -> E -> E -> E) -> GE E -> GE (E -> E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> GE E
forall a. Val a => a -> GE E
toGE a
b1 GE (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> GE E
forall a. Val a => a -> GE E
toGE a
b2 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tab -> GE E
unTab Tab
b3
    where f :: E -> E -> E -> E
f E
a1 E
a2 E
a3 = String -> Spec1 -> [E] -> E
opcs String
"cuserrnd" [(Rate
Ar,[Rate
Kr,Rate
Kr,Rate
Kr])
                                  ,(Rate
Ir,[Rate
Ir,Rate
Ir,Rate
Ir])
                                  ,(Rate
Kr,[Rate
Kr,Rate
Kr,Rate
Kr])] [E
a1,E
a2,E
a3]

-- | duserrnd — Discrete USER-defined-distribution RaNDom generator.
--
-- Discrete USER-defined-distribution RaNDom generator.
--
-- > aout duserrnd ktableNum
-- > iout duserrnd itableNum
-- > kout duserrnd ktableNum
--
-- csound doc: <http://www.csounds.com/manual/html/duserrnd.html>
--
-- the tab should be done with tabDist, randDist or rangeDist
duserrnd :: SigOrD a => Tab -> SE a
duserrnd :: Tab -> SE a
duserrnd Tab
b1 = (E -> a) -> SE E -> SE a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GE E -> a
forall a. Val a => GE E -> a
fromGE (GE E -> a) -> (E -> GE E) -> E -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E -> GE E
forall (m :: * -> *) a. Monad m => a -> m a
return) (SE E -> SE a) -> SE E -> SE a
forall a b. (a -> b) -> a -> b
$ Dep E -> SE E
forall a. Dep a -> SE a
SE (Dep E -> SE E) -> Dep E -> SE E
forall a b. (a -> b) -> a -> b
$ (E -> Dep E
forall (m :: * -> *). Monad m => E -> DepT m E
depT (E -> Dep E) -> Dep E -> Dep E
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Dep E -> Dep E) -> Dep E -> Dep E
forall a b. (a -> b) -> a -> b
$ GE E -> Dep E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> Dep E) -> GE E -> Dep E
forall a b. (a -> b) -> a -> b
$ (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap E -> E
f (GE E -> GE E) -> GE E -> GE E
forall a b. (a -> b) -> a -> b
$ Tab -> GE E
unTab Tab
b1
    where f :: E -> E
f E
a1 = String -> Spec1 -> [E] -> E
opcs String
"duserrnd" [(Rate
Ar,[Rate
Kr])
                                  ,(Rate
Ir,[Rate
Ir])
                                  ,(Rate
Kr,[Rate
Kr])] [E
a1]

----------------------------------------------------------------
-- tab args

bpRelativeArgs :: [Double] -> TabArgs
bpRelativeArgs :: [Double] -> TabArgs
bpRelativeArgs [Double]
ys = Reader Int [Double] -> TabArgs
ArgsPlain (Reader Int [Double] -> TabArgs) -> Reader Int [Double] -> TabArgs
forall a b. (a -> b) -> a -> b
$ (Int -> [Double]) -> Reader Int [Double]
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader ((Int -> [Double]) -> Reader Int [Double])
-> (Int -> [Double]) -> Reader Int [Double]
forall a b. (a -> b) -> a -> b
$ \Int
size -> Int -> [Double] -> [Double]
forall a. Integral a => a -> [Double] -> [Double]
fromRelative Int
size [Double]
ys
    where
        fromRelative :: a -> [Double] -> [Double]
fromRelative a
n [Double]
as = [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
substOdds (a -> [Double] -> [Double]
forall (f :: * -> *) a a.
(Functor f, RealFrac a, Integral a) =>
a -> f a -> f Double
makeRelative a
n ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ [Double] -> [Double]
forall a. [a] -> [a]
getOdds [Double]
as) [Double]
as

        getOdds :: [b] -> [b]
getOdds [b]
xs = ((Bool, b) -> b) -> [(Bool, b)] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, b) -> b
forall a b. (a, b) -> b
snd ([(Bool, b)] -> [b]) -> [(Bool, b)] -> [b]
forall a b. (a -> b) -> a -> b
$ ((Bool, b) -> Bool) -> [(Bool, b)] -> [(Bool, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, b) -> Bool
forall a b. (a, b) -> a
fst ([(Bool, b)] -> [(Bool, b)]) -> [(Bool, b)] -> [(Bool, b)]
forall a b. (a -> b) -> a -> b
$ [Bool] -> [b] -> [(Bool, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Bool] -> [Bool]
forall a. [a] -> [a]
cycle [Bool
True,Bool
False]) [b]
xs

        substOdds :: [d] -> [d] -> [d]
substOdds [d]
odds [d]
xs = (Bool -> d -> d -> d) -> [Bool] -> [d] -> [d] -> [d]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Bool -> d -> d -> d
forall p. Bool -> p -> p -> p
go ([Bool] -> [Bool]
forall a. [a] -> [a]
cycle [Bool
True,Bool
False]) ((\d
a -> [d
a,d
a]) (d -> [d]) -> [d] -> [d]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [d]
odds) [d]
xs
            where go :: Bool -> p -> p -> p
go Bool
flag p
odd' p
x = if Bool
flag then p
odd' else p
x

        makeRelative :: a -> f a -> f Double
makeRelative a
size f a
as = (a -> Double) -> f a -> f Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: (Int -> Double)) (Int -> Double) -> (a -> Int) -> a -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (a -> Int) -> (a -> a) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
size a -> a -> a
forall a. Num a => a -> a -> a
* )) f a
as

relativeArgs :: [Double] -> TabArgs
relativeArgs :: [Double] -> TabArgs
relativeArgs [Double]
xs = Reader Int [Double] -> TabArgs
ArgsPlain (Reader Int [Double] -> TabArgs) -> Reader Int [Double] -> TabArgs
forall a b. (a -> b) -> a -> b
$ (Int -> [Double]) -> Reader Int [Double]
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader ((Int -> [Double]) -> Reader Int [Double])
-> (Int -> [Double]) -> Reader Int [Double]
forall a b. (a -> b) -> a -> b
$ \Int
size -> Int -> [Double] -> [Double]
forall a. Integral a => a -> [Double] -> [Double]
fromRelative Int
size [Double]
xs
    where
        fromRelative :: a -> [Double] -> [Double]
fromRelative a
n [Double]
as = [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
substEvens (a -> [Double] -> [Double]
forall (t :: * -> *) b a.
(Functor t, Foldable t, RealFrac b, Integral a) =>
a -> t b -> t Double
mkRelative a
n ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ [Double] -> [Double]
forall a. [a] -> [a]
getEvens [Double]
as) [Double]
as

        getEvens :: [a] -> [a]
getEvens = \case
            [] -> []
            a
_:[] -> []
            a
_:a
b:[a]
as -> a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
getEvens [a]
as

        substEvens :: [a] -> [a] -> [a]
substEvens [a]
evens [a]
ys = case ([a]
evens, [a]
ys) of
            ([], [a]
as) -> [a]
as
            ([a]
_, []) -> []
            (a
e:[a]
es, a
a:a
_:[a]
as) -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
e a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
substEvens [a]
es [a]
as
            ([a], [a])
_ -> String -> [a]
forall a. HasCallStack => String -> a
error String
"table argument list should contain even number of elements"

relativeArgsGen16 :: [Double] -> TabArgs
relativeArgsGen16 :: [Double] -> TabArgs
relativeArgsGen16 [Double]
xs = Reader Int [Double] -> TabArgs
ArgsPlain (Reader Int [Double] -> TabArgs) -> Reader Int [Double] -> TabArgs
forall a b. (a -> b) -> a -> b
$ (Int -> [Double]) -> Reader Int [Double]
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader ((Int -> [Double]) -> Reader Int [Double])
-> (Int -> [Double]) -> Reader Int [Double]
forall a b. (a -> b) -> a -> b
$ \Int
size -> Int -> [Double] -> [Double]
forall a. Integral a => a -> [Double] -> [Double]
formRelativeGen16 Int
size [Double]
xs
    where
        formRelativeGen16 :: a -> [Double] -> [Double]
formRelativeGen16 a
n [Double]
as = [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
substGen16 (a -> [Double] -> [Double]
forall (t :: * -> *) b a.
(Functor t, Foldable t, RealFrac b, Integral a) =>
a -> t b -> t Double
mkRelative a
n ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ [Double] -> [Double]
forall a. [a] -> [a]
getGen16 [Double]
as) [Double]
as

        getGen16 :: [a] -> [a]
getGen16 = \case
            a
_:a
durN:a
_:[a]
rest    -> a
durN a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
getGen16 [a]
rest
            [a]
_                -> []

        substGen16 :: [a] -> [a] -> [a]
substGen16 [a]
durs [a]
ys = case ([a]
durs, [a]
ys) of
            ([], [a]
as) -> [a]
as
            ([a]
_, [])  -> []
            (a
d:[a]
ds, a
valN:a
_:a
typeN:[a]
rest)   -> a
valN a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
d a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
typeN a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
substGen16 [a]
ds [a]
rest
            ([a]
_, [a]
_)   -> [a]
ys

mkRelative :: (Functor t, Foldable t, RealFrac b, Integral a) => a -> t b -> t Double
mkRelative :: a -> t b -> t Double
mkRelative a
n t b
as = (b -> Double) -> t b -> t Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: (Int -> Double)) (Int -> Double) -> (b -> Int) -> b -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (b -> Int) -> (b -> b) -> b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b
s b -> b -> b
forall a. Num a => a -> a -> a
* )) t b
as
    where s :: b
s = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n b -> b -> b
forall a. Fractional a => a -> a -> a
/ t b -> b
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum t b
as