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
	(
                CsoundMonad, --exported from Interface
                csoundCreate,
                csoundCompile,
                csoundPerform,
                CsoundPerformStatus,
                csoundPreCompile,
                csoundSetHostImplementedAudioIO,

-- defined in this module
                csoundPerformKsmpsIO,
                csoundPerformBufferIO,
                withOpcodeList,
                withUtilityList,
                listUtilityNames,
                withChannelList
	)
where

import Sound.Csound.Interface
import Foreign.Marshal.Array (peekArray, pokeArray)
import Control.Monad.Error (liftIO, throwError)
import Control.Exception (bracket)

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

-- |Perform an entire score using csoundPerformKsmps, with handling of
-- input and output buffers spin and spout.  Note that
-- csoundSetHostImplementedIO must be called before csoundCompile.
csoundPerformKsmpsIO ::
        CsoundPtr -- ^Pointer to csound instance
        -> (Int -> Int -> IO [CsndFlt]) -- ^Function that takes buffer size
                                        -- and starting position (in samples)
                                        -- and returns a list of length
                                        -- buffersize of input to use.
        -> (Int -> Int -> [CsndFlt] -> IO ()) -- ^Function that takes
                                              -- buffer size, starting
                                              -- position (in samples),
                                              -- and list of CsndFlt
                                              -- and performs an IO action
                                              -- with the [CsndFlt]
        -> CsoundMonad ()
csoundPerformKsmpsIO csPtr inBuf outBuf = csoundPerformKsmpsIO' 0
        where
        bufSize = csoundGetKsmps csPtr
        ifn = inBuf bufSize
        ofn = outBuf bufSize
        peekFn = peekArray bufSize
        csoundPerformKsmpsIO' :: Int -> CsoundMonad ()
        csoundPerformKsmpsIO' iposAcc = do
                liftIO $ csoundGetSpin' csPtr >>= \iptr ->
                         ifn iposAcc >>= pokeArray iptr
                res <- csoundPerformKsmps csPtr
                liftIO $ csoundGetSpout' csPtr >>= peekFn >>= ofn iposAcc
                case res of
                        PerformStopped -> let newPosAcc = iposAcc + bufSize in
                                csoundPerformKsmpsIO' newPosAcc
                        PerformFinished -> return ()
                        _ -> throwError $ show res 

-- |Perform an entire score using csoundPerformBuffer, with handling of
-- input and output buffers.
csoundPerformBufferIO ::
  CsoundPtr -- ^Pointer to Csound struct
  -> (Int -> Int -> IO [CsndFlt]) -- ^Function that takes buffer size and
                                  -- starting position (in samples) and
                                  -- returns a list of length buffersize
                                  -- of input to use.
  -> (Int -> Int -> [CsndFlt] -> IO ()) -- ^Function that takes buffer
                                        -- size, starting position
                                        -- (in samples), and list of CsndFlt
                                        -- and performs an IO action
                                        -- with the [CsndFlt]
  -> CsoundMonad ()
csoundPerformBufferIO csp inBuf outBuf = csoundPerformBufferIO' 0
        where
        inBufSize = csoundGetInputBufferSize csp
        ifn = inBuf inBufSize
        outBufSize = csoundGetOutputBufferSize csp
        ofn = outBuf outBufSize
        peekFn = peekArray $ csoundGetInputBufferSize csp
        csoundPerformBufferIO' :: Int -> CsoundMonad ()
        csoundPerformBufferIO' iposAcc = do
                liftIO $ csoundGetInputBuffer' csp >>=
                         \iptr -> ifn iposAcc >>= pokeArray iptr
                res <- csoundPerformBuffer csp
                liftIO $ csoundGetOutputBuffer' csp >>= peekFn >>= ofn iposAcc
                case res of
                        PerformStopped -> let newPosAcc = iposAcc+inBufSize in
                                csoundPerformBufferIO' newPosAcc
                        PerformFinished -> return ()
                        _ -> throwError $ show res --Again, this should never happen

-- |Perform an IO action with the current csound opcode list,
-- properly disposing of the list after completing the action.
withOpcodeList :: CsoundPtr -> ([OpcodeListEntry] -> IO b) -> CsoundMonad b
withOpcodeList csPtr func = do
        openRes <- csoundNewOpcodeList csPtr
        liftIO $ bracket (return openRes) disposeFunc procFunc
        where
        disposeFunc (ptr, _) = csoundDisposeOpcodeList csPtr ptr
        procFunc (_, list) = func list

-- |Perform an action within the IO monad, using the list of named utilities.
withUtilityList :: CsoundPtr -> ([String] -> IO b) -> CsoundMonad b
withUtilityList csPtr func = do
        openRes <- csoundListUtilities csPtr
        case openRes of
                (_, []) -> throwError "No utilities found."
                _ -> liftIO $ bracket (return openRes) disposeFunc procFunc
        where
        disposeFunc (ptr, _) = csoundDeleteUtilityList csPtr ptr
        procFunc (_, list) = func list

-- |Get a list of all the registered csound utilities.  This should be used instead of csoundListUtilities.
-- because this function calls csoundDeleteUtilityList after use.
listUtilityNames :: CsoundPtr -> CsoundMonad [String]
listUtilityNames csPtr = withUtilityList csPtr return

-- |Perform an action within the IO monad, using the list of channels.
withChannelList :: CsoundPtr -> ([CsoundChannelListEntry] -> IO a) -> CsoundMonad a
withChannelList csPtr func = do
        openRes <- csoundListChannels csPtr
        case openRes of
                (_, []) -> throwError "No open channels"
                _ -> liftIO $ bracket (return openRes) disposeFunc procFunc
        where
        disposeFunc (ptr, _) = csoundDeleteChannelList csPtr ptr
        procFunc (_, list) = func list

-- |Perform a simple run of csound, with no special handling.
{-
runCsoundSimple :: String -> CsoundMonad CsoundPerformStatus
runCsoundSimple argList = do
        perfStatus <- liftIO $ bracket (csoundCreate nullPtr) csoundDestroy perform
	where
        perform csPtr = do
                res <- csoundCompile csPtr argv argc
                case res of
                        CsoundSuccess -> csoundPerform csPtr
                        otherwise -> return $ PerformError res
        argc = "csound" : words argList
	argv = length argc
-}