hCsound 0.2.3 → 0.3.0

raw patch · 11 files changed

+2478/−1974 lines, 11 filesdep +monads-tfdep +transformersdep +vectordep −haskell98dep −mtldep ~base

Dependencies added: monads-tf, transformers, vector

Dependencies removed: haskell98, mtl

Dependency ranges changed: base

Files

• README +11/−7
• TODO +1/−1
• examples/test2.hs +0/−3
• examples/test3.hs +1/−0
• hCsound.cabal +7/−5
• src/Sound/Csound.hs +87/−133
• src/Sound/Csound/C2HS.hs +0/−220
• src/Sound/Csound/Foreign.chs +1385/−0
• src/Sound/Csound/Interface.chs +0/−1605
• src/Sound/Csound/Interface.hs +867/−0
• src/Sound/Csound/Vector.hs +119/−0

@@ -2,17 +2,21 @@  Enable control of Csound from the Haskell language. -Requirements: a haskell compiler (currently tested with GHC 6.6+), a working Csound installation, and a version of libsndfile compatible with csound.+Requirements: a haskell compiler (currently tested with GHC 6.10.x) and a working Csound installation (Csound >= 5.08 && <= 6.0).  Building: In the simplest case, this program can be built in the standard cabal manner, as below:-        > runhaskell Setup.lhs configure-        > runhaskell Setup.lhs build-        > runhaskell Setup.lhs install+        > cabal configure -O2+        > cabal build+        > cabal install  The default is to build against 64-bit csound.  The flag useDouble controls whether the library is built against 32-bit or 64-bit csound.  Disable this flag (with -f-useDouble) to link to 32-bit csound. -Installing on Windows: Installing on Windows is tricky, and I have frequently had problems with the linker included in GHC and the csound DLL.  Please contact the hCsound maintainer for further help.+Installing on Unix/Linux: if Csound is in a non-standard location, you may need to specify the location during the configure step.+        > cabal configure -O2 --extra-include-dirs="/path/to/headers" --extra-lib-dirs="/path/to/libs" -Installing on Mac: the default cpp on Leopard seems buggy.  If c2hs has lexer errors during build, build with these options:-	--cpp=gcc --cppopts=-E --cppopts=-xc-header+Installing on Windows: hCsound has been successfully built on Windows, but I have frequently had problems with the linker included in GHC and the csound DLL.  Your best bet is to use MinGW.  Please contact the hCsound maintainer for further assistance.++Installing on Mac: if Csound was installed using the mac installer, hCsound will link to the installed frameworks.  If you have self-compiled csound and installed to a non-standard location (i.e. other than /Libraries/Frameworks/CsoundLib.framework and /Libraries/Frameworks/CsoundLib64.framework), use the flag -f-useFramework to disable linking to the frameworks.  In this case you will need to specify the header and library paths using --extra-include-dirs and --extra-lib-dirs if they aren't in the default locations.+ example:+        > cabal configure -O2 -f-useFramework --extra-include-dirs="/path/to/headers" --extra-lib-dirs="/path/to/libs"

@@ -2,7 +2,7 @@  1.  On darwin/Leopard, the standard cpp doesn't work.  Using the following command in the configure stage does: -runhaskell Setup.lhs configure --c2hs-options=--cpp=gcc --c2hs-options=--cppopts=-E --c2hs-options=--cppopts='-xc-header'+runhaskell Setup.lhs configure --c2hs-options=--cppopts=-U__BLOCKS__  try to make this automatic... 

@@ -22,6 +22,3 @@ 	csoundPerformKsmpsIO ptr (\x _ -> return $ replicate x 1) (\_ _ _ -> return () ) 	csoundDestroy ptr -reportResult :: Either String a -> IO ()-reportResult (Right _) = putStrLn ("Csound Ran! ")-reportResult (Left e) = putStrLn ("csound didn't run... " ++ (show e))

@@ -15,6 +15,7 @@         liftIO $ csoundSetHostImplementedAudioIO ptr 1 512         csoundCompile ptr args         csoundPerformBufferIO ptr (\x y -> return $ replicate x 1) (\_ _ _ -> return ())+        csoundDestroy ptr  outFn l i b = putStrLn ("Buffer Length: " ++ (show l) ++ "Position: " ++ (show i)) 

@@ -1,5 +1,5 @@ Name:           hCsound-Version:        0.2.3+Version:        0.3.0 Cabal-Version:  >= 1.2 Description:    Haskell interface to Csound API. License:        LGPL@@ -26,13 +26,15 @@  Library  Hs-Source-Dirs:        src-                        src/Sound-                        src/Sound/Csound- build-depends:         base, haskell98, mtl+ build-depends:         base         >=3 && < 5+                       ,monads-tf    >= 0.1 && < 0.2+                       ,transformers >= 0.2 && < 0.3+                       ,vector       >= 0.6 && < 0.8  build-tools:           c2hs- other-modules:         C2HS  exposed-modules:       Sound.Csound+                        Sound.Csound.Foreign                         Sound.Csound.Interface+                        Sound.Csound.Vector  includes:              csound.h  extra-libraries:       sndfile 

@@ -8,148 +8,102 @@ -- 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,+module Sound.Csound (+  module Sound.Csound.Interface,+  -- defined in this module+  performKsmpsIO,+  performBufferIO,+  withChannelList,+  runSimple+) --- 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)+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 csoundPerformKsmps, with handling of+-- |Perform an entire score using performKsmps, 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 +-- 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 csoundPerformBuffer, with handling of+-- |Perform an entire score using performBuffer, 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+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 :: 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+withChannelList :: ([CsoundChannelListEntry] -> IO a) -> Csound a+withChannelList func = do+  openRes <- listChannels+  x <- liftIO . func . snd $ openRes+  deleteChannelList . fst $ openRes+  return x --- |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--}

