-- | Table Access
module CsoundExpr.Opcodes.Siggen.Tableacc
    (oscil1,
     oscil1i,
     tableA,
     tableI,
     tableK,
     table3A,
     table3I,
     table3K,
     tableiA,
     tableiI,
     tableiK,
     tabA,
     tabK,
     tab_i,
     tabwA,
     tabwK,
     tabw_i)
where



import CsoundExpr.Base.Types
import CsoundExpr.Base.MultiOut
import CsoundExpr.Base.SideEffect
import CsoundExpr.Base.UserDefined



-- | * opcode : oscil1
--  
--  
-- * syntax : 
--  
--  >   kres oscil1 idel, kamp, idur, ifn
--  
--  
-- * description : 
--  
--  Accesses table values by incremental sampling.
--  
--  
-- * url : <http://www.csounds.com/manual/html/oscil1.html>
 
oscil1 :: (K k0) => Irate -> k0 -> Irate -> Irate -> Krate
oscil1 i0del k1amp i2dur i3fn = opcode "oscil1" args
  where args = [to i0del, to k1amp, to i2dur, to i3fn]


-- | * opcode : oscil1i
--  
--  
-- * syntax : 
--  
--  >   kres oscil1i idel, kamp, idur, ifn
--  
--  
-- * description : 
--  
--  Accesses table values by incremental sampling with linear
-- interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/oscil1i.html>
 
oscil1i :: (K k0) => Irate -> k0 -> Irate -> Irate -> Krate
oscil1i i0del k1amp i2dur i3fn = opcode "oscil1i" args
  where args = [to i0del, to k1amp, to i2dur, to i3fn]


-- | * opcode : table
--  
--  
-- * syntax : 
--  
--  >   ares table andx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   ires table indx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   kres table kndx, ifn [, ixmode] [, ixoff] [, iwrap]
--  
--  
-- * description : 
--  
--  Accesses table values by direct indexing.
--  
--  
-- * url : <http://www.csounds.com/manual/html/table.html>
 
tableA :: [Irate] -> Arate -> Irate -> Arate
tableA i0init a1ndx i2fn = opcode "table" args
  where args = [to a1ndx, to i2fn] ++ map to i0init


-- | * opcode : table
--  
--  
-- * syntax : 
--  
--  >   ares table andx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   ires table indx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   kres table kndx, ifn [, ixmode] [, ixoff] [, iwrap]
--  
--  
-- * description : 
--  
--  Accesses table values by direct indexing.
--  
--  
-- * url : <http://www.csounds.com/manual/html/table.html>
 
tableI :: [Irate] -> Irate -> Irate -> Irate
tableI i0init i1ndx i2fn = opcode "table" args
  where args = [to i1ndx, to i2fn] ++ map to i0init


-- | * opcode : table
--  
--  
-- * syntax : 
--  
--  >   ares table andx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   ires table indx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   kres table kndx, ifn [, ixmode] [, ixoff] [, iwrap]
--  
--  
-- * description : 
--  
--  Accesses table values by direct indexing.
--  
--  
-- * url : <http://www.csounds.com/manual/html/table.html>
 
tableK :: (K k0) => [Irate] -> k0 -> Irate -> Krate
tableK i0init k1ndx i2fn = opcode "table" args
  where args = [to k1ndx, to i2fn] ++ map to i0init


-- | * opcode : table3
--  
--  
-- * syntax : 
--  
--  >   ares table3 andx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   ires table3 indx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   kres table3 kndx, ifn [, ixmode] [, ixoff] [, iwrap]
--  
--  
-- * description : 
--  
--  Accesses table values by direct indexing with cubic
-- interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/table3.html>
 
table3A :: [Irate] -> Arate -> Irate -> Arate
table3A i0init a1ndx i2fn = opcode "table3" args
  where args = [to a1ndx, to i2fn] ++ map to i0init


