hCsound 0.2 → 0.2.2
raw patch · 7 files changed
+294/−147 lines, 7 filesdep ~base
Dependency ranges changed: base
Files
- README +4/−4
- TODO +19/−0
- changelog +6/−0
- examples/test1.csd +2/−2
- hCsound.cabal +33/−7
- src/Sound/Csound.hs +46/−36
- src/Sound/Csound/Interface.chs +184/−98
README view
@@ -10,9 +10,9 @@ > runhaskell Setup.lhs build > runhaskell Setup.lhs install -The standard build assumes that csound.h is intalled in /usr/local/include/csound (UNIX/Linux) or C:\Csound\include (Windows), and that the csound libary is installed in /usr/local/lib. If csound is installed in another location, you must edit hCsound.cabal and specify the correct location for the header file in the include-dirs: line, and the library in the extra-lib-dirs line. This library also assumes that you are using a 64-bit Csound.+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: Edit hCsound.cabal and change the extra-lib-dirs line to an appropriate value for your system. Also change include-dirs if necessary. 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 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. -Using with 32-bit Csound:-edit hCsound.cabal and change the extra-libraries line from csound64 to csound32.+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
+ TODO view
@@ -0,0 +1,19 @@+Build steps:++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'++try to make this automatic...++2. Re-check build on Ubuntu with changed header locations.++3. Finish darwin build process for automated csound installer, check for self-compiled versions as well.++4. Check PC build process (for automated csound installer and self-compiled).++Interface:++1. Clean up the safe/unsafe names of functions. Possibly separate into two modules...++2. Better documentation and Haddock organization.
+ changelog view
@@ -0,0 +1,6 @@+Changes since version 2.0:+ - Added new type synonym, UIntPtrT. This type is used by+ CsoundCreateThread and CsoundJoinThread as the ThreadId. jwlato,+ 2008/07/18.+ - much improved build system, made possible by improved c2hs and+ cabal. jwlato, 2009/02/19.
examples/test1.csd view
@@ -7,12 +7,12 @@ instr 1 ;untitled asig vco2 10000, 440-aout linen asig, .1, p3, .5+aout linen asig, .01, p3, .005 outs aout, aout endin </CsInstruments> <CsScore>-i1 0.0 120+i1 0.0 .02 e </CsScore> </CsoundSynthesizer>
hCsound.cabal view
@@ -1,5 +1,5 @@ Name: hCsound-Version: 0.2+Version: 0.2.2 Cabal-Version: >= 1.2 Description: Haskell interface to Csound API. License: LGPL@@ -10,12 +10,20 @@ synopsis: interface to CSound API category: Sound, Music build-type: Simple-tested-with: GHC == 6.8.2, GHC == 6.8.1, GHC == 6.6.1-extra-source-files: README COPYRIGHT examples/test1.csd examples/simple.hs examples/test2.hs examples/test3.hs+tested-with: GHC == 6.10.1, GHC == 6.8.3, GHC == 6.6.1+extra-source-files: README COPYRIGHT changelog TODO examples/test1.csd examples/simple.hs examples/test2.hs examples/test3.hs flag splitBase description: Choose the new split-up base package. +flag useDouble+ Description: link to doubles-based csound, if available+ Default: True++flag useFramework+ Description: Use CSound installed to /Libraries/Frameworks. OS X only.+ Default: True+ Library Hs-Source-Dirs: src src/Sound@@ -26,8 +34,26 @@ other-modules: C2HS exposed-modules: Sound.Csound Sound.Csound.Interface- Extensions: ForeignFunctionInterface- include-dirs: "/usr/local/include/csound" includes: csound.h- extra-libraries: csound64, sndfile- extra-lib-dirs: /usr/local/lib+ extra-libraries: sndfile++ if flag(useDouble)+ CC-Options: -DUSE_DOUBLE++ if os(darwin) && flag(useFramework)+ if flag(useDouble)+ frameworks: CsoundLib64+ include-dirs: /Library/Frameworks/CsoundLib64.framework/Headers+ else+ frameworks: CsoundLib+ include-dirs: /Library/Frameworks/CsoundLib.framework/Headers+ else+ if flag(useDouble)+ extra-libraries: csound64+ else+ extra-libraries: csound32++ if flag(splitBase)+ build-depends: base >= 3, base < 5+ else+ build-depends: base < 3
src/Sound/Csound.hs view
@@ -1,10 +1,12 @@--- |Sound.Csound provides a Haskell interface to the Csound API (defined in csound.h).--- (almost) all functions from the API are wrapped and marshalled in Sound.CSound.Interface.--- In addition to the raw functions provided there, Sound.CSound provides many more convenient--- to use when calling csound, as well as marshalling for some functions that return vectors.+-- |Sound.Csound provides a Haskell interface to the Csound API (defined in+-- csound.h). (almost) all functions from the API are wrapped and marshalled+-- in Sound.CSound.Interface.+-- In addition to the raw functions provided there, Sound.CSound provides+-- many more convenient to use when calling csound, as well as marshalling+-- for some functions that return vectors. ----- C++ class files, such as CSoundFile.hpp, are not yet wrapped. Also support for cscore is--- currently very limited.+-- C++ class files, such as CSoundFile.hpp, are not yet wrapped.+-- Also support for cscore is currently very limited. module Sound.Csound (@@ -38,12 +40,16 @@ -- 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+ -> (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]+ -> (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@@ -53,27 +59,30 @@ peekFn = peekArray bufSize csoundPerformKsmpsIO' :: Int -> CsoundMonad () csoundPerformKsmpsIO' iposAcc = do- liftIO $ csoundGetSpin' csPtr >>= (\iptr -> ifn iposAcc >>= pokeArray iptr)+ liftIO $ csoundGetSpin' csPtr >>= \iptr ->+ ifn iposAcc >>= pokeArray iptr res <- csoundPerformKsmps csPtr- liftIO $ csoundGetSpout' csPtr >>= peekFn >>= (ofn iposAcc)+ liftIO $ csoundGetSpout' csPtr >>= peekFn >>= ofn iposAcc case res of PerformStopped -> let newPosAcc = iposAcc + bufSize in csoundPerformKsmpsIO' newPosAcc PerformFinished -> return ()- _ -> throwError $ show res --I don't think this will ever happen,- -- because if it does csoundPerformKsmps should handle the error+ _ -> throwError $ show res -- |Perform an entire score using csoundPerformBuffer, with handling of -- input and output buffers. csoundPerformBufferIO ::- CsoundPtr -- ^Pointer to Csound struct- -> (Int -> Int -> IO [CsndFlt]) -- ^Function that takes buffer size and starting- -- position (in samples) and returns a list of length- -- buffersize of input to use.- -> (Int -> Int -> [CsndFlt] -> IO ()) -- ^Function that takes buffer size, starting- -- position (in samples), and list of CsndFlt- -- and performs an IO action with the [CsndFlt]- -> CsoundMonad ()+ 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@@ -83,24 +92,25 @@ peekFn = peekArray $ csoundGetInputBufferSize csp csoundPerformBufferIO' :: Int -> CsoundMonad () csoundPerformBufferIO' iposAcc = do- liftIO $ csoundGetInputBuffer' csp >>= (\iptr -> ifn iposAcc >>= pokeArray iptr)+ liftIO $ csoundGetInputBuffer' csp >>=+ \iptr -> ifn iposAcc >>= pokeArray iptr res <- csoundPerformBuffer csp- liftIO $ csoundGetOutputBuffer' csp >>= peekFn >>= (ofn iposAcc)+ 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+-- |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)+ 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@@ -110,10 +120,10 @@ (_, []) -> throwError "No utilities found." _ -> liftIO $ bracket (return openRes) disposeFunc procFunc where- disposeFunc = (\(ptr, _) -> csoundDeleteUtilityList csPtr ptr)- procFunc = (\(_, list) -> func list)+ 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+-- |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@@ -126,20 +136,20 @@ (_, []) -> throwError "No open channels" _ -> liftIO $ bracket (return openRes) disposeFunc procFunc where- disposeFunc = (\(ptr, _) -> csoundDeleteChannelList csPtr ptr)- procFunc = (\(_, list) -> func list)+ disposeFunc (ptr, _) = csoundDeleteChannelList csPtr ptr+ procFunc (_, list) = func list -- |Perform a simple run of csound, with no special handling. {- runCsoundSimple :: String -> CsoundMonad CsoundPerformStatus runCsoundSimple argList = do- perfStatus <- liftIO $ bracket (csoundCreate nullPtr) csoundDestroy perform + 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 + argc = "csound" : words argList argv = length argc -}
src/Sound/Csound/Interface.chs view
@@ -1,9 +1,10 @@-{-# LANGUAGE ForeignFunctionInterface #-}-{-# OPTIONS_GHC -fglasgow-exts #-}+{-# LANGUAGE ForeignFunctionInterface, GeneralizedNewtypeDeriving #-} -- |Interface to csound.h--- This module contains all foreign import statements, Haskell representations of most csound datatypes+-- 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@@ -15,6 +16,7 @@ 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@@ -28,11 +30,13 @@ 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+-- |Wrap functions that return CsoundStatus into the CsoundMonad+-- for error handling csoundStatusWrapper :: IO CsoundStatus -> CsoundMonad () csoundStatusWrapper csoundFunc = do res <- liftIO csoundFunc@@ -40,7 +44,8 @@ CsoundSuccess -> return () _ -> throwError $ show res --- |Wrap functions that return a CsoundStatus and one other value into the CsoundMonad for error handling.+-- |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@@ -49,7 +54,8 @@ _ -> throwError $ show stat -- |Wrap functions that return CsoundPerformStatus into the CsoundMonad.-csPerformStatusWrapper :: IO CsoundPerformStatus -> CsoundMonad CsoundPerformStatus+csPerformStatusWrapper :: IO CsoundPerformStatus ->+ CsoundMonad CsoundPerformStatus csPerformStatusWrapper csoundFunc = do res <- liftIO csoundFunc case res of@@ -78,8 +84,8 @@ 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.+-- 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@@ -108,9 +114,10 @@ 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).+-- 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@@ -125,7 +132,8 @@ toEnum 0 = CsoundCallbackAllTypes toEnum 1 = CsoundCallbackKbdEvent toEnum 2 = CsoundCallbackKbdText- toEnum unmatched = error ("CsoundCallbackFunctionType.toEnum: Cannot match " ++ show unmatched)+ toEnum unmatched = error+ ("CsoundCallbackFunctionType.toEnum: Cannot match " ++ show unmatched) newtype CsoundCallbackFunctionTypeMask = CsoundCallbackFunctionTypeMask Int deriving (Eq, Num, Ord, Show, Real, Enum, Integral, Bits)@@ -138,8 +146,8 @@ createTypeMask :: [CsoundCallbackFunctionType] -> CsoundCallbackFunctionTypeMask createTypeMask = foldl' orFunc (-1) where- orFunc (-1) r = typeToMask r --ignore a (-1) type, it's just for the initializer- orFunc _ CsoundCallbackAllTypes = 0 --Once an AllTypes is encountered, use a value 0 for everything.+ orFunc (-1) r = typeToMask r --ignore a (-1) type+ orFunc _ CsoundCallbackAllTypes = 0 orFunc 0 _ = 0 orFunc l r = l .|. typeToMask r @@ -194,7 +202,9 @@ 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 :: (Storable b, RealFloat b, RealFloat a) => [a]+ -> (Ptr b -> IO b1)+ -> IO b1 withCsndFltArray = withArray . map (cFloatConv) nest :: [(r -> a) -> a] -> ([r] -> a) -> a@@ -219,7 +229,8 @@ mapM peekCAString cstrAry ) --- |since c2hs doesn't allow "with" as an input marshaller, withObject is a synonym+-- |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 @@ -233,10 +244,10 @@ peekCsndOutAry ptrPtr = peek ptrPtr >>= \ptr -> return $ castPtr ptr -- |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.--- Without knowing more about how this is used, I hesitate to marshall the "frame"--- to a particular type. I will likely change that later.+-- 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,@@ -254,7 +265,8 @@ peek p = do nV <- liftM fromIntegral $ {#get PVSDATEXT.N#} p #ifdef SDFT- slidingV <- liftM Just . fromIntegral $ {#get PVSDATEXT.sliding#} p+ slidingV <- liftM Just . fromIntegral $+ {#get PVSDATEXT.sliding#} p nbV <- liftM Just . fromIntegral $ {#get PVSDATEXT.NB#} p #else let slidingV = Nothing@@ -264,15 +276,19 @@ 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+ framecountV <- liftM fromIntegral $+ {#get PVSDATEXT.framecount#} p frameV <- {#get PVSDATEXT.frame#} p- return $ PvsDatExt nV slidingV nbV overlapV winsizeV wintypeV formatV framecountV frameV+ 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+ -- 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@@ -339,7 +355,8 @@ {#fun pure unsafe csoundGetAPIVersion as csoundGetApiVersion {} -> `Int'#} csoundGetHostData :: CsoundPtr -> CsoundMonad (Ptr ())-csoundGetHostData = csoundWrapper {#call csoundGetHostData as csoundGetHostData_#}+csoundGetHostData = csoundWrapper+ {#call csoundGetHostData as csoundGetHostData_#} csoundSetHostData :: CsoundPtr -> Ptr () -> CsoundMonad () csoundSetHostData csp p = liftIO $@@ -348,15 +365,17 @@ {#fun csoundGetEnv {id `CsoundPtr', `String'} -> `String'#} csoundSetGlobalEnv :: String -> String -> CsoundMonad ()-csoundSetGlobalEnv name value = csoundStatusWrapper $ csoundSetGlobalEnv' name value+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+csoundCompile csPtr argList = csoundStatusWrapper $+ csoundCompile' csPtr argv argc where- argc = "csound" : words argList + argc = "csound" : words argList argv = length argc {#fun unsafe csoundCompile as csoundCompile' {@@ -376,7 +395,8 @@ {#fun csoundPerformKsmps as csoundPerformKsmps' {id `CsoundPtr'} -> `CsoundPerformStatus' toCsoundPerformStatus#} csoundPerformKsmpsAbsolute :: CsoundPtr -> CsoundMonad CsoundPerformStatus-csoundPerformKsmpsAbsolute csPtr = csPerformStatusWrapper $ csoundPerformKsmpsAbsolute' csPtr+csoundPerformKsmpsAbsolute csPtr = csPerformStatusWrapper $+ csoundPerformKsmpsAbsolute' csPtr {#fun csoundPerformKsmpsAbsolute as csoundPerformKsmpsAbsolute' {id `CsoundPtr'} -> `CsoundPerformStatus' toCsoundPerformStatus#}@@ -414,8 +434,8 @@ {#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,+-- **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@@ -638,13 +658,18 @@ -- *Function table display -- **Callback function types--- |Ptr to a WINDAT struct. I haven't made a haskell representation of this yet.+-- |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 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)@@ -729,7 +754,8 @@ type OpcodeFunction = FunPtr (CsoundPtr -> Ptr () -> IO CInt) -- **Csound opcode manipulation functions-csoundNewOpcodeList :: CsoundPtr -> CsoundMonad (OpcodeListEntryPtr, [OpcodeListEntry])+csoundNewOpcodeList :: CsoundPtr ->+ CsoundMonad (OpcodeListEntryPtr, [OpcodeListEntry]) csoundNewOpcodeList csptr = do (arrayLen, ptr) <- liftIO $ csoundNewOpcodeList' csptr case (arrayLen >= 0) of@@ -762,7 +788,8 @@ -> OpcodeFunction -- ^aopadr -> CsoundMonad () csoundAppendOpcode csPtr opName dsblksz thread outypes intypes iopadr kopadr aopadr =- csoundStatusWrapper $ 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' {@@ -816,20 +843,31 @@ 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+ 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+ 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+ {#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,@@ -844,14 +882,16 @@ 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+ {#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 CFloat -> CInt -> IO ())+type RtplayCallback = FunPtr (CsoundPtr -> Ptr CCsndFlt -> CInt -> IO ()) type RecopenCallback = FunPtr (CsoundPtr -> CsRtAudioParamsPtr -> IO CInt) @@ -910,9 +950,17 @@ csoundGetRtPlayUserData = {#call csoundGetRtPlayUserData as csoundGetRtPlayUserData_#} -csoundRegisterSenseEventCallback :: CsoundPtr -> FunPtr (CsoundPtr -> Ptr () -> IO ()) -> Ptr () -> CsoundMonad ()+csoundRegisterSenseEventCallback :: CsoundPtr ->+ FunPtr (+ CsoundPtr ->+ Ptr () ->+ IO ()+ ) ->+ Ptr () ->+ CsoundMonad () csoundRegisterSenseEventCallback csPtr funPtr dataPtr =- boolWrapper "RegisterSenseEventCallback failed." $ csoundRegisterSenseEventCallback' csPtr funPtr dataPtr+ boolWrapper "RegisterSenseEventCallback failed." $+ csoundRegisterSenseEventCallback' csPtr funPtr dataPtr {#fun csoundRegisterSenseEventCallback as csoundRegisterSenseEventCallback' {@@ -964,7 +1012,8 @@ --Adding 1 to the length to account for the guard point. case arrayLen of Just val -> liftIO $ peekArray (val+1) ptr- Nothing -> throwError $ "Table " ++ show tableNum ++ " not found."+ Nothing -> throwError $+ "Table " ++ show tableNum ++ " not found." {#fun unsafe csoundGetTable as csoundGetTable' {@@ -986,7 +1035,7 @@ mutexSuccessful 0 = AcMutexYes mutexSuccessful _ = AcMutexNo -csoundCreateThread :: FunPtr (Ptr () -> IO CUInt) -> Ptr () -> IO (Ptr ())+csoundCreateThread :: FunPtr (Ptr () -> IO UIntPtrT) -> Ptr () -> IO (Ptr ()) csoundCreateThread = {#call csoundCreateThread as csoundCreateThread_#} @@ -994,7 +1043,7 @@ csoundGetCurrentThreadId = {#call csoundGetCurrentThreadId as csoundGetCurrentThreadId_#} -csoundJoinThread :: Ptr () -> IO CUInt+csoundJoinThread :: Ptr () -> IO UIntPtrT csoundJoinThread = {#call csoundJoinThread as csoundJoinThread_#} @@ -1077,7 +1126,8 @@ -- *Csound global variable manipulations csoundCreateGlobalVariable :: CsoundPtr -> String -> Int -> CsoundMonad ()-csoundCreateGlobalVariable csPtr name sz = csoundStatusWrapper $ csoundCreateGlobalVariable' csPtr name sz+csoundCreateGlobalVariable csPtr name sz = csoundStatusWrapper $+ csoundCreateGlobalVariable' csPtr name sz {#fun unsafe csoundCreateGlobalVariable as csoundCreateGlobalVariable' {@@ -1091,7 +1141,8 @@ maybePtr <- liftIO $ csoundQueryGlobalVariable' csPtr name case maybePtr of Just val -> return val- Nothing -> throwError $ "Global variable " ++ name ++ " not found."+ Nothing -> throwError $+ "Global variable " ++ name ++ " not found." {#fun unsafe csoundQueryGlobalVariable as csoundQueryGlobalVariable' {@@ -1099,15 +1150,18 @@ `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'+-- |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+csoundDestroyGlobalVariable csPtr name = csoundStatusWrapper $+ csoundDestroyGlobalVariable' csPtr name {#fun unsafe csoundDestroyGlobalVariable as csoundDestroyGlobalVariable' {@@ -1120,7 +1174,8 @@ -- *Csound utility functions csoundRunUtility :: CsoundPtr -> String -> String -> CsoundMonad ()-csoundRunUtility csPtr name args = boolWrapper errStr $ csoundRunUtility' csPtr name argv argc+csoundRunUtility csPtr name args = boolWrapper errStr $+ csoundRunUtility' csPtr name argv argc where errStr = "Attempt to run utility " ++ name ++ " failed." argc = words args@@ -1154,7 +1209,8 @@ -- *Csound channel functions -- **Channel data types-{#pointer *CsoundChannelListEntry as CsoundChannelListEntryPtr -> CsoundChannelListEntry#}+{#pointer *CsoundChannelListEntry as+ CsoundChannelListEntryPtr -> CsoundChannelListEntry#} {#pointer CsoundChannelIOCallback_t as CsoundChannelIOCallbackT#} data CsoundChannelListEntry = CsoundChannelListEntry@@ -1168,11 +1224,13 @@ sizeOf _ = {#sizeof CsoundChannelListEntry#} peek p = do cliname <- {#get CsoundChannelListEntry.name#} p- cliTypeV <- liftM fromIntegral $ (\ptr -> do {peekByteOff ptr 4 ::IO CInt}) 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+ (\ptr val -> do {pokeByteOff ptr 4 (val::CInt)}) p $+ fromIntegral $ cliType cli -- |Type of a channel data CsoundChannelType =@@ -1187,7 +1245,8 @@ toEnum 1 = CsoundControlChannel toEnum 2 = CsoundAudioChannel toEnum 3 = CsoundStringChannel- toEnum unmatched = error ("CsoundChannelType.toEnum: Cannot match " ++ show unmatched)+ toEnum unmatched = error+ ("CsoundChannelType.toEnum: Cannot match " ++ show unmatched) -- |Direction of a channel data CsoundChannelDirection =@@ -1202,11 +1261,13 @@ toEnum 16 = CsoundInputChannel toEnum 32 = CsoundOutputChannel toEnum 48 = CsoundBiDirectionalChannel- toEnum unmatched = error ("CsoundChannelDirection.toEnum: Cannot match " ++ show unmatched)+ 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)+ CsoundChannelDirectionalType CsoundChannelType CsoundChannelDirection+ deriving (Eq, Show) -- |Specify the type of a control channel. data CsoundControlChannelType =@@ -1225,7 +1286,8 @@ toEnum 1 = CsoundControlChannelInt toEnum 2 = CsoundControlChannelLin toEnum 3 = CsoundControlChannelExp- toEnum unmatched = error ("CsoundControlChannelType.toEnum: Cannot match " ++ show unmatched)+ toEnum unmatched = error+ ("CsoundControlChannelType.toEnum: Cannot match " ++ show unmatched) -- |Status of ListChannels return value data CsoundListChannelStatus =@@ -1253,22 +1315,29 @@ fromIntegral $ (fromEnum typ) .|. (fromEnum dir) -- **Functions for the 'chan' family of opcodes-csoundGetChannelPtr :: CsoundPtr -> String -> CsoundChannelDirectionalType -> CsoundMonad (Ptr CsndFlt)+csoundGetChannelPtr :: CsoundPtr ->+ String ->+ CsoundChannelDirectionalType ->+ CsoundMonad (Ptr CsndFlt) 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 ++ "."+ (err, _) -> throwError $ "Error '" ++ show err +++ "' getting channel pointer " ++ name ++ "." {#fun unsafe csoundGetChannelPtr as csoundGetChannelPtr' { id `CsoundPtr', alloca- `Ptr CsndFlt' peekCsndOutAry*, `String',- csoundChannelDirectionalTypeToCInt `CsoundChannelDirectionalType'+ csoundChannelDirectionalTypeToCInt+ `CsoundChannelDirectionalType' } -> `CsoundStatus' cIntToEnum#} -csoundListChannels :: CsoundPtr -> CsoundMonad (CsoundChannelListEntryPtr, [CsoundChannelListEntry])+csoundListChannels :: CsoundPtr ->+ CsoundMonad (CsoundChannelListEntryPtr,+ [CsoundChannelListEntry]) csoundListChannels csPtr = do (arrayLen, ptr) <- liftIO $ csoundListChannels' csPtr case arrayLen of@@ -1297,7 +1366,8 @@ -> CsndFlt -- ^Maximum value for channel -> CsoundMonad () csoundSetControlChannelParams csPtr chanName chanType defVal minVal maxVal =- csoundStatusWrapper $ csoundSetControlChannelParams' csPtr chanName chanType defVal minVal maxVal+ csoundStatusWrapper $ csoundSetControlChannelParams' csPtr chanName+ chanType defVal minVal maxVal {#fun unsafe csoundSetControlChannelParams as csoundSetControlChannelParams' { id `CsoundPtr',@@ -1308,18 +1378,24 @@ 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.+-- |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))+ -> CsoundMonad (Maybe (CsoundControlChannelType, CsndFlt,+ CsndFlt, CsndFlt)) csoundGetControlChannelParams csPtr chanName = do- (typ, d, mn, mx) <- liftIO $ csoundGetControlChannelParams' csPtr chanName+ (typ, d, mn, mx) <- liftIO $+ csoundGetControlChannelParams' csPtr chanName case (typ < 0, toEnum typ) of- (True, _) -> throwError $ "csoundGetControlChannelParams returned error " ++ show typ+ (True, _) -> throwError $+ "csoundGetControlChannelParams returned error " +++ show typ (False, CsoundControlChannelClear) -> return Nothing (False, realTyp) -> return $ Just (realTyp, d, mn, mx) @@ -1341,7 +1417,8 @@ -> CsndFlt -- ^Value to set -> Int -- ^Channel number to access. -> CsoundMonad ()-csoundChanIKSet csPtr val chan = csoundStatusWrapper $ csoundChanIKSet' csPtr val chan+csoundChanIKSet csPtr val chan = csoundStatusWrapper $+ csoundChanIKSet' csPtr val chan {#fun unsafe csoundChanIKSet as csoundChanIKSet' {@@ -1366,7 +1443,8 @@ -> [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+csoundChanIASet csPtr ary chan = csoundStatusWrapper $+ csoundChanIASet' csPtr ary chan {#fun unsafe csoundChanIASet as csoundChanIASet' {@@ -1375,22 +1453,24 @@ `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 csoundChanOAGet'+-- |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 $ csoundChanOAGet' csPtr chan+ (stat, ptr) <- liftIO $ unsafeCsoundChanOAGet csPtr chan case (stat) of- CsoundSuccess -> liftIO $ fmap (map cFloatConv) $ peekArray len ptr+ CsoundSuccess -> liftIO $ fmap (map cFloatConv) $ peekArray+ len ptr err -> throwError $ show err -{#fun unsafe csoundChanOAGet as csoundChanOAGet'+{#fun unsafe csoundChanOAGet as unsafeCsoundChanOAGet { id `CsoundPtr',- alloca- `Ptr CFloat' id,+ alloca- `Ptr CCsndFlt' id, `Int' } -> `CsoundStatus' cIntToEnum#} @@ -1399,9 +1479,10 @@ -> PvsDatExt -- ^PvsDatExt object to send -> Int -- ^Index of channel -> CsoundMonad ()-csoundPvsinSet csPtr pvs chan = csoundStatusWrapper $ csoundPvsinSet' csPtr pvs chan+csoundPvsinSet csPtr pvs chan = csoundStatusWrapper $+ unsafeCsoundPvsinSet csPtr pvs chan -{#fun unsafe csoundPvsinSet as csoundPvsinSet'+{#fun unsafe csoundPvsinSet as unsafeCsoundPvsinSet { id `CsoundPtr', withObject* `PvsDatExt',@@ -1411,9 +1492,10 @@ csoundPvsoutGet :: CsoundPtr -- ^Pointer to this csound instance -> Int -- ^Index of channel -> CsoundMonad PvsDatExt-csoundPvsoutGet csPtr chan = csoundStatValWrapper $ csoundPvsoutGet' csPtr chan+csoundPvsoutGet csPtr chan = csoundStatValWrapper $+ unsafeCsoundPvsoutGet csPtr chan -{#fun unsafe csoundPvsoutGet as csoundPvsoutGet'+{#fun unsafe csoundPvsoutGet as unsafeCsoundPvsoutGet { id `CsoundPtr', alloca- `PvsDatExt' peek*,@@ -1426,7 +1508,7 @@ -- are bugs in the Storable instance. data CsoundRandMtState = CsoundRandMtState { mti :: Int,- mt :: [UInt32T] --Instead of a list, I should consider a StorableVector for this+ mt :: [UInt32T] } instance Storable (CsoundRandMtState) where alignment _ = alignment (undefined :: CInt)@@ -1471,7 +1553,8 @@ -> CsoundMonad CsoundSetCallbackStatus csoundSetCallback csPtr fnPtr dataPtr typeMask = do res <- liftIO $ fmap cIntToSetCallbackStatus $- {#call csoundSetCallback as csoundSetCallback_#} csPtr fnPtr dataPtr $ cIntConv typeMask+ {#call csoundSetCallback as csoundSetCallback_#} csPtr+ fnPtr dataPtr $ cIntConv typeMask case res of SetCallbackOk -> return SetCallbackOk err -> throwError $ show err@@ -1486,20 +1569,23 @@ -- *Csound messaging functions csoundEnableMessageBuffer :: CsoundPtr -> Int -> IO () csoundEnableMessageBuffer csPtr toStdOut =- {#call csoundEnableMessageBuffer as csoundEnableMessageBuffer_#} csPtr $ cIntConv 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+ 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+ cIntConv $ {#call pure unsafe csoundGetMessageCnt as+ csoundGetMessageCnt_#} csPtr csoundDestroyMessageBuffer :: CsoundPtr -> IO () csoundDestroyMessageBuffer csPtr =