Csound.hs

-- |Sound.Csound provides a Haskell interface to the Csound API (defined in
-- csound.h). (almost) all functions from the API are wrapped and marshalled
-- in Sound.CSound.Interface.
-- In addition to the raw functions provided there, Sound.CSound provides
-- many more convenient to use when calling csound, as well as marshalling
-- for some functions that return vectors.
--
-- C++ class files, such as CSoundFile.hpp, are not yet wrapped.
-- Also support for cscore is currently very limited.

module Sound.Csound (
  module Sound.Csound.Interface,
  -- defined in this module
  performKsmpsIO,
  performBufferIO,
  withChannelList,
  runSimple
)

where

import           Sound.Csound.Foreign
import           Sound.Csound.Interface
import           Sound.Csound.Vector

import           Foreign.Marshal.Array (peekArray, pokeArray)
import           Control.Exception (bracket)
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad.Error
import           Control.Monad.State

-- |Basic run with csound-implemented I/O
runSimple :: String -> IO (Maybe CsoundError)
runSimple args = fmap rf $ runCsound csnd
 where
  csnd = compile args >> perform >> destroy
  rf = either Just (const Nothing)

-- Functions to perform a score with input and output from the host.

-- |Perform an entire score using performKsmps, with handling of
-- input and output buffers spin and spout.  Note that
-- setHostImplementedIO must be called before compile.
performKsmpsIO ::
  (Int -> Int -> IO CsVector) -- ^Function that takes buffer size
                              -- and starting position (in samples)
                              -- and returns a list of length
                              -- buffersize of input to use.
  -> (Int -> Int -> CsVector -> IO ()) -- ^Function that takes
                                       -- buffer size, starting
                                       -- position (in samples),
                                       -- and list of CsndFlt
                                       -- and performs an IO action
                                       -- with the [CsndFlt]
  -> Csound ()
performKsmpsIO inBuf outBuf = do
  bufSize <- getKsmps
  let ifn = inBuf bufSize
  let ofn = outBuf bufSize
  let performKsmpsIO' :: Int -> Csound ()
      performKsmpsIO' iposAcc = do
        liftIO (ifn iposAcc) >>= unsafeVec2Spin
        res <- performKsmps
        readSpout >>= liftIO . ofn iposAcc
        case res of
          PerformStopped -> let newPosAcc = iposAcc + bufSize in
            performKsmpsIO' newPosAcc
          PerformFinished -> return ()
          PerformError stat -> throwError $ CsStatus stat 
  performKsmpsIO' 0

-- |Perform an entire score using performBuffer, with handling of
-- input and output buffers.
performBufferIO ::
  (Int -> Int -> IO CsVector) -- ^Function that takes buffer size and
                              -- starting position (in samples) and
                              -- returns a list of length buffersize
                              -- of input to use.
  -> (Int -> Int -> CsVector -> IO ()) -- ^Function that takes buffer
                                       -- size, starting position
                                       -- (in samples), and list of CsndFlt
                                       -- and performs an IO action
                                       -- with the [CsndFlt]
  -> Csound ()
performBufferIO inBuf outBuf = do
  inBufSize <- getInputBufferSize
  outBufSize <- getOutputBufferSize
  let ifn = inBuf inBufSize
  let ofn = outBuf outBufSize
  let performBufferIO' :: Int -> Csound ()
      performBufferIO' iposAcc = do
        ibufSz <- getInputBufferSize
        liftIO (ifn iposAcc) >>= vec2Ibuf
        res <- performBuffer
        readObuf >>= liftIO . ofn iposAcc
        case res of
          PerformStopped -> performBufferIO' $! iposAcc+inBufSize
          PerformFinished -> return ()
          PerformError stat -> throwError $ CsStatus stat :: Csound ()
  performBufferIO' 0

-- |Perform an action within the IO monad, using the list of channels.
withChannelList :: ([CsoundChannelListEntry] -> IO a) -> Csound a
withChannelList func = do
  openRes <- listChannels
  x <- liftIO . func . snd $ openRes
  deleteChannelList . fst $ openRes
  return x