module Csound.Typed.Opcode.SignalIO ( -- * File I/O. dumpk, dumpk2, dumpk3, dumpk4, ficlose, fin, fini, fink, fiopen, fout, fouti, foutir, foutk, fprintks, fprints, readk, readk2, readk3, readk4, -- * Signal Input. diskin, diskin2, in', in32, inch, inh, ino, inq, inrg, ins, invalue, inx, inz, mp3in, soundin, -- * Signal Output. mdelay, monitor, out, out32, outc, outch, outh, outo, outq, outq1, outq2, outq3, outq4, outrg, outs, outs1, outs2, outvalue, outx, outz, soundout, soundouts, -- * Software Bus. chani, chano, chn_k, chn_a, chn_S, chnclear, chnexport, chnget, chnmix, chnparams, chnrecv, chnsend, chnset, setksmps, xin, xout, -- * Printing and Display. dispfft, display, flashtxt, print', printf_i, printf, printk, printk2, printks, prints, -- * Soundfile Queries. filebit, filelen, filenchnls, filepeak, filesr, filevalid, mp3len) where import Control.Applicative import Control.Monad.Trans.Class import Csound.Dynamic import Csound.Typed -- File I/O. -- | -- Periodically writes an orchestra control-signal value to an external file. -- -- Periodically writes an orchestra control-signal value to a named external file in a specific format. -- -- > dumpk ksig, ifilname, iformat, iprd -- -- csound doc: dumpk :: Sig -> Str -> D -> D -> SE () dumpk b1 b2 b3 b4 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unStr b2 <*> unD b3 <*> unD b4 where f a1 a2 a3 a4 = opcs "dumpk" [(Xr,[Kr,Sr,Ir,Ir])] [a1,a2,a3,a4] -- | -- Periodically writes two orchestra control-signal values to an external file. -- -- Periodically writes two orchestra control-signal values to a named external file in a specific format. -- -- > dumpk2 ksig1, ksig2, ifilname, iformat, iprd -- -- csound doc: dumpk2 :: Sig -> Sig -> Str -> D -> D -> SE () dumpk2 b1 b2 b3 b4 b5 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unStr b3 <*> unD b4 <*> unD b5 where f a1 a2 a3 a4 a5 = opcs "dumpk2" [(Xr,[Kr,Kr,Sr,Ir,Ir])] [a1,a2,a3,a4,a5] -- | -- Periodically writes three orchestra control-signal values to an external file. -- -- Periodically writes three orchestra control-signal values to a named external file in a specific format. -- -- > dumpk3 ksig1, ksig2, ksig3, ifilname, iformat, iprd -- -- csound doc: dumpk3 :: Sig -> Sig -> Sig -> Str -> D -> D -> SE () dumpk3 b1 b2 b3 b4 b5 b6 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 <*> unStr b4 <*> unD b5 <*> unD b6 where f a1 a2 a3 a4 a5 a6 = opcs "dumpk3" [(Xr,[Kr,Kr,Kr,Sr,Ir,Ir])] [a1,a2,a3,a4,a5,a6] -- | -- Periodically writes four orchestra control-signal values to an external file. -- -- Periodically writes four orchestra control-signal values to a named external file in a specific format. -- -- > dumpk4 ksig1, ksig2, ksig3, ksig4, ifilname, iformat, iprd -- -- csound doc: dumpk4 :: Sig -> Sig -> Sig -> Sig -> Str -> D -> D -> SE () dumpk4 b1 b2 b3 b4 b5 b6 b7 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 <*> unSig b4 <*> unStr b5 <*> unD b6 <*> unD b7 where f a1 a2 a3 a4 a5 a6 a7 = opcs "dumpk4" [(Xr,[Kr,Kr,Kr,Kr,Sr,Ir,Ir])] [a1 ,a2 ,a3 ,a4 ,a5 ,a6 ,a7] -- | -- Closes a previously opened file. -- -- ficlose can be used to close a file which was opened with fiopen. -- -- > ficlose ihandle -- > ficlose Sfilename -- -- csound doc: ficlose :: D -> SE () ficlose b1 = SE $ (depT_ =<<) $ lift $ f <$> unD b1 where f a1 = opcs "ficlose" [(Xr,[Ir])] [a1] -- | -- Read signals from a file at a-rate. -- -- > fin ifilename, iskipframes, iformat, ain1 [, ain2] [, ain3] [,...] -- -- csound doc: fin :: Str -> D -> D -> [Sig] -> SE () fin b1 b2 b3 b4 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unD b2 <*> unD b3 <*> mapM unSig b4 where f a1 a2 a3 a4 = opcs "fin" [(Xr,[Sr,Ir,Ir] ++ (repeat Ar))] ([a1,a2,a3] ++ a4) -- | -- Read signals from a file at i-rate. -- -- > fini ifilename, iskipframes, iformat, in1 [, in2] [, in3] [, ...] -- -- csound doc: fini :: Str -> D -> D -> [D] -> SE () fini b1 b2 b3 b4 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unD b2 <*> unD b3 <*> mapM unD b4 where f a1 a2 a3 a4 = opcs "fini" [(Xr,[Sr] ++ (repeat Ir))] ([a1,a2,a3] ++ a4) -- | -- Read signals from a file at k-rate. -- -- > fink ifilename, iskipframes, iformat, kin1 [, kin2] [, kin3] [,...] -- -- csound doc: fink :: Str -> D -> D -> [Sig] -> SE () fink b1 b2 b3 b4 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unD b2 <*> unD b3 <*> mapM unSig b4 where f a1 a2 a3 a4 = opcs "fink" [(Xr,[Sr,Ir,Ir] ++ (repeat Kr))] ([a1,a2,a3] ++ a4) -- | -- Opens a file in a specific mode. -- -- fiopen can be used to open a file in one of the specified modes. -- -- > ihandle fiopen ifilename, imode -- -- csound doc: fiopen :: Str -> D -> SE D fiopen b1 b2 = fmap ( D . return) $ SE $ (depT =<<) $ lift $ f <$> unStr b1 <*> unD b2 where f a1 a2 = opcs "fiopen" [(Ir,[Sr,Ir])] [a1,a2] -- | -- Outputs a-rate signals to an arbitrary number of channels. -- -- fout outputs N a-rate signals to a specified file of N channels. -- -- > fout ifilename, iformat, aout1 [, aout2, aout3,...,aoutN] -- -- csound doc: fout :: Str -> D -> [Sig] -> SE () fout b1 b2 b3 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unD b2 <*> mapM unSig b3 where f a1 a2 a3 = opcs "fout" [(Xr,[Sr,Ir] ++ (repeat Ar))] ([a1,a2] ++ a3) -- | -- Outputs i-rate signals of an arbitrary number of channels to a specified file. -- -- fouti output N i-rate signals to a specified file of N channels. -- -- > fouti ihandle, iformat, iflag, iout1 [, iout2, iout3,....,ioutN] -- -- csound doc: fouti :: Str -> D -> D -> [D] -> SE () fouti b1 b2 b3 b4 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unD b2 <*> unD b3 <*> mapM unD b4 where f a1 a2 a3 a4 = opcs "fouti" [(Xr,(repeat Ir))] ([a1,a2,a3] ++ a4) -- | -- Outputs i-rate signals from an arbitrary number of channels to a specified file. -- -- foutir output N i-rate signals to a specified file of N channels. -- -- > foutir ihandle, iformat, iflag, iout1 [, iout2, iout3,....,ioutN] -- -- csound doc: foutir :: Str -> D -> D -> [D] -> SE () foutir b1 b2 b3 b4 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unD b2 <*> unD b3 <*> mapM unD b4 where f a1 a2 a3 a4 = opcs "foutir" [(Xr,(repeat Ir))] ([a1,a2,a3] ++ a4) -- | -- Outputs k-rate signals of an arbitrary number of channels to a specified file, in raw (headerless) format. -- -- foutk outputs N k-rate signals to a specified file of N channels. -- -- > foutk ifilename, iformat, kout1 [, kout2, kout3,....,koutN] -- -- csound doc: foutk :: Str -> D -> [Sig] -> SE () foutk b1 b2 b3 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unD b2 <*> mapM unSig b3 where f a1 a2 a3 = opcs "foutk" [(Xr,[Sr,Ir] ++ (repeat Kr))] ([a1,a2] ++ a3) -- | -- Similar to printks but prints to a file. -- -- > fprintks "filename", "string", [, kval1] [, kval2] [...] -- -- csound doc: fprintks :: Str -> Str -> [Sig] -> SE () fprintks b1 b2 b3 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unStr b2 <*> mapM unSig b3 where f a1 a2 a3 = opcs "fprintks" [(Xr,[Sr,Sr] ++ (repeat Kr))] ([a1,a2] ++ a3) -- | -- Similar to prints but prints to a file. -- -- > fprints "filename", "string" [, ival1] [, ival2] [...] -- -- csound doc: fprints :: Str -> Str -> [D] -> SE () fprints b1 b2 b3 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unStr b2 <*> mapM unD b3 where f a1 a2 a3 = opcs "fprints" [(Xr,[Sr,Sr] ++ (repeat Ir))] ([a1,a2] ++ a3) -- | -- Periodically reads an orchestra control-signal value from an external file. -- -- Periodically reads an orchestra control-signal value from a named external file in a specific format. -- -- > kres readk ifilname, iformat, iprd -- -- csound doc: readk :: Str -> D -> D -> Sig readk b1 b2 b3 = Sig $ f <$> unStr b1 <*> unD b2 <*> unD b3 where f a1 a2 a3 = opcs "readk" [(Kr,[Sr,Ir,Ir])] [a1,a2,a3] -- | -- Periodically reads two orchestra control-signal values from an external file. -- -- > kr1, kr2 readk2 ifilname, iformat, iprd -- -- csound doc: readk2 :: Tuple a => Str -> D -> D -> a readk2 b1 b2 b3 = pureTuple $ f <$> unStr b1 <*> unD b2 <*> unD b3 where f a1 a2 a3 = mopcs "readk2" ([Kr,Kr],[Sr,Ir,Ir]) [a1,a2,a3] -- | -- Periodically reads three orchestra control-signal values from an external file. -- -- > kr1, kr2, kr3 readk3 ifilname, iformat, iprd -- -- csound doc: readk3 :: Tuple a => Str -> D -> D -> a readk3 b1 b2 b3 = pureTuple $ f <$> unStr b1 <*> unD b2 <*> unD b3 where f a1 a2 a3 = mopcs "readk3" ([Kr,Kr,Kr],[Sr,Ir,Ir]) [a1,a2,a3] -- | -- Periodically reads four orchestra control-signal values from an external file. -- -- > kr1, kr2, kr3, kr4 readk4 ifilname, iformat, iprd -- -- csound doc: readk4 :: Tuple a => Str -> D -> D -> a readk4 b1 b2 b3 = pureTuple $ f <$> unStr b1 <*> unD b2 <*> unD b3 where f a1 a2 a3 = mopcs "readk4" ([Kr,Kr,Kr,Kr],[Sr,Ir,Ir]) [a1,a2,a3] -- Signal Input. -- | -- Deprecated. Reads audio data from an external device or stream and can alter its pitch. -- -- > ar1 [, ar2 [, ar3 [, ... arN]]] diskin ifilcod, kpitch [, iskiptim] \ -- > [, iwraparound] [, iformat] [, iskipinit] -- -- csound doc: diskin :: Tuple a => Str -> Sig -> a diskin b1 b2 = pureTuple $ f <$> unStr b1 <*> unSig b2 where f a1 a2 = mopcs "diskin" ((repeat Ar),[Sr,Kr,Ir,Ir,Ir,Ir]) [a1,a2] -- | -- 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. -- -- 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 in versions before 5.14, and 40 after. . -- diskin2 allows more control and higher -- sound quality than diskin, but there is -- also the disadvantage of higher CPU usage. -- -- > a1[, a2[, ... aN]] diskin2 ifilcod, kpitch[, iskiptim \ -- > [, iwrap[, iformat [, iwsize[, ibufsize[, iskipinit]]]]]] -- -- csound doc: diskin2 :: Tuple a => Str -> Sig -> a diskin2 b1 b2 = pureTuple $ f <$> unStr b1 <*> unSig b2 where f a1 a2 = mopcs "diskin2" ((repeat Ar),[Sr,Kr,Ir,Ir,Ir,Ir,Ir,Ir]) [a1,a2] -- | -- Reads mono audio data from an external device or stream. -- -- > ar1 in   -- -- csound doc: in' :: Sig in' = Sig $ return $ f where f = opcs "in" [(Ar,[])] [] -- | -- Reads a 32-channel audio signal from an external device or stream. -- -- > 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   -- -- csound doc: in32 :: Tuple a => a in32 = pureTuple $ return $ f where f = mopcs "in32" ([Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar] ,[]) [] -- | -- Reads from numbered channels in an external audio signal or stream. -- -- > ain1[, ...] inch kchan1[,...] -- -- csound doc: inch :: Tuple a => [Sig] -> a inch b1 = pureTuple $ f <$> mapM unSig b1 where f a1 = mopcs "inch" ((repeat Ar),(repeat Kr)) a1 -- | -- Reads six-channel audio data from an external device or stream. -- -- > ar1, ar2, ar3, ar4, ar5, ar6 inh   -- -- csound doc: inh :: Tuple a => a inh = pureTuple $ return $ f where f = mopcs "inh" ([Ar,Ar,Ar,Ar,Ar,Ar],[]) [] -- | -- Reads eight-channel audio data from an external device or stream. -- -- > ar1, ar2, ar3, ar4, ar5, ar6, ar7, ar8 ino   -- -- csound doc: ino :: Tuple a => a ino = pureTuple $ return $ f where f = mopcs "ino" ([Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar],[]) [] -- | -- Reads quad audio data from an external device or stream. -- -- > ar1, ar2, ar3, a4 inq   -- -- csound doc: inq :: Tuple a => a inq = pureTuple $ return $ f where f = mopcs "inq" ([Ar,Ar,Ar,Ar],[]) [] -- | -- Allow input from a range of adjacent audio channels from the audio input device -- -- inrg reads audio from a range of adjacent audio channels from the audio input device. -- -- > inrg kstart, ain1 [,ain2, ain3, ..., ainN] -- -- csound doc: inrg :: Sig -> [Sig] -> SE () inrg b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> mapM unSig b2 where f a1 a2 = opcs "inrg" [(Xr,[Kr] ++ (repeat Ar))] ([a1] ++ a2) -- | -- Reads stereo audio data from an external device or stream. -- -- > ar1, ar2 ins   -- -- csound doc: ins :: Tuple a => a ins = pureTuple $ return $ f where f = mopcs "ins" ([Ar,Ar],[]) [] -- | -- Reads a k-rate signal from a user-defined channel. -- -- Reads a k-rate signal or string from a user-defined channel. -- -- > kvalue invalue "channel name" -- > Sname invalue "channel name" -- -- csound doc: invalue :: Str -> Str invalue b1 = Str $ f <$> unStr b1 where f a1 = opcs "invalue" [(Kr,[Sr]),(Sr,[Sr])] [a1] -- | -- Reads a 16-channel audio signal from an external device or stream. -- -- > ar1, ar2, ar3, ar4, ar5, ar6, ar7, ar8, ar9, ar10, ar11, ar12, \ -- > ar13, ar14, ar15, ar16 inx   -- -- csound doc: inx :: Tuple a => a inx = pureTuple $ return $ f where f = mopcs "inx" ([Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar],[]) [] -- | -- Reads multi-channel audio samples into a ZAK array from an external device or stream. -- -- > inz ksig1 -- -- csound doc: inz :: Sig -> SE () inz b1 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 where f a1 = opcs "inz" [(Xr,[Kr])] [a1] -- | -- Reads stereo audio data from an external MP3 file. -- -- > ar1, ar2 mp3in ifilcod[, iskptim, iformat, iskipinit, ibufsize] -- -- csound doc: mp3in :: Tuple a => Str -> a mp3in b1 = pureTuple $ f <$> unStr b1 where f a1 = mopcs "mp3in" ([Ar,Ar],[Sr,Ir,Ir,Ir,Ir]) [a1] -- | -- Reads audio data from an external device or stream. -- -- Reads audio data from an external device or stream. Up to 24 -- channels may be read before v5.14, extended to 40 in later versions. -- -- > ar1[, ar2[, ar3[, ... a24]]] soundin ifilcod [, iskptim] [, iformat] \ -- > [, iskipinit] [, ibufsize] -- -- csound doc: soundin :: Tuple a => Str -> a soundin b1 = pureTuple $ f <$> unStr b1 where f a1 = mopcs "soundin" ((repeat Ar),[Sr,Ir,Ir,Ir,Ir]) [a1] -- Signal Output. -- | -- A MIDI delay opcode. -- -- > mdelay kstatus, kchan, kd1, kd2, kdelay -- -- csound doc: mdelay :: Sig -> Sig -> Sig -> Sig -> Sig -> SE () mdelay b1 b2 b3 b4 b5 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 <*> unSig b4 <*> unSig b5 where f a1 a2 a3 a4 a5 = opcs "mdelay" [(Xr,[Kr,Kr,Kr,Kr,Kr])] [a1,a2,a3,a4,a5] -- | -- Returns the audio spout frame. -- -- Returns the audio spout frame (if active), otherwise it returns zero. -- -- > aout1 [,aout2 ... aoutX] monitor   -- -- csound doc: monitor :: Tuple a => a monitor = pureTuple $ return $ f where f = mopcs "monitor" ((repeat Ar),[]) [] -- | -- Writes mono audio data to an external device or stream. -- -- > out asig -- -- csound doc: out :: Sig -> SE () out b1 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 where f a1 = opcs "out" [(Xr,[Ar])] [a1] -- | -- Writes 32-channel audio data to an external device or stream. -- -- > out32 asig1, asig2, asig3, asig4, asig5, asig6, asig7, asig8, asig10, \ -- > asig11, asig12, asig13, asig14, asig15, asig16, asig17, asig18, \ -- > asig19, asig20, asig21, asig22, asig23, asig24, asig25, asig26, \ -- > asig27, asig28, asig29, asig30, asig31, asig32 -- -- csound doc: out32 :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> SE () out32 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19 b20 b21 b22 b23 b24 b25 b26 b27 b28 b29 b30 b31 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 <*> unSig b4 <*> unSig b5 <*> unSig b6 <*> unSig b7 <*> unSig b8 <*> unSig b9 <*> unSig b10 <*> unSig b11 <*> unSig b12 <*> unSig b13 <*> unSig b14 <*> unSig b15 <*> unSig b16 <*> unSig b17 <*> unSig b18 <*> unSig b19 <*> unSig b20 <*> unSig b21 <*> unSig b22 <*> unSig b23 <*> unSig b24 <*> unSig b25 <*> unSig b26 <*> unSig b27 <*> unSig b28 <*> unSig b29 <*> unSig b30 <*> unSig b31 where f a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 a31 = opcs "out32" [(Xr ,[Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar ,Ar])] [a1 ,a2 ,a3 ,a4 ,a5 ,a6 ,a7 ,a8 ,a9 ,a10 ,a11 ,a12 ,a13 ,a14 ,a15 ,a16 ,a17 ,a18 ,a19 ,a20 ,a21 ,a22 ,a23 ,a24 ,a25 ,a26 ,a27 ,a28 ,a29 ,a30 ,a31] -- | -- Writes audio data with an arbitrary number of channels to an external device or stream. -- -- > outc asig1 [, asig2] [...] -- -- csound doc: outc :: [Sig] -> SE () outc b1 = SE $ (depT_ =<<) $ lift $ f <$> mapM unSig b1 where f a1 = opcs "outc" [(Xr,(repeat Ar))] a1 -- | -- Writes multi-channel audio data, with user-controllable channels, to an external device or stream. -- -- > outch kchan1, asig1 [, kchan2] [, asig2] [...] -- -- csound doc: outch :: Sig -> [Sig] -> SE () outch b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> mapM unSig b2 where f a1 a2 = opcs "outch" [(Xr,[Kr,Ar,Kr] ++ (repeat Ar))] ([a1] ++ a2) -- | -- Writes 6-channel audio data to an external device or stream. -- -- > outh asig1, asig2, asig3, asig4, asig5, asig6 -- -- csound doc: outh :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> SE () outh b1 b2 b3 b4 b5 b6 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 <*> unSig b4 <*> unSig b5 <*> unSig b6 where f a1 a2 a3 a4 a5 a6 = opcs "outh" [(Xr,[Ar,Ar,Ar,Ar,Ar,Ar])] [a1,a2,a3,a4,a5,a6] -- | -- Writes 8-channel audio data to an external device or stream. -- -- > outo asig1, asig2, asig3, asig4, asig5, asig6, asig7, asig8 -- -- csound doc: outo :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> SE () outo b1 b2 b3 b4 b5 b6 b7 b8 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 <*> unSig b4 <*> unSig b5 <*> unSig b6 <*> unSig b7 <*> unSig b8 where f a1 a2 a3 a4 a5 a6 a7 a8 = opcs "outo" [(Xr,[Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar])] [a1 ,a2 ,a3 ,a4 ,a5 ,a6 ,a7 ,a8] -- | -- Writes 4-channel audio data to an external device or stream. -- -- > outq asig1, asig2, asig3, asig4 -- -- csound doc: outq :: Sig -> Sig -> Sig -> Sig -> SE () outq b1 b2 b3 b4 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 <*> unSig b4 where f a1 a2 a3 a4 = opcs "outq" [(Xr,[Ar,Ar,Ar,Ar])] [a1,a2,a3,a4] -- | -- Writes samples to quad channel 1 of an external device or stream. -- -- > outq1 asig -- -- csound doc: outq1 :: Sig -> SE () outq1 b1 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 where f a1 = opcs "outq1" [(Xr,[Ar])] [a1] -- | -- Writes samples to quad channel 2 of an external device or stream. -- -- > outq2 asig -- -- csound doc: outq2 :: Sig -> SE () outq2 b1 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 where f a1 = opcs "outq2" [(Xr,[Ar])] [a1] -- | -- Writes samples to quad channel 3 of an external device or stream. -- -- > outq3 asig -- -- csound doc: outq3 :: Sig -> SE () outq3 b1 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 where f a1 = opcs "outq3" [(Xr,[Ar])] [a1] -- | -- Writes samples to quad channel 4 of an external device or stream. -- -- > outq4 asig -- -- csound doc: outq4 :: Sig -> SE () outq4 b1 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 where f a1 = opcs "outq4" [(Xr,[Ar])] [a1] -- | -- Allow output to a range of adjacent audio channels on the audio output device -- -- outrg outputs audio to a range of adjacent audio channels on the audio output device. -- -- > outrg kstart, aout1 [,aout2, aout3, ..., aoutN] -- -- csound doc: outrg :: Sig -> [Sig] -> SE () outrg b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> mapM unSig b2 where f a1 a2 = opcs "outrg" [(Xr,[Kr] ++ (repeat Ar))] ([a1] ++ a2) -- | -- Writes stereo audio data to an external device or stream. -- -- > outs asig1, asig2 -- -- csound doc: outs :: Sig -> Sig -> SE () outs b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 where f a1 a2 = opcs "outs" [(Xr,[Ar,Ar])] [a1,a2] -- | -- Writes samples to stereo channel 1 of an external device or stream. -- -- > outs1 asig -- -- csound doc: outs1 :: Sig -> SE () outs1 b1 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 where f a1 = opcs "outs1" [(Xr,[Ar])] [a1] -- | -- Writes samples to stereo channel 2 of an external device or stream. -- -- > outs2 asig -- -- csound doc: outs2 :: Sig -> SE () outs2 b1 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 where f a1 = opcs "outs2" [(Xr,[Ar])] [a1] -- | -- Sends a k-rate signal or string to a user-defined channel. -- -- > outvalue "channel name", kvalue -- > outvalue "channel name", "string" -- -- csound doc: outvalue :: Str -> Sig -> SE () outvalue b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unSig b2 where f a1 a2 = opcs "outvalue" [(Xr,[Sr,Kr])] [a1,a2] -- | -- Writes 16-channel audio data to an external device or stream. -- -- > outx asig1, asig2, asig3, asig4, asig5, asig6, asig7, asig8, \ -- > asig9, asig10, asig11, asig12, asig13, asig14, asig15, asig16 -- -- csound doc: outx :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> SE () outx b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 <*> unSig b4 <*> unSig b5 <*> unSig b6 <*> unSig b7 <*> unSig b8 <*> unSig b9 <*> unSig b10 <*> unSig b11 <*> unSig b12 <*> unSig b13 <*> unSig b14 <*> unSig b15 <*> unSig b16 where f a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 = opcs "outx" [(Xr ,[Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar])] [a1 ,a2 ,a3 ,a4 ,a5 ,a6 ,a7 ,a8 ,a9 ,a10 ,a11 ,a12 ,a13 ,a14 ,a15 ,a16] -- | -- Writes multi-channel audio data from a ZAK array to an external device or stream. -- -- > outz ksig1 -- -- csound doc: outz :: Sig -> SE () outz b1 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 where f a1 = opcs "outz" [(Xr,[Kr])] [a1] -- | -- Deprecated. Writes audio output to a disk file. -- -- The usage of soundout is discouraged. Please use fout instead. -- -- > soundout asig1, ifilcod [, iformat] -- -- csound doc: soundout :: Sig -> Str -> SE () soundout b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unStr b2 where f a1 a2 = opcs "soundout" [(Xr,[Ar,Sr,Ir])] [a1,a2] -- | -- Deprecated. Writes audio output to a disk file. -- -- The usage of soundouts is discouraged. Please use fout instead. -- -- > soundouts asigl, asigr, ifilcod [, iformat] -- -- csound doc: soundouts :: Sig -> Sig -> Str -> SE () soundouts b1 b2 b3 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unStr b3 where f a1 a2 a3 = opcs "soundouts" [(Xr,[Ar,Ar,Sr,Ir])] [a1,a2,a3] -- Software Bus. -- | -- Reads data from the software bus -- -- Reads data from a channel of the inward software bus. -- -- > kval chani kchan -- > aval chani kchan -- -- csound doc: chani :: Sig -> SE Sig chani b1 = fmap ( Sig . return) $ SE $ (depT =<<) $ lift $ f <$> unSig b1 where f a1 = opcs "chani" [(Kr,[Kr]),(Ar,[Kr])] [a1] -- | -- Send data to the outwards software bus -- -- Send data to a channel of the outward software bus. -- -- > chano kval, kchan -- > chano aval, kchan -- -- csound doc: chano :: Sig -> Sig -> SE () chano b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 where f a1 a2 = opcs "chano" [(Xr,[Kr,Kr])] [a1,a2] -- | -- Declare a channel of the named software bus. -- -- 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. -- -- > chn_k Sname, imode[, itype, idflt, imin, ima, ix, iy, iwidth, iheight, Sattributes] -- -- csound doc: chn_k :: Str -> D -> SE () chn_k b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unD b2 where f a1 a2 = opcs "chn_k" [(Xr,[Sr,Ir,Ir,Ir,Ir,Ir,Ir,Ir,Ir,Ir,Sr])] [a1,a2] -- | -- Declare a channel of the named software bus. -- -- 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. -- -- > chn_a Sname, imode -- -- csound doc: chn_a :: Str -> D -> SE () chn_a b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unD b2 where f a1 a2 = opcs "chn_a" [(Xr,[Sr,Ir])] [a1,a2] -- | -- Declare a channel of the named software bus. -- -- 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. -- -- > chn_S Sname, imode -- -- csound doc: chn_S :: Str -> D -> SE () chn_S b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unD b2 where f a1 a2 = opcs "chn_S" [(Xr,[Sr,Ir])] [a1,a2] -- | -- Clears an audio output channel of the named software bus. -- -- Clears an audio channel of the named software bus to zero. -- Implies declaring the channel with imode=2 (see also -- chn_a). -- -- > chnclear Sname -- -- csound doc: chnclear :: Str -> SE () chnclear b1 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 where f a1 = opcs "chnclear" [(Xr,[Sr])] [a1] -- | -- Export a global variable as a channel of the bus. -- -- Export a global variable as a channel of the bus; the channel -- should not already exist, otherwise an init error occurs. -- This opcode is normally called from the orchestra header, and allows -- the host application to read or write orchestra variables directly, -- without having to use -- chnget or -- chnset to copy data. -- -- > gival chnexport Sname, imode[, itype, idflt, imin, imax] -- > gkval chnexport Sname, imode[, itype, idflt, imin, imax] -- > gaval chnexport Sname, imode -- > gSval chnexport Sname, imode -- -- csound doc: chnexport :: Str -> D -> Str chnexport b1 b2 = Str $ f <$> unStr b1 <*> unD b2 where f a1 a2 = opcs "chnexport" [(Ir,[Sr,Ir,Ir,Ir,Ir,Ir]) ,(Kr,[Sr,Ir,Ir,Ir,Ir,Ir]) ,(Ar,[Sr,Ir]) ,(Sr,[Sr,Ir])] [a1,a2] -- | -- Reads data from the software bus. -- -- 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). -- -- > ival chnget Sname -- > kval chnget Sname -- > aval chnget Sname -- > Sval chnget Sname -- -- csound doc: chnget :: Str -> SE Str chnget b1 = fmap ( Str . return) $ SE $ (depT =<<) $ lift $ f <$> unStr b1 where f a1 = opcs "chnget" [(Ir,[Sr]),(Kr,[Sr]),(Ar,[Sr]),(Sr,[Sr])] [a1] -- | -- Writes audio data to the named software bus, mixing to the previous -- output. -- -- Adds an audio signal to a channel of the named software bus. -- Implies declaring the channel with imode=2 (see also -- chn_a). -- -- > chnmix aval, Sname -- -- csound doc: chnmix :: Sig -> Str -> SE () chnmix b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unStr b2 where f a1 a2 = opcs "chnmix" [(Xr,[Ar,Sr])] [a1,a2] -- | -- Query parameters of a channel. -- -- Query parameters of a channel (if it does not exist, all -- returned values are zero). -- -- > itype, imode, ictltype, idflt, imin, imax chnparams   -- -- csound doc: chnparams :: Tuple a => a chnparams = pureTuple $ return $ f where f = mopcs "chnparams" ([Ir,Ir,Ir,Ir,Ir,Ir],[]) [] -- | -- Recieves data from the software bus. -- -- 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). -- Note that -- chnsend/chnrecv (which in Csound6 work identically to invalue/outvalue) -- are usually used for the callback-based communication between Csound and -- an external host. Use the chnset/chnget opcodes for sending and receiving -- data inside Csound. -- -- > ival chnrecv Sname -- > kval chnrecv Sname -- > aval chnrecv Sname -- > Sval chnrecv Sname -- -- csound doc: chnrecv :: Str -> SE Str chnrecv b1 = fmap ( Str . return) $ SE $ (depT =<<) $ lift $ f <$> unStr b1 where f a1 = opcs "chnrecv" [(Ir,[Sr]),(Kr,[Sr]),(Ar,[Sr]),(Sr,[Sr])] [a1] -- | -- Sends data via the named software bus. -- -- 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). Note that -- chnsend/chnrecv (which in Csound6 work identically to invalue/outvalue) -- are usually used for the callback-based communication between Csound and -- an external host. Use the chnset/chnget opcodes for sending and receiving -- data inside Csound. -- -- > chnsend ival, Sname -- > chnsend kval, Sname -- > chnsend aval, Sname -- > chnsend Sval, Sname -- -- csound doc: chnsend :: D -> Str -> SE () chnsend b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unD b1 <*> unStr b2 where f a1 a2 = opcs "chnsend" [(Xr,[Ir,Sr])] [a1,a2] -- | -- Writes data to the named software bus. -- -- 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). -- -- > chnset ival, Sname -- > chnset kval, Sname -- > chnset aval, Sname -- > chnset Sval, Sname -- -- csound doc: chnset :: D -> Str -> SE () chnset b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unD b1 <*> unStr b2 where f a1 a2 = opcs "chnset" [(Xr,[Ir,Sr])] [a1,a2] -- | -- Sets the local ksmps value in an instrument or user-defined opcode block -- -- Sets the local ksmps value in an instrument or user-defined opcode block. -- -- > setksmps iksmps -- -- csound doc: setksmps :: D -> SE () setksmps b1 = SE $ (depT_ =<<) $ lift $ f <$> unD b1 where f a1 = opcs "setksmps" [(Xr,[Ir])] [a1] -- | -- Passes variables to a user-defined opcode block, -- -- The xin and xout opcodes copy variables to and from the opcode definition, allowing communication with the calling instrument. -- -- > xinarg1 [, xinarg2] ... [xinargN] xin   -- -- csound doc: xin :: Tuple a => a xin = pureTuple $ return $ f where f = mopcs "xin" ((repeat Xr),[]) [] -- | -- Retrieves variables from a user-defined opcode block, -- -- The xin and xout opcodes copy variables to and from the opcode definition, allowing communication with the calling instrument. -- -- > xout xoutarg1 [, xoutarg2] ... [, xoutargN] -- -- csound doc: xout :: [Sig] -> SE () xout b1 = SE $ (depT_ =<<) $ lift $ f <$> mapM unSig b1 where f a1 = opcs "xout" [(Xr,(repeat Xr))] a1 -- Printing and Display. -- | -- Displays the Fourier Transform of an audio or control signal. -- -- These units will print orchestra init-values, or produce graphic display of orchestra control signals and audio signals. Uses X11 windows if enabled, else (or if -g flag is set) displays are approximated in ASCII characters. -- -- > dispfft xsig, iprd, iwsiz [, iwtyp] [, idbout] [, iwtflg] -- -- csound doc: dispfft :: Sig -> D -> D -> SE () dispfft b1 b2 b3 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unD b2 <*> unD b3 where f a1 a2 a3 = opcs "dispfft" [(Xr,[Xr,Ir,Ir,Ir,Ir,Ir])] [a1,a2,a3] -- | -- Displays the audio or control signals as an amplitude vs. time graph. -- -- These units will print orchestra init-values, or produce graphic display of orchestra control signals and audio signals. Uses X11 windows if enabled, else (or if -g flag is set) displays are approximated in ASCII characters. -- -- > display xsig, iprd [, inprds] [, iwtflg] -- -- csound doc: display :: Sig -> D -> SE () display b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unD b2 where f a1 a2 = opcs "display" [(Xr,[Xr,Ir,Ir,Ir])] [a1,a2] -- | -- Allows text to be displayed from instruments like sliders -- -- Allows text to be displayed from instruments like sliders etc. (only on Unix and Windows at present) -- -- > flashtxt iwhich, String -- -- csound doc: flashtxt :: D -> Str -> SE () flashtxt b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unD b1 <*> unStr b2 where f a1 a2 = opcs "flashtxt" [(Xr,[Ir,Sr])] [a1,a2] -- | -- Displays the values init (i-rate) variables. -- -- These units will print orchestra init-values. -- -- > print iarg [, iarg1] [, iarg2] [...] -- -- csound doc: print' :: [D] -> SE () print' b1 = SE $ (depT_ =<<) $ lift $ f <$> mapM unD b1 where f a1 = opcs "print" [(Xr,(repeat Ir))] a1 -- | -- printf-style formatted output -- -- printf and printf_i write -- formatted output, similarly to the C function -- printf(). printf_i runs at i-time only, while -- printf runs both at initialization and -- performance time. -- -- > printf_i Sfmt, itrig, [iarg1[, iarg2[, ... ]]] -- -- csound doc: printf_i :: Str -> D -> [D] -> SE () printf_i b1 b2 b3 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unD b2 <*> mapM unD b3 where f a1 a2 a3 = opcs "printf_i" [(Xr,[Sr] ++ (repeat Ir))] ([a1,a2] ++ a3) -- | -- printf-style formatted output -- -- printf and printf_i write -- formatted output, similarly to the C function -- printf(). printf_i runs at i-time only, while -- printf runs both at initialization and -- performance time. -- -- > printf Sfmt, ktrig, [xarg1[, xarg2[, ... ]]] -- -- csound doc: printf :: Str -> Sig -> [Sig] -> SE () printf b1 b2 b3 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unSig b2 <*> mapM unSig b3 where f a1 a2 a3 = opcs "printf" [(Xr,[Sr,Kr] ++ (repeat Xr))] ([a1,a2] ++ a3) -- | -- Prints one k-rate value at specified intervals. -- -- > printk itime, kval [, ispace] -- -- csound doc: printk :: D -> Sig -> SE () printk b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unD b1 <*> unSig b2 where f a1 a2 = opcs "printk" [(Xr,[Ir,Kr,Ir])] [a1,a2] -- | -- Prints a new value every time a control variable changes. -- -- > printk2 kvar [, inumspaces] -- -- csound doc: printk2 :: Sig -> SE () printk2 b1 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 where f a1 = opcs "printk2" [(Xr,[Kr,Ir])] [a1] -- | -- Prints at k-rate using a printf() style syntax. -- -- > printks "string", itime [, kval1] [, kval2] [...] -- -- csound doc: printks :: Str -> D -> [Sig] -> SE () printks b1 b2 b3 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unD b2 <*> mapM unSig b3 where f a1 a2 a3 = opcs "printks" [(Xr,[Sr,Ir] ++ (repeat Kr))] ([a1,a2] ++ a3) -- | -- Prints at init-time using a printf() style syntax. -- -- > prints "string" [, kval1] [, kval2] [...] -- -- csound doc: prints :: Str -> [Sig] -> SE () prints b1 b2 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> mapM unSig b2 where f a1 a2 = opcs "prints" [(Xr,[Sr] ++ (repeat Kr))] ([a1] ++ a2) -- Soundfile Queries. -- | -- Returns the number of bits in each sample in a sound file. -- -- > ir filebit ifilcod [, iallowraw] -- -- csound doc: filebit :: Str -> D filebit b1 = D $ f <$> unStr b1 where f a1 = opcs "filebit" [(Ir,[Sr,Ir])] [a1] -- | -- Returns the length of a sound file. -- -- > ir filelen ifilcod, [iallowraw] -- -- csound doc: filelen :: Str -> D filelen b1 = D $ f <$> unStr b1 where f a1 = opcs "filelen" [(Ir,[Sr,Ir])] [a1] -- | -- Returns the number of channels in a sound file. -- -- > ir filenchnls ifilcod [, iallowraw] -- -- csound doc: filenchnls :: Str -> D filenchnls b1 = D $ f <$> unStr b1 where f a1 = opcs "filenchnls" [(Ir,[Sr,Ir])] [a1] -- | -- Returns the peak absolute value of a sound file. -- -- > ir filepeak ifilcod [, ichnl] -- -- csound doc: filepeak :: Str -> D filepeak b1 = D $ f <$> unStr b1 where f a1 = opcs "filepeak" [(Ir,[Sr,Ir])] [a1] -- | -- Returns the sample rate of a sound file. -- -- > ir filesr ifilcod [, iallowraw] -- -- csound doc: filesr :: Str -> D filesr b1 = D $ f <$> unStr b1 where f a1 = opcs "filesr" [(Ir,[Sr,Ir])] [a1] -- | -- Checks that a file can be used. -- -- Returns 1 if the sound file is valid, or 0 if not. -- -- > ir filevalid ifilcod -- -- csound doc: filevalid :: Str -> D filevalid b1 = D $ f <$> unStr b1 where f a1 = opcs "filevalid" [(Ir,[Sr])] [a1] -- | -- Returns the length of an MP3 sound file. -- -- > ir mp3len ifilcod -- -- csound doc: mp3len :: Str -> D mp3len b1 = D $ f <$> unStr b1 where f a1 = opcs "mp3len" [(Ir,[Sr])] [a1]