Interface.hs

{-# LANGUAGE TypeFamilies #-}

-- |Interface to csound.h
-- This module contains all foreign import statements, Haskell
-- representations of most csound datatypes
-- and their Storable instances, and some extra marshalling functions.

module Sound.Csound.Interface (
 -- * Types
  CsndFlt
 ,UInt32T
 ,CsoundError (..)
 ,Csound (..)
 ,CsoundInit
 ,CsoundPerformStatus (..)
 ,CsoundSetCallbackStatus (..)
 ,CsoundCallbackFunctionType
 ,CsoundCallbackFunctionTypeMask
 ,OpcodeListEntry (..)

 -- * Csound Functions
 -- ** Engine
 ,runCsound
 ,destroy
 ,preCompile
 ,initializeCscore
 ,queryInterface
 ,getHostData
 ,setHostData
 ,getEnv
 ,setGlobalEnv

 -- ** Performance functions
 ,compile
 ,perform
 ,performKsmps
 ,performKsmpsAbsolute
 ,performBuffer
 ,stop
 ,cleanup
 ,reset
 ,setHostImplementedAudioIO
 ,unsafePerformKsmps

 -- *** buffer access
 ,getInputBufferSize
 ,getOutputBufferSize
 ,getInputBuffer
 ,getOutputBuffer
 ,getSpin
 ,getSpout

 -- ** Csound attributes
 ,getSr
 ,getKr
 ,getKsmps
 ,getNchnls
 ,get0dBFS
 ,getStrVarMaxLen
 ,getSampleFormat
 ,getSampleSize
 ,getOutputFileName
 ,getDebug
 ,setDebug

 -- ** Score functions
 ,getScoreTime
 ,isScorePending
 ,setScorePending
 ,getScoreOffsetSeconds
 ,setScoreOffsetSeconds
 ,rewindScore
 ,setCscoreCallback
 ,scoreSort
 ,scoreExtract
 ,scoreEvent

 -- ** Messages
 ,getMessageLevel
 ,setMessageLevel
 ,inputMessage
 ,keyPress

 -- *** Callbacks
 ,setInputValueCallback
 ,setOutputValueCallback

 -- *** operations
 ,enableMessageBuffer
 ,getFirstMessage
 ,getFirstMessageAttr
 ,popFirstMessage
 ,getMessageCnt
 ,destroyMessageBuffer

 -- ** MIDI
 ,setExternalMidiInOpenCallback
 ,setExternalMidiReadCallback
 ,setExternalMidiInCloseCallback
 ,setExternalMidiOutOpenCallback
 ,setExternalMidiWriteCallback
 ,setExternalMidiErrorStringCallback

 -- ** Graphing
 ,setIsGraphable
 ,setMakeGraphCallback
 ,setDrawGraphCallback
 ,setKillGraphCallback
 ,setMakeXYinCallback
 ,setReadXYinCallback
 ,setKillXYinCallback
 ,setExitGraphCallback

 -- ** Opcode manipulation
 ,newOpcodeList
 ,disposeOpcodeList
 ,appendOpcode

 -- ** Library
 ,openLibrary
 ,closeLibrary
 ,getLibrarySymbol

 -- ** Real-time Play/Record
 ,setYieldCallback
 ,setPlayopenCallback
 ,setRtplayCallback
 ,setRecopenCallback
 ,setRtrecordCallback
 ,setRtcloseCallback
 ,getRtRecordUserData
 ,getRtPlayUserData
 ,registerSenseEventCallback

 -- ** FTables
 ,tableLength
 ,tableGet
 ,tableSet
 ,getTable
 ,withTable

 -- ** Threading
 ,createThread
 ,getCurrentThreadId
 ,joinThread
 ,runCommand
 ,createThreadLock
 ,waitThreadLock
 ,waitThreadLockNoTimeout
 ,notifyThreadLock
 ,destroyThreadLock
 ,createMutex
 ,lockMutex
 ,lockMutexNoWait
 ,unlockMutex
 ,destroyMutex
 ,createBarrier
 ,destroyBarrier
 ,waitBarrier
 ,sleep

 -- ** Timing
 ,initTimerStruct
 ,getRealTime
 ,getCPUTime
 ,getRandomSeedFromTime

 -- ** Locality
 ,setLanguage
 ,localizeString

 -- ** Globals
 ,createGlobalVariable
 ,queryGlobalVariable
 ,queryGlobalVariableNoCheck
 ,destroyGlobalVariable

 -- ** Utilities
 ,runUtility
 ,listUtilities
 ,getUtilityDescription

 -- ** Communications
 -- *** 'chan' opcodes
 ,getChannelPtr
 ,listChannels
 ,deleteChannelList
 ,setControlChannelParams
 ,getControlChannelParams
 ,setChannelIOCallback

 -- *** 'ichannel' opcodes
 ,chanIKSet
 ,chanOKGet
 ,chanIASet
 ,chanOAGet

 -- *** 'pvs' opcodes
 ,pvsinSet
 ,pvsoutGet

 -- ** Callbacks
 ,setCallback
 ,removeCallback
 ,setFileOpenCallback

 -- ** Randomization
 ,rand31
)

where

import Sound.Csound.Foreign
import Control.Applicative
import Control.Monad (liftM)
import Control.Monad.IO.Class
import Control.Monad.Error
import Control.Monad.Trans.Error (ErrorT)
import Control.Monad.Reader
import qualified Control.Monad.Trans.Cont as Cont
import Data.Bits
import Data.List ( foldl')
import Foreign.C
import Foreign.C.Types
import Foreign

io0cm :: (CsoundPtr -> IO a) -> Csound a
io0cm f = ask >>= liftIO . f

io1cm :: (CsoundPtr -> a -> IO b) -> a -> Csound b
io1cm f a = ask >>= liftIO . flip f a

io2cm :: (CsoundPtr -> a -> b -> IO c) -> a -> b -> Csound c
io2cm f a b = ask >>= \csptr -> liftIO (f csptr a b)

io3cm :: (CsoundPtr -> a -> b -> c -> IO d) -> a -> b -> c -> Csound d
io3cm f a b c = ask >>= \csptr -> liftIO (f csptr a b c)

runCsound :: Csound a -> IO (Either CsoundError a)
runCsound csd = do
  p <- unsafeCsoundCreate nullPtr
  res <- runErrorT $ runReaderT (unStack csd) p
  -- need to destroy the pointer even if Csound threw an error
  -- not using bracket because it's probably not safe to destroy the
  -- pointer in case of an IO exception.
  destroy' p
  return res
  

destroy :: Csound ()
destroy = io0cm destroy'

preCompile :: Csound ()
preCompile = ask >>= csoundStatusWrapper . unsafeCsoundPreCompile

initializeCscore :: FilePtr -> FilePtr -> Csound ()
initializeCscore iScore oScore = do
  csPtr <- ask
  csoundStatusWrapper $ unsafeCsoundInitializeCscore csPtr iScore oScore

queryInterface :: String -> Csound (CsoundStatus, Ptr (), Int)
queryInterface str = do
  res <- liftIO $ csoundQueryInterface' str
  case res of
    (CsoundSuccess, _, _) -> return res
    (errCode, _, _) -> throwError $ CsStatus errCode

getHostData :: Csound (Ptr ())
getHostData = io0cm getHostData'

setHostData :: Ptr () -> Csound ()
setHostData = io1cm setHostData'

getEnv :: String -> Csound String
getEnv str = ask >>= liftIO . flip getEnv' str

setGlobalEnv :: String -> String -> Csound ()
setGlobalEnv name value = csoundStatusWrapper $ setGlobalEnv' name value

-- *Performance functions
compile :: String -> Csound ()
compile argList = ask >>= \csPtr -> csoundStatusWrapper $
  compile' csPtr argv argc
 where
  argc = "csound" : words argList
  argv = length argc

perform :: Csound CsoundPerformStatus
perform = ask >>= csPerformStatusWrapper . perform'

performKsmps :: Csound CsoundPerformStatus
performKsmps = ask >>= csPerformStatusWrapper . performKsmps'

-- | Perform a Ksmps buffer.  The C function is called with the "unsafe"
-- modifier, which makes callbacks to Haskell unsafe.
unsafePerformKsmps :: Csound CsoundPerformStatus
unsafePerformKsmps = ask >>= csPerformStatusWrapper . unsafePerformKsmps'

performKsmpsAbsolute :: Csound CsoundPerformStatus
performKsmpsAbsolute = ask >>= csPerformStatusWrapper .
  performKsmpsAbsolute'

performBuffer :: Csound CsoundPerformStatus
performBuffer = ask >>= csPerformStatusWrapper . performBuffer'

stop :: Csound ()
stop = io0cm stop'

cleanup :: Csound Int
cleanup = io0cm cleanup'

reset :: Csound ()
reset = io0cm reset'

-- *Csound Attributes
getSr :: Csound CsndFlt
getSr = io0cm getSr'

getKr :: Csound CsndFlt
getKr = io0cm getKr'

getKsmps :: Csound Int
getKsmps = io0cm getKsmps'

getNchnls :: Csound Int
getNchnls = io0cm getNchnls'

get0dBFS :: Csound CsndFlt
get0dBFS = io0cm get0dBFS'

getStrVarMaxLen :: Csound Int
getStrVarMaxLen = io0cm getStrVarMaxLen'

getSampleFormat :: Csound Int
getSampleFormat = io0cm getSampleFormat'

getSampleSize :: Csound Int
getSampleSize = io0cm getSampleSize'

getInputBufferSize :: Csound Int
getInputBufferSize = io0cm getInputBufferSize'

getOutputBufferSize :: Csound Int
getOutputBufferSize = io0cm getOutputBufferSize'

getInputBuffer :: Csound (Ptr CsndFlt)
getInputBuffer = io0cm getInputBuffer'

getOutputBuffer :: Csound (Ptr CsndFlt)
getOutputBuffer = io0cm getOutputBuffer'

getSpin :: Csound (Ptr CsndFlt)
getSpin = io0cm getSpin'

getSpout :: Csound (Ptr CsndFlt)
getSpout = io0cm getSpout'

getOutputFileName :: Csound String
getOutputFileName = io0cm getOutputFileName'

setHostImplementedAudioIO :: Int -> Int -> Csound ()
setHostImplementedAudioIO = io2cm setHostImplementedAudioIO'

-- -----------------------------------------------
-- Score functions

getScoreTime :: Csound CsndFlt
getScoreTime = io0cm getScoreTime'

isScorePending :: Csound Int
isScorePending = io0cm isScorePending'

setScorePending :: Int -> Csound ()
setScorePending = io1cm setScorePending'

getScoreOffsetSeconds :: Csound CsndFlt
getScoreOffsetSeconds = io0cm getScoreOffsetSeconds'

setScoreOffsetSeconds :: CsndFlt -> Csound ()
setScoreOffsetSeconds = io1cm setScoreOffsetSeconds'

rewindScore :: Csound ()
rewindScore = io0cm rewindScore'

setCscoreCallback :: FunPtr (CsoundPtr -> IO ()) -> Csound ()
setCscoreCallback = io1cm setCscoreCallback'

scoreSort :: FilePtr -> FilePtr -> Csound ()
scoreSort inFile outFile = do
  csPtr <- ask
  csoundStatusWrapper $ scoreSort' csPtr inFile outFile

scoreExtract :: FilePtr -> FilePtr -> FilePtr -> Csound ()
scoreExtract inFile outFile extractFile = do
  csPtr <- ask
  csoundStatusWrapper $ scoreExtract' csPtr inFile outFile extractFile

-- -------------------------------------
-- Messages and Text

getMessageLevel :: Csound Int
getMessageLevel = io0cm getMessageLevel'

setMessageLevel :: Int -> Csound ()
setMessageLevel = io1cm setMessageLevel'

inputMessage :: String -> Csound ()
inputMessage = io1cm inputMessage'

keyPress :: Char -> Csound ()
keyPress = io1cm keyPress'

-- -------------------------------------
-- Callback functions
setInputValueCallback :: InputValueCallback -> Csound ()
setInputValueCallback = io1cm setInputValueCallback'

setOutputValueCallback :: OutputValueCallback -> Csound ()
setOutputValueCallback = io1cm setOutputValueCallback'

scoreEvent :: Char -> [CsndFlt] -> Int -> Csound Int
scoreEvent = io3cm scoreEvent'

-- -------------------------------------
-- MIDI

setExternalMidiInOpenCallback :: ExternalMidiOpenCallback -> Csound ()
setExternalMidiInOpenCallback = io1cm setExternalMidiInOpenCallback'

setExternalMidiReadCallback :: ExternalMidiReadCallback -> Csound ()
setExternalMidiReadCallback = io1cm setExternalMidiReadCallback'

setExternalMidiInCloseCallback :: ExternalMidiCloseCallback -> Csound ()
setExternalMidiInCloseCallback = io1cm setExternalMidiInCloseCallback'

setExternalMidiOutOpenCallback :: ExternalMidiOpenCallback -> Csound ()
setExternalMidiOutOpenCallback = io1cm setExternalMidiOutOpenCallback'

setExternalMidiWriteCallback :: ExternalMidiWriteCallback -> Csound ()
setExternalMidiWriteCallback = io1cm setExternalMidiWriteCallback'

setExternalMidiErrorCallback :: ExternalMidiErrorStringCallback -> Csound ()
setExternalMidiErrorCallback = io1cm setExternalMidiErrorStringCallback'

setExternalMidiErrorStringCallback ::
  ExternalMidiErrorStringCallback
  -> Csound ()
setExternalMidiErrorStringCallback = io1cm setExternalMidiErrorStringCallback'

-- -------------------------------------
-- Graph/Table functions

setIsGraphable :: Int -> Csound Int
setIsGraphable = io1cm setIsGraphable'

setMakeGraphCallback :: MakeGraphCallback -> Csound ()
setMakeGraphCallback = io1cm setMakeGraphCallback'

setDrawGraphCallback :: DrawGraphCallback -> Csound ()
setDrawGraphCallback = io1cm setDrawGraphCallback'

setKillGraphCallback :: KillGraphCallback -> Csound ()
setKillGraphCallback = io1cm setKillGraphCallback'

setMakeXYinCallback :: MakeXYinCallback -> Csound ()
setMakeXYinCallback = io1cm setMakeXYinCallback'

setReadXYinCallback :: ReadXYinCallback -> Csound ()
setReadXYinCallback = io1cm setReadXYinCallback'

setKillXYinCallback :: KillXYinCallback -> Csound ()
setKillXYinCallback = io1cm setKillXYinCallback'

setExitGraphCallback :: ExitGraphCallback -> Csound ()
setExitGraphCallback = io1cm setExitGraphCallback'


-- -------------------------------------
-- **Csound opcode manipulation functions
newOpcodeList :: Csound [OpcodeListEntry]
newOpcodeList = do
  csptr <- ask
  (arrayLen, ptr) <- liftIO $ newOpcodeList' csptr
  if arrayLen >= 0
    then liftIO (peekArray arrayLen ptr) <* disposeOpcodeList ptr
    else throwError $ CsStatus (toEnum arrayLen)

disposeOpcodeList :: OpcodeListEntryPtr -> Csound ()
disposeOpcodeList = io1cm disposeOpcodeList'

appendOpcode ::
  String -- ^Name of opcode to append
  -> Int -- ^dsblksize
  -> Int -- ^thread id
  -> String -- ^outypes
  -> String -- ^intypes
  -> OpcodeFunction -- ^iopadr
  -> OpcodeFunction -- ^kopadr
  -> OpcodeFunction -- ^aopadr
  -> Csound ()
appendOpcode opName dsblksz thread outypes intypes iopadr kopadr aopadr = do
  csPtr <- ask
  csoundStatusWrapper $ appendOpcode' csPtr opName dsblksz
    thread outypes intypes iopadr kopadr aopadr

-- -----------------------------------------
-- **Csound library functions.

openLibrary :: String -> Csound (Int, Ptr ())
openLibrary = liftIO . openLibrary'

closeLibrary :: Ptr () -> Csound Int
closeLibrary = liftIO . closeLibrary'

getLibrarySymbol :: Ptr () -> String -> Csound (Ptr ())
getLibrarySymbol ptr str = liftIO $ getLibrarySymbol' ptr str

-- *Real-time Audio Play and Record
-- **wrappers to csound real-time audio functions.

setYieldCallback :: YieldCallback -> Csound ()
setYieldCallback = io1cm setYieldCallback'

setPlayopenCallback :: PlayopenCallback -> Csound ()
setPlayopenCallback = io1cm setPlayopenCallback'

setRtplayCallback :: RtplayCallback -> Csound ()
setRtplayCallback = io1cm setRtplayCallback'

setRecopenCallback :: RecopenCallback -> Csound ()
setRecopenCallback = io1cm setRecopenCallback'

setRtrecordCallback :: RtrecordCallback -> Csound ()
setRtrecordCallback = io1cm setRtrecordCallback'

setRtcloseCallback :: RtcloseCallback -> Csound ()
setRtcloseCallback = io1cm setRtcloseCallback'

getRtRecordUserData :: Csound (Ptr (Ptr ()))
getRtRecordUserData = io0cm getRtRecordUserData'

getRtPlayUserData :: Csound (Ptr (Ptr ()))
getRtPlayUserData = io0cm getRtPlayUserData'

registerSenseEventCallback :: 
  FunPtr (
      CsoundPtr 
      -> Ptr () 
      -> IO () ) 
  -> Ptr () 
  -> Csound ()
registerSenseEventCallback funPtr dataPtr = do
  csPtr <- ask
  boolWrapper "RegisterSenseEventCallback failed." $
    registerSenseEventCallback' csPtr funPtr dataPtr

getDebug :: Csound Bool
getDebug = io0cm getDebug'

setDebug :: Bool -> Csound ()
setDebug = io1cm setDebug'

-- *Functions to set and retrieve information from csound function tables.
tableLength :: Int -> Csound Int
tableLength tblNum = do
  csPtr <- ask
  tableLen <- liftIO $ tableLength' csPtr tblNum
  if tableLen > 0
    then return tableLen
    else throwError $ CsString "Table not found."

tableGet :: Int -> Int -> Csound CsndFlt
tableGet = io2cm tableGet'

tableSet :: Int -> Int -> CsndFlt -> Csound ()
tableSet = io3cm tableSet'

getTable :: Int -> Csound [CsndFlt]
getTable tableNum = do
  csptr <- ask
  (arrayLen, ptr) <- liftIO $ getTable' csptr tableNum
  --Adding 1 to the length to account for the guard point.
  case arrayLen of
    Just val -> liftIO . liftM (map cFloatConv) $ peekArray (val+1) ptr
    Nothing -> throwError $ CsString $
      "Table " ++ show tableNum ++ " not found."

-- |Performs an action with a table.  The type of CCsndFlt is
-- unfortunately csound-dependent.
withTable :: Int -> (Ptr CCsndFlt -> Int -> IO b) -> Csound b
withTable tableNum f = do
  csptr <- ask
  (arrayLen, ptr) <- liftIO $ getTable' csptr tableNum
  case arrayLen of
    Just val -> liftIO $ f ptr val
    Nothing  -> throwError . CsString $
      "Table " ++ show tableNum ++ " not found."

-- *Csound threading
-- **Csound threading functions

createThread :: FunPtr (Ptr () -> IO UIntPtrT) -> Ptr () -> Csound (Ptr ())
createThread fp p = liftIO $ createThread' fp p

getCurrentThreadId :: Csound (Ptr ())
getCurrentThreadId = liftIO getCurrentThreadId'

joinThread :: Ptr () -> Csound UIntPtrT
joinThread = liftIO . joinThread'

runCommand :: [String] -> Bool -> Csound Int
runCommand args noWait = do
  output <- liftIO $ runCommand' args noWait
  if output < 0
    then throwError . CsString $ show output
    else return output

createThreadLock :: Csound (Ptr ())
createThreadLock = liftIO createThreadLock'

waitThreadLock :: Ptr () -> Int -> Csound (Bool, Ptr ())
waitThreadLock ptr i = liftIO $ waitThreadLock' ptr i

waitThreadLockNoTimeout :: Ptr () -> Csound ()
waitThreadLockNoTimeout = liftIO . waitThreadLockNoTimeout'

notifyThreadLock :: Ptr () -> Csound ()
notifyThreadLock = liftIO . notifyThreadLock'

destroyThreadLock :: Ptr () -> Csound ()
destroyThreadLock = liftIO . destroyThreadLock'

createMutex :: CInt -> Csound (Ptr ())
createMutex = liftIO . createMutex'

lockMutex :: Ptr () -> Csound ()
lockMutex = liftIO . lockMutex'

lockMutexNoWait :: Ptr () -> Csound AcquiredMutex
lockMutexNoWait = liftIO . lockMutexNoWait'

unlockMutex :: Ptr () -> Csound ()
unlockMutex = liftIO . unlockMutex'

destroyMutex :: Ptr () -> IO ()
destroyMutex = liftIO . destroyMutex'

createBarrier :: Int -> Csound (Ptr ())
createBarrier = liftIO . createBarrier'

destroyBarrier :: Ptr () -> Csound Int
destroyBarrier = liftIO . destroyBarrier'

waitBarrier :: Ptr () -> Csound Int
waitBarrier = liftIO . waitBarrier'

sleep :: Int -> Csound ()
sleep = liftIO . sleep'

-- ---------------------------------------
-- *Time / local functions
initTimerStruct :: Csound RtClockPtr
initTimerStruct = liftIO initTimerStruct'

getRealTime :: RtClockPtr -> Csound Double
getRealTime = liftIO . getRealTime'

getCPUTime :: RtClockPtr -> Csound Double
getCPUTime = liftIO . getCPUTime'

getRandomSeedFromTime :: Csound UInt32T
getRandomSeedFromTime = liftIO getRandomSeedFromTime'

setLanguage :: CsLanguage -> Csound ()
setLanguage = liftIO . setLanguage'

localizeString :: String -> Csound String
localizeString = liftIO . localizeString'

-- *Csound global variable manipulations
createGlobalVariable :: String -> Int -> Csound ()
createGlobalVariable name sz = do
  csPtr <- ask
  csoundStatusWrapper $ createGlobalVariable' csPtr name sz

queryGlobalVariable :: String -> Csound (Maybe (Ptr ()))
queryGlobalVariable = io1cm queryGlobalVariable'

queryGlobalVariableNoCheck :: String -> Csound (Ptr ())
queryGlobalVariableNoCheck = io1cm queryGlobalVariableNoCheck'

destroyGlobalVariable :: String -> Csound ()
destroyGlobalVariable name = do
  csPtr <- ask
  csoundStatusWrapper $ destroyGlobalVariable' csPtr name


-- *Csound utility functions
runUtility :: String -> String -> Csound ()
runUtility name args = do
  csPtr <- ask
  boolWrapper errStr $ runUtility' csPtr name argv argc
   where
    errStr = "Attempt to run utility " ++ name ++ " failed."
    argc = words args
    argv = length argc

listUtilities :: Csound ([String])
listUtilities = do
  csPtr <- ask
  (p, u) <- liftIO $ unsafeListUtilities csPtr
  liftIO $ deleteUtilityList' csPtr p
  return u

getUtilityDescription :: String -> Csound String
getUtilityDescription = io1cm getUtilityDescription'

-- *Csound channel functions

-- **Functions for the 'chan' family of opcodes
getChannelPtr :: String -> CsoundChannelDirectionalType -> Csound (Ptr CCsndFlt)
getChannelPtr name chantype = do
  csPtr <- ask
  res <- liftIO $ getChannelPtr' csPtr name chantype
  case res of
    (CsoundSuccess, myPtr) -> return myPtr
    (err, _) -> throwError . CsString $ "Error '" ++ show err ++
      "' getting channel pointer " ++ name ++ "."

listChannels :: Csound (CsoundChannelListEntryPtr, [CsoundChannelListEntry])
listChannels = do
  csPtr <- ask
  (arrayLen, ptr) <- liftIO $ listChannels' csPtr
  case arrayLen of
    NumChannels 0 -> return (ptr, [])
    NumChannels nC -> do
      vals <- liftIO $ peekArray nC ptr
      return (ptr, vals)
    ChanError err -> throwError $ CsStatus err

deleteChannelList :: CsoundChannelListEntryPtr -> Csound ()
deleteChannelList = io1cm deleteChannelList'

setControlChannelParams ::
  String -- ^Name of channel to write to
  -> CsoundControlChannelType -- ^Type of channel
  -> CsndFlt -- ^Default value for channel
  -> CsndFlt -- ^Minimum value for channel
  -> CsndFlt -- ^Maximum value for channel
  -> Csound ()
setControlChannelParams chanName chanType defVal minVal maxVal = do
  csPtr <- ask
  csoundStatusWrapper $ setControlChannelParams' csPtr chanName
    chanType defVal minVal maxVal

-- |Query a control channel to get special parameters (as specified by
-- csoundSetControlChannelParams).  If the channel exists and the params
-- are set, the type of the control channel, default, minimum and
-- maximum are returned.  If the control channel exists but no special params
-- are defined, this function will have a value of Nothing.
-- Otherwise the error code will be specified in Csound.
getControlChannelParams ::
  String -- ^Name of channel to query
  -> Csound (Maybe (CsoundControlChannelType, CsndFlt, CsndFlt, CsndFlt))
getControlChannelParams chanName = do
  (typ, d, mn, mx) <- io1cm getControlChannelParams' chanName
  case (typ < 0, toEnum typ) of
    (True, _) -> throwError $ CsStatus (toEnum typ)
    (False, CsoundControlChannelClear) -> return Nothing
    (False, realTyp) -> return $ Just (realTyp, d, mn, mx)

setChannelIOCallback :: CsoundChannelIOCallbackT -> Csound ()
setChannelIOCallback = io1cm setChannelIOCallback'

-- **functions for the 'ichannel' family of opcodes
chanIKSet ::
  CsndFlt -- ^Value to set
  -> Int -- ^Channel number to access.
  -> Csound ()
chanIKSet val chan = do
  csPtr <- ask
  csoundStatusWrapper $ chanIKSet' csPtr val chan

chanOKGet ::
  Int -- ^Index of channel
  -> Csound CsndFlt -- ^current value of the channel
chanOKGet chan = do
  csPtr <- ask
  csoundStatValWrapper $ chanOKGet' csPtr chan

chanIASet ::
  [CsndFlt] -- ^Array of value (of length ksmps) to write to a channel
  -> Int -- ^Index of channel
  -> Csound ()
chanIASet ary chan = do
  csPtr <- ask
  csoundStatusWrapper $ chanIASet' csPtr ary chan

-- |TODO: Possible bug- it's likely that a buffer ksmps long will need to be
-- allocated, instead of
-- the single pointer actually allocated within unsafeCsoundChanOAGet
chanOAGet ::
  Int -- ^Length of audio array (ksmps)
  -> Int -- ^Index of channel
  -> Csound [CsndFlt]
chanOAGet len chan = do
  csPtr <- ask
  (stat, ptr) <- liftIO $ chanOAGet' csPtr chan
  case stat of
    CsoundSuccess -> liftIO $ fmap (map cFloatConv) $ peekArray len ptr
    err -> throwError $ CsStatus err

-- **Functions for PvsIn and PvsOut
pvsinSet ::
  PvsDatExt -- ^PvsDatExt object to send
  -> Int -- ^Index of channel
  -> Csound ()
pvsinSet pvs chan = do
  csPtr <- ask
  csoundStatusWrapper $ csoundPvsinSet' csPtr pvs chan

pvsoutGet ::
  Int -- ^Index of channel
  -> Csound PvsDatExt
pvsoutGet chan = do
  csPtr <- ask
  csoundStatValWrapper $ csoundPvsoutGet' csPtr chan

rand31 :: Int -> Csound Int
rand31 = liftIO . rand31'

setCallback ::
  CsoundCallbackFunction
  -> Ptr ()
  -> CsoundCallbackFunctionTypeMask
  -> Csound CsoundSetCallbackStatus
setCallback cfn p mk = do
  res <- io3cm setCallback' cfn p mk
  case res of
    SetCallbackError err -> throwError $ CsStatus err
    _                    -> return res

removeCallback :: CsoundCallbackFunction -> Csound ()
removeCallback = io1cm removeCallback'

-- ----------------------------------
-- Messaging functions
enableMessageBuffer :: Int -> Csound ()
enableMessageBuffer = io1cm enableMessageBuffer'

getFirstMessage :: Csound String
getFirstMessage = io0cm getFirstMessage'

getFirstMessageAttr :: Csound Int
getFirstMessageAttr = io0cm getFirstMessageAttr'

popFirstMessage :: Csound ()
popFirstMessage = io0cm popFirstMessage'

getMessageCnt :: Csound Int
getMessageCnt = io0cm getMessageCnt'

destroyMessageBuffer :: Csound ()
destroyMessageBuffer = io0cm destroyMessageBuffer'

setFileOpenCallback :: CsoundFileOpenCallback -> Csound ()
setFileOpenCallback = io1cm setFileOpenCallback'