{-# LANGUAGE 
        MultiParamTypeClasses, 
        FlexibleContexts #-}

-- | Gen routines
-- <http://www.csounds.com/manual/html/ScoreGenRef.html>

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
) 
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.
gen09 :: Int -> [Double] -> Irate
gen09 = genD 9

-- | GEN10 - Composite waveforms made up of weighted sums of simple sinusoids.
gen10 :: Int -> [Double] -> Irate
gen10 = genD 10

-- | GEN11 - Additive set of cosine partials.
gen11 :: Int -> [Double] -> Irate
gen11 = genD 11

-- | GEN19 - Composite waveforms made up of weighted sums of simple sinusoids.
gen19 :: Int -> [Double] -> Irate
gen19 = genD 19


-- | GEN30 - Generates harmonic partials by analyzing an existing table.
gen30 :: Int -> Irate -> [Double] -> Irate
gen30 = gen3x 30

-- | GEN33 - Generate composite waveforms by mixing simple sinusoids.
gen33 :: Int -> Irate -> [Double] -> Irate
gen33 = gen3x 33


-- | GEN34 - Generate composite waveforms by mixing simple sinusoids.
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.
gen05 :: Int -> [Double] -> Irate
gen05 = genD 5

-- | GEN06 - Generates a function comprised of segments of cubic polynomials.
gen06 :: Int -> [Double] -> Irate
gen06 = genD 6

-- | GEN07 - Constructs functions from segments of straight lines.
gen07 :: Int -> [Double] -> Irate
gen07 = genD 7

-- | GEN08 - Generate a piecewise cubic spline curve.
gen08 :: Int -> [Double] -> Irate
gen08 = genD 8

-- | GEN16 - Creates a table from a starting value to an ending value.
gen16 :: Int -> [Double] -> Irate
gen16 = genD 16

-- | GEN25 - Construct functions from segments of exponential curves in breakpoint fashion.
gen25 :: Int -> [Double] -> Irate
gen25 = genD 25

-- | GEN27 - Construct functions from segments of straight lines in breakpoint fashion.
gen27 :: Int -> [Double] -> Irate
gen27 = genD 27


-- File Access GEN Routines:
--       gen01, gen23, gen28,

-- | GEN01 - Transfers data from a soundfile into a function table.
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.
gen23 :: Int -> String -> Irate
gen23 n file = gen 23 n [ftvalS file]

-- | GEN28 - Reads a text file which contains a time-tagged trajectory.
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.
gen02 :: Int -> [Double] -> Irate
gen02 = genD 2 

-- | GEN17 - Creates a step function from given x-y pairs.
gen17 :: Int -> [Double] -> Irate
gen17 = genD 17

-- Window Function GEN Routines
--     gen20,

-- | GEN20 - Generates functions of different windows.
gen20 :: Int -> [Double] -> Irate
gen20 = genD 20


-- Random Function GEN Routines
--     gen21, gen40, gen41, gen42, gen43, 

-- | GEN21 - Generates tables of different random distributions.
gen21 :: Int -> [Double] -> SideEffect Irate
gen21 = gen21 

-- | GEN41 - Generates a random list of numerical pairs.
gen41 :: Int -> [Double] -> SideEffect Irate
gen41 = gen41 

-- | GEN42 - Generates a random distribution of discrete ranges of values.
gen42 :: Int -> [Double] -> SideEffect Irate
gen42 = gen42 

-- | GEN40 - Generates a random distribution using a distribution histogram.
gen40 :: Int -> Irate -> SideEffect Irate
gen40 n ft = gen 40 n [ftvalF ft]

-- | GEN43 - Loads a PVOCEX file containing a PV analysis.
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.
gen03 :: Int -> [Double] -> Irate
gen03 = genD 3

-- | GEN13 - Stores a polynomial whose coefficients derive from the Chebyshev polynomials of the first kind.
gen13 :: Int -> [Double] -> Irate
gen13 = genD 13

-- | GEN14 - Stores a polynomial whose coefficients derive from Chebyshevs of the second kind.
gen14 :: Int -> [Double] -> Irate
gen14 = genD 14

-- | GEN15 - Creates two tables of stored polynomial functions.
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.
gen12 :: Int -> [Double] -> Irate
gen12 = genD 12 

-- | GEN04 - Generates a normalizing function.
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.
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.
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.
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.
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]