-- | * opcode : table3
--  
--  
-- * syntax : 
--  
--  >   ares table3 andx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   ires table3 indx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   kres table3 kndx, ifn [, ixmode] [, ixoff] [, iwrap]
--  
--  
-- * description : 
--  
--  Accesses table values by direct indexing with cubic
-- interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/table3.html>
 
table3I :: [Irate] -> Irate -> Irate -> Irate
table3I i0init i1ndx i2fn = opcode "table3" args
  where args = [to i1ndx, to i2fn] ++ map to i0init


-- | * opcode : table3
--  
--  
-- * syntax : 
--  
--  >   ares table3 andx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   ires table3 indx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   kres table3 kndx, ifn [, ixmode] [, ixoff] [, iwrap]
--  
--  
-- * description : 
--  
--  Accesses table values by direct indexing with cubic
-- interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/table3.html>
 
table3K :: (K k0) => [Irate] -> k0 -> Irate -> Krate
table3K i0init k1ndx i2fn = opcode "table3" args
  where args = [to k1ndx, to i2fn] ++ map to i0init


-- | * opcode : tablei
--  
--  
-- * syntax : 
--  
--  >   ares tablei andx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   ires tablei indx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   kres tablei kndx, ifn [, ixmode] [, ixoff] [, iwrap]
--  
--  
-- * description : 
--  
--  Accesses table values by direct indexing with linear
-- interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/tablei.html>
 
tableiA :: [Irate] -> Arate -> Irate -> Arate
tableiA i0init a1ndx i2fn = opcode "tablei" args
  where args = [to a1ndx, to i2fn] ++ map to i0init


-- | * opcode : tablei
--  
--  
-- * syntax : 
--  
--  >   ares tablei andx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   ires tablei indx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   kres tablei kndx, ifn [, ixmode] [, ixoff] [, iwrap]
--  
--  
-- * description : 
--  
--  Accesses table values by direct indexing with linear
-- interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/tablei.html>
 
tableiI :: [Irate] -> Irate -> Irate -> Irate
tableiI i0init i1ndx i2fn = opcode "tablei" args
  where args = [to i1ndx, to i2fn] ++ map to i0init


-- | * opcode : tablei
--  
--  
-- * syntax : 
--  
--  >   ares tablei andx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   ires tablei indx, ifn [, ixmode] [, ixoff] [, iwrap]
--  >   kres tablei kndx, ifn [, ixmode] [, ixoff] [, iwrap]
--  
--  
-- * description : 
--  
--  Accesses table values by direct indexing with linear
-- interpolation.
--  
--  
-- * url : <http://www.csounds.com/manual/html/tablei.html>
 
tableiK :: (K k0) => [Irate] -> k0 -> Irate -> Krate
tableiK i0init k1ndx i2fn = opcode "tablei" args
  where args = [to k1ndx, to i2fn] ++ map to i0init


-- | * opcode : tab
--  
--  
-- * syntax : 
--  
--  >   ir tab_i indx, ifn[, ixmode]
--  >   kr tab kndx, ifn[, ixmode]
--  >   ar tab xndx, ifn[, ixmode]
--  >   tabw_i isig, indx, ifn [,ixmode]
--  >   tabw ksig, kndx, ifn [,ixmode]
--  >   tabw asig, andx, ifn [,ixmode]
--  
--  
-- * description : 
--  
--  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).
--  
--  
-- * url : <http://www.csounds.com/manual/html/tab.html>
 
tabA :: (X x0) => [Irate] -> x0 -> Irate -> Arate
tabA i0init x1ndx i2fn = opcode "tab" args
  where args = [to x1ndx, to i2fn] ++ map to i0init


