-- | Signal Input
module CsoundExpr.Opcodes.Sigio.Input
    (in',
     in32,
     inch,
     inh,
     ino,
     inq,
     inrg,
     ins,
     inx,
     diskin,
     diskin2,
     soundin,
     invalueK,
     invalueS,
     inz)
where



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



-- | * opcode : in
--  
--  
-- * syntax : 
--  
--  >   ar1 in
--  
--  
-- * description : 
--  
--  Reads mono audio data from an external device or stream.
--  
--  
-- * url : <http://www.csounds.com/manual/html/in.html>
 
in' :: Arate
in' = opcode "in" args
  where args = []


-- | * opcode : in32
--  
--  
-- * syntax : 
--  
--  >   ar1, ar2, ar3, ar4, ar5, ar6, ar7, ar8, ar9, ar10, ar11, ar12, ar13, ar14, 
--  >       ar15, ar16, ar17, ar18, ar19, ar20, ar21, ar22, ar23, ar24, ar25, ar26, 
--  >       ar27, ar28, ar29, ar30, ar31, ar32 in32
--  
--  
-- * description : 
--  
--  Reads a 32-channel audio signal from an external device or
-- stream.
--  
--  
-- * url : <http://www.csounds.com/manual/html/in32.html>
 
in32 :: MultiOut
in32 = opcode "in32" args
  where args = []


-- | * opcode : inch
--  
--  
-- * syntax : 
--  
--  >   ain inch kchan
--  
--  
-- * description : 
--  
--  Reads from a numbered channel in an external audio signal or
-- stream.
--  
--  
-- * url : <http://www.csounds.com/manual/html/inch.html>
 
inch :: (K k0) => k0 -> Arate
inch k0chan = opcode "inch" args
  where args = [to k0chan]


-- | * opcode : inh
--  
--  
-- * syntax : 
--  
--  >   ar1, ar2, ar3, ar4, ar5, ar6 inh
--  
--  
-- * description : 
--  
--  Reads six-channel audio data from an external device or stream.
--  
--  
-- * url : <http://www.csounds.com/manual/html/inh.html>
 
inh :: MultiOut
inh = opcode "inh" args
  where args = []


-- | * opcode : ino
--  
--  
-- * syntax : 
--  
--  >   ar1, ar2, ar3, ar4, ar5, ar6, ar7, ar8 ino
--  
--  
-- * description : 
--  
--  Reads eight-channel audio data from an external device or
-- stream.
--  
--  
-- * url : <http://www.csounds.com/manual/html/ino.html>
 
ino :: MultiOut
ino = opcode "ino" args
  where args = []


-- | * opcode : inq
--  
--  
-- * syntax : 
--  
--  >   ar1, ar2, ar3, a4 inq
--  
--  
-- * description : 
--  
--  Reads quad audio data from an external device or stream.
--  
--  
-- * url : <http://www.csounds.com/manual/html/inq.html>
 
inq :: MultiOut
inq = opcode "inq" args
  where args = []


-- | * opcode : inrg
--  
--  
-- * syntax : 
--  
--  >   inrg kstart, ain1 [,ain2, ain3,..., ainN]
--  
--  
-- * description : 
--  
--  inrg reads audio from a range of adjacent audio channels from
-- the audio input device.
--  
--  
-- * url : <http://www.csounds.com/manual/html/inrg.html>
 
inrg :: (K k0) => k0 -> [Arate] -> SignalOut
inrg k0start a1ins = outOpcode "inrg" args
  where args = [to k0start] ++ map to a1ins


-- | * opcode : ins
--  
--  
-- * syntax : 
--  
--  >   ar1, ar2 ins
--  
--  
-- * description : 
--  
--  Reads stereo audio data from an external device or stream.
--  
--  
-- * url : <http://www.csounds.com/manual/html/ins.html>
 
ins :: MultiOut
ins = opcode "ins" args
  where args = []


