{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-} -- | Gen routines. First argument is ftable's size, load time is set to zero. -- -- -- module CsoundExpr.Base.Gens ( skipNorm, -- * Empty table (csound f0) ftempty, -- * Sine/Cosine generators gen09, gen10, gen11, gen19, gen30, gen33, gen34, -- * Line/Exponential Segment Generators: gen05, gen06, gen07, gen08, gen16, gen25, gen27, -- * File Access GEN Routines: gen01, gen23, gen28, -- * Numeric Value Access GEN Routines gen02, gen17, -- * Window Function GEN Routines gen20, -- * Random Function GEN Routines gen21, gen40, gen41, gen42, gen43, -- * Waveshaping GEN Routines gen03, gen13, gen14, gen15, -- * Amplitude Scaling GEN Routines gen04, gen12, gen24, -- * Mixing GEN Routines gen18, gen31, gen32, -- * genXX'2 -- | Gens size is power of two -- -- >genXX'2 = genXX . (2^) gen09'2, gen10'2, gen11'2, gen19'2, gen30'2, gen33'2, gen34'2, gen05'2, gen06'2, gen07'2, gen08'2, gen16'2, gen25'2, gen27'2, gen01'2, gen23'2, gen28'2, gen02'2, gen17'2, gen20'2, gen21'2, gen40'2, gen41'2, gen42'2, gen43'2, gen03'2, gen13'2, gen14'2, gen15'2, gen04'2, gen12'2, gen24'2, gen18'2, gen31'2, gen32'2, -- * genXX'12 -- | Gens size is power of two plus one -- -- >genXX'12 = genXX . (+1) . (2^) gen09'12, gen10'12, gen11'12, gen19'12, gen30'12, gen33'12, gen34'12, gen05'12, gen06'12, gen07'12, gen08'12, gen16'12, gen25'12, gen27'12, gen01'12, gen23'12, gen28'12, gen02'12, gen17'12, gen20'12, gen21'12, gen40'12, gen41'12, gen42'12, gen43'12, gen03'12, gen13'12, gen14'12, gen15'12, gen04'12, gen12'12, gen24'12, gen18'12, gen31'12, gen32'12 ) where import CsoundExpr.Base.SideEffect import CsoundExpr.Translator.Types import CsoundExpr.Translator.ExprTree.ExprTree import CsoundExpr.Translator.Cs.CsTree import CsoundExpr.Translator.Cs.Utils import CsoundExpr.Translator.Cs.IM -- | ftempty value is rendered to 0 ftempty :: Irate ftempty = ftable EmptyFtable gen :: IM CsTree a => Id -> Size -> [CsTree] -> a gen id n = ftable . Ftable n . GEN id genD :: Id -> Size -> [Double] -> Irate genD id n = gen id n . map ftvalD ftvalI :: Int -> CsTree ftvalI = int ftvalD = double ftvalS = string ftvalF :: Irate -> CsTree ftvalF = ftable . getFtable . to -- | skip normalization skipNorm :: Irate -> Irate skipNorm = from . mapFtable skip . to where skip (Ftable n (GEN id xs)) = Ftable n $ GEN (-(abs id)) xs -- Sine/Cosine generators -- gen09, gen10, gen11, gen19, gen30, gen33, gen34, -- GEN09 -- Generate composite waveforms made up of weighted -- sums of simple sinusoids -- f # time size 9 pna stra phsa pnb strb phsb -- pnX - partial no (relative to fundamental) -- strX - strength -- phsX - phase -- | GEN09 - Composite waveforms made up of weighted sums of simple sinusoids. -- -- url : gen09 :: Int -> [Double] -> Irate gen09 = genD 9 -- | GEN10 - Composite waveforms made up of weighted sums of simple sinusoids. -- -- url : gen10 :: Int -> [Double] -> Irate gen10 = genD 10 -- | GEN11 - Additive set of cosine partials. -- -- url : gen11 :: Int -> [Double] -> Irate gen11 = genD 11 -- | GEN19 - Composite waveforms made up of weighted sums of simple sinusoids. -- -- url : gen19 :: Int -> [Double] -> Irate gen19 = genD 19 -- | GEN30 - Generates harmonic partials by analyzing an existing table. -- -- url : gen30 :: Int -> Irate -> [Double] -> Irate gen30 = gen3x 30 -- | GEN33 - Generate composite waveforms by mixing simple sinusoids. -- -- url : gen33 :: Int -> Irate -> [Double] -> Irate gen33 = gen3x 33 -- | GEN34 - Generate composite waveforms by mixing simple sinusoids. -- -- url : gen34 :: Int -> Irate -> [Double] -> Irate gen34 = gen3x 34 gen3x :: Int -> Int -> Irate -> [Double] -> Irate gen3x id n ft vs = gen id n $ [ftvalF ft] ++ map ftvalD vs -- Line/Exponential Segment Generators: -- gen05, gen06, gen07, gen08, gen16, gen25, gen27, -- GEN05 -- Constructs functions from segments of exponential curves. -- f # time size 5 a n1 b n2 c ... -- a, b, c, etc. -- ordinate values, in odd-numbered pfields p5, p7, p9, . . . -- These must be nonzero and must be alike in sign. -- n1, n2,... -- length of segment -- | GEN05 - Constructs functions from segments of exponential curves. -- -- url : gen05 :: Int -> [Double] -> Irate gen05 = genD 5 -- | GEN06 - Generates a function comprised of segments of cubic polynomials. -- -- url : gen06 :: Int -> [Double] -> Irate gen06 = genD 6 -- | GEN07 - Constructs functions from segments of straight lines. -- -- url : gen07 :: Int -> [Double] -> Irate gen07 = genD 7 -- | GEN08 - Generate a piecewise cubic spline curve. -- -- url : gen08 :: Int -> [Double] -> Irate gen08 = genD 8 -- | GEN16 - Creates a table from a starting value to an ending value. -- -- url : gen16 :: Int -> [Double] -> Irate gen16 = genD 16 -- | GEN25 - Construct functions from segments of exponential curves in breakpoint fashion. -- -- url : gen25 :: Int -> [Double] -> Irate gen25 = genD 25 -- | GEN27 - Construct functions from segments of straight lines in breakpoint fashion. -- -- url : gen27 :: Int -> [Double] -> Irate gen27 = genD 27 -- File Access GEN Routines: -- gen01, gen23, gen28, -- | GEN01 - Transfers data from a soundfile into a function table. -- -- url : gen01 :: Int -> String -> [Double] -> Irate gen01 n file xs = gen 1 n $ [ftvalS file] ++ map ftvalD xs -- | GEN23 - Reads numeric values from a text file. -- -- url : gen23 :: Int -> String -> Irate gen23 n file = gen 23 n [ftvalS file] -- | GEN28 - Reads a text file which contains a time-tagged trajectory. -- -- url : gen28 :: Int -> String -> Irate gen28 n file = gen 28 n [ftvalS file] -- Numeric Value Access GEN Routines -- gen02, gen17, -- | GEN02 - Transfers data from immediate pfields into a function table. -- -- url : gen02 :: Int -> [Double] -> Irate gen02 = genD 2 -- | GEN17 - Creates a step function from given x-y pairs. -- -- url : gen17 :: Int -> [Double] -> Irate gen17 = genD 17 -- Window Function GEN Routines -- gen20, -- | GEN20 - Generates functions of different windows. -- -- url : gen20 :: Int -> [Double] -> Irate gen20 = genD 20 -- Random Function GEN Routines -- gen21, gen40, gen41, gen42, gen43, -- | GEN21 - Generates tables of different random distributions. -- -- url : gen21 :: Int -> [Double] -> SideEffect Irate gen21 = gen21 -- | GEN41 - Generates a random list of numerical pairs. -- -- url : gen41 :: Int -> [Double] -> SideEffect Irate gen41 = gen41 -- | GEN42 - Generates a random distribution of discrete ranges of values. -- -- url : gen42 :: Int -> [Double] -> SideEffect Irate gen42 = gen42 -- | GEN40 - Generates a random distribution using a distribution histogram. -- -- url : gen40 :: Int -> Irate -> SideEffect Irate gen40 n ft = gen 40 n [ftvalF ft] -- | GEN43 - Loads a PVOCEX file containing a PV analysis. -- -- url : gen43 :: Int -> String -> [Double] -> Irate gen43 n file vs = gen 43 n $ [ftvalS file] ++ map ftvalD vs -- Waveshaping GEN Routines -- gen03, gen13, gen14, gen15, -- | GEN03 - Generates a stored function table by evaluating a polynomial. -- -- url : gen03 :: Int -> [Double] -> Irate gen03 = genD 3 -- | GEN13 - Stores a polynomial whose coefficients derive from the Chebyshev polynomials of the first kind. -- -- url : gen13 :: Int -> [Double] -> Irate gen13 = genD 13 -- | GEN14 - Stores a polynomial whose coefficients derive from Chebyshevs of the second kind. -- -- url : gen14 :: Int -> [Double] -> Irate gen14 = genD 14 -- | GEN15 - Creates two tables of stored polynomial functions. -- -- url : gen15 :: Int -> [Double] -> Irate gen15 = genD 15 -- Amplitude Scaling GEN Routines -- gen04, gen12, gen24, -- | GEN12 - Generates the log of a modified Bessel function of the second kind. -- -- url : gen12 :: Int -> [Double] -> Irate gen12 = genD 12 -- | GEN04 - Generates a normalizing function. -- -- url : gen04 :: Int -> Irate -> [Double] -> Irate gen04 n ft vs = gen 4 n $ [ftvalF ft] ++ map ftvalD vs -- | GEN24 - Reads numeric values from another allocated function-table and rescales them. -- -- url : gen24 :: Int -> Irate -> [Double] -> Irate gen24 n ft vs = gen 24 n $ [ftvalF ft] ++ map ftvalD vs -- Mixing GEN Routines -- gen18, gen31, gen32 -- | GEN18 - Writes composite waveforms made up of pre-existing waveforms. -- -- url : gen18 :: Int -> [(Irate, Double, Int, Int)] -> Irate gen18 n xs = gen 18 n (f =<< xs) where f (x1, x2, x3, x4) = [ftvalF x1, ftvalD x2, ftvalI x3, ftvalI x4] -- | GEN31 - Mixes any waveform specified in an existing table. -- -- url : gen31 :: Int -> Irate -> [Double] -> Irate gen31 n ft vs = gen 31 n $ [ftvalF ft] ++ map ftvalD vs -- | GEN32 - Mixes any waveform, resampled with either FFT or linear interpolation. -- -- url : gen32 :: Int -> [(Irate, Int, Double, Double)] -> Irate gen32 n xs = gen 32 n (f =<< xs) where f (x1, x2, x3, x4) = [ftvalF x1, ftvalI x2, ftvalD x3, ftvalD x4] -------------------------------------------------------------- -- -- genXX'(12|2) generation program {- import Text.PrettyPrint ids = [9, 10, 11, 19, 30, 33, 34] ++ [5 .. 8] ++ [16, 25, 27] ++ [1, 23, 28] ++ [2, 17] ++ [20] ++ [21] ++ [40 .. 43] ++ [3] ++ [13 .. 15] ++ [4, 12, 24] ++ [18, 31, 32] toStr x | length s == 1 = "0" ++ s | otherwise = s where s = show x -- genXX'2 = genXX . (^2) toGen'2 x = show $ name <> text "'2" <+> equals <+> name <+> text ". (^2)" where name = text "gen" <> text (toStr x) -- genXX'12 = genXX . (+1) . (^2) toGen'12 x = show $ name <> text "'12" <+> equals <+> name <+> text ". (+1) . (^2)" where name = text "gen" <> text (toStr x) main = do mapM_ (putStrLn . toGen'12) ids -} -------------------------------------------------------------- -- genXX'2 -- gen09'2 = gen09 . (2^) gen10'2 = gen10 . (2^) gen11'2 = gen11 . (2^) gen19'2 = gen19 . (2^) gen30'2 = gen30 . (2^) gen33'2 = gen33 . (2^) gen34'2 = gen34 . (2^) gen05'2 = gen05 . (2^) gen06'2 = gen06 . (2^) gen07'2 = gen07 . (2^) gen08'2 = gen08 . (2^) gen16'2 = gen16 . (2^) gen25'2 = gen25 . (2^) gen27'2 = gen27 . (2^) gen01'2 = gen01 . (2^) gen23'2 = gen23 . (2^) gen28'2 = gen28 . (2^) gen02'2 = gen02 . (2^) gen17'2 = gen17 . (2^) gen20'2 = gen20 . (2^) gen21'2 = gen21 . (2^) gen40'2 = gen40 . (2^) gen41'2 = gen41 . (2^) gen42'2 = gen42 . (2^) gen43'2 = gen43 . (2^) gen03'2 = gen03 . (2^) gen13'2 = gen13 . (2^) gen14'2 = gen14 . (2^) gen15'2 = gen15 . (2^) gen04'2 = gen04 . (2^) gen12'2 = gen12 . (2^) gen24'2 = gen24 . (2^) gen18'2 = gen18 . (2^) gen31'2 = gen31 . (2^) gen32'2 = gen32 . (2^) -------------------------------------------------------------- -- genXX'12 -- gen09'12 = gen09 . (+1) . (2^) gen10'12 = gen10 . (+1) . (2^) gen11'12 = gen11 . (+1) . (2^) gen19'12 = gen19 . (+1) . (2^) gen30'12 = gen30 . (+1) . (2^) gen33'12 = gen33 . (+1) . (2^) gen34'12 = gen34 . (+1) . (2^) gen05'12 = gen05 . (+1) . (2^) gen06'12 = gen06 . (+1) . (2^) gen07'12 = gen07 . (+1) . (2^) gen08'12 = gen08 . (+1) . (2^) gen16'12 = gen16 . (+1) . (2^) gen25'12 = gen25 . (+1) . (2^) gen27'12 = gen27 . (+1) . (2^) gen01'12 = gen01 . (+1) . (2^) gen23'12 = gen23 . (+1) . (2^) gen28'12 = gen28 . (+1) . (2^) gen02'12 = gen02 . (+1) . (2^) gen17'12 = gen17 . (+1) . (2^) gen20'12 = gen20 . (+1) . (2^) gen21'12 = gen21 . (+1) . (2^) gen40'12 = gen40 . (+1) . (2^) gen41'12 = gen41 . (+1) . (2^) gen42'12 = gen42 . (+1) . (2^) gen43'12 = gen43 . (+1) . (2^) gen03'12 = gen03 . (+1) . (2^) gen13'12 = gen13 . (+1) . (2^) gen14'12 = gen14 . (+1) . (2^) gen15'12 = gen15 . (+1) . (2^) gen04'12 = gen04 . (+1) . (2^) gen12'12 = gen12 . (+1) . (2^) gen24'12 = gen24 . (+1) . (2^) gen18'12 = gen18 . (+1) . (2^) gen31'12 = gen31 . (+1) . (2^) gen32'12 = gen32 . (+1) . (2^)