-- | * opcode : tab
--  
--  
-- * syntax : 
--  
--  >   ir tab_i indx, ifn[, ixmode]
--  >   kr tab kndx, ifn[, ixmode]
--  >   ar tab xndx, ifn[, ixmode]
--  >   tabw_i isig, indx, ifn [,ixmode]
--  >   tabw ksig, kndx, ifn [,ixmode]
--  >   tabw asig, andx, ifn [,ixmode]
--  
--  
-- * description : 
--  
--  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).
--  
--  
-- * url : <http://www.csounds.com/manual/html/tab.html>
 
tabK :: (K k0) => [Irate] -> k0 -> Irate -> Krate
tabK i0init k1ndx i2fn = opcode "tab" args
  where args = [to k1ndx, to i2fn] ++ map to i0init


-- | * opcode : tab_i
--  
--  
-- * syntax : 
--  
--  >   ir tab_i indx, ifn[, ixmode]
--  >   kr tab kndx, ifn[, ixmode]
--  >   ar tab xndx, ifn[, ixmode]
--  >   tabw_i isig, indx, ifn [,ixmode]
--  >   tabw ksig, kndx, ifn [,ixmode]
--  >   tabw asig, andx, ifn [,ixmode]
--  
--  
-- * description : 
--  
--  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).
--  
--  
-- * url : <http://www.csounds.com/manual/html/tab.html>
 
tab_i :: [Irate] -> Irate -> Irate -> Irate
tab_i i0init i1ndx i2fn = opcode "tab_i" args
  where args = [to i1ndx, to i2fn] ++ map to i0init


-- | * opcode : tabw
--  
--  
-- * syntax : 
--  
--  >   ir tab_i indx, ifn[, ixmode]
--  >   kr tab kndx, ifn[, ixmode]
--  >   ar tab xndx, ifn[, ixmode]
--  >   tabw_i isig, indx, ifn [,ixmode]
--  >   tabw ksig, kndx, ifn [,ixmode]
--  >   tabw asig, andx, ifn [,ixmode]
--  
--  
-- * description : 
--  
--  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).
--  
--  
-- * url : <http://www.csounds.com/manual/html/tab.html>
 
tabwA :: [Irate] -> Arate -> Arate -> Irate -> SignalOut
tabwA i0init a1sig a2ndx i3fn = outOpcode "tabw" args
  where args = [to a1sig, to a2ndx, to i3fn] ++ map to i0init


-- | * opcode : tabw
--  
--  
-- * syntax : 
--  
--  >   ir tab_i indx, ifn[, ixmode]
--  >   kr tab kndx, ifn[, ixmode]
--  >   ar tab xndx, ifn[, ixmode]
--  >   tabw_i isig, indx, ifn [,ixmode]
--  >   tabw ksig, kndx, ifn [,ixmode]
--  >   tabw asig, andx, ifn [,ixmode]
--  
--  
-- * description : 
--  
--  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).
--  
--  
-- * url : <http://www.csounds.com/manual/html/tab.html>
 
tabwK :: (K k0, K k1) => [Irate] -> k0 -> k1 -> Irate -> SignalOut
tabwK i0init k1sig k2ndx i3fn = outOpcode "tabw" args
  where args = [to k1sig, to k2ndx, to i3fn] ++ map to i0init


-- | * opcode : tabw_i
--  
--  
-- * syntax : 
--  
--  >   ir tab_i indx, ifn[, ixmode]
--  >   kr tab kndx, ifn[, ixmode]
--  >   ar tab xndx, ifn[, ixmode]
--  >   tabw_i isig, indx, ifn [,ixmode]
--  >   tabw ksig, kndx, ifn [,ixmode]
--  >   tabw asig, andx, ifn [,ixmode]
--  
--  
-- * description : 
--  
--  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).
--  
--  
-- * url : <http://www.csounds.com/manual/html/tab.html>
 
tabw_i :: [Irate] -> Irate -> Irate -> Irate -> SignalOut
tabw_i i0init i1sig i2ndx i3fn = outOpcode "tabw_i" args
  where args = [to i1sig, to i2ndx, to i3fn] ++ map to i0init