{-# LANGUAGE 
        MultiParamTypeClasses, 
        FlexibleContexts #-}

-- | Gen routines. First argument is ftable's size, load time is set to zero.
--
-- <http://www.csounds.com/manual/html/ScoreGenRef.html>
--
module CsoundExpr.Base.Gens 
 (
             skipNorm, 
             
-- * Specific gens

-- | Converts values created with genXXs to some specific GEN form.
--
-- >q = toFtgentmp $ gen10 4096 [1]
             toFtgen, toFtgentmp, toFtgenonce,
-- * 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.Base.UserDefined
import CsoundExpr.Base.Arithmetic

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 :: IM CsTree a => Id -> Size -> [Double] -> a
genD id n = gen id n . map double

genXD :: IM CsTree b => Id -> (a -> CsTree) -> Size -> a -> [Double] -> b
genXD id fun n v vs = gen id n $ fun v : map double vs

ftval :: Irate -> CsTree
ftval = ftable . getFtable . to

-- | skip normalization. It can be applied to values created 
-- with genXX functions or genXX-like values (i.e. things
-- converted from genXX to specific gens, or things created
-- with genXX'NN)
skipNorm :: Irate -> Irate
skipNorm x 
    | isFtable' h = from $ mapFtable skipFt $ to x
    | isOpc     h = from $ skipOpc h t 
    | otherwise   = skipErrorMsg
    where (h, t) = decompCsTree $ to x


isFtable' :: CsExpr -> Bool
isFtable' x 
    | isVal x   = isFtable $ value x
    | otherwise = False


skipErrorMsg = error "skipNorm argument should be genXX or gen-like value"

skipFt :: Ftable -> Ftable
skipFt x = case x of
              (Ftable n (GEN id xs)) -> Ftable n $ GEN (-(abs id)) xs
              _                      -> x

skipOpc :: CsExpr -> [CsTree] -> CsTree
skipOpc h args
    | isGenLike h = pure h $ skipGenId args
    | otherwise   = skipErrorMsg


isGenLike :: CsExpr -> Bool
isGenLike = (`elem` ["ftgen", "ftgentmp", "ftgenonce"]) . opcName

skipGenId :: [CsTree] -> [CsTree]
skipGenId xs = take 3 xs ++ (skipElem $ xs !! 3) : drop 4 xs
    where skipElem = int . negate . abs . 
                      (\(ValueInt x) -> x) . value . getCsExpr


-- | converts values created with genXX 
-- to 'ftgen' csound opcode representation.
-- Two first arguments assigned to zero.
toFtgen :: Irate -> Irate
toFtgen = fromGen "ftgen"

-- | converts values created with genXX 
-- to 'ftgentmp' csound opcode representation.
-- Two first arguments assigned to zero.
toFtgentmp :: Irate -> Irate
toFtgentmp = fromGen "ftgentmp"

-- | converts values created with genXX 
-- to 'ftgenonce' csound opcode representation.
-- Two first arguments assigned to zero.
toFtgenonce :: Irate -> Irate
toFtgenonce = fromGen "ftgenonce" 

fromGen :: String -> Irate -> Irate
fromGen name x = opcode name args
    where args = int 0 : int 0 : int n : int id : xs
          (Ftable n (GEN id xs)) = errorIfEmpty $ getFtable $ to x

errorIfEmpty :: Ftable -> Ftable
errorIfEmpty x = 
    case x of
        EmptyFtable -> error msg
        _           -> x
    where msg = "conversion is possible for non-empty ftables only"
    



-- 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 : <http://www.csounds.com/manual/html/GEN09.html>
gen09 :: Int -> [Double] -> Irate
gen09 = genD 9

-- | GEN10 - Composite waveforms made up of weighted sums of simple sinusoids.
--
-- url : <http://www.csounds.com/manual/html/GEN10.html>
gen10 :: Int -> [Double] -> Irate
gen10 = genD 10

-- | GEN11 - Additive set of cosine partials.
--
-- url : <http://www.csounds.com/manual/html/GEN11.html>
gen11 :: Int -> Int -> [Double] -> Irate
gen11 = genXD 11 int

-- | GEN19 - Composite waveforms made up of weighted sums of simple sinusoids.
--
-- url : <http://www.csounds.com/manual/html/GEN19.html>
gen19 :: Int -> [Double] -> Irate
gen19 = genD 19


-- | GEN30 - Generates harmonic partials by analyzing an existing table.
--
-- url : <http://www.csounds.com/manual/html/GEN30.html>
gen30 :: Int -> Irate -> [Double] -> Irate
gen30 = genXD 30 ftval

-- | GEN33 - Generate composite waveforms by mixing simple sinusoids.
--
-- url : <http://www.csounds.com/manual/html/GEN33.html>
gen33 :: Int -> Irate -> [Double] -> Irate
gen33 = genXD 33 ftval


-- | GEN34 - Generate composite waveforms by mixing simple sinusoids.
--
-- url : <http://www.csounds.com/manual/html/GEN34.html>
gen34 :: Int -> Irate -> [Double] -> Irate
gen34 = genXD 34 ftval

-- 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 : <http://www.csounds.com/manual/html/GEN05.html>
gen05 :: Int -> [Double] -> Irate
gen05 = genD 5

-- | GEN06 - Generates a function comprised of segments of cubic polynomials.
--
-- url : <http://www.csounds.com/manual/html/GEN06.html>
gen06 :: Int -> [Double] -> Irate
gen06 = genD 6

-- | GEN07 - Constructs functions from segments of straight lines.
--
-- url : <http://www.csounds.com/manual/html/GEN07.html>
gen07 :: Int -> [Double] -> Irate
gen07 = genD 7

-- | GEN08 - Generate a piecewise cubic spline curve.
--
-- url : <http://www.csounds.com/manual/html/GEN08.html>
gen08 :: Int -> [Double] -> Irate
gen08 = genD 8

-- | GEN16 - Creates a table from a starting value to an ending value.
--
-- url : <http://www.csounds.com/manual/html/GEN16.html>
gen16 :: Int -> [Double] -> Irate
gen16 = genD 16

-- | GEN25 - Construct functions from segments of exponential curves in breakpoint fashion.
--
-- url : <http://www.csounds.com/manual/html/GEN25.html>
gen25 :: Int -> [Double] -> Irate
gen25 = genD 25

-- | GEN27 - Construct functions from segments of straight lines in breakpoint fashion.
--
-- url : <http://www.csounds.com/manual/html/GEN27.html>
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 : <http://www.csounds.com/manual/html/GEN01.html>
gen01 :: Int -> String -> [Double] -> Irate
gen01 = genXD 1 string 

-- | GEN23 - Reads numeric values from a text file.
--
-- url : <http://www.csounds.com/manual/html/GEN23.html>
gen23 :: Int -> String -> Irate
gen23 n file = gen 23 n [string file]

-- | GEN28 - Reads a text file which contains a time-tagged trajectory.
--
-- url : <http://www.csounds.com/manual/html/GEN28.html>
gen28 :: Int -> String -> Irate
gen28 n file = gen 28 n [string file]


-- Numeric Value Access GEN Routines
--     gen02, gen17,

-- | GEN02 - Transfers data from immediate pfields into a function table.
--
-- url : <http://www.csounds.com/manual/html/GEN02.html>
gen02 :: Int -> [Double] -> Irate
gen02 = genD 2 

-- | GEN17 - Creates a step function from given x-y pairs.
--
-- url : <http://www.csounds.com/manual/html/GEN17.html>
gen17 :: Int -> [Double] -> Irate
gen17 = genD 17

-- Window Function GEN Routines
--     gen20,

-- | GEN20 - Generates functions of different windows.
--
-- url : <http://www.csounds.com/manual/html/GEN20.html>
gen20 :: Int -> [Double] -> Irate
gen20 = genD 20


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

-- | GEN21 - Generates tables of different random distributions.
--
-- url : <http://www.csounds.com/manual/html/GEN21.html>
gen21 :: Int -> [Double] -> SideEffect Irate
gen21 = genD 21 

-- | GEN41 - Generates a random list of numerical pairs.
--
-- url : <http://www.csounds.com/manual/html/GEN41.html>
gen41 :: Int -> [Double] -> SideEffect Irate
gen41 = genD 41 

-- | GEN42 - Generates a random distribution of discrete ranges of values.
--
-- url : <http://www.csounds.com/manual/html/GEN42.html>
gen42 :: Int -> [Double] -> SideEffect Irate
gen42 = genD 42 

-- | GEN40 - Generates a random distribution using a distribution histogram.
--
-- url : <http://www.csounds.com/manual/html/GEN40.html>
gen40 :: Int -> Irate -> SideEffect Irate
gen40 n ft = gen 40 n [ftval ft]

-- | GEN43 - Loads a PVOCEX file containing a PV analysis.
--
-- url : <http://www.csounds.com/manual/html/GEN43.html>
gen43 :: Int -> String -> [Double] -> Irate
gen43 = genXD 43 string


-- Waveshaping GEN Routines
--     gen03, gen13, gen14, gen15,


-- | GEN03 - Generates a stored function table by evaluating a polynomial.
--
-- url : <http://www.csounds.com/manual/html/GEN03.html>
gen03 :: Int -> [Double] -> Irate
gen03 = genD 3

-- | GEN13 - Stores a polynomial whose coefficients derive from the Chebyshev polynomials of the first kind.
--
-- url : <http://www.csounds.com/manual/html/GEN13.html>
gen13 :: Int -> [Double] -> Irate
gen13 = genD 13

-- | GEN14 - Stores a polynomial whose coefficients derive from Chebyshevs of the second kind.
--
-- url : <http://www.csounds.com/manual/html/GEN14.html>
gen14 :: Int -> [Double] -> Irate
gen14 = genD 14

-- | GEN15 - Creates two tables of stored polynomial functions.
--
-- url : <http://www.csounds.com/manual/html/GEN15.html>
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 : <http://www.csounds.com/manual/html/GEN12.html>
gen12 :: Int -> [Double] -> Irate
gen12 = genD 12 

-- | GEN04 - Generates a normalizing function.
--
-- url : <http://www.csounds.com/manual/html/GEN04.html>
gen04 :: Int -> Irate -> [Double] -> Irate
gen04 = genXD 4 ftval

-- | GEN24 - Reads numeric values from another allocated function-table and rescales them.
--
-- url : <http://www.csounds.com/manual/html/GEN24.html>
gen24 :: Int -> Irate -> [Double] -> Irate
gen24 = genXD 24 ftval


-- Mixing GEN Routines
--    gen18, gen31, gen32

-- | GEN18 - Writes composite waveforms made up of pre-existing waveforms.
--
-- url : <http://www.csounds.com/manual/html/GEN18.html>
gen18 :: Int -> [(Irate, Double, Int, Int)] -> Irate
gen18 n xs = gen 18 n (f =<< xs)
    where f (x1, x2, x3, x4) = [ftval x1, double x2, int x3, int x4]

-- | GEN31 - Mixes any waveform specified in an existing table.
--
-- url : <http://www.csounds.com/manual/html/GEN31.html>
gen31 :: Int -> Irate -> [Double] -> Irate
gen31 = genXD 31 ftval

-- | GEN32 - Mixes any waveform, resampled with either FFT or linear interpolation.
--
-- url : <http://www.csounds.com/manual/html/GEN32.html>
gen32 :: Int -> [(Irate, Int, Double, Double)] -> Irate
gen32 n xs = gen 32 n (f =<< xs)
    where f (x1, x2, x3, x4) = [ftval x1, int x2, double x3, double 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^)