packages feed

hCsound-0.3.0: src/Sound/Csound/Foreign.chs

{-# LANGUAGE ForeignFunctionInterface, GeneralizedNewtypeDeriving,
  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.Foreign where

import Control.Applicative
import Control.Monad (liftM)
import Control.Monad.IO.Class
import Control.Monad.Error.Class
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

#include <csound.h>

-- **Haskell representations of basic csound types.
-- |Type for one audio sample value.  CsndFlt is a double regardless of the size of CSNDFLT
type CsndFlt = Double

#ifndef USE_DOUBLE
-- |C representation of CSNDFLT, depending on if USE_DOUBLE is defined.
type CCsndFlt = CFloat
#else
type CCsndFlt = CDouble
#endif

type IntLeast64T = {#type int_least64_t#}
type UInt32T = {#type uint32_t#}
type UIntPtrT = {#type uintptr_t#}

-- **Csound error type
data CsoundError =
    CsString String
  | CsStatus CsoundStatus
  deriving (Show, Eq)

instance Error CsoundError where
  strMsg = CsString

-- **The Csound and associated functions
newtype Csound a = Stack {
  unStack :: ReaderT CsoundPtr (ErrorT CsoundError IO) a }
  deriving (Monad, Functor, MonadIO, Applicative)

instance MonadError Csound where
  type ErrorType Csound = CsoundError
  throwError e = Stack (lift $ throwError e)
  catchError m f = Stack $ catchError (unStack m) (unStack . f)

instance MonadReader Csound where
  type  EnvType Csound = CsoundPtr
  ask = Stack ask
  local f = Stack . local f . unStack

-- |Wrap functions that return CsoundStatus into the Csound
-- for error handling
csoundStatusWrapper :: IO CsoundStatus -> Csound ()
csoundStatusWrapper csoundFunc = do
  res <- liftIO csoundFunc
  case res of
    CsoundSuccess -> return ()
    _ -> throwError $ CsStatus res

-- |Wrap functions that return a CsoundStatus and one other value into the
-- Csound for error handling.
csoundStatValWrapper :: IO (CsoundStatus, a) -> Csound a
csoundStatValWrapper func = do
  (stat, output) <- liftIO func
  case stat of
    CsoundSuccess -> return output
    _ -> throwError (CsStatus stat) >> return output

-- |Wrap functions that return CsoundPerformStatus into the Csound.
csPerformStatusWrapper ::
  IO CsoundPerformStatus
  -> Csound CsoundPerformStatus
csPerformStatusWrapper csoundFunc = do
  res <- liftIO csoundFunc
  case res of
    PerformError stat -> throwError $ CsStatus stat
    _ -> return res

-- |Wrap any function from IO monad to Csound
csoundWrapper :: (a -> IO b) -> a -> Csound b
csoundWrapper fn v = liftIO $ fn v
{-# INLINE csoundWrapper #-}

-- |Wrap functions that return Bool into the Csound
boolWrapper :: String -> IO Bool -> Csound ()
boolWrapper errStr action = do
  res <- liftIO action
  case res of
    True -> return ()
    False -> throwError $ CsString errStr

{#pointer *CSOUND as CsoundPtr newtype#}
{#pointer *FILE as FilePtr newtype#}
{#pointer *PVSDATEXT as PvsDatExtPtr -> PvsDatExt#}

-- **Enumerations.
-- | Flags for csoundInitialize().
data CsoundInit =
    CsoundInitNoSignalHandler
  | CsoundInitNoAtExit
-- rather than hardwiring the enums, I should probably use cpp on this file
-- to get the values directly from the header.
instance Enum CsoundInit where
  fromEnum CsoundInitNoSignalHandler = 1
  fromEnum CsoundInitNoAtExit = 2

  toEnum 1 = CsoundInitNoSignalHandler
  toEnum 2 = CsoundInitNoAtExit
  toEnum i = error ("CsoundInit.toEnum: Cannot match " ++ show i)

-- |Csound Languages.
{#enum cslanguage_t as CsLanguage {underscoreToCase} deriving (Eq, Show)#}

-- |CSound status.
{#enum CSOUND_STATUS as CsoundStatus {underscoreToCase} deriving (Eq, Show)#}

-- |CsoundPerform results
data CsoundPerformStatus =
    PerformFinished
  | PerformStopped
  | PerformError CsoundStatus deriving Show

-- |The return values of the csoundSetCallback function.
data CsoundSetCallbackStatus =
    SetCallbackOk
  | SetCallbackError CsoundStatus
  | SetCallbackIgnored Int
  deriving (Eq, Show)

-- |Csound callback function types.
-- A callback function will receive one of these types to specify the type
-- of event calling it.
-- when setting a callback, the bitwise 'or' of all desired types should
-- be used (or the special 'alltypes' value).

data CsoundCallbackFunctionType =
    CsoundCallbackAllTypes
  | CsoundCallbackKbdEvent
  | CsoundCallbackKbdText
  deriving (Eq)

instance Enum CsoundCallbackFunctionType where
  fromEnum CsoundCallbackAllTypes = 0
  fromEnum CsoundCallbackKbdEvent = 1
  fromEnum CsoundCallbackKbdText = 2

  toEnum 0 = CsoundCallbackAllTypes
  toEnum 1 = CsoundCallbackKbdEvent
  toEnum 2 = CsoundCallbackKbdText
  toEnum unmatched = error
          ("CsoundCallbackFunctionType.toEnum: Cannot match " ++ show unmatched)

newtype CsoundCallbackFunctionTypeMask = CsoundCallbackFunctionTypeMask Int
  deriving (Eq, Num, Ord, Show, Real, Enum, Integral, Bits)

typeToMask :: CsoundCallbackFunctionType -> CsoundCallbackFunctionTypeMask
typeToMask CsoundCallbackAllTypes = 0
typeToMask typ = fromIntegral $ fromEnum typ

-- |Create a TypeMask from a list of CsoundCallbackFunctionType
createTypeMask :: [CsoundCallbackFunctionType] -> CsoundCallbackFunctionTypeMask
createTypeMask = foldl' orFunc (-1)
 where
  orFunc (-1) r = typeToMask r --ignore a (-1) type
  orFunc _ CsoundCallbackAllTypes = 0
  orFunc 0 _ = 0
  orFunc l r = l .|. typeToMask r

-- | Filetypes recognized by CSound
{#enum CSOUND_FILETYPES as CsoundFiletypes {underscoreToCase} deriving (Eq, Show)#}

-- **Utility marshalling functions
cIntConv :: (Integral a, Num b) => a -> b
cIntConv = fromIntegral

cFloatConv :: (Real a, Fractional b) => a -> b
cFloatConv = realToFrac

withIntConv :: Int -> (Ptr CInt -> IO b) -> IO b
withIntConv i f = alloca (\p -> poke p (fromIntegral i) >> f p)

peekIntConv = fmap fromIntegral . peek

-- |Marshal an enumeration to a CInt
cIntFromEnum :: Enum a => a -> CInt
cIntFromEnum = cIntConv . fromEnum

-- |Marshal a CInt to an enumeration
cIntToEnum :: Enum a => CInt -> a
cIntToEnum = toEnum . cIntConv

-- |Marshal a CInt to Bool.  False if CInt== 0, otherwise true.
cIntToBool :: CInt -> Bool
cIntToBool 0 = False
cIntToBool _ = True

-- |Marshal a CInt to Bool.  True if CInt== 0, otherwise false.
-- Some standardization of the underlying library would be nice.
-- Even better is knowing that it will never be fixed.
cIntToBoolSwitch :: CInt -> Bool
cIntToBoolSwitch 0 = True
cIntToBoolSwitch _ = False

-- |Marshal a CInt to a Maybe Int, Nothing if CInt <0
maybeCInt :: CInt -> Maybe Int
maybeCInt i
  | i >= 0 = Just $ cIntConv i
  | otherwise = Nothing

-- |Check if a Ptr () is valid or not.
checkNullPtr :: Ptr () -> Maybe (Ptr ())
checkNullPtr ptr
  | ptr == nullPtr = Nothing
  | otherwise = Just ptr

-- |Create a CsoundPerformStatus
toCsoundPerformStatus :: CInt -> CsoundPerformStatus
toCsoundPerformStatus a
  | a == 0 = PerformStopped
  | a < 0  = PerformError $ cIntToEnum a
  | otherwise = PerformFinished

cIntToSetCallbackStatus :: CInt -> CsoundSetCallbackStatus
cIntToSetCallbackStatus 0 = SetCallbackOk
cIntToSetCallbackStatus val
 | val < 0   = SetCallbackError $ cIntToEnum val
 | otherwise = SetCallbackIgnored $ cIntConv val

-- |Marshal a list of CsndFlt to an array of MYFLT.
withCsndFltArray :: (Storable b, RealFloat b, RealFloat a) =>
  [a]
  -> (Ptr b -> IO b1)
  -> IO b1
withCsndFltArray = withArray . map (cFloatConv)

nest :: Monad m => [(r -> m a) -> m a] -> ([r] -> m a) -> m a
nest xs = Cont.runContT (sequence (map Cont.ContT xs))

-- |Marshal a [String] to a (Ptr (Ptr CChar))
withStringList :: [String] -> (Ptr CString -> IO a) -> IO a
withStringList strings act = nest (map withCString strings)
  (\rs -> withArray0 nullPtr rs act)

-- |Marshal (Ptr (Ptr CChar)) to [String].
-- Keep track of the original pointer because it will often
-- need to be manually freed.
peekStringArrayPtr :: Ptr (Ptr (CChar)) -> IO (Ptr (CString), [String])
peekStringArrayPtr ptrPtr = do
  strAry <- peekStringArray ptrPtr
  return (ptrPtr, strAry)

peekStringArray :: Ptr CString -> IO [String]
peekStringArray ptrPtr = withCString "" (\nul-> do
  cstrAry <- peekArray0 nul ptrPtr
  mapM peekCAString cstrAry
  )

-- |since c2hs doesn't allow "with" as an input marshaller,
-- withObject is a synonym.
withObject :: Storable a => a -> (Ptr a -> IO b) -> IO b
withObject = with

-- |Peek from a Ptr CFloat to a CsndFloat
peekCsndFlt :: Ptr CCsndFlt -> IO CsndFlt
peekCsndFlt = liftM cFloatConv . peek

-- |Marshal a Ptr (Ptr CCsndFlt) to a Ptr (CCsndFlt).
peekCsndOutAry :: Ptr (Ptr CCsndFlt) -> IO (Ptr CCsndFlt)
peekCsndOutAry ptrPtr = peek ptrPtr

-- |Variation on PVSDAT used in the pvs bus interface.
-- The two parameters sliding and nb are only present
-- #ifdef SDFT.  If compiled with SDFT support, the fields will be Just a,
-- otherwise they will be Nothing.
-- hCsound does not currently implement SDFT.
data PvsDatExt = PvsDatExt {
  n :: Int,
  sliding :: Maybe Int,
  nb :: Maybe Int,
  overlap :: Int,
  winsize :: Int,
  wintype :: Int,
  format :: Int,
  framecount :: Int,
  frame :: Ptr CFloat
  }

instance Storable (PvsDatExt) where
  alignment _ = alignment (undefined :: CInt)
  sizeOf _ = {#sizeof PVSDATEXT#}
  peek p = do
    nV <- liftM fromIntegral $ {#get PVSDATEXT.N#} p
#ifdef SDFT
    slidingV <- liftM Just . fromIntegral $
                            {#get PVSDATEXT.sliding#} p
    nbV <- liftM Just . fromIntegral $ {#get PVSDATEXT.NB#} p
#else
    let slidingV = Nothing
    let nbV = Nothing
#endif
    overlapV <- liftM fromIntegral $ {#get PVSDATEXT.overlap#} p
    winsizeV <- liftM fromIntegral $ {#get PVSDATEXT.winsize#} p
    wintypeV <- liftM fromIntegral $ {#get PVSDATEXT.wintype#} p
    formatV <- liftM fromIntegral $ {#get PVSDATEXT.format#} p
    framecountV <- liftM fromIntegral $ {#get PVSDATEXT.framecount#} p
    frameV <- {#get PVSDATEXT.frame#} p
    return $ PvsDatExt nV slidingV nbV overlapV winsizeV
                          wintypeV formatV framecountV frameV
  poke p pvs = do
      {#set PVSDATEXT.N#} p $ fromIntegral $ n pvs
#ifdef SDFT
      -- If the structure was marshalled from C, these will have a
      -- value. If these are Nothing and SDFT is defined,
      -- it should be an error anyway.
      {#set PVSDATEXT.sliding#} p $ fromIntegral . fromJust $ sliding pvs
      {#set PVSDATEXT.NB#} p $ fromIntegral . fromJust $ nb pvs
#endif
      {#set PVSDATEXT.overlap#} p $ fromIntegral $ overlap pvs
      {#set PVSDATEXT.winsize#} p $ fromIntegral $ winsize pvs
      {#set PVSDATEXT.wintype#} p $ fromIntegral $ wintype pvs
      {#set PVSDATEXT.format#} p $ fromIntegral $ format pvs
      {#set PVSDATEXT.framecount#} p $ fromIntegral $ framecount pvs
      {#set PVSDATEXT.frame#} p $ frame pvs

-- *Csound Initialization functions
{- I don't want to do this yet; I don't know if the input values are
retained by the csound library.
{#fun unsafe csoundInitialize as ^
  {
    `Int',
    strAryInMarshal* `[String]',
    `Int'
  } -> `Int'#}
-}

unsafeCsoundCreate :: Ptr () -> IO (CsoundPtr)
unsafeCsoundCreate = {#call unsafe csoundCreate as uCsoundCreate'#}

{#fun unsafe csoundPreCompile as unsafeCsoundPreCompile
  {id `CsoundPtr'} -> `CsoundStatus' cIntToEnum #}

{#fun unsafe csoundInitializeCscore as unsafeCsoundInitializeCscore
  {
    id `CsoundPtr',
    id `FilePtr',
    id `FilePtr'
  } -> `CsoundStatus' cIntToEnum#}

-- |Returns (Result, ptr to interface, version number) if the interface is available.
{#fun csoundQueryInterface as csoundQueryInterface'
  {
    `String',
    alloca- `Ptr ()' peek*,
    alloca- `Int' peekIntConv*
  } -> `CsoundStatus' cIntToEnum#}

{#fun unsafe csoundGetVersion as getVersion' {} -> `Int'#}

{#fun unsafe csoundGetAPIVersion as getApiVersion' {} -> `Int'#}

destroy' :: CsoundPtr -> IO ()
destroy' = {#call unsafe csoundDestroy #}

getHostData' :: CsoundPtr -> IO (Ptr ())
getHostData' = {#call csoundGetHostData #}

setHostData' :: CsoundPtr -> Ptr () -> IO ()
setHostData' = {#call csoundSetHostData #}

{#fun csoundGetEnv as getEnv' {id `CsoundPtr', `String'} ->  `String'#}

{#fun csoundSetGlobalEnv as setGlobalEnv'
  {`String', `String'} -> `CsoundStatus' cIntToEnum#}

-- *Performance functions
{#fun unsafe csoundCompile as compile'
  {
    id `CsoundPtr',
    `Int',
    withStringList* `[String]'
  } -> `CsoundStatus' cIntToEnum#}

{#fun csoundPerform as perform' {id `CsoundPtr'} -> `CsoundPerformStatus' toCsoundPerformStatus#}

{#fun csoundPerformKsmps as performKsmps' {id `CsoundPtr'} -> `CsoundPerformStatus' toCsoundPerformStatus#}

{#fun unsafe csoundPerformKsmps as unsafePerformKsmps' {id `CsoundPtr'} -> `CsoundPerformStatus' toCsoundPerformStatus#}

{#fun csoundPerformKsmpsAbsolute as performKsmpsAbsolute'
        {id `CsoundPtr'} -> `CsoundPerformStatus' toCsoundPerformStatus#}

{#fun csoundPerformBuffer as performBuffer' {id `CsoundPtr'} -> `CsoundPerformStatus' toCsoundPerformStatus#}

{#fun csoundStop as stop' {id `CsoundPtr'} -> `()'#}

{#fun csoundCleanup as cleanup' {id `CsoundPtr'} -> `Int'#}

{#fun csoundReset as reset' {id `CsoundPtr'} -> `()'#}

-- *Csound Attributes
{#fun unsafe csoundGetSr as getSr'
  { id `CsoundPtr'} -> `CsndFlt' cFloatConv#}

{#fun unsafe csoundGetKr as getKr'
  { id `CsoundPtr'} -> `CsndFlt' cFloatConv#}

{#fun unsafe csoundGetKsmps as getKsmps'
  { id `CsoundPtr'} -> `Int'#}

{#fun unsafe csoundGetNchnls as getNchnls' { id `CsoundPtr'} -> `Int'#}

{#fun unsafe csoundGet0dBFS as get0dBFS'
  { id `CsoundPtr'} -> `CsndFlt' cFloatConv#}

{#fun unsafe csoundGetStrVarMaxLen as getStrVarMaxLen'
  { id `CsoundPtr'} -> `Int'#}

{#fun unsafe csoundGetSampleFormat as getSampleFormat'
  { id `CsoundPtr'} -> `Int'#}

{#fun unsafe csoundGetSampleSize as getSampleSize'
  { id `CsoundPtr'} -> `Int'#}

{#fun unsafe csoundGetInputBufferSize as getInputBufferSize'
  { id `CsoundPtr'} -> `Int'#}

{#fun unsafe csoundGetOutputBufferSize as getOutputBufferSize'
  { id `CsoundPtr'} -> `Int'#}

-- *Input\/output functions
-- **These functions return a MYFLT array.  To marshall this to haskell,
-- you need to first get the size of the array (using getInputBufferSize,
-- getOutputBufferSize, or getKsmps),
-- then the output can be marshalled with
-- Foreign.Marshal.Array.peekArray
-- There are some convience functions in Sound.Csound that do some of this.
{#fun unsafe csoundGetInputBuffer as getInputBuffer'
  { id `CsoundPtr'} -> `Ptr CsndFlt' castPtr#}

{#fun unsafe csoundGetOutputBuffer as getOutputBuffer'
  { id `CsoundPtr'} -> `Ptr CsndFlt' castPtr#}

{#fun unsafe csoundGetSpin as getSpin'
  { id `CsoundPtr'} -> `Ptr CsndFlt' castPtr#}

{#fun unsafe csoundGetSpout as getSpout'
  { id `CsoundPtr'} -> `Ptr CsndFlt' castPtr#}

{#fun unsafe csoundGetOutputFileName as getOutputFileName'
  { id `CsoundPtr'} -> `String'#}

-- |Call between csoundPreCompile and csoundCompile to set Host Implemented IO
{#fun unsafe csoundSetHostImplementedAudioIO as setHostImplementedAudioIO'
  {
    id `CsoundPtr',
    `Int',
    `Int'
  } -> `()'#}

-- *Score handling functions.
{#fun unsafe csoundGetScoreTime as getScoreTime'
  { id `CsoundPtr'} -> `CsndFlt' cFloatConv#}

{#fun unsafe csoundIsScorePending as isScorePending' { id `CsoundPtr'} -> `Int'#}

{#fun unsafe csoundSetScorePending as setScorePending'
  {
    id `CsoundPtr',
    `Int'
  } -> `()'#}

{#fun unsafe csoundGetScoreOffsetSeconds as getScoreOffsetSeconds'
  { id `CsoundPtr'} -> `CsndFlt' cFloatConv#}

{#fun unsafe csoundSetScoreOffsetSeconds as setScoreOffsetSeconds'
  {
    id `CsoundPtr',
    cFloatConv `CsndFlt'
  } -> `()'#}

rewindScore' :: CsoundPtr -> IO ()
rewindScore' = {#call csoundRewindScore #}

setCscoreCallback' :: CsoundPtr -> FunPtr (CsoundPtr -> IO ()) -> IO ()
setCscoreCallback' = {#call csoundSetCscoreCallback #}

{#fun csoundScoreSort as scoreSort'
  {
    id `CsoundPtr',
    id `FilePtr',
    id `FilePtr'
  } -> `CsoundStatus' cIntToEnum#}

{#fun csoundScoreExtract as scoreExtract'
  {
    id `CsoundPtr',
    id `FilePtr',
    id `FilePtr',
    id `FilePtr'
  } -> `CsoundStatus' cIntToEnum#}

-- *Messages and Text
{#fun unsafe csoundGetMessageLevel as getMessageLevel'
  {id `CsoundPtr'} -> `Int'#}

{#fun unsafe csoundSetMessageLevel as setMessageLevel'
  {
    id `CsoundPtr',
    `Int'
  } -> `()'#}

{#fun unsafe csoundInputMessage as inputMessage'
  {
    id `CsoundPtr',
    `String'
  } -> `()'#}

{#fun csoundKeyPress as keyPress'
  {
    id `CsoundPtr',
    castCharToCChar `Char'
  } -> `()'#}

-- *Control and events
-- these functions are used by the \'invalue\' and \'outvalue\' opcodes.
-- **Callback types
-- |Csound Instance, Channel name, Value read (in csound) from channel
type InputValueCallback  = FunPtr (
  CsoundPtr
  -> CString
  -> Ptr CCsndFlt
  -> IO () )
-- |Csound instance, channel name, value to write (from csound) to channel
type OutputValueCallback = FunPtr (
  CsoundPtr
  -> CString
  -> CCsndFlt
  -> IO ())

-- **Set csound callbacks
-- |called by 'invalue' opcode.
setInputValueCallback' ::
  CsoundPtr
  -> InputValueCallback
  -> IO ()
setInputValueCallback' = {#call csoundSetInputValueCallback #}

-- |called by 'outvalue' opcode.
setOutputValueCallback' ::
  CsoundPtr
  -> OutputValueCallback
  -> IO ()
setOutputValueCallback' = {#call csoundSetOutputValueCallback #}

{#fun csoundScoreEvent as scoreEvent'
  {
    id `CsoundPtr',
    castCharToCChar `Char',
    withCsndFltArray* `[CsndFlt]',
    `Int'
  } -> `Int'#}

-- *MIDI
-- **MIDI callback function types
-- |Csound instance, **UserData, Device name
type ExternalMidiOpenCallback = FunPtr (
  CsoundPtr
  -> Ptr (Ptr ())
  -> CString
  -> IO CInt
  )

-- |Csound instance, *UserData, Buffer, number of bytes
type ExternalMidiReadCallback  = FunPtr (
  CsoundPtr
  -> Ptr ()
  -> Ptr CUChar
  -> CInt
  -> IO CInt
  )

type ExternalMidiWriteCallback = ExternalMidiReadCallback

-- |Csound instance -> *UserData
type ExternalMidiCloseCallback = FunPtr (
  CsoundPtr
  -> Ptr ()
  -> IO CInt
  )

-- |MIDI error code -> string representation
type ExternalMidiErrorStringCallback = FunPtr (
  CInt
  -> IO CString
  )

-- **Csound MIDI functions

setExternalMidiInOpenCallback' ::
  CsoundPtr
  -> ExternalMidiOpenCallback
  -> IO ()
setExternalMidiInOpenCallback' = {#call csoundSetExternalMidiInOpenCallback #}

setExternalMidiReadCallback' ::
  CsoundPtr
  -> ExternalMidiReadCallback
  -> IO ()
setExternalMidiReadCallback' = {#call csoundSetExternalMidiReadCallback #}

setExternalMidiInCloseCallback' ::
  CsoundPtr
  -> ExternalMidiCloseCallback
  -> IO ()
setExternalMidiInCloseCallback' = {#call csoundSetExternalMidiInCloseCallback #}

setExternalMidiOutOpenCallback' ::
  CsoundPtr
  -> ExternalMidiOpenCallback
  -> IO ()
setExternalMidiOutOpenCallback' = {#call csoundSetExternalMidiOutOpenCallback #}

setExternalMidiWriteCallback' ::
  CsoundPtr
  -> ExternalMidiWriteCallback
  -> IO ()
setExternalMidiWriteCallback' = {#call csoundSetExternalMidiWriteCallback #}

setExternalMidiOutCloseCallback' ::
  CsoundPtr
  -> ExternalMidiCloseCallback
  -> IO ()
setExternalMidiOutCloseCallback' =
  {#call csoundSetExternalMidiOutCloseCallback #}

setExternalMidiErrorStringCallback' ::
  CsoundPtr
  -> ExternalMidiErrorStringCallback
  -> IO ()
setExternalMidiErrorStringCallback' =
  {#call csoundSetExternalMidiErrorStringCallback #}

-- *Function table display
-- **Callback function types
-- |Ptr to a WINDAT struct.  I haven't made a haskell representation of this.
{#pointer *WINDAT as WinDatPtr#}

type MakeGraphCallback = FunPtr (CsoundPtr -> WinDatPtr -> CString -> IO ())
type DrawGraphCallback = FunPtr (CsoundPtr -> WinDatPtr -> IO ())
type KillGraphCallback = FunPtr (CsoundPtr -> WinDatPtr -> IO ())
type MakeXYinCallback = FunPtr
  (CsoundPtr
   -> WinDatPtr
   -> CCsndFlt
   -> CCsndFlt
   -> IO ()
  )
type ReadXYinCallback = FunPtr (CsoundPtr -> WinDatPtr -> IO ())
type KillXYinCallback = FunPtr (CsoundPtr -> WinDatPtr -> IO ())
type ExitGraphCallback = FunPtr (CsoundPtr -> IO CInt)

-- **Csound functions
{#fun csoundSetIsGraphable as setIsGraphable'
  {id `CsoundPtr', `Int' } -> `Int'#}

setMakeGraphCallback' ::
  CsoundPtr
  -> MakeGraphCallback
  -> IO ()
setMakeGraphCallback' = {#call csoundSetMakeGraphCallback #}

setDrawGraphCallback' ::
  CsoundPtr
  -> DrawGraphCallback
  -> IO ()
setDrawGraphCallback' = {#call csoundSetDrawGraphCallback #}

setKillGraphCallback' ::
  CsoundPtr
  -> KillGraphCallback
  -> IO ()
setKillGraphCallback' = {#call csoundSetKillGraphCallback #}

setMakeXYinCallback' ::
   CsoundPtr
   -> MakeXYinCallback
   -> IO ()
setMakeXYinCallback' = {#call csoundSetMakeXYinCallback #}

setReadXYinCallback' ::
  CsoundPtr
  -> ReadXYinCallback
  -> IO ()
setReadXYinCallback' = {#call csoundSetReadXYinCallback #}

setKillXYinCallback' ::
  CsoundPtr
  -> KillXYinCallback
  -> IO ()
setKillXYinCallback' = {#call csoundSetKillXYinCallback #}

setExitGraphCallback' ::
  CsoundPtr
  -> ExitGraphCallback
  -> IO ()
setExitGraphCallback' = {#call csoundSetExitGraphCallback #}

-- *Csound opcodes
-- **Opcode data types
{#pointer *opcodeListEntry as OpcodeListEntryPtr -> OpcodeListEntry#}

data OpcodeListEntry = OpcodeListEntry {
  opcodeName :: String, -- ^Name of opcode
  ouTypes :: String, -- ^Output types
  inTypes :: String -- ^Input types
  } deriving (Eq, Show)

instance Storable (OpcodeListEntry) where
  alignment _ = 16
  sizeOf _ = {#sizeof opcodeListEntry#}
  peek p = do
    nameV <- {#get opcodeListEntry.opname#} p >>= peekCString
    otypesV <- {#get opcodeListEntry.outypes#} p >>= peekCString
    itypesV <- {#get opcodeListEntry.intypes#} p >>= peekCString
    return $ OpcodeListEntry nameV otypesV itypesV
  poke p li = do
    newCString (opcodeName li) >>= {#set opcodeListEntry.opname#} p
    newCString (ouTypes li) >>= {#set opcodeListEntry.outypes#} p
    newCString (inTypes li) >>= {#set opcodeListEntry.intypes#} p

-- **opcode function types
-- |Type for a callback function of a new csound opcode.
type OpcodeFunction = FunPtr (CsoundPtr -> Ptr () -> IO CInt)

-- **Csound opcode manipulation functions
{#fun unsafe csoundNewOpcodeList as newOpcodeList'
  {
    id `CsoundPtr',
    alloca- `OpcodeListEntryPtr' peek*
  } -> `Int' #}

disposeOpcodeList' ::
  CsoundPtr
  -> OpcodeListEntryPtr
  -> IO ()
disposeOpcodeList' = {#call unsafe csoundDisposeOpcodeList #}

{#fun csoundAppendOpcode as appendOpcode'
  {
    id `CsoundPtr',
    `String',
    `Int',
    `Int',
    `String',
    `String',
    id `OpcodeFunction',
    id `OpcodeFunction',
    id `OpcodeFunction'
  } -> `CsoundStatus' cIntToEnum#}

-- *Csound library functions.
{#fun csoundOpenLibrary as openLibrary'
  {
    alloca- `Ptr ()' peek*,
    `String'
  } -> `Int'#}

{#fun csoundCloseLibrary as closeLibrary' { id `Ptr ()' } -> `Int'#}

{#fun csoundGetLibrarySymbol as getLibrarySymbol'
  {
    id `Ptr ()',
    `String'
  } -> `Ptr ()' id#}

-- *Real-time Audio Play and Record
-- **Real-time data types
{#pointer *csRtAudioParams as CsRtAudioParamsPtr -> CsRtAudioParams#}
{#pointer *RTCLOCK as RtClockPtr -> RtClock#}

-- |Real-time audio parameters.
-- The sampleFormat should actually be an enum, as defined in soundio.h.
data CsRtAudioParams = CsRtAudioParams {
  devName :: CString, -- ^ Name of device
  devNum :: Int, -- ^ Device number
  bufSampSW :: Int, -- ^ Software buffer size in sample frames
  bufSampHW :: Int, -- ^ Hardware buffer size in sample frames
  nChannels :: Int, -- ^ Number of channels
  sampleFormat :: Int, -- ^ Sample format (AE_SHORT etc.)
  sampleRate :: Float -- ^ Sample rate in Hz
  }

instance Storable (CsRtAudioParams) where
  alignment _ = 16
  sizeOf _ = {#sizeof csRtAudioParams#}
  peek p = do
    dName <- {#get csRtAudioParams.devName#} p
    dNum <- liftM fromIntegral $ {#get csRtAudioParams.devNum#} p
    bufSampSw <- liftM fromIntegral $
                       {#get csRtAudioParams.bufSamp_SW#} p
    bufSampHw <- liftM fromIntegral $
                       {#get csRtAudioParams.bufSamp_HW#} p
    chns <- liftM fromIntegral $ {#get csRtAudioParams.nChannels#} p
    sf <- liftM fromIntegral $
                {#get csRtAudioParams.sampleFormat#} p
    sr <- liftM (fromRational . toRational) $
                {#get csRtAudioParams.sampleRate#} p
    return $ CsRtAudioParams dName dNum bufSampSw bufSampHw chns sf sr
  poke p params = do
    {#set csRtAudioParams.devName#} p $ devName params
    {#set csRtAudioParams.devNum#} p $ fromIntegral . devNum $
                  params
    {#set csRtAudioParams.bufSamp_SW#} p $ fromIntegral . bufSampSW $ params
    {#set csRtAudioParams.bufSamp_HW#} p $ fromIntegral . bufSampHW $ params
    {#set csRtAudioParams.nChannels#} p $ fromIntegral . nChannels $ params
    {#set csRtAudioParams.sampleFormat#} p . fromIntegral . sampleFormat $
      params
    {#set csRtAudioParams.sampleRate#} p . fromRational . toRational .
      sampleRate $ params

data RtClock = RtClock {
  startTimeReal :: IntLeast64T,
  startTimeCPU :: IntLeast64T
  }

instance Storable (RtClock) where
  alignment _ = alignment (undefined ::CInt)
  sizeOf _ = {#sizeof RTCLOCK#}
  peek p = do
    real <- liftM fromIntegral $ {#get RTCLOCK.starttime_real#} p
    cpu <- liftM fromIntegral $ {#get RTCLOCK.starttime_CPU#} p
    return $ RtClock real cpu
  poke p rt = do
    {#set RTCLOCK.starttime_real#} p . fromIntegral . startTimeReal $ rt
    {#set RTCLOCK.starttime_CPU#} p . fromIntegral . startTimeCPU $ rt

type YieldCallback = FunPtr (CsoundPtr -> IO CInt)

type PlayopenCallback = FunPtr (CsoundPtr -> CsRtAudioParamsPtr -> IO CInt)

type RtplayCallback = FunPtr (CsoundPtr -> Ptr CCsndFlt -> CInt -> IO ())

type RecopenCallback = FunPtr (CsoundPtr -> CsRtAudioParamsPtr -> IO CInt)

type RtrecordCallback = FunPtr (CsoundPtr -> Ptr CCsndFlt -> CInt -> IO CInt)

type RtcloseCallback = FunPtr (CsoundPtr -> IO ())

-- **wrappers to csound real-time audio functions.
setYieldCallback' ::
  CsoundPtr
  -> YieldCallback
  -> IO ()
setYieldCallback' = {#call csoundSetYieldCallback #}

setPlayopenCallback' ::
  CsoundPtr
  -> PlayopenCallback
  -> IO ()
setPlayopenCallback' = {#call csoundSetPlayopenCallback #}

setRtplayCallback' ::
  CsoundPtr
  -> RtplayCallback
  -> IO ()
setRtplayCallback' = {#call csoundSetRtplayCallback #}

setRecopenCallback' ::
  CsoundPtr
  -> RecopenCallback
  -> IO ()
setRecopenCallback' = {#call csoundSetRecopenCallback #}

setRtrecordCallback' ::
  CsoundPtr
  -> RtrecordCallback
  -> IO ()
setRtrecordCallback' = {#call csoundSetRtrecordCallback #}

setRtcloseCallback' ::
  CsoundPtr
  -> RtcloseCallback
  -> IO ()
setRtcloseCallback' = {#call unsafe csoundSetRtcloseCallback #}

getRtRecordUserData' :: CsoundPtr -> IO (Ptr (Ptr ()))
getRtRecordUserData' = {#call csoundGetRtRecordUserData #}

getRtPlayUserData' :: CsoundPtr -> IO (Ptr (Ptr ()))
getRtPlayUserData' = {#call csoundGetRtPlayUserData #}

{#fun csoundRegisterSenseEventCallback as registerSenseEventCallback'
  {
    id `CsoundPtr',
    id `FunPtr (CsoundPtr -> Ptr () -> IO ())',
    id `Ptr ()'
  } -> `Bool' cIntToBoolSwitch#}

{#fun unsafe csoundGetDebug as getDebug'
  { id `CsoundPtr' } -> `Bool' cIntToBool#}

{#fun unsafe csoundSetDebug as setDebug'
  {
    id `CsoundPtr',
    cIntFromEnum `Bool'
  } -> `()'#}

-- *Functions to set and retrieve information from csound function tables.
{#fun unsafe csoundTableLength as tableLength'
  {
    id `CsoundPtr',
    `Int'
  } -> `Int'#}

{#fun unsafe csoundTableGet as tableGet'
  {
    id `CsoundPtr',
    `Int',
    `Int'
  } -> `CsndFlt' cFloatConv#}

{#fun unsafe csoundTableSet as tableSet'
  {
    id `CsoundPtr',
    `Int',
    `Int',
    cFloatConv `CsndFlt'
  } -> `()'#}

{#fun unsafe csoundGetTable as getTable'
  {
    id `CsoundPtr',
    alloca- `Ptr CCsndFlt' peekCsndOutAry*,
    `Int'
  } -> `Maybe Int' maybeCInt#}

-- *Csound threading
-- **Threading data types
-- |Signify if a function was able to acquire a mutex object.
data AcquiredMutex =
        AcMutexYes
        | AcMutexNo deriving (Eq)

-- **Csound threading functions
-- |Determine if csoundLockMutexNoWait was successful
mutexSuccessful :: CInt -> AcquiredMutex
mutexSuccessful 0 = AcMutexYes
mutexSuccessful _ = AcMutexNo

createThread' :: FunPtr (Ptr () -> IO UIntPtrT) -> Ptr () -> IO (Ptr ())
createThread' = {#call csoundCreateThread #}

getCurrentThreadId' :: IO (Ptr ())
getCurrentThreadId' = {#call csoundGetCurrentThreadId #}

joinThread' :: Ptr () -> IO UIntPtrT
joinThread' = {#call csoundJoinThread #}

{#fun csoundRunCommand as runCommand'
  {
    withStringList* `[String]',
    cIntFromEnum `Bool'
  } -> `Int'#}

createThreadLock' :: IO (Ptr ())
createThreadLock' = {#call csoundCreateThreadLock #}

{#fun csoundWaitThreadLock as waitThreadLock'
  {
    id `Ptr ()' id,
    `Int'
  } -> `Bool' cIntToBool#}

waitThreadLockNoTimeout' :: Ptr () -> IO ()
waitThreadLockNoTimeout' = {#call csoundWaitThreadLockNoTimeout #}

notifyThreadLock' :: Ptr () -> IO ()
notifyThreadLock' =
  {#call csoundNotifyThreadLock #}

destroyThreadLock' :: Ptr () -> IO ()
destroyThreadLock' = {#call csoundDestroyThreadLock #}

createMutex' :: CInt -> IO (Ptr ())
createMutex' = {#call csoundCreateMutex #}

lockMutex' :: Ptr () -> IO ()
lockMutex' = {#call csoundLockMutex #}

{#fun csoundLockMutexNoWait as lockMutexNoWait'
  {id `Ptr ()'}-> `AcquiredMutex' mutexSuccessful#}

unlockMutex' :: Ptr () -> IO ()
unlockMutex' = {#call csoundUnlockMutex #}

destroyMutex' :: Ptr () -> IO ()
destroyMutex' = {#call csoundDestroyMutex #}

{#fun csoundCreateBarrier as createBarrier' {`Int'} -> `Ptr ()' id #}

{#fun csoundDestroyBarrier as destroyBarrier' {id `Ptr ()'} -> `Int'#}

{#fun csoundWaitBarrier as waitBarrier' {id `Ptr ()'} -> `Int'#}

{#fun unsafe csoundSleep as sleep' {`Int'} -> `()'#}

-- *Functions to manipulate time\/locale
initTimerStruct' :: IO (RtClockPtr)
initTimerStruct' = do
  ptr <- malloc
  {#call unsafe csoundInitTimerStruct #} ptr
  return ptr

{#fun unsafe csoundGetRealTime as getRealTime' { id `RtClockPtr'} -> `Double'#}

{#fun unsafe csoundGetCPUTime as getCPUTime' {id `RtClockPtr'} -> `Double'#}

{#fun unsafe csoundGetRandomSeedFromTime as getRandomSeedFromTime'
  { } -> `UInt32T' cIntConv #}

{#fun unsafe csoundSetLanguage as setLanguage'
  { cIntFromEnum `CsLanguage' } -> `()'#}

{#fun unsafe csoundLocalizeString as localizeString' {`String'} -> `String'#}

-- *Csound global variable manipulations
{#fun unsafe csoundCreateGlobalVariable as createGlobalVariable'
  {
    id `CsoundPtr',
    `String',
    `Int'
  } -> `CsoundStatus' cIntToEnum#}

{#fun unsafe csoundQueryGlobalVariable as queryGlobalVariable'
  {
    id `CsoundPtr',
    `String'
  } -> `Maybe (Ptr ())' checkNullPtr#}

-- |Even if the returned pointer is not null, it may not be a valid
-- pointer if the name was invalid.
{#fun unsafe csoundQueryGlobalVariableNoCheck as
  queryGlobalVariableNoCheck'
  {
    id `CsoundPtr',
    `String'
  } -> `Ptr ()' id#}

{#fun unsafe csoundDestroyGlobalVariable as destroyGlobalVariable'
  {
    id `CsoundPtr',
    `String'
  } -> `CsoundStatus' cIntToEnum#}

{#fun pure unsafe csoundGetSizeOfMYFLT as getSizeOfMYFLT {} -> `Int'#}


-- *Csound utility functions

{#fun csoundRunUtility as runUtility'
  {
    id `CsoundPtr',
    `String',
    `Int',
    withStringList* `[String]'
  } -> `Bool' cIntToBoolSwitch#}

{#fun unsafe csoundListUtilities as unsafeListUtilities
  {
    id `CsoundPtr'
  } -> `(Ptr CString, [String])' peekStringArrayPtr*#}

deleteUtilityList' :: CsoundPtr -> Ptr (Ptr CChar) -> IO ()
deleteUtilityList' = {#call unsafe csoundDeleteUtilityList #}

{#fun unsafe csoundGetUtilityDescription as getUtilityDescription'
  {
    id `CsoundPtr',
    `String'
  } -> `String'#}

-- *Csound channel functions
-- **Channel data types
{#pointer *CsoundChannelListEntry as
  CsoundChannelListEntryPtr -> CsoundChannelListEntry#}
{#pointer CsoundChannelIOCallback_t as CsoundChannelIOCallbackT#}

data CsoundChannelListEntry = CsoundChannelListEntry
 {
  cliName :: CString, -- ^Name of Csound channel
  cliType :: Int -- ^Type of Csound channel
 }

-- Can't use the hooks for names with type in them :(
instance Storable (CsoundChannelListEntry) where
  alignment _ = alignment (undefined :: CInt)
  sizeOf _ = {#sizeof CsoundChannelListEntry#}
  peek p = do
    cliname <- {#get CsoundChannelListEntry.name#} p
    cliTypeV <- liftM fromIntegral $
                  (\ptr -> do {peekByteOff ptr 4 ::IO CInt}) p
    return $ CsoundChannelListEntry cliname cliTypeV
  poke p cli = do
    {#set CsoundChannelListEntry.name#} p $ cliName cli
    (\ptr val -> do {pokeByteOff ptr 4 (val::CInt)}) p $
      fromIntegral $ cliType cli

-- |Type of a channel
data CsoundChannelType =
    CsoundControlChannel
  | CsoundAudioChannel
  | CsoundStringChannel deriving (Eq, Show)
instance Enum CsoundChannelType where
  fromEnum CsoundControlChannel = 1
  fromEnum CsoundAudioChannel = 2
  fromEnum CsoundStringChannel = 3

  toEnum 1 = CsoundControlChannel
  toEnum 2 = CsoundAudioChannel
  toEnum 3 = CsoundStringChannel
  toEnum unmatched = error
    ("CsoundChannelType.toEnum: Cannot match " ++ show unmatched)

-- |Direction of a channel
data CsoundChannelDirection =
    CsoundInputChannel
  | CsoundOutputChannel
  | CsoundBiDirectionalChannel deriving (Eq, Show)
instance Enum CsoundChannelDirection where
  fromEnum CsoundInputChannel = 16
  fromEnum CsoundOutputChannel = 32
  fromEnum CsoundBiDirectionalChannel = 48

  toEnum 16 = CsoundInputChannel
  toEnum 32 = CsoundOutputChannel
  toEnum 48 = CsoundBiDirectionalChannel
  toEnum unmatched = error
    ("CsoundChannelDirection.toEnum: Cannot match " ++ show unmatched)

-- |Specify both direction and type of a channel.
data CsoundChannelDirectionalType =
  CsoundChannelDirectionalType CsoundChannelType CsoundChannelDirection
  deriving (Eq, Show)

-- |Specify the type of a control channel.
data CsoundControlChannelType =
    CsoundControlChannelClear
  | CsoundControlChannelInt
  | CsoundControlChannelLin
  | CsoundControlChannelExp
  deriving (Eq, Show)
instance Enum CsoundControlChannelType where
  fromEnum CsoundControlChannelClear = 0
  fromEnum CsoundControlChannelInt = 1
  fromEnum CsoundControlChannelLin = 2
  fromEnum CsoundControlChannelExp = 3

  toEnum 0 = CsoundControlChannelClear
  toEnum 1 = CsoundControlChannelInt
  toEnum 2 = CsoundControlChannelLin
  toEnum 3 = CsoundControlChannelExp
  toEnum unmatched = error
    ("CsoundControlChannelType.toEnum: Cannot match " ++ show unmatched)

-- |Status of ListChannels return value
data CsoundListChannelStatus =
    NumChannels Int
  | ChanError CsoundStatus

-- |Decode channel information
decodeChannelInfo :: CInt -> (CsoundChannelType, CsoundChannelDirection)
decodeChannelInfo val = (chanType, chanDir)
 where
  chanType = toEnum $ (.&.) 15 $ cIntConv val
  chanDir = case (testBit val 5, testBit val 6) of
    (True, False) -> CsoundInputChannel
    (False, True) -> CsoundOutputChannel
    (True, True) -> CsoundBiDirectionalChannel
    _ -> error "Invalid channel direction."

toChannelListStatus :: CInt -> CsoundListChannelStatus
toChannelListStatus val = case (val >= 0) of
        True -> NumChannels $ cIntConv val
        False -> ChanError $ cIntToEnum val

csoundChannelDirectionalTypeToCInt :: CsoundChannelDirectionalType -> CInt
csoundChannelDirectionalTypeToCInt (CsoundChannelDirectionalType typ dir) =
        fromIntegral $ (fromEnum typ) .|. (fromEnum dir)

-- **Functions for the 'chan' family of opcodes

{#fun unsafe csoundGetChannelPtr as getChannelPtr'
  {
    id `CsoundPtr',
    alloca- `Ptr CCsndFlt' peekCsndOutAry*,
    `String',
    csoundChannelDirectionalTypeToCInt `CsoundChannelDirectionalType'
  } -> `CsoundStatus' cIntToEnum#}


{#fun unsafe csoundListChannels as listChannels'
  {
    id `CsoundPtr',
    alloca- `CsoundChannelListEntryPtr' peek*
  } -> `CsoundListChannelStatus' toChannelListStatus#}

deleteChannelList' :: CsoundPtr -> CsoundChannelListEntryPtr -> IO ()
deleteChannelList' = {#call unsafe csoundDeleteChannelList #}

{#fun unsafe csoundSetControlChannelParams as setControlChannelParams'
  {
    id `CsoundPtr',
    `String',
    cIntFromEnum `CsoundControlChannelType',
    cFloatConv `CsndFlt',
    cFloatConv `CsndFlt',
    cFloatConv `CsndFlt'
  } -> `CsoundStatus' cIntToEnum#}

{#fun unsafe csoundGetControlChannelParams as getControlChannelParams'
  {
    id `CsoundPtr',
    `String',
    alloca- `CsndFlt' peekCsndFlt*,
    alloca- `CsndFlt' peekCsndFlt*,
    alloca- `CsndFlt' peekCsndFlt*
  } -> `Int'#}

setChannelIOCallback' :: CsoundPtr -> CsoundChannelIOCallbackT -> IO ()
setChannelIOCallback' = {#call csoundSetChannelIOCallback #}

-- **functions for the 'ichannel' family of opcodes

{#fun unsafe csoundChanIKSet as chanIKSet'
  {
    id `CsoundPtr',
    cFloatConv `CsndFlt',
    `Int'
  } -> `CsoundStatus' cIntToEnum#}

{#fun unsafe csoundChanOKGet as chanOKGet'
  {
    id `CsoundPtr',
    alloca- `CsndFlt' peekCsndFlt*,
    `Int'
  } -> `CsoundStatus' cIntToEnum#}

{#fun unsafe csoundChanIASet as chanIASet'
  {
    id `CsoundPtr',
    withCsndFltArray* `[CsndFlt]',
    `Int'
  } -> `CsoundStatus' cIntToEnum#}

{#fun unsafe csoundChanOAGet as chanOAGet'
  {
    id `CsoundPtr',
    alloca- `Ptr CCsndFlt' id,
    `Int'
  } -> `CsoundStatus' cIntToEnum#}

-- **Functions for PvsIn and PvsOut
{#fun unsafe csoundPvsinSet as csoundPvsinSet'
  {
    id `CsoundPtr',
    withObject* `PvsDatExt',
    `Int'
  } -> `CsoundStatus' cIntToEnum#}

{#fun unsafe csoundPvsoutGet as csoundPvsoutGet'
  {
    id `CsoundPtr',
    alloca- `PvsDatExt' peek*,
    `Int'
  } -> `CsoundStatus' cIntToEnum#}

-- *Csound randomization functions.
-- **Randomization state data types
-- |This uses some pointer magic, there's a good chance that there
-- are bugs in the Storable instance.
data CsoundRandMtState = CsoundRandMtState {
  mti :: Int,
  mt :: [UInt32T]
 }
instance Storable (CsoundRandMtState) where
  alignment _ = alignment (undefined :: CInt)
  sizeOf _ = {#sizeof CsoundRandMTState#}
  peek p = do
    mtiV <- liftM fromIntegral $ {#get CsoundRandMTState.mti#} p
    aryPtr <- {#get CsoundRandMTState.mt#} p
    mtV <- peekArray 624 aryPtr
    return $ CsoundRandMtState mtiV mtV
  poke p mtstate = do
    {#set CsoundRandMTState.mti#} p $ fromIntegral . mti $ mtstate
    let aryPtr = plusPtr p $ sizeOf (1 :: CInt)
    pokeArray aryPtr $ mt mtstate

-- **Csound functions
{#fun unsafe csoundRand31 as rand31'
  {
    `Int'
  } -> `Int'#}
{-
   * Initialise Mersenne Twister (MT19937) random number generator,
   * using 'keyLength' unsigned 32 bit values from 'initKey' as seed.
   * If the array is NULL, the length parameter is used for seeding.
   */
  PUBLIC void csoundSeedRandMT(CsoundRandMTState *p,
                               const uint32_t *initKey, uint32_t keyLength);

  /**
   * Returns next random number from MT19937 generator.
   * The PRNG must be initialised first by calling csoundSeedRandMT().
   */
  PUBLIC uint32_t csoundRandMT(CsoundRandMTState *p);
-}

-- *Csound generic callback functions
type CsoundCallbackFunction = FunPtr (Ptr () -> Ptr () -> CUInt -> IO CInt)

setCallback' ::
  CsoundPtr -- ^Pointer to this csound instance.
  -> CsoundCallbackFunction -- ^Callback function
  -> Ptr () -- ^Pointer to "userdata"
  -> CsoundCallbackFunctionTypeMask
  -> IO CsoundSetCallbackStatus
setCallback' csPtr fnPtr dataPtr typeMask = do
  fmap  cIntToSetCallbackStatus $
           {#call csoundSetCallback as csoundSetCallback_#} csPtr
           fnPtr dataPtr $ cIntConv typeMask

removeCallback' ::
  CsoundPtr
  -> CsoundCallbackFunction
  -> IO ()
removeCallback' = {#call csoundRemoveCallback #}

-- *Csound messaging functions
enableMessageBuffer' :: CsoundPtr -> Int -> IO ()
enableMessageBuffer' csPtr toStdOut =
  {#call csoundEnableMessageBuffer #}
  csPtr $ cIntConv toStdOut

{#fun csoundGetFirstMessage as getFirstMessage' { id `CsoundPtr'} -> `String'#}

getFirstMessageAttr' :: CsoundPtr -> IO Int
getFirstMessageAttr' csPtr =
  liftM cIntConv $ {#call csoundGetFirstMessageAttr #} csPtr

popFirstMessage' :: CsoundPtr -> IO ()
popFirstMessage' = {#call csoundPopFirstMessage #}

getMessageCnt' :: CsoundPtr -> IO Int
getMessageCnt' csPtr = fmap cIntConv $
  {#call unsafe csoundGetMessageCnt #} csPtr

destroyMessageBuffer' :: CsoundPtr -> IO ()
destroyMessageBuffer' csPtr = {#call csoundDestroyMessageBuffer #} csPtr

-- |Not doing sigcpy now, it looks like a utility function and I don't know
-- if I'll need it.

#if !defined(SWIG)
type CsoundFileOpenCallback = FunPtr (CsoundPtr -> CString -> CInt -> CInt -> CInt -> IO ())
setFileOpenCallback' ::
  CsoundPtr
  -> CsoundFileOpenCallback
  -> IO ()
setFileOpenCallback' csPtr funPtr =
  {#call unsafe csoundSetFileOpenCallback #} csPtr funPtr
#endif