-- | Software Bus
module CsoundExpr.Opcodes.Sigio.SoftwareBus
    (chn_k,
     chn_a,
     chn_S,
     chngetA,
     chngetI,
     chngetK,
     chngetS,
     chnsetA,
     chnsetI,
     chnsetK,
     chnsetS,
     chnsendA,
     chnsendI,
     chnsendK,
     chnsendS,
     chnrecvA,
     chnrecvI,
     chnrecvK,
     chnrecvS,
     chnclear,
     chnmix,
     chnparams)
where



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



-- | * opcode : chn_k
--  
--  
-- * syntax : 
--  
--  >   chn_k Sname, imode[, itype, idflt, imin, imax]
--  >   chn_a Sname, imode
--  >   chn_S Sname, imode
--  
--  
-- * description : 
--  
--  Declare a channel of the named software bus, with setting
-- optional parameters in the case of a control channel. If the
-- channel does not exist yet, it is created, with an inital value
-- of zero or empty string. Otherwise, the type (control, audio, or
-- string) of the existing channel must match the declaration, or an
-- init error occurs. The input/output mode of an existing channel
-- is updated so that it becomes the bitwise OR of the previous and
-- the newly specified value.
--  
--  
-- * url : <http://www.csounds.com/manual/html/chn.html>
 
chn_k :: [Irate] -> String -> Irate -> SignalOut
chn_k i0init s1name i2mode = outOpcode "chn_k" args
  where args = [to s1name, to i2mode] ++ map to i0init


-- | * opcode : chn_a
--  
--  
-- * syntax : 
--  
--  >   chn_k Sname, imode[, itype, idflt, imin, imax]
--  >   chn_a Sname, imode
--  >   chn_S Sname, imode
--  
--  
-- * description : 
--  
--  Declare a channel of the named software bus, with setting
-- optional parameters in the case of a control channel. If the
-- channel does not exist yet, it is created, with an inital value
-- of zero or empty string. Otherwise, the type (control, audio, or
-- string) of the existing channel must match the declaration, or an
-- init error occurs. The input/output mode of an existing channel
-- is updated so that it becomes the bitwise OR of the previous and
-- the newly specified value.
--  
--  
-- * url : <http://www.csounds.com/manual/html/chn.html>
 
chn_a :: String -> Irate -> SignalOut
chn_a s0name i1mode = outOpcode "chn_a" args
  where args = [to s0name, to i1mode]


-- | * opcode : chn_S
--  
--  
-- * syntax : 
--  
--  >   chn_k Sname, imode[, itype, idflt, imin, imax]
--  >   chn_a Sname, imode
--  >   chn_S Sname, imode
--  
--  
-- * description : 
--  
--  Declare a channel of the named software bus, with setting
-- optional parameters in the case of a control channel. If the
-- channel does not exist yet, it is created, with an inital value
-- of zero or empty string. Otherwise, the type (control, audio, or
-- string) of the existing channel must match the declaration, or an
-- init error occurs. The input/output mode of an existing channel
-- is updated so that it becomes the bitwise OR of the previous and
-- the newly specified value.
--  
--  
-- * url : <http://www.csounds.com/manual/html/chn.html>
 
chn_S :: String -> Irate -> SignalOut
chn_S s0name i1mode = outOpcode "chn_S" args
  where args = [to s0name, to i1mode]


-- | * opcode : chnget
--  
--  
-- * syntax : 
--  
--  >   ival chnget Sname
--  >   kval chnget Sname
--  >   aval chnget Sname
--  >   Sval chnget Sname
--  
--  
-- * description : 
--  
--  Reads data from a channel of the inward named software bus.
-- Implies declaring the channel with imode=1 (see also chn_k,
-- chn_a, and chn_S).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnget.html>
 
chngetA :: String -> Arate
chngetA s0name = opcode "chnget" args
  where args = [to s0name]


-- | * opcode : chnget
--  
--  
-- * syntax : 
--  
--  >   ival chnget Sname
--  >   kval chnget Sname
--  >   aval chnget Sname
--  >   Sval chnget Sname
--  
--  
-- * description : 
--  
--  Reads data from a channel of the inward named software bus.
-- Implies declaring the channel with imode=1 (see also chn_k,
-- chn_a, and chn_S).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnget.html>
 
chngetI :: String -> Irate
chngetI s0name = opcode "chnget" args
  where args = [to s0name]


