-- | Read/Write Operations module CsoundExpr.Opcodes.Table.Readwrit (ftloadk, ftload, ftsavek, ftsave, tablecopy, tablegpw, tableicopy, tableigpw, tableimix, tableiw, tablemix, tablera, tablewA, tablewI, tablewK, tablewa, tablewktA, tablewktK, tabmorph, tabmorpha, tabmorphak, tabmorphi, tabrec, tabplay) where import CsoundExpr.Base.Types import CsoundExpr.Base.MultiOut import CsoundExpr.Base.SideEffect import CsoundExpr.Base.UserDefined -- | * opcode : ftloadk -- -- -- * syntax : -- -- > ftloadk "filename", ktrig, iflag, ifn1 [, ifn2] [...] -- -- -- * description : -- -- Load a set of previously-allocated tables from a file. -- -- -- * url : ftloadk :: (K k0) => String -> k0 -> Irate -> [Irate] -> SignalOut ftloadk s0filename k1trig i2flag i3fns = outOpcode "ftloadk" args where args = [to s0filename, to k1trig, to i2flag] ++ map to i3fns -- | * opcode : ftload -- -- -- * syntax : -- -- > ftload "filename", iflag, ifn1 [, ifn2] [...] -- -- -- * description : -- -- Load a set of previously-allocated tables from a file. -- -- -- * url : ftload :: String -> Irate -> [Irate] -> SignalOut ftload s0filename i1flag i2fns = outOpcode "ftload" args where args = [to s0filename, to i1flag] ++ map to i2fns -- | * opcode : ftsavek -- -- -- * syntax : -- -- > ftsavek "filename", ktrig, iflag, ifn1 [, ifn2] [...] -- -- -- * description : -- -- Save a set of previously-allocated tables to a file. -- -- -- * url : ftsavek :: (K k0) => String -> k0 -> Irate -> [Irate] -> SignalOut ftsavek s0filename k1trig i2flag i3fns = outOpcode "ftsavek" args where args = [to s0filename, to k1trig, to i2flag] ++ map to i3fns -- | * opcode : ftsave -- -- -- * syntax : -- -- > ftsave "filename", iflag, ifn1 [, ifn2] [...] -- -- -- * description : -- -- Save a set of previously-allocated tables to a file. -- -- -- * url : ftsave :: String -> Irate -> [Irate] -> SignalOut ftsave s0filename i1flag i2fns = outOpcode "ftsave" args where args = [to s0filename, to i1flag] ++ map to i2fns -- | * opcode : tablecopy -- -- -- * syntax : -- -- > tablecopy kdft, ksft -- -- -- * description : -- -- Simple, fast table copy opcode. -- -- -- * url : tablecopy :: (K k0, K k1) => k0 -> k1 -> SignalOut tablecopy k0dft k1sft = outOpcode "tablecopy" args where args = [to k0dft, to k1sft] -- | * opcode : tablegpw -- -- -- * syntax : -- -- > tablegpw kfn -- -- -- * description : -- -- Writes a table's guard point. -- -- -- * url : tablegpw :: (K k0) => k0 -> SignalOut tablegpw k0fn = outOpcode "tablegpw" args where args = [to k0fn] -- | * opcode : tableicopy -- -- -- * syntax : -- -- > tableicopy idft, isft -- -- -- * description : -- -- Simple, fast table copy opcode. -- -- -- * url : tableicopy :: Irate -> Irate -> SignalOut tableicopy i0dft i1sft = outOpcode "tableicopy" args where args = [to i0dft, to i1sft] -- | * opcode : tableigpw -- -- -- * syntax : -- -- > tableigpw ifn -- -- -- * description : -- -- Writes a table's guard point. -- -- -- * url : tableigpw :: Irate -> SignalOut tableigpw i0fn = outOpcode "tableigpw" args where args = [to i0fn] -- | * opcode : tableimix -- -- -- * syntax : -- -- > tableimix idft, idoff, ilen, is1ft, is1off, is1g, is2ft, is2off, is2g -- -- -- * description : -- -- Mixes two tables. -- -- -- * url : tableimix :: Irate -> Irate -> Irate -> Irate -> Irate -> Irate -> Irate -> Irate -> Irate -> SignalOut tableimix i0dft i1doff i2len i3s1ft i4s1off i5s1g i6s2ft i7s2off i8s2g = outOpcode "tableimix" args where args = [to i0dft, to i1doff, to i2len, to i3s1ft, to i4s1off, to i5s1g, to i6s2ft, to i7s2off, to i8s2g] -- | * opcode : tableiw -- -- -- * syntax : -- -- > tableiw isig, indx, ifn [, ixmode] [, ixoff] [, iwgmode] -- -- -- * description : -- -- This opcode operates on existing function tables, changing their -- contents. tableiw is used when all inputs are init time variables -- or constants and you only want to run it at the initialization of -- the instrument. The valid combinations of variable types are -- shown by the first letter of the variable names. -- -- -- * url : tableiw :: [Irate] -> Irate -> Irate -> Irate -> SignalOut tableiw i0init i1sig i2ndx i3fn = outOpcode "tableiw" args where args = [to i1sig, to i2ndx, to i3fn] ++ map to i0init -- | * opcode : tablemix -- -- -- * syntax : -- -- > tablemix kdft, kdoff, klen, ks1ft, ks1off, ks1g, ks2ft, ks2off, ks2g -- -- -- * description : -- -- Mixes two tables. -- -- -- * url : tablemix :: (K k0, K k1, K k2, K k3, K k4, K k5, K k6, K k7, K k8) => k0 -> k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8 -> SignalOut tablemix k0dft k1doff k2len k3s1ft k4s1off k5s1g k6s2ft k7s2off k8s2g = outOpcode "tablemix" args where args = [to k0dft, to k1doff, to k2len, to k3s1ft, to k4s1off, to k5s1g, to k6s2ft, to k7s2off, to k8s2g] -- | * opcode : tablera -- -- -- * syntax : -- -- > ares tablera kfn, kstart, koff -- -- -- * description : -- -- These opcode reads tables in sequential locations to an a-rate -- variable. Some thought is required before using it. It has at -- least two major, and quite different, applications which are -- discussed below. -- -- -- * url : tablera :: (K k0, K k1, K k2) => k0 -> k1 -> k2 -> Arate tablera k0fn k1start k2off = opcode "tablera" args where args = [to k0fn, to k1start, to k2off] -- | * opcode : tablew -- -- -- * syntax : -- -- > tablew asig, andx, ifn [, ixmode] [, ixoff] [, iwgmode] -- > tablew isig, indx, ifn [, ixmode] [, ixoff] [, iwgmode] -- > tablew ksig, kndx, ifn [, ixmode] [, ixoff] [, iwgmode] -- -- -- * description : -- -- This opcode operates on existing function tables, changing their -- contents. tablew is for writing at k- or at a-rates, with the -- table number being specified at init time. The valid combinations -- of variable types are shown by the first letter of the variable -- names. -- -- -- * url : tablewA :: [Irate] -> Arate -> Arate -> Irate -> SignalOut tablewA i0init a1sig a2ndx i3fn = outOpcode "tablew" args where args = [to a1sig, to a2ndx, to i3fn] ++ map to i0init -- | * opcode : tablew -- -- -- * syntax : -- -- > tablew asig, andx, ifn [, ixmode] [, ixoff] [, iwgmode] -- > tablew isig, indx, ifn [, ixmode] [, ixoff] [, iwgmode] -- > tablew ksig, kndx, ifn [, ixmode] [, ixoff] [, iwgmode] -- -- -- * description : -- -- This opcode operates on existing function tables, changing their -- contents. tablew is for writing at k- or at a-rates, with the -- table number being specified at init time. The valid combinations -- of variable types are shown by the first letter of the variable -- names. -- -- -- * url : tablewI :: [Irate] -> Irate -> Irate -> Irate -> SignalOut tablewI i0init i1sig i2ndx i3fn = outOpcode "tablew" args where args = [to i1sig, to i2ndx, to i3fn] ++ map to i0init -- | * opcode : tablew -- -- -- * syntax : -- -- > tablew asig, andx, ifn [, ixmode] [, ixoff] [, iwgmode] -- > tablew isig, indx, ifn [, ixmode] [, ixoff] [, iwgmode] -- > tablew ksig, kndx, ifn [, ixmode] [, ixoff] [, iwgmode] -- -- -- * description : -- -- This opcode operates on existing function tables, changing their -- contents. tablew is for writing at k- or at a-rates, with the -- table number being specified at init time. The valid combinations -- of variable types are shown by the first letter of the variable -- names. -- -- -- * url : tablewK :: (K k0, K k1) => [Irate] -> k0 -> k1 -> Irate -> SignalOut tablewK i0init k1sig k2ndx i3fn = outOpcode "tablew" args where args = [to k1sig, to k2ndx, to i3fn] ++ map to i0init -- | * opcode : tablewa -- -- -- * syntax : -- -- > kstart tablewa kfn, asig, koff -- -- -- * description : -- -- This opcode writes to a table in sequential locations to and -- from an a-rate variable. Some thought is required before using -- it. It has at least two major, and quite different, applications -- which are discussed below. -- -- -- * url : tablewa :: (K k0, K k1) => k0 -> Arate -> k1 -> Krate tablewa k0fn a1sig k2off = opcode "tablewa" args where args = [to k0fn, to a1sig, to k2off] -- | * opcode : tablewkt -- -- -- * syntax : -- -- > tablewkt asig, andx, kfn [, ixmode] [, ixoff] [, iwgmode] -- > tablewkt ksig, kndx, kfn [, ixmode] [, ixoff] [, iwgmode] -- -- -- * description : -- -- This opcode operates on existing function tables, changing their -- contents. tablewkt uses a k-rate variable for selecting the table -- number. The valid combinations of variable types are shown by the -- first letter of the variable names. -- -- -- * url : tablewktA :: (K k0) => [Irate] -> Arate -> Arate -> k0 -> SignalOut tablewktA i0init a1sig a2ndx k3fn = outOpcode "tablewkt" args where args = [to a1sig, to a2ndx, to k3fn] ++ map to i0init -- | * opcode : tablewkt -- -- -- * syntax : -- -- > tablewkt asig, andx, kfn [, ixmode] [, ixoff] [, iwgmode] -- > tablewkt ksig, kndx, kfn [, ixmode] [, ixoff] [, iwgmode] -- -- -- * description : -- -- This opcode operates on existing function tables, changing their -- contents. tablewkt uses a k-rate variable for selecting the table -- number. The valid combinations of variable types are shown by the -- first letter of the variable names. -- -- -- * url : tablewktK :: (K k0, K k1, K k2) => [Irate] -> k0 -> k1 -> k2 -> SignalOut tablewktK i0init k1sig k2ndx k3fn = outOpcode "tablewkt" args where args = [to k1sig, to k2ndx, to k3fn] ++ map to i0init -- | * opcode : tabmorph -- -- -- * syntax : -- -- > kout tabmorph kindex, kweightpoint, ktabnum1, ktabnum2, -- > ifn1, ifn2 [, ifn3, ifn4,... ifnN] -- -- -- * description : -- -- tabmorph allows morphing between a set of tables of the same -- size, by means of a weighted average between two currently -- selected tables. -- -- -- * url : tabmorph :: (K k0, K k1, K k2, K k3) => k0 -> k1 -> k2 -> k3 -> [Irate] -> Krate tabmorph k0index k1weightpoint k2tabnum1 k3tabnum2 i4fn = opcode "tabmorph" args where args = [to k0index, to k1weightpoint, to k2tabnum1, to k3tabnum2] ++ map to i4fn -- | * opcode : tabmorpha -- -- -- * syntax : -- -- > aout tabmorpha aindex, aweightpoint, atabnum1, atabnum2, -- > ifn1, ifn2 [, ifn3, ifn4,... ifnN] -- -- -- * description : -- -- tabmorpha allows morphing between a set of tables of the same -- size, by means of a weighted average between two currently -- selected tables. -- -- -- * url : tabmorpha :: Arate -> Arate -> Arate -> Arate -> [Irate] -> Arate tabmorpha a0index a1weightpoint a2tabnum1 a3tabnum2 i4fn = opcode "tabmorpha" args where args = [to a0index, to a1weightpoint, to a2tabnum1, to a3tabnum2] ++ map to i4fn -- | * opcode : tabmorphak -- -- -- * syntax : -- -- > aout tabmorphak aindex, kweightpoint, ktabnum1, ktabnum2, -- > ifn1, ifn2 [, ifn3, ifn4,... ifnN] -- -- -- * description : -- -- tabmorphak allows morphing between a set of tables of the same -- size, by means of a weighted average between two currently -- selected tables. -- -- -- * url : tabmorphak :: (K k0, K k1, K k2) => Arate -> k0 -> k1 -> k2 -> [Irate] -> Arate tabmorphak a0index k1weightpoint k2tabnum1 k3tabnum2 i4fn = opcode "tabmorphak" args where args = [to a0index, to k1weightpoint, to k2tabnum1, to k3tabnum2] ++ map to i4fn -- | * opcode : tabmorphi -- -- -- * syntax : -- -- > kout tabmorphi kindex, kweightpoint, ktabnum1, ktabnum2, -- > ifn1, ifn2 [, ifn3, ifn4,... ifnN] -- -- -- * description : -- -- tabmorphi allows morphing between a set of tables of the same -- size, by means of a weighted average between two currently -- selected tables. -- -- -- * url : tabmorphi :: (K k0, K k1, K k2, K k3) => k0 -> k1 -> k2 -> k3 -> [Irate] -> Krate tabmorphi k0index k1weightpoint k2tabnum1 k3tabnum2 i4fn = opcode "tabmorphi" args where args = [to k0index, to k1weightpoint, to k2tabnum1, to k3tabnum2] ++ map to i4fn -- | * opcode : tabrec -- -- -- * syntax : -- -- > tabrec ktrig_start, ktrig_stop, knumtics, kfn, kin1 [,kin2,...,kinN] -- -- -- * description : -- -- Records control-rate signals on trigger-temporization basis. -- -- -- * url : tabrec :: (K k0, K k1, K k2, K k3, K k4) => k0 -> k1 -> k2 -> k3 -> [k4] -> SignalOut tabrec k0trig_start k1trig_stop k2numtics k3fn k4inN = outOpcode "tabrec" args where args = [to k0trig_start, to k1trig_stop, to k2numtics, to k3fn] ++ map to k4inN -- | * opcode : tabplay -- -- -- * syntax : -- -- > tabplay ktrig, knumtics, kfn, kout1 [,kout2,..., koutN] -- -- -- * description : -- -- Plays-back control-rate signals on trigger-temporization basis. -- -- -- * url : tabplay :: (K k0, K k1, K k2, K k3) => k0 -> k1 -> k2 -> [k3] -> SignalOut tabplay k0trig k1numtics k2fn k3outN = outOpcode "tabplay" args where args = [to k0trig, to k1numtics, to k2fn] ++ map to k3outN