module Csound.Typed.Opcode.TableControl (
    
    
    
    ftfree, ftgen, ftgentmp, sndload) where

import Control.Applicative
import Control.Monad.Trans.Class
import Csound.Dynamic
import Csound.Typed

-- 

-- | 
-- Deletes function table.
--
-- >  ftfree  ifno, iwhen
--
-- csound doc: <http://www.csounds.com/manual/html/ftfree.html>
ftfree ::  Tab -> D -> SE ()
ftfree b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unTab b1 <*> unD b2
    where f a1 a2 = opcs "ftfree" [(Xr,[Ir,Ir])] [a1,a2]

-- | 
-- Generate a score function table from within the orchestra.
--
-- > gir  ftgen  ifn, itime, isize, igen, iarga [, iargb ] [...]
--
-- csound doc: <http://www.csounds.com/manual/html/ftgen.html>
ftgen ::  Tab -> D -> D -> D -> D -> SE D
ftgen b1 b2 b3 b4 b5 = fmap ( D . return) $ SE $ (depT =<<) $ lift $ f <$> unTab b1 <*> unD b2 <*> unD b3 <*> unD b4 <*> unD b5
    where f a1 a2 a3 a4 a5 = opcs "ftgen" [(Ir,(repeat Ir))] [a1,a2,a3,a4,a5]

-- | 
-- Generate a score function table from within the orchestra, which is deleted at the end of the note.
--
-- Generate a score function table from within the orchestra,
--     which is optionally deleted at the end of the note.
--
-- > ifno  ftgentmp  ip1, ip2dummy, isize, igen, iarga, iargb, ...
--
-- csound doc: <http://www.csounds.com/manual/html/ftgentmp.html>
ftgentmp ::  D -> D -> D -> D -> D -> [D] -> Tab
ftgentmp b1 b2 b3 b4 b5 b6 = Tab $ f <$> unD b1 <*> unD b2 <*> unD b3 <*> unD b4 <*> unD b5 <*> mapM unD b6
    where f a1 a2 a3 a4 a5 a6 = opcs "ftgentmp" [(Ir,(repeat Ir))] ([a1,a2,a3,a4,a5] ++ a6)

-- | 
-- Loads a sound file into memory for use by loscilx
--
-- sndload loads a sound file into memory for use by loscilx.
--
-- >  sndload  Sfname[, ifmt[, ichns[, isr[, ibas[, iamp[, istrt   \
-- >           [, ilpmod[, ilps[, ilpe]]]]]]]]]
--
-- csound doc: <http://www.csounds.com/manual/html/sndload.html>
sndload ::  Str -> SE ()
sndload b1 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1
    where f a1 = opcs "sndload" [(Xr,[Sr,Ir,Ir,Ir,Ir,Ir,Ir,Ir,Ir,Ir])] [a1]