-- | * opcode : chnget
--  
--  
-- * syntax : 
--  
--  >   ival chnget Sname
--  >   kval chnget Sname
--  >   aval chnget Sname
--  >   Sval chnget Sname
--  
--  
-- * description : 
--  
--  Reads data from a channel of the inward named software bus.
-- Implies declaring the channel with imode=1 (see also chn_k,
-- chn_a, and chn_S).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnget.html>
 
chngetK :: String -> Krate
chngetK s0name = opcode "chnget" args
  where args = [to s0name]


-- | * opcode : chnget
--  
--  
-- * syntax : 
--  
--  >   ival chnget Sname
--  >   kval chnget Sname
--  >   aval chnget Sname
--  >   Sval chnget Sname
--  
--  
-- * description : 
--  
--  Reads data from a channel of the inward named software bus.
-- Implies declaring the channel with imode=1 (see also chn_k,
-- chn_a, and chn_S).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnget.html>
 
chngetS :: String -> String
chngetS s0name = opcode "chnget" args
  where args = [to s0name]


-- | * opcode : chnset
--  
--  
-- * syntax : 
--  
--  >   chnset ival, Sname
--  >   chnset kval, Sname
--  >   chnset aval, Sname
--  >   chnset Sval, Sname
--  
--  
-- * description : 
--  
--  Write to a channel of the named software bus. Implies declaring
-- the channel with imod=2 (see also chn_k, chn_a, and chn_S).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnset.html>
 
chnsetA :: Arate -> String -> SignalOut
chnsetA a0val s1name = outOpcode "chnset" args
  where args = [to a0val, to s1name]


-- | * opcode : chnset
--  
--  
-- * syntax : 
--  
--  >   chnset ival, Sname
--  >   chnset kval, Sname
--  >   chnset aval, Sname
--  >   chnset Sval, Sname
--  
--  
-- * description : 
--  
--  Write to a channel of the named software bus. Implies declaring
-- the channel with imod=2 (see also chn_k, chn_a, and chn_S).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnset.html>
 
chnsetI :: Irate -> String -> SignalOut
chnsetI i0val s1name = outOpcode "chnset" args
  where args = [to i0val, to s1name]


-- | * opcode : chnset
--  
--  
-- * syntax : 
--  
--  >   chnset ival, Sname
--  >   chnset kval, Sname
--  >   chnset aval, Sname
--  >   chnset Sval, Sname
--  
--  
-- * description : 
--  
--  Write to a channel of the named software bus. Implies declaring
-- the channel with imod=2 (see also chn_k, chn_a, and chn_S).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnset.html>
 
chnsetK :: (K k0) => k0 -> String -> SignalOut
chnsetK k0val s1name = outOpcode "chnset" args
  where args = [to k0val, to s1name]


-- | * opcode : chnset
--  
--  
-- * syntax : 
--  
--  >   chnset ival, Sname
--  >   chnset kval, Sname
--  >   chnset aval, Sname
--  >   chnset Sval, Sname
--  
--  
-- * description : 
--  
--  Write to a channel of the named software bus. Implies declaring
-- the channel with imod=2 (see also chn_k, chn_a, and chn_S).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnset.html>
 
chnsetS :: String -> String -> SignalOut
chnsetS s0val s1name = outOpcode "chnset" args
  where args = [to s0val, to s1name]


-- | * opcode : chnsend
--  
--  
-- * syntax : 
--  
--  >   chnsend ival, Sname
--  >   chnsend kval, Sname
--  >   chnsend aval, Sname
--  >   chnsend Sval, Sname
--  
--  
-- * description : 
--  
--  Send to a channel of the named software bus. Implies declaring
-- the channel with imode=2 (see also chn_k, chn_a, and chn_S).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnsend.html>
 
chnsendA :: Arate -> String -> SignalOut
chnsendA a0val s1name = outOpcode "chnsend" args
  where args = [to a0val, to s1name]


-- | * opcode : chnsend
--  
--  
-- * syntax : 
--  
--  >   chnsend ival, Sname
--  >   chnsend kval, Sname
--  >   chnsend aval, Sname
--  >   chnsend Sval, Sname
--  
--  
-- * description : 
--  
--  Send to a channel of the named software bus. Implies declaring
-- the channel with imode=2 (see also chn_k, chn_a, and chn_S).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnsend.html>
 
chnsendI :: Irate -> String -> SignalOut
chnsendI i0val s1name = outOpcode "chnsend" args
  where args = [to i0val, to s1name]


-- | * opcode : chnsend
--  
--  
-- * syntax : 
--  
--  >   chnsend ival, Sname
--  >   chnsend kval, Sname
--  >   chnsend aval, Sname
--  >   chnsend Sval, Sname
--  
--  
-- * description : 
--  
--  Send to a channel of the named software bus. Implies declaring
-- the channel with imode=2 (see also chn_k, chn_a, and chn_S).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnsend.html>
 
