hCsound (empty) → 0.2
raw patch · 12 files changed
+2534/−0 lines, 12 filesdep +basedep +haskell98dep +mtlsetup-changed
Dependencies added: base, haskell98, mtl
Files
- COPYRIGHT +4/−0
- LICENSE +504/−0
- README +18/−0
- Setup.lhs +4/−0
- examples/simple.hs +19/−0
- examples/test1.csd +18/−0
- examples/test2.hs +27/−0
- examples/test3.hs +23/−0
- hCsound.cabal +33/−0
- src/Sound/Csound.hs +145/−0
- src/Sound/Csound/C2HS.hs +220/−0
- src/Sound/Csound/Interface.chs +1519/−0
+ COPYRIGHT view
@@ -0,0 +1,4 @@+Except where otherwise indicated, these files are copyright John W. Lato, 2008. Permission to use this library is granted by the GNU LGPL v. 2.1 (see LICENSE).++The file C2HS.hs is copyright Manuel M T Chakravarty, and is governed by different license restrictions. Details are included in the file.+
+ LICENSE view
@@ -0,0 +1,504 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 2.1, February 1999++ Copyright (C) 1991, 1999 Free Software Foundation, Inc.+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++[This is the first released version of the Lesser GPL. It also counts+ as the successor of the GNU Library Public License, version 2, hence+ the version number 2.1.]++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+Licenses are intended to guarantee your freedom to share and change+free software--to make sure the software is free for all its users.++ This license, the Lesser General Public License, applies to some+specially designated software packages--typically libraries--of the+Free Software Foundation and other authors who decide to use it. You+can use it too, but we suggest you first think carefully about whether+this license or the ordinary General Public License is the better+strategy to use in any particular case, based on the explanations below.++ When we speak of free software, we are referring to freedom of use,+not price. Our General Public Licenses are designed to make sure that+you have the freedom to distribute copies of free software (and charge+for this service if you wish); that you receive source code or can get+it if you want it; that you can change the software and use pieces of+it in new free programs; and that you are informed that you can do+these things.++ To protect your rights, we need to make restrictions that forbid+distributors to deny you these rights or to ask you to surrender these+rights. These restrictions translate to certain responsibilities for+you if you distribute copies of the library or if you modify it.++ For example, if you distribute copies of the library, whether gratis+or for a fee, you must give the recipients all the rights that we gave+you. You must make sure that they, too, receive or can get the source+code. If you link other code with the library, you must provide+complete object files to the recipients, so that they can relink them+with the library after making changes to the library and recompiling+it. And you must show them these terms so they know their rights.++ We protect your rights with a two-step method: (1) we copyright the+library, and (2) we offer you this license, which gives you legal+permission to copy, distribute and/or modify the library.++ To protect each distributor, we want to make it very clear that+there is no warranty for the free library. Also, if the library is+modified by someone else and passed on, the recipients should know+that what they have is not the original version, so that the original+author's reputation will not be affected by problems that might be+introduced by others.++ Finally, software patents pose a constant threat to the existence of+any free program. We wish to make sure that a company cannot+effectively restrict the users of a free program by obtaining a+restrictive license from a patent holder. Therefore, we insist that+any patent license obtained for a version of the library must be+consistent with the full freedom of use specified in this license.++ Most GNU software, including some libraries, is covered by the+ordinary GNU General Public License. This license, the GNU Lesser+General Public License, applies to certain designated libraries, and+is quite different from the ordinary General Public License. We use+this license for certain libraries in order to permit linking those+libraries into non-free programs.++ When a program is linked with a library, whether statically or using+a shared library, the combination of the two is legally speaking a+combined work, a derivative of the original library. The ordinary+General Public License therefore permits such linking only if the+entire combination fits its criteria of freedom. The Lesser General+Public License permits more lax criteria for linking other code with+the library.++ We call this license the "Lesser" General Public License because it+does Less to protect the user's freedom than the ordinary General+Public License. It also provides other free software developers Less+of an advantage over competing non-free programs. These disadvantages+are the reason we use the ordinary General Public License for many+libraries. However, the Lesser license provides advantages in certain+special circumstances.++ For example, on rare occasions, there may be a special need to+encourage the widest possible use of a certain library, so that it becomes+a de-facto standard. To achieve this, non-free programs must be+allowed to use the library. A more frequent case is that a free+library does the same job as widely used non-free libraries. In this+case, there is little to gain by limiting the free library to free+software only, so we use the Lesser General Public License.++ In other cases, permission to use a particular library in non-free+programs enables a greater number of people to use a large body of+free software. For example, permission to use the GNU C Library in+non-free programs enables many more people to use the whole GNU+operating system, as well as its variant, the GNU/Linux operating+system.++ Although the Lesser General Public License is Less protective of the+users' freedom, it does ensure that the user of a program that is+linked with the Library has the freedom and the wherewithal to run+that program using a modified version of the Library.++ The precise terms and conditions for copying, distribution and+modification follow. Pay close attention to the difference between a+"work based on the library" and a "work that uses the library". The+former contains code derived from the library, whereas the latter must+be combined with the library in order to run.++ GNU LESSER GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License Agreement applies to any software library or other+program which contains a notice placed by the copyright holder or+other authorized party saying it may be distributed under the terms of+this Lesser General Public License (also called "this License").+Each licensee is addressed as "you".++ A "library" means a collection of software functions and/or data+prepared so as to be conveniently linked with application programs+(which use some of those functions and data) to form executables.++ The "Library", below, refers to any such software library or work+which has been distributed under these terms. A "work based on the+Library" means either the Library or any derivative work under+copyright law: that is to say, a work containing the Library or a+portion of it, either verbatim or with modifications and/or translated+straightforwardly into another language. (Hereinafter, translation is+included without limitation in the term "modification".)++ "Source code" for a work means the preferred form of the work for+making modifications to it. For a library, complete source code means+all the source code for all modules it contains, plus any associated+interface definition files, plus the scripts used to control compilation+and installation of the library.++ Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running a program using the Library is not restricted, and output from+such a program is covered only if its contents constitute a work based+on the Library (independent of the use of the Library in a tool for+writing it). Whether that is true depends on what the Library does+and what the program that uses the Library does.+ + 1. You may copy and distribute verbatim copies of the Library's+complete source code as you receive it, in any medium, provided that+you conspicuously and appropriately publish on each copy an+appropriate copyright notice and disclaimer of warranty; keep intact+all the notices that refer to this License and to the absence of any+warranty; and distribute a copy of this License along with the+Library.++ You may charge a fee for the physical act of transferring a copy,+and you may at your option offer warranty protection in exchange for a+fee.++ 2. You may modify your copy or copies of the Library or any portion+of it, thus forming a work based on the Library, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) The modified work must itself be a software library.++ b) You must cause the files modified to carry prominent notices+ stating that you changed the files and the date of any change.++ c) You must cause the whole of the work to be licensed at no+ charge to all third parties under the terms of this License.++ d) If a facility in the modified Library refers to a function or a+ table of data to be supplied by an application program that uses+ the facility, other than as an argument passed when the facility+ is invoked, then you must make a good faith effort to ensure that,+ in the event an application does not supply such function or+ table, the facility still operates, and performs whatever part of+ its purpose remains meaningful.++ (For example, a function in a library to compute square roots has+ a purpose that is entirely well-defined independent of the+ application. Therefore, Subsection 2d requires that any+ application-supplied function or table used by this function must+ be optional: if the application does not supply it, the square+ root function must still compute square roots.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Library,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Library, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote+it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Library.++In addition, mere aggregation of another work not based on the Library+with the Library (or with a work based on the Library) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may opt to apply the terms of the ordinary GNU General Public+License instead of this License to a given copy of the Library. To do+this, you must alter all the notices that refer to this License, so+that they refer to the ordinary GNU General Public License, version 2,+instead of to this License. (If a newer version than version 2 of the+ordinary GNU General Public License has appeared, then you can specify+that version instead if you wish.) Do not make any other change in+these notices.++ Once this change is made in a given copy, it is irreversible for+that copy, so the ordinary GNU General Public License applies to all+subsequent copies and derivative works made from that copy.++ This option is useful when you wish to copy part of the code of+the Library into a program that is not a library.++ 4. You may copy and distribute the Library (or a portion or+derivative of it, under Section 2) in object code or executable form+under the terms of Sections 1 and 2 above provided that you accompany+it with the complete corresponding machine-readable source code, which+must be distributed under the terms of Sections 1 and 2 above on a+medium customarily used for software interchange.++ If distribution of object code is made by offering access to copy+from a designated place, then offering equivalent access to copy the+source code from the same place satisfies the requirement to+distribute the source code, even though third parties are not+compelled to copy the source along with the object code.++ 5. A program that contains no derivative of any portion of the+Library, but is designed to work with the Library by being compiled or+linked with it, is called a "work that uses the Library". Such a+work, in isolation, is not a derivative work of the Library, and+therefore falls outside the scope of this License.++ However, linking a "work that uses the Library" with the Library+creates an executable that is a derivative of the Library (because it+contains portions of the Library), rather than a "work that uses the+library". The executable is therefore covered by this License.+Section 6 states terms for distribution of such executables.++ When a "work that uses the Library" uses material from a header file+that is part of the Library, the object code for the work may be a+derivative work of the Library even though the source code is not.+Whether this is true is especially significant if the work can be+linked without the Library, or if the work is itself a library. The+threshold for this to be true is not precisely defined by law.++ If such an object file uses only numerical parameters, data+structure layouts and accessors, and small macros and small inline+functions (ten lines or less in length), then the use of the object+file is unrestricted, regardless of whether it is legally a derivative+work. (Executables containing this object code plus portions of the+Library will still fall under Section 6.)++ Otherwise, if the work is a derivative of the Library, you may+distribute the object code for the work under the terms of Section 6.+Any executables containing that work also fall under Section 6,+whether or not they are linked directly with the Library itself.++ 6. As an exception to the Sections above, you may also combine or+link a "work that uses the Library" with the Library to produce a+work containing portions of the Library, and distribute that work+under terms of your choice, provided that the terms permit+modification of the work for the customer's own use and reverse+engineering for debugging such modifications.++ You must give prominent notice with each copy of the work that the+Library is used in it and that the Library and its use are covered by+this License. You must supply a copy of this License. If the work+during execution displays copyright notices, you must include the+copyright notice for the Library among them, as well as a reference+directing the user to the copy of this License. Also, you must do one+of these things:++ a) Accompany the work with the complete corresponding+ machine-readable source code for the Library including whatever+ changes were used in the work (which must be distributed under+ Sections 1 and 2 above); and, if the work is an executable linked+ with the Library, with the complete machine-readable "work that+ uses the Library", as object code and/or source code, so that the+ user can modify the Library and then relink to produce a modified+ executable containing the modified Library. (It is understood+ that the user who changes the contents of definitions files in the+ Library will not necessarily be able to recompile the application+ to use the modified definitions.)++ b) Use a suitable shared library mechanism for linking with the+ Library. A suitable mechanism is one that (1) uses at run time a+ copy of the library already present on the user's computer system,+ rather than copying library functions into the executable, and (2)+ will operate properly with a modified version of the library, if+ the user installs one, as long as the modified version is+ interface-compatible with the version that the work was made with.++ c) Accompany the work with a written offer, valid for at+ least three years, to give the same user the materials+ specified in Subsection 6a, above, for a charge no more+ than the cost of performing this distribution.++ d) If distribution of the work is made by offering access to copy+ from a designated place, offer equivalent access to copy the above+ specified materials from the same place.++ e) Verify that the user has already received a copy of these+ materials or that you have already sent this user a copy.++ For an executable, the required form of the "work that uses the+Library" must include any data and utility programs needed for+reproducing the executable from it. However, as a special exception,+the materials to be distributed need not include anything that is+normally distributed (in either source or binary form) with the major+components (compiler, kernel, and so on) of the operating system on+which the executable runs, unless that component itself accompanies+the executable.++ It may happen that this requirement contradicts the license+restrictions of other proprietary libraries that do not normally+accompany the operating system. Such a contradiction means you cannot+use both them and the Library together in an executable that you+distribute.++ 7. You may place library facilities that are a work based on the+Library side-by-side in a single library together with other library+facilities not covered by this License, and distribute such a combined+library, provided that the separate distribution of the work based on+the Library and of the other library facilities is otherwise+permitted, and provided that you do these two things:++ a) Accompany the combined library with a copy of the same work+ based on the Library, uncombined with any other library+ facilities. This must be distributed under the terms of the+ Sections above.++ b) Give prominent notice with the combined library of the fact+ that part of it is a work based on the Library, and explaining+ where to find the accompanying uncombined form of the same work.++ 8. You may not copy, modify, sublicense, link with, or distribute+the Library except as expressly provided under this License. Any+attempt otherwise to copy, modify, sublicense, link with, or+distribute the Library is void, and will automatically terminate your+rights under this License. However, parties who have received copies,+or rights, from you under this License will not have their licenses+terminated so long as such parties remain in full compliance.++ 9. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Library or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Library (or any work based on the+Library), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Library or works based on it.++ 10. Each time you redistribute the Library (or any work based on the+Library), the recipient automatically receives a license from the+original licensor to copy, distribute, link with or modify the Library+subject to these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties with+this License.++ 11. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Library at all. For example, if a patent+license would not permit royalty-free redistribution of the Library by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Library.++If any portion of this section is held invalid or unenforceable under any+particular circumstance, the balance of the section is intended to apply,+and the section as a whole is intended to apply in other circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 12. If the distribution and/or use of the Library is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Library under this License may add+an explicit geographical distribution limitation excluding those countries,+so that distribution is permitted only in or among countries not thus+excluded. In such case, this License incorporates the limitation as if+written in the body of this License.++ 13. The Free Software Foundation may publish revised and/or new+versions of the Lesser General Public License from time to time.+Such new versions will be similar in spirit to the present version,+but may differ in detail to address new problems or concerns.++Each version is given a distinguishing version number. If the Library+specifies a version number of this License which applies to it and+"any later version", you have the option of following the terms and+conditions either of that version or of any later version published by+the Free Software Foundation. If the Library does not specify a+license version number, you may choose any version ever published by+the Free Software Foundation.++ 14. If you wish to incorporate parts of the Library into other free+programs whose distribution conditions are incompatible with these,+write to the author to ask for permission. For software which is+copyrighted by the Free Software Foundation, write to the Free+Software Foundation; we sometimes make exceptions for this. Our+decision will be guided by the two goals of preserving the free status+of all derivatives of our free software and of promoting the sharing+and reuse of software generally.++ NO WARRANTY++ 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE+LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++ 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH+DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Libraries++ If you develop a new library, and you want it to be of the greatest+possible use to the public, we recommend making it free software that+everyone can redistribute and change. You can do so by permitting+redistribution under these terms (or, alternatively, under the terms of the+ordinary General Public License).++ To apply these terms, attach the following notices to the library. It is+safest to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least the+"copyright" line and a pointer to where the full notice is found.++ <one line to give the library's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This library is free software; you can redistribute it and/or+ modify it under the terms of the GNU Lesser General Public+ License as published by the Free Software Foundation; either+ version 2.1 of the License, or (at your option) any later version.++ This library is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+ Lesser General Public License for more details.++ You should have received a copy of the GNU Lesser General Public+ License along with this library; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA++Also add information on how to contact you by electronic and paper mail.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the library, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the+ library `Frob' (a library for tweaking knobs) written by James Random Hacker.++ <signature of Ty Coon>, 1 April 1990+ Ty Coon, President of Vice++That's all there is to it!++
+ README view
@@ -0,0 +1,18 @@+hCsound - Haskell interface to the Csound API.++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.++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++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.++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.++Using with 32-bit Csound:+edit hCsound.cabal and change the extra-libraries line from csound64 to csound32.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ examples/simple.hs view
@@ -0,0 +1,19 @@+module Main where++import Sound.Csound+import Sound.Csound.Interface (csoundCreate, csoundDestroy, csoundCompile, csoundPerform, CsoundPerformStatus)+import Control.Monad.Error++main :: IO ()+main = (runErrorT $ runCsound "-W -otest.wav test1.csd") >>= reportResult++runCsound :: String -> CsoundMonad ()+runCsound args = do+ ptr <- csoundCreate+ csoundCompile ptr args+ csoundPerform ptr+ csoundDestroy ptr++reportResult :: Either String () -> IO ()+reportResult (Right _) = putStrLn ("Csound Ran! " )+reportResult (Left e) = putStrLn ("csound didn't run... " ++ (show e))
+ examples/test1.csd view
@@ -0,0 +1,18 @@+<CsoundSynthesizer>+<CsInstruments>+; create a 2-second test tone+sr=96000+ksmps=10+nchnls=2++instr 1 ;untitled+asig vco2 10000, 440+aout linen asig, .1, p3, .5+ outs aout, aout+ endin+</CsInstruments>+<CsScore>+i1 0.0 120+e+</CsScore>+</CsoundSynthesizer>
+ examples/test2.hs view
@@ -0,0 +1,27 @@+module Main where++import Prelude+import Sound.Csound+import Sound.Csound.Interface+import Control.Monad.Error+import Data.Binary.Put+import Data.Word+import qualified Data.ByteString.Lazy as L+import Foreign.Marshal.Array (peekArray, pokeArray)++main :: IO ()+main = do+ runErrorT (runCsound "-W -o test2.wav test1.csd")+ return ()++runCsound :: String -> CsoundMonad ()+runCsound args = do+ ptr <- csoundCreate+ liftIO $ csoundSetHostImplementedAudioIO ptr 1 512+ csoundCompile ptr args+ 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))
+ examples/test3.hs view
@@ -0,0 +1,23 @@+module Main where++import Prelude+import Sound.Csound+import Sound.Csound.Interface+import Control.Monad.Error++main :: IO ()+main = (runErrorT $ runCsound "-W -otest3.wav test1.csd") >>= reportResult++runCsound :: String -> CsoundMonad ()+runCsound args = do+ ptr <- csoundCreate+ csoundPreCompile ptr+ liftIO $ csoundSetHostImplementedAudioIO ptr 1 512+ csoundCompile ptr args+ csoundPerformBufferIO ptr (\x y -> return $ replicate x 1) (\_ _ _ -> return ())++outFn l i b = putStrLn ("Buffer Length: " ++ (show l) ++ "Position: " ++ (show i))++reportResult :: Either String a -> IO ()+reportResult (Right _) = (putStrLn "Csound Ran! ")+reportResult (Left e) = putStrLn ("csound didn't run... " ++ (show e))
+ hCsound.cabal view
@@ -0,0 +1,33 @@+Name: hCsound+Version: 0.2+Cabal-Version: >= 1.2+Description: Haskell interface to Csound API.+License: LGPL+License-file: LICENSE+Author: John W. Lato, jwlato@gmail.com+Maintainer: John W. Lato, jwlato@gmail.com+Stability: experimental+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++flag splitBase+ description: Choose the new split-up base package.++Library+ Hs-Source-Dirs: src+ src/Sound+ src/Sound/Csound+ ghc-options: -O2+ build-depends: base, haskell98, mtl+ build-tools: c2hs+ 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
+ src/Sound/Csound.hs view
@@ -0,0 +1,145 @@+-- |Sound.Csound provides a Haskell interface to the Csound API (defined in csound.h).+-- (almost) all functions from the API are wrapped and marshalled in Sound.CSound.Interface.+-- In addition to the raw functions provided there, Sound.CSound provides many more convenient+-- to use when calling csound, as well as marshalling for some functions that return vectors.+--+-- C++ class files, such as CSoundFile.hpp, are not yet wrapped. Also support for cscore is+-- currently very limited.++module Sound.Csound+ (+ CsoundMonad, --exported from Interface+ csoundCreate,+ csoundCompile,+ csoundPerform,+ CsoundPerformStatus,+ csoundPreCompile,+ csoundSetHostImplementedAudioIO,++-- defined in this module+ csoundPerformKsmpsIO,+ csoundPerformBufferIO,+ withOpcodeList,+ withUtilityList,+ listUtilityNames,+ withChannelList+ )+where++import Sound.Csound.Interface+import Foreign.Marshal.Array (peekArray, pokeArray)+import Control.Monad.Error (liftIO, throwError)+import Control.Exception (bracket)++-- Functions to perform a score with input and output from the host.++-- |Perform an entire score using csoundPerformKsmps, with handling of+-- input and output buffers spin and spout. Note that+-- csoundSetHostImplementedIO must be called before csoundCompile.+csoundPerformKsmpsIO ::+ CsoundPtr -- ^Pointer to csound instance+ -> (Int -> Int -> IO [CsndFlt]) -- ^Function that takes buffer size and starting+ -- position (in samples) and returns a list of length+ -- buffersize of input to use.+ -> (Int -> Int -> [CsndFlt] -> IO ()) -- ^Function that takes buffer size, starting+ -- position (in samples), and list of CsndFlt+ -- and performs an IO action with the [CsndFlt]+ -> CsoundMonad ()+csoundPerformKsmpsIO csPtr inBuf outBuf = csoundPerformKsmpsIO' 0+ where+ bufSize = csoundGetKsmps csPtr+ ifn = inBuf bufSize+ ofn = outBuf bufSize+ peekFn = peekArray bufSize+ csoundPerformKsmpsIO' :: Int -> CsoundMonad ()+ csoundPerformKsmpsIO' iposAcc = do+ liftIO $ csoundGetSpin' csPtr >>= (\iptr -> ifn iposAcc >>= pokeArray iptr)+ res <- csoundPerformKsmps csPtr+ liftIO $ csoundGetSpout' csPtr >>= peekFn >>= (ofn iposAcc)+ case res of+ PerformStopped -> let newPosAcc = iposAcc + bufSize in+ csoundPerformKsmpsIO' newPosAcc+ PerformFinished -> return ()+ _ -> throwError $ show res --I don't think this will ever happen,+ -- because if it does csoundPerformKsmps should handle the error++-- |Perform an entire score using csoundPerformBuffer, with handling of+-- input and output buffers.+csoundPerformBufferIO ::+ CsoundPtr -- ^Pointer to Csound struct+ -> (Int -> Int -> IO [CsndFlt]) -- ^Function that takes buffer size and starting+ -- position (in samples) and returns a list of length+ -- buffersize of input to use.+ -> (Int -> Int -> [CsndFlt] -> IO ()) -- ^Function that takes buffer size, starting+ -- position (in samples), and list of CsndFlt+ -- and performs an IO action with the [CsndFlt]+ -> CsoundMonad ()+csoundPerformBufferIO csp inBuf outBuf = csoundPerformBufferIO' 0+ where+ inBufSize = csoundGetInputBufferSize csp+ ifn = inBuf inBufSize+ outBufSize = csoundGetOutputBufferSize csp+ ofn = outBuf outBufSize+ peekFn = peekArray $ csoundGetInputBufferSize csp+ csoundPerformBufferIO' :: Int -> CsoundMonad ()+ csoundPerformBufferIO' iposAcc = do+ liftIO $ csoundGetInputBuffer' csp >>= (\iptr -> ifn iposAcc >>= pokeArray iptr)+ res <- csoundPerformBuffer csp+ liftIO $ csoundGetOutputBuffer' csp >>= peekFn >>= (ofn iposAcc)+ case res of+ PerformStopped -> let newPosAcc = iposAcc+inBufSize in+ csoundPerformBufferIO' newPosAcc+ PerformFinished -> return ()+ _ -> throwError $ show res --Again, this should never happen++-- |Perform an IO action with the current csound opcode list, properly disposing of the list after completing+-- the action+withOpcodeList :: CsoundPtr -> ([OpcodeListEntry] -> IO b) -> CsoundMonad b+withOpcodeList csPtr func = do+ openRes <- csoundNewOpcodeList csPtr+ liftIO $ bracket (return openRes) disposeFunc procFunc+ where+ disposeFunc = (\(ptr, _) -> csoundDisposeOpcodeList csPtr ptr)+ procFunc = (\(_, list) -> func list)++-- |Perform an action within the IO monad, using the list of named utilities.+withUtilityList :: CsoundPtr -> ([String] -> IO b) -> CsoundMonad b+withUtilityList csPtr func = do+ openRes <- csoundListUtilities csPtr+ case openRes of+ (_, []) -> throwError "No utilities found."+ _ -> liftIO $ bracket (return openRes) disposeFunc procFunc+ where+ disposeFunc = (\(ptr, _) -> csoundDeleteUtilityList csPtr ptr)+ procFunc = (\(_, list) -> func list)++-- |Get a list of all the registered csound utilities. This should be used instead of csoundListUtilities+-- because this function calls csoundDeleteUtilityList after use.+listUtilityNames :: CsoundPtr -> CsoundMonad [String]+listUtilityNames csPtr = withUtilityList csPtr return++-- |Perform an action within the IO monad, using the list of channels.+withChannelList :: CsoundPtr -> ([CsoundChannelListEntry] -> IO a) -> CsoundMonad a+withChannelList csPtr func = do+ openRes <- csoundListChannels csPtr+ case openRes of+ (_, []) -> throwError "No open channels"+ _ -> liftIO $ bracket (return openRes) disposeFunc procFunc+ where+ disposeFunc = (\(ptr, _) -> csoundDeleteChannelList csPtr ptr)+ procFunc = (\(_, list) -> func list)++-- |Perform a simple run of csound, with no special handling.+{-+runCsoundSimple :: String -> CsoundMonad CsoundPerformStatus+runCsoundSimple argList = do+ perfStatus <- liftIO $ bracket (csoundCreate nullPtr) csoundDestroy perform + where+ perform csPtr = do+ res <- csoundCompile csPtr argv argc+ case res of+ CsoundSuccess -> csoundPerform csPtr+ otherwise -> return $ PerformError res+ argc = "csound" : words argList + argv = length argc+-}
+ src/Sound/Csound/C2HS.hs view
@@ -0,0 +1,220 @@+-- 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
+ src/Sound/Csound/Interface.chs view
@@ -0,0 +1,1519 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# OPTIONS_GHC -fglasgow-exts #-}++-- |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#}++-- **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, it's just for the initializer+ orFunc _ CsoundCallbackAllTypes = 0 --Once an AllTypes is encountered, use a value 0 for everything.+ 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 a = peek a >>= \x -> return $ cFloatConv x++-- |Marshal a Ptr (Ptr CFloat) to a Ptr (CsndFlt).+-- This is very likely broken.+peekCsndOutAry :: Ptr (Ptr CCsndFlt) -> IO (Ptr CsndFlt)+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.+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 yet.+{#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 CFloat -> 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 $ peekArray (val+1) ptr+ Nothing -> throwError $ "Table " ++ show tableNum ++ " not found."++{#fun unsafe csoundGetTable as csoundGetTable'+ {+ id `CsoundPtr',+ alloca- `Ptr CsndFlt' 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 CUInt) -> Ptr () -> IO (Ptr ())+csoundCreateThread =+ {#call csoundCreateThread as csoundCreateThread_#}++csoundGetCurrentThreadId :: IO (Ptr ())+csoundGetCurrentThreadId =+ {#call csoundGetCurrentThreadId as csoundGetCurrentThreadId_#}++csoundJoinThread :: Ptr () -> IO CUInt+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 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 ++ "."++{#fun unsafe csoundGetChannelPtr as csoundGetChannelPtr'+ {+ id `CsoundPtr',+ alloca- `Ptr CsndFlt' 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 csoundChanOAGet'+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+ case (stat) of+ CsoundSuccess -> liftIO $ fmap (map cFloatConv) $ peekArray len ptr+ err -> throwError $ show err++{#fun unsafe csoundChanOAGet as csoundChanOAGet'+ {+ id `CsoundPtr',+ alloca- `Ptr CFloat' 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 $ csoundPvsinSet' csPtr pvs chan++{#fun unsafe csoundPvsinSet as csoundPvsinSet'+ {+ id `CsoundPtr',+ withObject* `PvsDatExt',+ `Int'+ } -> `CsoundStatus' cIntToEnum#}++csoundPvsoutGet :: CsoundPtr -- ^Pointer to this csound instance+ -> Int -- ^Index of channel+ -> CsoundMonad PvsDatExt+csoundPvsoutGet csPtr chan = csoundStatValWrapper $ csoundPvsoutGet' csPtr chan++{#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] --Instead of a list, I should consider a StorableVector for this+ }+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