@@ -1,220 +0,0 @@---  C->Haskell Compiler: Marshalling library------  Copyright (c) [1999...2005] Manuel M T Chakravarty------  Redistribution and use in source and binary forms, with or without---  modification, are permitted provided that the following conditions are met:--- ---  1. Redistributions of source code must retain the above copyright notice,---     this list of conditions and the following disclaimer. ---  2. Redistributions in binary form must reproduce the above copyright---     notice, this list of conditions and the following disclaimer in the---     documentation and/or other materials provided with the distribution. ---  3. The name of the author may not be used to endorse or promote products---     derived from this software without specific prior written permission. ------  THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR---  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES---  OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN---  NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, ---  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED---  TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR---  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF---  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING---  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS---  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.------- Description ---------------------------------------------------------------------  Language: Haskell 98------  This module provides the marshaling routines for Haskell files produced by ---  C->Haskell for binding to C library interfaces.  It exports all of the---  low-level FFI (language-independent plus the C-specific parts) together---  with the C->HS-specific higher-level marshalling routines.-----module C2HS (--  -- * Re-export the language-independent component of the FFI -  module Foreign,--  -- * Re-export the C language component of the FFI-  module CForeign,--  -- * Composite marshalling functions-  withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv,-  peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum,--  -- * Conditional results using 'Maybe'-  nothingIf, nothingIfNull,--  -- * Bit masks-  combineBitMasks, containsBitMask, extractBitMasks,--  -- * Conversion between C and Haskell types-  cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum-) where ---import Foreign-       hiding       (Word)-		    -- Should also hide the Foreign.Marshal.Pool exports in-		    -- compilers that export them-import CForeign--import Monad        (when, liftM)----- Composite marshalling functions--- ----------------------------------- Strings with explicit length----withCStringLenIntConv s f    = withCStringLen s $ \(p, n) -> f (p, cIntConv n)-peekCStringLenIntConv (s, n) = peekCStringLen (s, cIntConv n)---- Marshalling of numerals-----withIntConv   :: (Storable b, Integral a, Integral b) -	      => a -> (Ptr b -> IO c) -> IO c-withIntConv    = with . cIntConv--withFloatConv :: (Storable b, RealFloat a, RealFloat b) -	      => a -> (Ptr b -> IO c) -> IO c-withFloatConv  = with . cFloatConv--peekIntConv   :: (Storable a, Integral a, Integral b) -	      => Ptr a -> IO b-peekIntConv    = liftM cIntConv . peek--peekFloatConv :: (Storable a, RealFloat a, RealFloat b) -	      => Ptr a -> IO b-peekFloatConv  = liftM cFloatConv . peek---- Passing Booleans by reference-----withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b-withBool  = with . fromBool--peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool-peekBool  = liftM toBool . peek----- Passing enums by reference-----withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c-withEnum  = with . cFromEnum--peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a-peekEnum  = liftM cToEnum . peek----- Storing of 'Maybe' values--- ---------------------------instance Storable a => Storable (Maybe a) where-  sizeOf    _ = sizeOf    (undefined :: Ptr ())-  alignment _ = alignment (undefined :: Ptr ())--  peek p = do-	     ptr <- peek (castPtr p)-	     if ptr == nullPtr-	       then return Nothing-	       else liftM Just $ peek ptr--  poke p v = do-	       ptr <- case v of-		        Nothing -> return nullPtr-			Just v' -> new v'-               poke (castPtr p) ptr----- Conditional results using 'Maybe'--- ------------------------------------- Wrap the result into a 'Maybe' type.------ * the predicate determines when the result is considered to be non-existing,---   ie, it is represented by `Nothing'------ * the second argument allows to map a result wrapped into `Just' to some---   other domain----nothingIf       :: (a -> Bool) -> (a -> b) -> a -> Maybe b-nothingIf p f x  = if p x then Nothing else Just $ f x---- |Instance for special casing null pointers.----nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b-nothingIfNull  = nothingIf (== nullPtr)----- Support for bit masks--- ------------------------- Given a list of enumeration values that represent bit masks, combine these--- masks using bitwise disjunction.----combineBitMasks :: (Enum a, Bits b) => [a] -> b-combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)---- Tests whether the given bit mask is contained in the given bit pattern--- (i.e., all bits set in the mask are also set in the pattern).----containsBitMask :: (Bits a, Enum b) => a -> b -> Bool-bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm-			    in-			    bm' .&. bits == bm'---- |Given a bit pattern, yield all bit masks that it contains.------ * This does *not* attempt to compute a minimal set of bit masks that when---   combined yield the bit pattern, instead all contained bit masks are---   produced.----extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b]-extractBitMasks bits = -  [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm]----- Conversion routines--- ----------------------- |Integral conversion----cIntConv :: (Integral a, Integral b) => a -> b-cIntConv  = fromIntegral---- |Floating conversion----cFloatConv :: (RealFloat a, RealFloat b) => a -> b-cFloatConv  = realToFrac--- As this conversion by default goes via `Rational', it can be very slow...-{-# RULES -  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;-  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x- #-}---- |Obtain C value from Haskell 'Bool'.----cFromBool :: Num a => Bool -> a-cFromBool  = fromBool---- |Obtain Haskell 'Bool' from C value.----cToBool :: Num a => a -> Bool-cToBool  = toBool---- |Convert a C enumeration to Haskell.----cToEnum :: (Integral i, Enum e) => i -> e-cToEnum  = toEnum . cIntConv---- |Convert a Haskell enumeration to C.----cFromEnum :: (Enum e, Integral i) => e -> i-cFromEnum  = cIntConv . fromEnum

@@ -0,0 +1,1385 @@+{-# 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

@@ -1,1605 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface, GeneralizedNewtypeDeriving #-}---- |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 where--import Prelude-import C2HS-import Control.Monad (liftM)-import Control.Monad.Error (ErrorT, liftIO, throwError)-import Data.Bits-import Data.List ( foldl')-import qualified Control.Monad.Cont as Cont--#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#}---- **The CsoundMonad and associated functions-type CsoundMonad = ErrorT String IO -- ^Wrap IO and produce error messages as applicable.---- |Wrap functions that return CsoundStatus into the CsoundMonad--- for error handling-csoundStatusWrapper :: IO CsoundStatus -> CsoundMonad ()-csoundStatusWrapper csoundFunc = do-        res <- liftIO csoundFunc-        case res of-                CsoundSuccess -> return ()-                _ -> throwError $ show res---- |Wrap functions that return a CsoundStatus and one other value into the--- CsoundMonad for error handling.-csoundStatValWrapper :: IO (CsoundStatus, a) -> CsoundMonad a-csoundStatValWrapper func = do-        (stat, output) <- liftIO func-        case stat of-                CsoundSuccess -> return output-                _ -> throwError $ show stat---- |Wrap functions that return CsoundPerformStatus into the CsoundMonad.-csPerformStatusWrapper :: IO CsoundPerformStatus ->-                          CsoundMonad CsoundPerformStatus-csPerformStatusWrapper csoundFunc = do-        res <- liftIO csoundFunc-        case res of-                PerformError _ -> throwError $ show res-                _ -> return res---- |Wrap any function from IO monad to CsoundMonad-csoundWrapper :: (a -> IO b) -> a -> CsoundMonad b-csoundWrapper fn v = liftIO $ fn v-{-# INLINE csoundWrapper #-}---- |Wrap functions that return Bool into the CsoundMonad-boolWrapper :: String -> IO Bool -> CsoundMonad ()-boolWrapper errStr action = do-        res <- liftIO action-        case res of-                True -> return ()-                False -> throwError 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 unmatched = error ("CsoundInit.toEnum: Cannot match " ++ show unmatched)---- |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---- |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 val | val == 0 = False-        | otherwise = 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 val | val == 0 = True-        | otherwise = 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 = case (val < 0) of-        True -> SetCallbackError $ cIntToEnum val-        False -> 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 :: [(r -> a) -> a] -> ([r] -> a) -> a-nest xs = Cont.runCont (sequence (map Cont.Cont 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'#}--}--csoundCreate :: CsoundMonad CsoundPtr-csoundCreate = liftIO $ unsafeCsoundCreate nullPtr--unsafeCsoundCreate :: Ptr () -> IO (CsoundPtr)-unsafeCsoundCreate = {#call unsafe csoundCreate as uCsoundCreate_#}--csoundPreCompile :: CsoundPtr -> CsoundMonad ()-csoundPreCompile csPtr = csoundStatusWrapper $ unsafeCsoundPreCompile csPtr--{#fun unsafe csoundPreCompile as unsafeCsoundPreCompile-        {id `CsoundPtr'} -> `CsoundStatus' cIntToEnum #}--csoundInitializeCscore :: CsoundPtr -> FilePtr -> FilePtr -> CsoundMonad ()-csoundInitializeCscore csPtr iScore oScore =-        csoundStatusWrapper $ unsafeCsoundInitializeCscore csPtr iScore oScore--{#fun unsafe csoundInitializeCscore as unsafeCsoundInitializeCscore-        {-                id `CsoundPtr',-                id `FilePtr',-                id `FilePtr'-        } -> `CsoundStatus' cIntToEnum#}--csoundQueryInterface :: String -> CsoundMonad (CsoundStatus, Ptr (), Int)-csoundQueryInterface str = do-        res <- liftIO $ csoundQueryInterface' str-        case res of-                (CsoundSuccess, _, _) -> return res-                (errCode, _, _) -> throwError $ show errCode---- |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#}--csoundDestroy :: CsoundPtr -> CsoundMonad ()-csoundDestroy =  csoundWrapper {#call unsafe csoundDestroy as uCsoundDestroy_#}--{#fun pure unsafe csoundGetVersion {} -> `Int'#}--{#fun pure unsafe csoundGetAPIVersion as csoundGetApiVersion {} -> `Int'#}--csoundGetHostData :: CsoundPtr -> CsoundMonad (Ptr ())-csoundGetHostData = csoundWrapper-                     {#call csoundGetHostData as csoundGetHostData_#}--csoundSetHostData :: CsoundPtr -> Ptr () -> CsoundMonad ()-csoundSetHostData csp p = liftIO $-    {#call csoundSetHostData as csoundSetHostData_#} csp p--{#fun csoundGetEnv {id `CsoundPtr', `String'} ->  `String'#}--csoundSetGlobalEnv :: String -> String -> CsoundMonad ()-csoundSetGlobalEnv name value = csoundStatusWrapper $-                                csoundSetGlobalEnv' name value--{#fun csoundSetGlobalEnv as csoundSetGlobalEnv' {`String', `String'} -> `CsoundStatus' cIntToEnum#}---- *Performance functions-csoundCompile :: CsoundPtr -> String -> CsoundMonad ()-csoundCompile csPtr argList = csoundStatusWrapper $-                              csoundCompile' csPtr argv argc-        where-        argc = "csound" : words argList-	argv = length argc--{#fun unsafe csoundCompile as csoundCompile' {-        id `CsoundPtr',-        `Int',-        withStringList* `[String]'-        } -> `CsoundStatus' cIntToEnum#}--csoundPerform :: CsoundPtr -> CsoundMonad CsoundPerformStatus-csoundPerform csPtr = csPerformStatusWrapper $ csoundPerform' csPtr--{#fun csoundPerform as csoundPerform' {id `CsoundPtr'} -> `CsoundPerformStatus' toCsoundPerformStatus#}--csoundPerformKsmps :: CsoundPtr -> CsoundMonad CsoundPerformStatus-csoundPerformKsmps csPtr = csPerformStatusWrapper $ csoundPerformKsmps' csPtr--{#fun csoundPerformKsmps as csoundPerformKsmps' {id `CsoundPtr'} -> `CsoundPerformStatus' toCsoundPerformStatus#}--csoundPerformKsmpsAbsolute :: CsoundPtr -> CsoundMonad CsoundPerformStatus-csoundPerformKsmpsAbsolute csPtr = csPerformStatusWrapper $-                                   csoundPerformKsmpsAbsolute' csPtr--{#fun csoundPerformKsmpsAbsolute as csoundPerformKsmpsAbsolute'-        {id `CsoundPtr'} -> `CsoundPerformStatus' toCsoundPerformStatus#}--csoundPerformBuffer :: CsoundPtr -> CsoundMonad CsoundPerformStatus-csoundPerformBuffer csPtr = csPerformStatusWrapper $ csoundPerformBuffer' csPtr--{#fun csoundPerformBuffer as csoundPerformBuffer' {id `CsoundPtr'} -> `CsoundPerformStatus' toCsoundPerformStatus#}--{#fun csoundStop {id `CsoundPtr'} -> `()'#}--{#fun csoundCleanup {id `CsoundPtr'} -> `Int'#}--{#fun csoundReset {id `CsoundPtr'} -> `()'#}---- *Csound Attributes-{#fun pure unsafe csoundGetSr { id `CsoundPtr'} -> `CsndFlt' cFloatConv#}--{#fun pure unsafe csoundGetKr { id `CsoundPtr'} -> `CsndFlt' cFloatConv#}--{#fun pure unsafe csoundGetKsmps { id `CsoundPtr'} -> `Int'#}--{#fun pure unsafe csoundGetNchnls { id `CsoundPtr'} -> `Int'#}--{#fun pure unsafe csoundGet0dBFS { id `CsoundPtr'} -> `CsndFlt' cFloatConv#}--{#fun pure unsafe csoundGetStrVarMaxLen { id `CsoundPtr'} -> `Int'#}--{#fun pure unsafe csoundGetSampleFormat { id `CsoundPtr'} -> `Int'#}--{#fun pure unsafe csoundGetSampleSize { id `CsoundPtr'} -> `Int'#}--{#fun pure unsafe csoundGetInputBufferSize { id `CsoundPtr'} -> `Int'#}--{#fun pure unsafe csoundGetOutputBufferSize { 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 csoundGetInputBuffer' { id `CsoundPtr'}-        -> `Ptr CsndFlt' castPtr#}--{#fun unsafe csoundGetOutputBuffer as csoundGetOutputBuffer' { id `CsoundPtr'}-        -> `Ptr CsndFlt' castPtr#}--{#fun unsafe csoundGetSpin as csoundGetSpin' { id `CsoundPtr'}-        -> `Ptr CsndFlt' castPtr#}--{#fun unsafe csoundGetSpout as csoundGetSpout' { id `CsoundPtr'}-        -> `Ptr CsndFlt' castPtr#}--{#fun unsafe csoundGetOutputFileName { id `CsoundPtr'}-        -> `String'#}---- |Call between csoundPreCompile and csoundCompile to set Host Implemented IO-{#fun unsafe csoundSetHostImplementedAudioIO {-        id `CsoundPtr',-        `Int',-        `Int'-        } -> `()'#}---- *Score handling functions.-{#fun unsafe csoundGetScoreTime { id `CsoundPtr'}-        -> `CsndFlt' cFloatConv#}--{#fun unsafe csoundIsScorePending { id `CsoundPtr'} -> `Int'#}--{#fun unsafe csoundSetScorePending-        {-        id `CsoundPtr',-        `Int'}-        -> `()'#}--{#fun unsafe csoundGetScoreOffsetSeconds { id `CsoundPtr'}-        -> `CsndFlt' cFloatConv#}--{#fun unsafe csoundSetScoreOffsetSeconds-        {-        id `CsoundPtr',-        cFloatConv `CsndFlt' }-        -> `()'#}--csoundRewindScore :: CsoundPtr -> IO ()-csoundRewindScore =-        {#call csoundRewindScore as csoundRewindScore_#}--csoundSetCscoreCallback :: CsoundPtr -> FunPtr (CsoundPtr -> IO ()) -> IO ()-csoundSetCscoreCallback =-        {#call csoundSetCscoreCallback as csoundSetCscoreCallback_#}--csoundScoreSort :: CsoundPtr -> FilePtr -> FilePtr -> CsoundMonad ()-csoundScoreSort csPtr inFile outFile = csoundStatusWrapper $ csoundScoreSort' csPtr inFile outFile--{#fun csoundScoreSort as csoundScoreSort'-        {-                id `CsoundPtr',-                id `FilePtr',-                id `FilePtr'-        } -> `CsoundStatus' cIntToEnum#}--csoundScoreExtract :: CsoundPtr -> FilePtr -> FilePtr -> FilePtr -> CsoundMonad ()-csoundScoreExtract csPtr inFile outFile extractFile =-        csoundStatusWrapper $ csoundScoreExtract' csPtr inFile outFile extractFile--{#fun csoundScoreExtract as csoundScoreExtract'-        {-                id `CsoundPtr',-                id `FilePtr',-                id `FilePtr',-                id `FilePtr'-        } -> `CsoundStatus' cIntToEnum#}---- *Messages and Text-{#fun pure unsafe csoundGetMessageLevel {id `CsoundPtr'} -> `Int'#}--{#fun unsafe csoundSetMessageLevel-        {-                id `CsoundPtr',-                `Int'-        } -> `()'#}--{#fun unsafe csoundInputMessage-        {-                id `CsoundPtr',-                `String'-        } -> `()'#}--{#fun csoundKeyPress-        {-                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.-csoundSetInputValueCallback ::-        CsoundPtr-        -> InputValueCallback-        -> IO ()-csoundSetInputValueCallback =-        {#call csoundSetInputValueCallback as csoundSetInputValueCallback_#}---- |called by 'outvalue' opcode.-csoundSetOutputValueCallback ::-        CsoundPtr-        -> OutputValueCallback-        -> IO ()-csoundSetOutputValueCallback =-        {#call csoundSetOutputValueCallback as csoundSetOutputValueCallback_#}--{#fun csoundScoreEvent-        {-                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--csoundSetExternalMidiInOpenCallback ::-        CsoundPtr-        -> ExternalMidiOpenCallback-        -> IO ()-csoundSetExternalMidiInOpenCallback =-        {#call csoundSetExternalMidiInOpenCallback as csoundSetExternalMidiInOpenCallback_#}--csoundSetExternalMidiReadCallback ::-        CsoundPtr-        -> ExternalMidiReadCallback-        -> IO ()-csoundSetExternalMidiReadCallback =-        {#call csoundSetExternalMidiReadCallback as csoundSetExternalMidiReadCallback_#}--csoundSetExternalMidiInCloseCallback ::-        CsoundPtr-        -> ExternalMidiCloseCallback-        -> IO ()-csoundSetExternalMidiInCloseCallback =-        {#call csoundSetExternalMidiInCloseCallback as csoundSetExternalMidiInCloseCallback_#}--csoundSetExternalMidiOutOpenCallback ::-        CsoundPtr-        -> ExternalMidiOpenCallback-        -> IO ()-csoundSetExternalMidiOutOpenCallback =-        {#call csoundSetExternalMidiOutOpenCallback as csoundSetExternalMidiOutOpenCallback_#}--csoundSetExternalMidiWriteCallback ::-        CsoundPtr-        -> ExternalMidiWriteCallback-        -> IO ()-csoundSetExternalMidiWriteCallback =-        {#call csoundSetExternalMidiWriteCallback as csoundSetExternalMidiWriteCallback_#}--csoundSetExternalMidiOutCloseCallback ::-        CsoundPtr-        -> ExternalMidiCloseCallback-        -> IO ()-csoundSetExternalMidiOutCloseCallback =-        {#call csoundSetExternalMidiOutCloseCallback as csoundSetExternalMidiOutCloseCallback_#}--csoundSetExternalMidiErrorStringCallback ::-        CsoundPtr-        -> ExternalMidiErrorStringCallback-        -> IO ()-csoundSetExternalMidiErrorStringCallback =-        {#call csoundSetExternalMidiErrorStringCallback as 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 {id `CsoundPtr', `Int' } -> `Int'#}--csoundSetMakeGraphCallback ::-        CsoundPtr-        -> MakeGraphCallback-        -> IO ()-csoundSetMakeGraphCallback =-        {#call csoundSetMakeGraphCallback as csoundSetMakeGraphCallback_#}--csoundSetDrawGraphCallback ::-        CsoundPtr-        -> DrawGraphCallback-        -> IO ()-csoundSetDrawGraphCallback =-        {#call csoundSetDrawGraphCallback as csoundSetDrawGraphCallback_#}--csoundSetKillGraphCallback ::-        CsoundPtr-        -> KillGraphCallback-        -> IO ()-csoundSetKillGraphCallback =-        {#call csoundSetKillGraphCallback as csoundSetKillGraphCallback_#}--csoundSetMakeXYinCallback ::-        CsoundPtr-        -> MakeXYinCallback-        -> IO ()-csoundSetMakeXYinCallback =-        {#call csoundSetMakeXYinCallback as csoundSetMakeXYinCallback_#}--csoundSetReadXYinCallback ::-        CsoundPtr-        -> ReadXYinCallback-        -> IO ()-csoundSetReadXYinCallback =-        {#call csoundSetReadXYinCallback as csoundSetReadXYinCallback_#}--csoundSetKillXYinCallback ::-        CsoundPtr-        -> KillXYinCallback-        -> IO ()-csoundSetKillXYinCallback =-        {#call csoundSetKillXYinCallback as csoundSetKillXYinCallback_#}--csoundSetExitGraphCallback ::-        CsoundPtr-        -> ExitGraphCallback-        -> IO ()-csoundSetExitGraphCallback =-        {#call csoundSetExitGraphCallback as csoundSetExitGraphCallback_#}---- *Csound opcodes--- **Opcode data types-{#pointer *opcodeListEntry as OpcodeListEntryPtr -> OpcodeListEntry#}--data OpcodeListEntry = OpcodeListEntry {-        opcodeName :: CString, -- ^Name of opcode-        ouTypes :: CString, -- ^Output types-        inTypes :: CString -- ^Input types-        }--instance Storable (OpcodeListEntry) where-        alignment _ = 16-        sizeOf _ = {#sizeof opcodeListEntry#}-        peek p = do-                nameV <- {#get opcodeListEntry.opname#} p-                otypesV <- {#get opcodeListEntry.outypes#} p-                itypesV <- {#get opcodeListEntry.intypes#} p-                return $ OpcodeListEntry nameV otypesV itypesV-        poke p li = do-                {#set opcodeListEntry.opname#} p $ opcodeName li-                {#set opcodeListEntry.outypes#} p $ ouTypes li-                {#set opcodeListEntry.intypes#} p $ inTypes li---- **opcode function types--- |Type for a callback function of a new csound opcode.-type OpcodeFunction = FunPtr (CsoundPtr -> Ptr () -> IO CInt)---- **Csound opcode manipulation functions-csoundNewOpcodeList :: CsoundPtr ->-                       CsoundMonad (OpcodeListEntryPtr, [OpcodeListEntry])-csoundNewOpcodeList csptr = do-        (arrayLen, ptr) <- liftIO $ csoundNewOpcodeList' csptr-        case (arrayLen >= 0) of-                True -> do-                        outAry <- liftIO $ peekArray arrayLen ptr-                        return (ptr, outAry)-                False -> throwError $ show ((toEnum arrayLen) :: CsoundStatus)--{#fun unsafe csoundNewOpcodeList as csoundNewOpcodeList'-        {-                id `CsoundPtr',-                alloca- `OpcodeListEntryPtr' peek*-        } -> `Int' #}--csoundDisposeOpcodeList ::-        CsoundPtr-        -> OpcodeListEntryPtr-        -> IO ()-csoundDisposeOpcodeList =-        {#call unsafe csoundDisposeOpcodeList as csoundDisposeOpcodeList_#}--csoundAppendOpcode :: CsoundPtr -- ^Pointer to csound instance-        -> String -- ^Name of opcode to append-        -> Int -- ^dsblksize-        -> Int -- ^thread id-        -> String -- ^outypes-        -> String -- ^intypes-        -> OpcodeFunction -- ^iopadr-        -> OpcodeFunction -- ^kopadr-        -> OpcodeFunction -- ^aopadr-        -> CsoundMonad ()-csoundAppendOpcode csPtr opName dsblksz thread outypes intypes iopadr kopadr aopadr =-        csoundStatusWrapper $ csoundAppendOpcode' csPtr opName dsblksz-          thread outypes intypes iopadr kopadr aopadr--{#fun csoundAppendOpcode as csoundAppendOpcode'-        {-                id `CsoundPtr',-                `String',-                `Int',-                `Int',-                `String',-                `String',-                id `OpcodeFunction',-                id `OpcodeFunction',-                id `OpcodeFunction'-        } -> `CsoundStatus' cIntToEnum#}---- *Csound library functions.-{#fun csoundOpenLibrary-        {-                alloca- `Ptr ()' peek*,-                `String'-        } -> `Int'#}--{#fun csoundCloseLibrary { id `Ptr ()' } -> `Int'#}--{#fun csoundGetLibrarySymbol-        {-                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 _ = alignment (undefined :: CInt) -- I know there's a better value...-        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.-csoundSetYieldCallback ::-        CsoundPtr-        -> YieldCallback-        -> IO ()-csoundSetYieldCallback =-        {#call csoundSetYieldCallback as csoundSetYieldCallback_#}--csoundSetPlayopenCallback ::-        CsoundPtr-        -> PlayopenCallback-        -> IO ()-csoundSetPlayopenCallback =-        {#call csoundSetPlayopenCallback as csoundSetPlayopenCallback_#}--csoundSetRtplayCallback ::-        CsoundPtr-        -> RtplayCallback-        -> IO ()-csoundSetRtplayCallback =-        {#call csoundSetRtplayCallback as csoundSetRtplayCallback_#}--csoundSetRecopenCallback ::-        CsoundPtr-        -> RecopenCallback-        -> IO ()-csoundSetRecopenCallback =-        {#call csoundSetRecopenCallback as csoundSetRecopenCallback_#}--csoundSetRtrecordCallback ::-        CsoundPtr-        -> RtrecordCallback-        -> IO ()-csoundSetRtrecordCallback =-        {#call csoundSetRtrecordCallback as csoundSetRtrecordCallback_#}--csoundSetRtcloseCallback ::-        CsoundPtr-        -> RtcloseCallback-        -> IO ()-csoundSetRtcloseCallback =-        {#call unsafe csoundSetRtcloseCallback as csoundSetRtcloseCallback_#}--csoundGetRtRecordUserData :: CsoundPtr -> IO (Ptr (Ptr ()))-csoundGetRtRecordUserData =-        {#call csoundGetRtRecordUserData as csoundGetRtRecordUserData_#}--csoundGetRtPlayUserData :: CsoundPtr -> IO (Ptr (Ptr ()))-csoundGetRtPlayUserData =-        {#call csoundGetRtPlayUserData as csoundGetRtPlayUserData_#}--csoundRegisterSenseEventCallback :: CsoundPtr ->-                                    FunPtr (-                                      CsoundPtr ->-                                      Ptr () ->-                                      IO ()-                                    ) ->-                                    Ptr () ->-                                    CsoundMonad ()-csoundRegisterSenseEventCallback csPtr funPtr dataPtr =-        boolWrapper "RegisterSenseEventCallback failed." $-          csoundRegisterSenseEventCallback' csPtr funPtr dataPtr--{#fun csoundRegisterSenseEventCallback as csoundRegisterSenseEventCallback'-        {-                id `CsoundPtr',-                id `FunPtr (CsoundPtr -> Ptr () -> IO ())',-                id `Ptr ()'-        } -> `Bool' cIntToBoolSwitch#}--{#fun pure unsafe csoundGetDebug { id `CsoundPtr' } -> `Bool' cIntToBool#}--{#fun unsafe csoundSetDebug-        {-                id `CsoundPtr',-                cIntFromEnum `Bool'-        } -> `()'#}---- *Functions to set and retrieve information from csound function tables.-csoundTableLength :: CsoundPtr -> Int -> CsoundMonad Int-csoundTableLength csPtr tblNum = do-        tableLen <- liftIO $ csoundTableLength' csPtr tblNum-        case (tableLen > 0) of-                True -> return tableLen-                False -> throwError "Table not found."--{#fun unsafe csoundTableLength as csoundTableLength'-        {-                id `CsoundPtr',-                `Int'-        } -> `Int'#}--{#fun unsafe csoundTableGet-        {-                id `CsoundPtr',-                `Int',-                `Int'-        } -> `CsndFlt' cFloatConv#}--{#fun unsafe csoundTableSet-        {-                id `CsoundPtr',-                `Int',-                `Int',-                cFloatConv `CsndFlt'-        } -> `()'#}--csoundGetTable :: CsoundPtr -> Int -> CsoundMonad [CsndFlt]-csoundGetTable csptr tableNum = do-        (arrayLen, ptr) <- liftIO $ csoundGetTable' 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 $-                           "Table " ++ show tableNum ++ " not found."--{#fun unsafe csoundGetTable as csoundGetTable'-        {-                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--csoundCreateThread :: FunPtr (Ptr () -> IO UIntPtrT) -> Ptr () -> IO (Ptr ())-csoundCreateThread =-        {#call csoundCreateThread as csoundCreateThread_#}--csoundGetCurrentThreadId :: IO (Ptr ())-csoundGetCurrentThreadId =-        {#call csoundGetCurrentThreadId as csoundGetCurrentThreadId_#}--csoundJoinThread :: Ptr () -> IO UIntPtrT-csoundJoinThread =-        {#call csoundJoinThread as csoundJoinThread_#}--csoundRunCommand :: [String] -> Bool -> CsoundMonad Int-csoundRunCommand args noWait = do-        output <- liftIO $ csoundRunCommand' args noWait-        if (output < 0) then throwError $ show output-                else return output--{#fun csoundRunCommand as csoundRunCommand'-        {-                withStringList* `[String]',-                cIntFromEnum `Bool'-        } -> `Int'#}--csoundCreateThreadLock :: IO (Ptr ())-csoundCreateThreadLock =-        {#call csoundCreateThreadLock as csoundCreateThreadLock_#}--{#fun csoundWaitThreadLock-        {-                id `Ptr ()' id,-                `Int'-        } -> `Bool' cIntToBool#}--csoundWaitThreadLockNoTimeout :: Ptr () -> IO ()-csoundWaitThreadLockNoTimeout =-        {#call csoundWaitThreadLockNoTimeout as csoundWaitThreadLockNoTimeout_#}--csoundNotifyThreadLock :: Ptr () -> IO ()-csoundNotifyThreadLock =-        {#call csoundNotifyThreadLock as csoundNotifyThreadLock_#}--csoundDestroyThreadLock :: Ptr () -> IO ()-csoundDestroyThreadLock =-        {#call csoundDestroyThreadLock as csoundDestroyThreadLock_#}--csoundCreateMutex :: CInt -> IO (Ptr ())-csoundCreateMutex =-        {#call csoundCreateMutex as csoundCreateMutex_#}--csoundLockMutex :: Ptr () -> IO ()-csoundLockMutex =-        {#call csoundLockMutex as csoundLockMutex_#}--{#fun csoundLockMutexNoWait {id `Ptr ()'}-> `AcquiredMutex' mutexSuccessful#}--csoundUnlockMutex :: Ptr () -> IO ()-csoundUnlockMutex =-        {#call csoundUnlockMutex as csoundUnlockMutex_#}--csoundDestroyMutex :: Ptr () -> IO ()-csoundDestroyMutex =-        {#call csoundDestroyMutex as csoundDestroyMutex_#}--{#fun csoundCreateBarrier {`Int'} -> `Ptr ()' id #}--{#fun csoundDestroyBarrier {id `Ptr ()'} -> `Int'#}--{#fun csoundWaitBarrier {id `Ptr ()'} -> `Int'#}--{#fun unsafe csoundSleep {`Int'} -> `()'#}---- *Functions to manipulate time\/locale-csoundInitTimerStruct :: IO (RtClockPtr)-csoundInitTimerStruct = do-        ptr <- malloc-        {#call unsafe csoundInitTimerStruct as csoundInitTimerStruct_#} ptr-        return ptr--{#fun pure unsafe csoundGetRealTime { id `RtClockPtr'} -> `Double'#}--{#fun pure unsafe csoundGetCPUTime {id `RtClockPtr'} -> `Double'#}--{#fun unsafe csoundGetRandomSeedFromTime { } -> `UInt32T' cIntConv #}--{#fun unsafe csoundSetLanguage { cIntFromEnum `CsLanguage' } -> `()'#}--{#fun unsafe csoundLocalizeString {`String'} -> `String'#}---- *Csound global variable manipulations-csoundCreateGlobalVariable :: CsoundPtr -> String -> Int -> CsoundMonad ()-csoundCreateGlobalVariable csPtr name sz = csoundStatusWrapper $-  csoundCreateGlobalVariable' csPtr name sz--{#fun unsafe csoundCreateGlobalVariable as csoundCreateGlobalVariable'-        {-                id `CsoundPtr',-                `String',-                `Int'-        } -> `CsoundStatus' cIntToEnum#}--csoundQueryGlobalVariable :: CsoundPtr -> String -> CsoundMonad (Ptr ())-csoundQueryGlobalVariable csPtr name = do-        maybePtr <- liftIO $ csoundQueryGlobalVariable' csPtr name-        case maybePtr of-                Just val -> return val-                Nothing -> throwError $-                           "Global variable " ++ name ++ " not found."--{#fun unsafe csoundQueryGlobalVariable as csoundQueryGlobalVariable'-        {-                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-  csoundQueryGlobalVariableNoCheck'-        {-                id `CsoundPtr',-                `String'-        } -> `Ptr ()' id#}--csoundDestroyGlobalVariable :: CsoundPtr -> String -> CsoundMonad ()-csoundDestroyGlobalVariable csPtr name = csoundStatusWrapper $-  csoundDestroyGlobalVariable' csPtr name--{#fun unsafe csoundDestroyGlobalVariable as csoundDestroyGlobalVariable'-        {-                id `CsoundPtr',-                `String'-        } -> `CsoundStatus' cIntToEnum#}--{#fun pure unsafe csoundGetSizeOfMYFLT {} -> `Int'#}----- *Csound utility functions-csoundRunUtility :: CsoundPtr -> String -> String -> CsoundMonad ()-csoundRunUtility csPtr name args = boolWrapper errStr $-  csoundRunUtility' csPtr name argv argc-        where-        errStr = "Attempt to run utility " ++ name ++ " failed."-        argc = words args-        argv = length argc--{#fun csoundRunUtility as csoundRunUtility'-        {-                id `CsoundPtr',-                `String',-                `Int',-                withStringList* `[String]'-        } -> `Bool' cIntToBoolSwitch#}--csoundListUtilities :: CsoundPtr -> CsoundMonad (Ptr CString, [String])-csoundListUtilities csPtr = liftIO $ unsafeCsoundListUtilities csPtr--{#fun unsafe csoundListUtilities as unsafeCsoundListUtilities-        {-                id `CsoundPtr'-        } -> `(Ptr CString, [String])' peekStringArrayPtr*#}--csoundDeleteUtilityList :: CsoundPtr -> Ptr (Ptr CChar) -> IO ()-csoundDeleteUtilityList =-        {#call unsafe csoundDeleteUtilityList as uCsoundDeleteUtilityList_#}--{#fun pure unsafe csoundGetUtilityDescription-        {-                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-csoundGetChannelPtr :: CsoundPtr ->-                       String ->-                       CsoundChannelDirectionalType ->-                       CsoundMonad (Ptr CCsndFlt)-csoundGetChannelPtr csPtr name chantype = do-        res <- liftIO $ csoundGetChannelPtr' csPtr name chantype-        case res of-                (CsoundSuccess, myPtr) -> return myPtr-                (err, _) -> throwError $ "Error '" ++ show err ++-                  "' getting channel pointer " ++ name ++ "."--{#fun unsafe csoundGetChannelPtr as csoundGetChannelPtr'-        {-                id `CsoundPtr',-                alloca- `Ptr CCsndFlt' peekCsndOutAry*,-                `String',-                csoundChannelDirectionalTypeToCInt-                  `CsoundChannelDirectionalType'-        } -> `CsoundStatus' cIntToEnum#}--csoundListChannels :: CsoundPtr ->-                      CsoundMonad (CsoundChannelListEntryPtr,-                        [CsoundChannelListEntry])-csoundListChannels csPtr = do-        (arrayLen, ptr) <- liftIO $ csoundListChannels' csPtr-        case arrayLen of-                NumChannels 0 -> return (ptr, [])-                NumChannels nC -> do-                        vals <- liftIO $ peekArray nC ptr-                        return (ptr, vals)-                ChanError err -> throwError $ show err--{#fun unsafe csoundListChannels as csoundListChannels'-        {-                id `CsoundPtr',-                alloca- `CsoundChannelListEntryPtr' peek*-        } -> `CsoundListChannelStatus' toChannelListStatus#}--csoundDeleteChannelList :: CsoundPtr -> CsoundChannelListEntryPtr -> IO ()-csoundDeleteChannelList =-        {#call unsafe csoundDeleteChannelList as csoundDeleteChannelList_#}--csoundSetControlChannelParams ::-        CsoundPtr -- ^Pointer to Csound instance.-        -> 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-        -> CsoundMonad ()-csoundSetControlChannelParams csPtr chanName chanType defVal minVal maxVal =-        csoundStatusWrapper $ csoundSetControlChannelParams' csPtr chanName-          chanType defVal minVal maxVal-{#fun unsafe csoundSetControlChannelParams as csoundSetControlChannelParams'-        {-                id `CsoundPtr',-                `String',-                cIntFromEnum `CsoundControlChannelType',-                cFloatConv `CsndFlt',-                cFloatConv `CsndFlt',-                cFloatConv `CsndFlt'-        } -> `CsoundStatus' cIntToEnum#}---- |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 CsoundMonad.-csoundGetControlChannelParams ::-        CsoundPtr -- ^Pointer to this csound instance-        -> String -- ^Name of channel to query-        -> CsoundMonad (Maybe (CsoundControlChannelType, CsndFlt,-             CsndFlt, CsndFlt))-csoundGetControlChannelParams csPtr chanName = do-        (typ, d, mn, mx) <- liftIO $-                            csoundGetControlChannelParams' csPtr chanName-        case (typ < 0, toEnum typ) of-                (True, _) -> throwError $-                             "csoundGetControlChannelParams returned error " ++-                             show typ-                (False, CsoundControlChannelClear) -> return Nothing-                (False, realTyp) -> return $ Just (realTyp, d, mn, mx)--{#fun unsafe csoundGetControlChannelParams as csoundGetControlChannelParams'-        {-                id `CsoundPtr',-                `String',-                alloca- `CsndFlt' peekCsndFlt*,-                alloca- `CsndFlt' peekCsndFlt*,-                alloca- `CsndFlt' peekCsndFlt*-        } -> `Int'#}--csoundSetChannelIOCallback :: CsoundPtr -> CsoundChannelIOCallbackT -> IO ()-csoundSetChannelIOCallback =-        {#call csoundSetChannelIOCallback as csoundSetChannelIOCallback_#}---- **functions for the 'ichannel' family of opcodes-csoundChanIKSet :: CsoundPtr -- ^Pointer to this csound instance-        -> CsndFlt -- ^Value to set-        -> Int -- ^Channel number to access.-        -> CsoundMonad ()-csoundChanIKSet csPtr val chan = csoundStatusWrapper $-                                 csoundChanIKSet' csPtr val chan--{#fun unsafe csoundChanIKSet as csoundChanIKSet'-        {-                id `CsoundPtr',-                cFloatConv `CsndFlt',-                `Int'-        } -> `CsoundStatus' cIntToEnum#}--csoundChanOKGet :: CsoundPtr -- ^Pointer to this csound instance-        -> Int -- ^Index of channel-        -> CsoundMonad CsndFlt -- ^current value of the channel-csoundChanOKGet csPtr chan = csoundStatValWrapper $ csoundChanOKGet' csPtr chan--{#fun unsafe csoundChanOKGet as csoundChanOKGet'-        {-                id `CsoundPtr',-                alloca- `CsndFlt' peekCsndFlt*,-                `Int'-        } -> `CsoundStatus' cIntToEnum#}--csoundChanIASet :: CsoundPtr -- ^Pointer to this csound instance.-        -> [CsndFlt] -- ^Array of value (of length ksmps) to write to a channel-        -> Int -- ^Index of channel-        -> CsoundMonad ()-csoundChanIASet csPtr ary chan = csoundStatusWrapper $-                                 csoundChanIASet' csPtr ary chan--{#fun unsafe csoundChanIASet as csoundChanIASet'-        {-                id `CsoundPtr',-                withCsndFltArray* `[CsndFlt]',-                `Int'-        } -> `CsoundStatus' cIntToEnum#}---- |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-csoundChanOAGet :: CsoundPtr -- ^Pointer to this csound instance.-        -> Int -- ^Length of audio array (ksmps)-        -> Int -- ^Index of channel-        -> CsoundMonad [CsndFlt]-csoundChanOAGet csPtr len chan = do-        (stat, ptr) <- liftIO $ unsafeCsoundChanOAGet csPtr chan-        case (stat) of-                CsoundSuccess -> liftIO $ fmap (map cFloatConv) $ peekArray-                                 len ptr-                err -> throwError $ show err--{#fun unsafe csoundChanOAGet as unsafeCsoundChanOAGet-        {-                id `CsoundPtr',-                alloca- `Ptr CCsndFlt' id,-                `Int'-        } -> `CsoundStatus' cIntToEnum#}---- **Functions for PvsIn and PvsOut-csoundPvsinSet :: CsoundPtr -- ^Pointer to this csound instance.-        -> PvsDatExt -- ^PvsDatExt object to send-        -> Int -- ^Index of channel-        -> CsoundMonad ()-csoundPvsinSet csPtr pvs chan = csoundStatusWrapper $-                                unsafeCsoundPvsinSet csPtr pvs chan--{#fun unsafe csoundPvsinSet as unsafeCsoundPvsinSet-        {-                id `CsoundPtr',-                withObject* `PvsDatExt',-                `Int'-        } -> `CsoundStatus' cIntToEnum#}--csoundPvsoutGet :: CsoundPtr -- ^Pointer to this csound instance-        -> Int -- ^Index of channel-        -> CsoundMonad PvsDatExt-csoundPvsoutGet csPtr chan = csoundStatValWrapper $-                             unsafeCsoundPvsoutGet csPtr chan--{#fun unsafe csoundPvsoutGet as unsafeCsoundPvsoutGet-        {-                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 pure unsafe csoundRand31-        {-                `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)--csoundSetCallback :: CsoundPtr -- ^Pointer to this csound instance.-        -> CsoundCallbackFunction -- ^Callback function-        -> Ptr () -- ^Pointer to "userdata"-        -> CsoundCallbackFunctionTypeMask-        -> CsoundMonad CsoundSetCallbackStatus-csoundSetCallback csPtr fnPtr dataPtr typeMask = do-        res <- liftIO $ fmap  cIntToSetCallbackStatus $-                {#call csoundSetCallback as csoundSetCallback_#} csPtr-                fnPtr dataPtr $ cIntConv typeMask-        case res of-                SetCallbackOk -> return SetCallbackOk-                err -> throwError $ show err--csoundRemoveCallback ::-        CsoundPtr-        -> CsoundCallbackFunction-        -> IO ()-csoundRemoveCallback =-        {#call csoundRemoveCallback as csoundRemoveCallback_#}---- *Csound messaging functions-csoundEnableMessageBuffer :: CsoundPtr -> Int -> IO ()-csoundEnableMessageBuffer csPtr toStdOut =-        {#call csoundEnableMessageBuffer as csoundEnableMessageBuffer_#}-        csPtr $ cIntConv toStdOut--{#fun csoundGetFirstMessage { id `CsoundPtr'} -> `String'#}--csoundGetFirstMessageAttr :: CsoundPtr -> IO Int-csoundGetFirstMessageAttr csPtr =-        liftM cIntConv $ {#call csoundGetFirstMessageAttr as-          csoundGetFirstMessageAttr_#} csPtr--csoundPopFirstMessage :: CsoundPtr -> IO ()-csoundPopFirstMessage = {#call csoundPopFirstMessage as csoundPopFirstMessage_#}--csoundGetMessageCnt :: CsoundPtr -> Int-csoundGetMessageCnt csPtr =-        cIntConv $ {#call pure unsafe csoundGetMessageCnt as-          csoundGetMessageCnt_#} csPtr--csoundDestroyMessageBuffer :: CsoundPtr -> IO ()-csoundDestroyMessageBuffer csPtr =-        {#call csoundDestroyMessageBuffer as 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 ())-csoundSetFileOpenCallback ::-        CsoundPtr-        -> CsoundFileOpenCallback-        -> IO ()-csoundSetFileOpenCallback csPtr funPtr =-        {#call unsafe csoundSetFileOpenCallback as csoundSetFileOpenCallback_#} csPtr funPtr-#endif

@@ -0,0 +1,867 @@+{-# 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'

@@ -0,0 +1,119 @@+module Sound.Csound.Vector (+ -- * Types+  BufferWriteStatus (..)+ ,CsVector++ -- *Input/output functions+ -- ** Spin/spout+ ,unsafeVec2Spin+ ,vec2Spin+ ,readSpout++ -- ** ibuf/obuf+ ,unsafeVec2Ibuf+ ,vec2Ibuf+ ,readObuf++)++where++import Sound.Csound.Interface++import Data.Vector.Storable (Vector)+import qualified Data.Vector.Storable as V++import Control.Monad+import Control.Monad.IO.Class+import Foreign++type CsVector = V.Vector CsndFlt++-- copy data from first buffer to second+cpPtr :: Storable a => Int -> Ptr a -> Ptr a -> IO ()+cpPtr 0 ibuf obuf = return ()+cpPtr n ibuf obuf = do+  x <- peek ibuf+  poke obuf x+  cpPtr (n-1) (ibuf `advancePtr` 1) (obuf `advancePtr` 1)++-- |Result of a buffer write operation+data BufferWriteStatus =+    BufOk+  | BufferNotFull Int+  | DataRemaining CsVector+  deriving (Eq, Show)++-- |Writes a vector to the input buffer.  This function doesn't check the+-- length of the buffer before writing.+unsafeVec2Ibuf :: CsVector -> Csound ()+unsafeVec2Ibuf vec = do+  ibuf <- getInputBuffer+  let (vbuf, off, len) = V.unsafeToForeignPtr vec+  liftIO . withForeignPtr vbuf $ \ptr -> cpPtr len (ptr `advancePtr` off) ibuf++-- |Writes a vector to the input buffer.  Returns any data remaining in the+-- vector.+vec2Ibuf :: CsVector -> Csound BufferWriteStatus+vec2Ibuf vec = do+  isz <- getInputBufferSize+  let len = V.length vec+  case (len == isz, len > isz) of+    (True, _) -> do+      unsafeVec2Ibuf vec+      return BufOk+    (False, True) -> do+      unsafeVec2Ibuf $ V.unsafeTake isz vec+      return . DataRemaining $ V.unsafeDrop isz vec+    (False, False) -> do+      unsafeVec2Ibuf vec+      return . BufferNotFull $ isz - len++-- |Reads from obuf to a vector.+readObuf :: Csound CsVector+readObuf = do+  bufsz <- getOutputBufferSize+  fptr <- liftIO $ mallocForeignPtrArray bufsz+  obuf <- getOutputBuffer+  liftIO $ withForeignPtr fptr (cpPtr bufsz obuf)+  return $ V.unsafeFromForeignPtr fptr 0 bufsz++-- ----------------------------------+-- Spin/spout++-- |Writes a vector to the spin buffer.  Doesn't check the buffer length+-- before writing.+unsafeVec2Spin :: CsVector -> Csound ()+unsafeVec2Spin vec = do+  ibuf <- getSpin+  let (vbuf, off, len) = V.unsafeToForeignPtr vec+  liftIO . withForeignPtr vbuf $ \ptr -> cpPtr len (ptr `advancePtr` off) ibuf++-- |Writes a vector to Spin.  Returns any data remaining in the vector.+vec2Spin :: CsVector -> Csound BufferWriteStatus+vec2Spin vec = do+  ik <- getKsmps+  inch <- getNchnls+  let isz = ik * inch+  let len = V.length vec+  case (len == isz, len > isz) of+    (True, _) -> do+      unsafeVec2Spin vec+      return BufOk+    (False, True) -> do+      unsafeVec2Spin $ V.unsafeTake isz vec+      return . DataRemaining $ V.unsafeDrop isz vec+    (False, False) -> do+      unsafeVec2Spin vec+      return . BufferNotFull $ isz - len++-- |Reads from Spout to a vector.+readSpout :: Csound CsVector+readSpout = do+  ik <- getKsmps+  inch <- getNchnls+  let bufsz = ik * inch+  fptr <- liftIO $ mallocForeignPtrArray bufsz+  spout <- getSpout+  liftIO $ withForeignPtr fptr (cpPtr bufsz spout)+  return $ V.unsafeFromForeignPtr fptr 0 bufsz