-- | * opcode : inx
--  
--  
-- * syntax : 
--  
--  >   ar1, ar2, ar3, ar4, ar5, ar6, ar7, ar8, ar9, ar10, ar11, ar12, 
--  >       ar13, ar14, ar15, ar16 inx
--  
--  
-- * description : 
--  
--  Reads a 16-channel audio signal from an external device or
-- stream.
--  
--  
-- * url : <http://www.csounds.com/manual/html/inx.html>
 
inx :: MultiOut
inx = opcode "inx" args
  where args = []


-- | * opcode : diskin
--  
--  
-- * syntax : 
--  
--  >   ar1 [, ar2 [, ar3 [,... ar24]]] diskin ifilcod, kpitch [, iskiptim] 
--  >       [, iwraparound] [, iformat] [, iskipinit]
--  
--  
-- * description : 
--  
--  Deprecated. Reads audio data from an external device or stream
-- and can alter its pitch.
--  
--  
-- * url : <http://www.csounds.com/manual/html/diskin.html>
 
diskin :: (K k0) => [Irate] -> String -> k0 -> MultiOut
diskin i0init s1file k2pitch = opcode "diskin" args
  where args = [to s1file, to k2pitch] ++ map to i0init


-- | * opcode : diskin2
--  
--  
-- * syntax : 
--  
--  >   a1[, a2[,... a24]] diskin2 ifilcod, kpitch[, iskiptim 
--  >       [, iwrap[, iformat [, iwsize[, ibufsize[, iskipinit]]]]]]
--  
--  
-- * description : 
--  
--  Reads audio data from a file, and can alter its pitch using one
-- of several available interpolation types, as well as convert the
-- sample rate to match the orchestra sr setting. diskin2 can also
-- read multichannel files with any number of channels in the range
-- 1 to 24. diskin2 allows more control and higher sound quality
-- than diskin, but there is also the disadvantage of higher CPU
-- usage.
--  
--  
-- * url : <http://www.csounds.com/manual/html/diskin2.html>
 
diskin2 :: (K k0) => [Irate] -> String -> k0 -> MultiOut
diskin2 i0init s1file k2pitch = opcode "diskin2" args
  where args = [to s1file, to k2pitch] ++ map to i0init


-- | * opcode : soundin
--  
--  
-- * syntax : 
--  
--  >   ar1[, ar2[, ar3[,... a24]]] soundin ifilcod [, iskptim] [, iformat] 
--  >       [, iskipinit] [, ibufsize]
--  
--  
-- * description : 
--  
--  Reads audio data from an external device or stream. Up to 24
-- channels may be read.
--  
--  
-- * url : <http://www.csounds.com/manual/html/soundin.html>
 
soundin :: [Irate] -> String -> MultiOut
soundin i0init s1file = opcode "soundin" args
  where args = [to s1file] ++ map to i0init


-- | * opcode : invalue
--  
--  
-- * syntax : 
--  
--  >   kvalue invalue "channel name"
--  >   Sname invalue "channel name"
--  
--  
-- * description : 
--  
--  Reads a k-rate signal or string from a user-defined channel.
--  
--  
-- * url : <http://www.csounds.com/manual/html/invalue.html>
 
invalueK :: String -> Krate
invalueK s0channelname = opcode "invalue" args
  where args = [to s0channelname]


-- | * opcode : invalue
--  
--  
-- * syntax : 
--  
--  >   kvalue invalue "channel name"
--  >   Sname invalue "channel name"
--  
--  
-- * description : 
--  
--  Reads a k-rate signal or string from a user-defined channel.
--  
--  
-- * url : <http://www.csounds.com/manual/html/invalue.html>
 
invalueS :: String -> String
invalueS s0channelname = opcode "invalue" args
  where args = [to s0channelname]


-- | * opcode : inz
--  
--  
-- * syntax : 
--  
--  >   inz ksig1
--  
--  
-- * description : 
--  
--  Reads multi-channel audio samples into a ZAK array from an
-- external device or stream.
--  
--  
-- * url : <http://www.csounds.com/manual/html/inz.html>
 
inz :: (K k0) => k0 -> SignalOut
inz k0sig1 = outOpcode "inz" args
  where args = [to k0sig1]