chnsendK :: (K k0) => k0 -> String -> SignalOut
chnsendK k0val s1name = outOpcode "chnsend" args
  where args = [to k0val, to s1name]


-- | * opcode : chnsend
--  
--  
-- * syntax : 
--  
--  >   chnsend ival, Sname
--  >   chnsend kval, Sname
--  >   chnsend aval, Sname
--  >   chnsend Sval, Sname
--  
--  
-- * description : 
--  
--  Send to a channel of the named software bus. Implies declaring
-- the channel with imode=2 (see also chn_k, chn_a, and chn_S).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnsend.html>
 
chnsendS :: String -> String -> SignalOut
chnsendS s0val s1name = outOpcode "chnsend" args
  where args = [to s0val, to s1name]


-- | * opcode : chnrecv
--  
--  
-- * syntax : 
--  
--  >   ival chnrecv Sname
--  >   kval chnrecv Sname
--  >   aval chnrecv Sname
--  >   Sval chnrecv Sname
--  
--  
-- * description : 
--  
--  Receives data from a channel of the inward named software bus.
-- Implies declaring the channel with imode=1 (see also chn_k,
-- chn_a, and chn_S).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnrecv.html>
 
chnrecvA :: String -> Arate
chnrecvA s0name = opcode "chnrecv" args
  where args = [to s0name]


-- | * opcode : chnrecv
--  
--  
-- * syntax : 
--  
--  >   ival chnrecv Sname
--  >   kval chnrecv Sname
--  >   aval chnrecv Sname
--  >   Sval chnrecv Sname
--  
--  
-- * description : 
--  
--  Receives data from a channel of the inward named software bus.
-- Implies declaring the channel with imode=1 (see also chn_k,
-- chn_a, and chn_S).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnrecv.html>
 
chnrecvI :: String -> Irate
chnrecvI s0name = opcode "chnrecv" args
  where args = [to s0name]


-- | * opcode : chnrecv
--  
--  
-- * syntax : 
--  
--  >   ival chnrecv Sname
--  >   kval chnrecv Sname
--  >   aval chnrecv Sname
--  >   Sval chnrecv Sname
--  
--  
-- * description : 
--  
--  Receives data from a channel of the inward named software bus.
-- Implies declaring the channel with imode=1 (see also chn_k,
-- chn_a, and chn_S).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnrecv.html>
 
chnrecvK :: String -> Krate
chnrecvK s0name = opcode "chnrecv" args
  where args = [to s0name]


-- | * opcode : chnrecv
--  
--  
-- * syntax : 
--  
--  >   ival chnrecv Sname
--  >   kval chnrecv Sname
--  >   aval chnrecv Sname
--  >   Sval chnrecv Sname
--  
--  
-- * description : 
--  
--  Receives data from a channel of the inward named software bus.
-- Implies declaring the channel with imode=1 (see also chn_k,
-- chn_a, and chn_S).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnrecv.html>
 
chnrecvS :: String -> String
chnrecvS s0name = opcode "chnrecv" args
  where args = [to s0name]


-- | * opcode : chnclear
--  
--  
-- * syntax : 
--  
--  >   chnclear Sname
--  
--  
-- * description : 
--  
--  Clears an audio channel of the named software bus to zero.
-- Implies declaring the channel with imode=2 (see also chn_a).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnclear.html>
 
chnclear :: String -> SignalOut
chnclear s0name = outOpcode "chnclear" args
  where args = [to s0name]


-- | * opcode : chnmix
--  
--  
-- * syntax : 
--  
--  >   chnmix aval, Sname
--  
--  
-- * description : 
--  
--  Adds an audio signal to a channel of the named software bus.
-- Implies declaring the channel with imode=2 (see also chn_a).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnmix.html>
 
chnmix :: Arate -> String -> SignalOut
chnmix a0val s1name = outOpcode "chnmix" args
  where args = [to a0val, to s1name]


-- | * opcode : chnparams
--  
--  
-- * syntax : 
--  
--  >   itype, imode, ictltype, idflt, imin, imax chnparams
--  
--  
-- * description : 
--  
--  Query parameters of a channel (if it does not exist, all
-- returned values are zero).
--  
--  
-- * url : <http://www.csounds.com/manual/html/chnparams.html>
 
chnparams :: MultiOut
chnparams = opcode "chnparams" args
  where args = []