packages feed

synthesizer-dimensional (empty) → 0.2

raw patch · 48 files changed

+10734/−0 lines, 48 filesdep +basedep +binarydep +bytestringsetup-changed

Dependencies added: base, binary, bytestring, event-list, non-negative, numeric-prelude, old-time, process, random, sox, special-functors, storable-record, storablevector, synthesizer-core, transformers, utility-ht

Files

+ LICENSE view
@@ -0,0 +1,674 @@+                    GNU GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                            Preamble++  The GNU General Public License is a free, copyleft license for+software and other kinds of works.++  The licenses for most software and other practical works are designed+to take away your freedom to share and change the works.  By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users.  We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors.  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, 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+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++  To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights.  Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received.  You must make sure that they, too, receive+or can get the source code.  And you must show them these terms so they+know their rights.++  Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++  For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software.  For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++  Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so.  This is fundamentally incompatible with the aim of+protecting users' freedom to change the software.  The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable.  Therefore, we+have designed this version of the GPL to prohibit the practice for those+products.  If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++  Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary.  To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++  The precise terms and conditions for copying, distribution and+modification follow.++                       TERMS AND CONDITIONS++  0. Definitions.++  "This License" refers to version 3 of the GNU General Public License.++  "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++  "The Program" refers to any copyrightable work licensed under this+License.  Each licensee is addressed as "you".  "Licensees" and+"recipients" may be individuals or organizations.++  To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy.  The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++  A "covered work" means either the unmodified Program or a work based+on the Program.++  To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy.  Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++  To "convey" a work means any kind of propagation that enables other+parties to make or receive copies.  Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++  An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License.  If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++  1. Source Code.++  The "source code" for a work means the preferred form of the work+for making modifications to it.  "Object code" means any non-source+form of a work.++  A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++  The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form.  A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++  The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities.  However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work.  For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++  The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++  The Corresponding Source for a work in source code form is that+same work.++  2. Basic Permissions.++  All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met.  This License explicitly affirms your unlimited+permission to run the unmodified Program.  The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work.  This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++  You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force.  You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright.  Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++  Conveying under any other circumstances is permitted solely under+the conditions stated below.  Sublicensing is not allowed; section 10+makes it unnecessary.++  3. Protecting Users' Legal Rights From Anti-Circumvention Law.++  No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++  When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++  4. Conveying Verbatim Copies.++  You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++  You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++  5. Conveying Modified Source Versions.++  You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++    a) The work must carry prominent notices stating that you modified+    it, and giving a relevant date.++    b) The work must carry prominent notices stating that it is+    released under this License and any conditions added under section+    7.  This requirement modifies the requirement in section 4 to+    "keep intact all notices".++    c) You must license the entire work, as a whole, under this+    License to anyone who comes into possession of a copy.  This+    License will therefore apply, along with any applicable section 7+    additional terms, to the whole of the work, and all its parts,+    regardless of how they are packaged.  This License gives no+    permission to license the work in any other way, but it does not+    invalidate such permission if you have separately received it.++    d) If the work has interactive user interfaces, each must display+    Appropriate Legal Notices; however, if the Program has interactive+    interfaces that do not display Appropriate Legal Notices, your+    work need not make them do so.++  A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit.  Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++  6. Conveying Non-Source Forms.++  You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++    a) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by the+    Corresponding Source fixed on a durable physical medium+    customarily used for software interchange.++    b) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by a+    written offer, valid for at least three years and valid for as+    long as you offer spare parts or customer support for that product+    model, to give anyone who possesses the object code either (1) a+    copy of the Corresponding Source for all the software in the+    product that is covered by this License, on a durable physical+    medium customarily used for software interchange, for a price no+    more than your reasonable cost of physically performing this+    conveying of source, or (2) access to copy the+    Corresponding Source from a network server at no charge.++    c) Convey individual copies of the object code with a copy of the+    written offer to provide the Corresponding Source.  This+    alternative is allowed only occasionally and noncommercially, and+    only if you received the object code with such an offer, in accord+    with subsection 6b.++    d) Convey the object code by offering access from a designated+    place (gratis or for a charge), and offer equivalent access to the+    Corresponding Source in the same way through the same place at no+    further charge.  You need not require recipients to copy the+    Corresponding Source along with the object code.  If the place to+    copy the object code is a network server, the Corresponding Source+    may be on a different server (operated by you or a third party)+    that supports equivalent copying facilities, provided you maintain+    clear directions next to the object code saying where to find the+    Corresponding Source.  Regardless of what server hosts the+    Corresponding Source, you remain obligated to ensure that it is+    available for as long as needed to satisfy these requirements.++    e) Convey the object code using peer-to-peer transmission, provided+    you inform other peers where the object code and Corresponding+    Source of the work are being offered to the general public at no+    charge under subsection 6d.++  A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++  A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling.  In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage.  For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product.  A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++  "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source.  The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++  If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information.  But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++  The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed.  Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++  Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++  7. Additional Terms.++  "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law.  If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++  When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it.  (Additional permissions may be written to require their own+removal in certain cases when you modify the work.)  You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++  Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++    a) Disclaiming warranty or limiting liability differently from the+    terms of sections 15 and 16 of this License; or++    b) Requiring preservation of specified reasonable legal notices or+    author attributions in that material or in the Appropriate Legal+    Notices displayed by works containing it; or++    c) Prohibiting misrepresentation of the origin of that material, or+    requiring that modified versions of such material be marked in+    reasonable ways as different from the original version; or++    d) Limiting the use for publicity purposes of names of licensors or+    authors of the material; or++    e) Declining to grant rights under trademark law for use of some+    trade names, trademarks, or service marks; or++    f) Requiring indemnification of licensors and authors of that+    material by anyone who conveys the material (or modified versions of+    it) with contractual assumptions of liability to the recipient, for+    any liability that these contractual assumptions directly impose on+    those licensors and authors.++  All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10.  If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term.  If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++  If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++  Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++  8. Termination.++  You may not propagate or modify a covered work except as expressly+provided under this License.  Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++  However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++  Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++  Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License.  If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++  9. Acceptance Not Required for Having Copies.++  You are not required to accept this License in order to receive or+run a copy of the Program.  Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance.  However,+nothing other than this License grants you permission to propagate or+modify any covered work.  These actions infringe copyright if you do+not accept this License.  Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++  10. Automatic Licensing of Downstream Recipients.++  Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License.  You are not responsible+for enforcing compliance by third parties with this License.++  An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations.  If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++  You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License.  For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++  11. Patents.++  A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based.  The+work thus licensed is called the contributor's "contributor version".++  A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version.  For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++  Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++  In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement).  To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++  If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients.  "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++  If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++  A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License.  You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++  Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++  12. No Surrender of Others' Freedom.++  If 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 convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all.  For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++  13. Use with the GNU Affero General Public License.++  Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work.  The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++  14. Revised Versions of this License.++  The Free Software Foundation may publish revised and/or new versions of+the GNU 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+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation.  If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++  If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++  Later license versions may give you additional or different+permissions.  However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++  15. Disclaimer of Warranty.++  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "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 PROGRAM+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. Limitation of Liability.++  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++  17. Interpretation of Sections 15 and 16.++  If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++                     END OF TERMS AND CONDITIONS++            How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+state 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 program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software: you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation, either version 3 of the License, or+    (at your option) any later version.++    This program 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 General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program.  If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++  If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++    <program>  Copyright (C) <year>  <name of author>+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++  You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++  The GNU General Public License does not permit incorporating your program+into proprietary programs.  If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library.  If this is what you want to do, use the GNU Lesser General+Public License instead of this License.  But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ src/Demonstration.hs view
@@ -0,0 +1,6 @@+module Main where++import qualified Synthesizer.Dimensional.RateAmplitude.Demonstration as Demo++main :: IO ()+main = Demo.main
+ src/Synthesizer/Dimensional/Abstraction/Flat.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Class that allows unified handling of+@SigS.T@ and @Sig.D Dim.Scalar@+which is often used for control curves.+-}+module Synthesizer.Dimensional.Abstraction.Flat where++import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.RatePhantom as RP+import qualified Synthesizer.Dimensional.Straight.Signal as SigS+import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA++import qualified Synthesizer.State.Signal as Sig++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++{-+import qualified Algebra.Module         as Module+import qualified Algebra.Field          as Field+-}+import qualified Algebra.Ring           as Ring++-- import Number.DimensionTerm ((&/&))+++-- import NumericPrelude+import PreludeBase+-- import Prelude ()+++toSamples :: C sig y => RP.T s sig y -> Sig.T y+toSamples = unwrappedToSamples . RP.toSignal++class C sig y where+   unwrappedToSamples :: sig y -> Sig.T y++instance C Sig.T y where+   unwrappedToSamples = id++instance C sig y => C (SigS.T sig) y where+   unwrappedToSamples = unwrappedToSamples . SigS.samples+++{-+instance (Dim.IsScalar scalar, Module.C y yv) => C (SigA.D scalar y) yv where+   toSamples =+      SigA.vectorSamples (DN.toNumber . DN.rewriteDimension Dim.toScalar)+-}++{-+instance (C flat y, OccScalar.C y amp, Amp.C amp, Ring.C y) =>+             C (SigA.T amp flat) y where+   unwrappedToSamples =+      SigA.scalarSamples OccScalar.toScalar .+      (\x ->+         SigA.fromSamples+            (SigA.privateAmplitude x)+            (unwrappedToSamples (SigA.signal x)))+-}++{-+we could use OccasionallyScalar class,+but this would flood user code with OccScalar.C y y constraints+-}+class Amp.C amp => Amplitude y amp where+   toScalar :: amp -> y++instance Ring.C y => Amplitude y Amp.Flat where+   toScalar = const Ring.one++instance (Dim.IsScalar v) => Amplitude y (DN.T v y) where+   toScalar = DN.toNumber . DN.rewriteDimension Dim.toScalar++instance (C flat y, Amplitude y amp, Ring.C y) =>+             C (SigA.T amp flat) y where+   unwrappedToSamples =+      SigA.scalarSamples toScalar .+      (\x ->+         SigA.fromSamples+            (SigA.privateAmplitude x)+            (unwrappedToSamples (SigA.signal x)))
+ src/Synthesizer/Dimensional/Abstraction/Homogeneous.hs view
@@ -0,0 +1,71 @@+{- |+Copyright   :  (c) Henning Thielemann 2008-2009+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Class that allows unified handling of+@SigS.T@ and @SigA.R s u@+whenever the applied function is homogeneous (with degree one),+that is scaling of the input must only result in scaling of the output.+Unfortunately, Haskell's type system cannot check this property,+so use this abstraction only for signal processes that are actually homogeneous.+-}+module Synthesizer.Dimensional.Abstraction.Homogeneous where++import qualified Synthesizer.State.Signal as Sig+import qualified Synthesizer.Dimensional.RatePhantom as RP+import qualified Synthesizer.Dimensional.Straight.Signal as SigS+import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Amplitude as Amp++{-+import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import qualified Algebra.Module         as Module+import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring+-}++-- import Number.DimensionTerm ((&/&))+++-- import NumericPrelude+-- import PreludeBase+-- import Prelude ()++{-# INLINE processSamples #-}+processSamples :: C sig =>+   (Sig.T y0 -> Sig.T y1) -> RP.T s sig y0 -> RP.T s sig y1+processSamples f =+   RP.fromSignal . unwrappedProcessSamples f . RP.toSignal+++{-# INLINE processSampleList #-}+processSampleList :: C sig =>+   ([y0] -> [y1]) ->+   RP.T s sig y0 ->+   RP.T s sig y1+processSampleList f =+   processSamples (Sig.fromList . f . Sig.toList)+++class C sig where+   unwrappedProcessSamples :: (Sig.T y0 -> Sig.T y1) -> sig y0 -> sig y1+++instance C Sig.T where+   unwrappedProcessSamples f = f++instance C sig => C (SigS.T sig) where+--   processSamples = SigS.processSamples+   unwrappedProcessSamples f =+      SigS.processSamplesPrivate (unwrappedProcessSamples f)++instance (C sig, Amp.C amp) => C (SigA.T amp sig) where+   unwrappedProcessSamples f =+      (\(SigA.Cons amp sig) ->+         SigA.Cons amp (unwrappedProcessSamples f sig))
+ src/Synthesizer/Dimensional/Abstraction/HomogeneousGen.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2009+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Class similar to "Synthesizer.Dimensional.Abstraction.Homogeneous"+but it can be used for different storage types.+-}+module Synthesizer.Dimensional.Abstraction.HomogeneousGen where++import Synthesizer.Dimensional.Amplitude (Flat(Flat))+import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.State.Signal as Sig+import qualified Synthesizer.Storable.Signal as SigSt+import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth+import qualified Synthesizer.Basic.Wave         as Wave+import qualified Synthesizer.Dimensional.RatePhantom as RP+import qualified Synthesizer.Dimensional.Straight.Signal as SigS+import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA++{-+import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import qualified Algebra.Module         as Module+import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring+-}++-- import Number.DimensionTerm ((&/&))++import Data.Tuple.HT (mapSnd, )++-- import NumericPrelude+-- import PreludeBase+-- import Prelude ()++{-# INLINE processSamples #-}+processSamples ::+   (C amp storage0 signal0, C amp storage1 signal1) =>+   (storage0 y0 -> storage1 y1) -> RP.T s signal0 y0 -> RP.T s signal1 y1+processSamples f =+   RP.fromSignal . plainProcessSamples f . RP.toSignal+++plainProcessSamples ::+   (C amp storage0 signal0, C amp storage1 signal1) =>+   (storage0 y0 -> storage1 y1) ->+   (signal0 y0 -> signal1 y1)+plainProcessSamples f =+   plainWrap . mapSnd f . plainUnwrap+++wrap ::+   (C amp storage signal) =>+   (amp, storage y) -> RP.T s signal y+wrap =+   RP.fromSignal . plainWrap++unwrap ::+   (C amp storage signal) =>+   RP.T s signal y -> (amp, storage y)+unwrap =+   plainUnwrap . RP.toSignal+++{- |+Functions using this class might define their own class with functional dependencies,+that allow to infer automatically, say,+that an amplitude input signal requires an amplitude output signal.+-}+class C amp storage signal |+     signal -> amp storage where+   plainWrap   :: (amp, storage y) -> signal y+   plainUnwrap :: signal y -> (amp, storage y)++instance C Flat Sig.T Sig.T where+   plainWrap = snd+   plainUnwrap = (,) Flat++instance C Flat SigSt.T SigSt.T where+   plainWrap = snd+   plainUnwrap = (,) Flat++instance C Flat sig (SigS.T sig) where+   plainWrap = SigS.Cons . snd+   plainUnwrap = (,) Flat . SigS.samples++instance (Amp.C amp) => C amp sig (SigA.T amp (SigS.T sig)) where+   plainWrap = uncurry SigA.Cons . mapSnd SigS.Cons+   plainUnwrap (SigA.Cons amp sig) = (amp, SigS.samples sig)++++++{- |+These instances are used in oscillator+where we even do not need homogenity,+since values from the waveform+go untouched to the output signal.+-}++instance C Flat (Wave.T t) (Wave.T t) where+   plainWrap = snd+   plainUnwrap = (,) Flat++instance C Flat (WaveSmooth.T t) (WaveSmooth.T t) where+   plainWrap = snd+   plainUnwrap = (,) Flat++instance (Amp.C amp) => C amp (Wave.T t) (SigA.T amp (Wave.T t)) where+   plainWrap = uncurry SigA.Cons+   plainUnwrap (SigA.Cons amp sig) = (amp, sig)++instance (Amp.C amp) => C amp (WaveSmooth.T t) (SigA.T amp (WaveSmooth.T t)) where+   plainWrap = uncurry SigA.Cons+   plainUnwrap (SigA.Cons amp sig) = (amp, sig)
+ src/Synthesizer/Dimensional/Abstraction/RateIndependent.hs view
@@ -0,0 +1,38 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Class that allows unified handling of @RP.T@ and @SigP.T@+whenever the applied function does not depend on the sample rate.+Unfortunately, Haskell's type system cannot check this property,+so use this abstraction only for signal processes that are actually sample rate independent.+-}+module Synthesizer.Dimensional.Abstraction.RateIndependent where++-- import qualified Synthesizer.Dimensional.RatePhantom as RP+-- import qualified Synthesizer.Dimensional.RateWrapper as SigP++-- import qualified Number.DimensionTerm        as DN+-- import qualified Algebra.DimensionTerm       as Dim++{-+import qualified Algebra.Module         as Module+import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring+-}++-- import Number.DimensionTerm ((&/&))+++-- import NumericPrelude+-- import PreludeBase+-- import Prelude ()+++class C w where+   toSignal :: w sig y -> sig y+   processSignal :: (sig0 y0 -> sig1 y1) -> w sig0 y0 -> w sig1 y1
+ src/Synthesizer/Dimensional/Amplitude.hs view
@@ -0,0 +1,27 @@+module Synthesizer.Dimensional.Amplitude where++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++{- |+Can be used as amplitude value in 'Synthesizer.Dimensional.Causal.Process.T'+or in 'Synthesizer.Dimensional.Abstraction.HomogeneousGen',+whenever the signal has no amplitude.+It would be a bad idea to omit the @Flat@ parameter+in 'Synthesizer.Dimensional.Causal.Process.applyFlat' routine,+since 'Synthesizer.Dimensional.Causal.Process.apply' can still be used+but the correspondence between amplitude type and sample type is lost.+-}+data Flat = Flat++{- |+This class is used to make 'Synthesizer.Dimensional.Causal.Process.mapAmplitude'+both flexible and a bit safe.+Its instances are dimensional numbers 'DN.T' and 'Flat'.+It should not be necessary to add more instances.+-}+class C amp where++instance C Flat where++instance Dim.C v => C (DN.T v y) where
+ src/Synthesizer/Dimensional/Amplitude/Analysis.hs view
@@ -0,0 +1,171 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Dimensional.Amplitude.Analysis (+    volumeMaximum,+    volumeEuclidean,+    volumeSum,+    volumeVectorMaximum,+    volumeVectorEuclidean,+    volumeVectorSum,++    directCurrentOffset,+    rectify,+    flipFlopHysteresis,++    compare,+    lessOrEqual,+  ) where++import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind+import qualified Synthesizer.Dimensional.Abstraction.Homogeneous as Hom++-- import qualified Synthesizer.Dimensional.RatePhantom as RP+import qualified Synthesizer.Dimensional.Straight.Signal as SigS++import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Amplitude.Cut    as CutD+-- import Synthesizer.Dimensional.Amplitude.Signal (toAmplitudeScalar)++import qualified Synthesizer.State.Analysis as Ana+import qualified Synthesizer.State.Signal   as Sig++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import Number.DimensionTerm ((*&))++import qualified Algebra.NormedSpace.Maximum   as NormedMax+import qualified Algebra.NormedSpace.Euclidean as NormedEuc+import qualified Algebra.NormedSpace.Sum       as NormedSum++import qualified Algebra.Algebraic           as Algebraic+import qualified Algebra.Module              as Module+import qualified Algebra.Field               as Field+import qualified Algebra.Real                as Real+import qualified Algebra.Ring                as Ring+++import PreludeBase (Ord, Bool, (<=), ($), (.), uncurry, )+-- import NumericPrelude+import qualified Prelude as P++++{- * Notions of volume -}++{- |+Volume based on Manhattan norm.+-}+{-# INLINE volumeMaximum #-}+volumeMaximum :: (Ind.C w, Real.C y, Dim.C u) =>+   w (SigA.S u y) y -> DN.T u y+volumeMaximum = volumeAux Ana.volumeMaximum++{- |+Volume based on Energy norm.+-}+{-# INLINE volumeEuclidean #-}+volumeEuclidean :: (Ind.C w, Algebraic.C y, Dim.C u) =>+   w (SigA.S u y) y -> DN.T u y+volumeEuclidean = volumeAux Ana.volumeEuclidean++{- |+Volume based on Sum norm.+-}+{-# INLINE volumeSum #-}+volumeSum :: (Ind.C w, Field.C y, Real.C y, Dim.C u) =>+   w (SigA.S u y) y -> DN.T u y+volumeSum = volumeAux Ana.volumeSum++++{- |+Volume based on Manhattan norm.+-}+{-# INLINE volumeVectorMaximum #-}+volumeVectorMaximum :: (Ind.C w, NormedMax.C y yv, Ord y, Dim.C u) =>+   w (SigA.S u y) yv -> DN.T u y+volumeVectorMaximum = volumeAux Ana.volumeVectorMaximum++{- |+Volume based on Energy norm.+-}+{-# INLINE volumeVectorEuclidean #-}+volumeVectorEuclidean :: (Ind.C w, NormedEuc.C y yv, Algebraic.C y, Dim.C u) =>+   w (SigA.S u y) yv -> DN.T u y+volumeVectorEuclidean = volumeAux Ana.volumeVectorEuclidean++{- |+Volume based on Sum norm.+-}+{-# INLINE volumeVectorSum #-}+volumeVectorSum :: (Ind.C w, NormedSum.C y yv, Field.C y, Dim.C u) =>+   w (SigA.S u y) yv -> DN.T u y+volumeVectorSum = volumeAux Ana.volumeVectorSum+++{-# INLINE volumeAux #-}+volumeAux :: (Ind.C w, Ring.C y, Dim.C u) =>+   (Sig.T yv -> y) -> w (SigA.S u y) yv -> DN.T u y+volumeAux vol x =+   vol (SigA.samples x) *& SigA.amplitude x+++{- * Miscellaneous -}++{- |+Requires finite length.+This is identical to the arithmetic mean.+-}+{-# INLINE directCurrentOffset #-}+directCurrentOffset :: (Ind.C w, Field.C y, Dim.C u) =>+   w (SigA.S u y) y -> DN.T u y+directCurrentOffset =+   volumeAux Ana.directCurrentOffset++{-# INLINE rectify #-}+rectify :: (Ind.C w, Hom.C sig, Real.C y) =>+   w sig y -> w sig y+rectify = Ind.processSignal (Hom.unwrappedProcessSamples Ana.rectify)+++{- |+Detect thresholds with a hysteresis.+-}+{-# INLINE flipFlopHysteresis #-}+flipFlopHysteresis :: (Ind.C w, Ord y, Field.C y, Dim.C u) =>+   (DN.T u y, DN.T u y) -> Bool ->+   w (SigA.S u y) y -> w SigS.S Bool+--   SigA.R s u y y -> SigS.Binary s+flipFlopHysteresis (lower,upper) start x =+   let l = SigA.toAmplitudeScalar x lower+       h = SigA.toAmplitudeScalar x upper+   in  Ind.processSignal+          (SigS.Cons .+           Ana.flipFlopHysteresis (l,h) start .+           SigA.privateSamples) x+++{- * comparison -}++{-# INLINE compare #-}+compare ::+   (Ord y, Field.C y, Dim.C u,+    Module.C y yv, Ord yv) =>+   SigA.R s u y yv -> SigA.R s u y yv -> SigS.R s P.Ordering+compare x y =+   SigS.fromSamples $ Sig.map (uncurry P.compare) $ SigA.samples $ CutD.zip x y++{-# INLINE lessOrEqual #-}+lessOrEqual ::+   (Ord y, Field.C y, Dim.C u,+    Module.C y yv, Ord yv) =>+   SigA.R s u y yv -> SigA.R s u y yv -> SigS.Binary s+lessOrEqual x y =+   P.fmap (<= P.EQ) $ compare x y
+ src/Synthesizer/Dimensional/Amplitude/Control.hs view
@@ -0,0 +1,132 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+++Control curves which can be used+as envelopes, for controlling filter parameters and so on.+-}+module Synthesizer.Dimensional.Amplitude.Control+   ({- * Primitives -}+    constant, constantVector,+    {- * Preparation -}+    mapLinear, mapLinearDimension,+    mapExponential,+   ) where++import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind+import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat++-- import qualified Synthesizer.Dimensional.RatePhantom as RP+import qualified Synthesizer.Dimensional.Straight.Signal as SigS+import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+import Synthesizer.Dimensional.Amplitude.Signal (toAmplitudeScalar)++import qualified Synthesizer.State.Control as Ctrl+import qualified Synthesizer.State.Signal  as Sig++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import Number.DimensionTerm ((&*&))++-- import qualified Algebra.Module             as Module+import qualified Algebra.Transcendental     as Trans+import qualified Algebra.Field              as Field+import qualified Algebra.Real               as Real+import qualified Algebra.Ring               as Ring+import qualified Algebra.Additive           as Additive++import NumericPrelude+import PreludeBase as P+import Prelude ()+++{-# INLINE constant #-}+constant :: (Real.C y, Dim.C u) =>+      DN.T u y {-^ value -}+   -> SigA.R s u y y+constant =+   uncurry constantVector .+   DN.absSignum++{- |+The amplitude must be positive!+This is not checked.+-}+{-# INLINE constantVector #-}+constantVector :: -- (Field.C y', Real.C y', OccScalar.C y y') =>+      DN.T u y {-^ amplitude -}+   -> yv       {-^ value -}+   -> SigA.R s u y yv+constantVector y yv =+   SigA.fromSamples y (Ctrl.constant yv)++++{-+This signature is too general.+It will cause strange type errors+if u is Scalar and further process want to use the Flat instance.+The Flat instance cannot be found, if q cannot be determined.++mapLinear :: (Ind.C w, Flat.C flat y, Ring.C y, Dim.C u) =>+    y ->+    DN.T u q ->+    w flat y ->+    w (SigA.S u q) y+-}++{-# INLINE mapLinear #-}+mapLinear :: (Ind.C w, Flat.C flat y, Ring.C y, Dim.C u) =>+    y ->+    DN.T u y ->+    w flat y ->+    w (SigA.S u y) y+mapLinear depth center =+   Ind.processSignal+      (SigA.Cons center . SigS.Cons .+       Sig.map (\x -> one+x*depth) .+       Flat.unwrappedToSamples)++{-# INLINE mapExponential #-}+mapExponential :: (Ind.C w, Flat.C flat y, Trans.C y, Dim.C u) =>+    y ->+    DN.T u q ->+    w flat y ->+    w (SigA.S u q) y+mapExponential depth center =+   Ind.processSignal+      (SigA.Cons center . SigS.Cons .+       Sig.map (depth**) .+       Flat.unwrappedToSamples)+++-- combination of 'raise' and 'amplify' ***+{- |+Map a control curve without amplitude unit+by a linear (affine) function with a unit.+-}+{-# INLINE mapLinearDimension #-}+mapLinearDimension ::+   (Ind.C w, Field.C y, Real.C y, Dim.C u, Dim.C v) =>+      DN.T v y               {- ^ range: one is mapped to @center + range * ampX@ -}+   -> DN.T (Dim.Mul v u) y  {- ^ center: zero is mapped to @center@ -}+   -> w (SigA.S u y) y+   -> w (SigA.S (Dim.Mul v u) y) y+mapLinearDimension range center x =+   let absRange  = DN.abs range &*& SigA.amplitude x+       absCenter = DN.abs center+       rng = toAmplitudeScalar z absRange+       cnt = toAmplitudeScalar z absCenter+       z =+          Ind.processSignal+             (SigA.Cons (absRange + absCenter) . SigS.Cons .+              Sig.map (\y -> cnt + rng*y) .+              SigA.privateSamples) x+   in  z+-- SynI.mapScalar 1 (absRange + absCenter) (\y -> cnt + rng*y) x
+ src/Synthesizer/Dimensional/Amplitude/Cut.hs view
@@ -0,0 +1,221 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Dimensional.Amplitude.Cut (+   {- * dissection -}+   unzip,+   unzip3,+   leftFromStereo, rightFromStereo,++   {- * glueing -}+   concat,      concatVolume,+   append,      appendVolume,+   zip,         zipVolume,+   zip3,        zip3Volume,+   mergeStereo, mergeStereoVolume,+   selectBool,+  ) where++import qualified Synthesizer.Dimensional.Straight.Signal as SigS+import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+import Synthesizer.Dimensional.Amplitude.Signal (toAmplitudeScalar)++import qualified Synthesizer.State.Signal  as Sig++import qualified Synthesizer.Frame.Stereo as Stereo++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++-- import Number.DimensionTerm ((&*&))++-- import qualified Algebra.NormedSpace.Maximum as NormedMax+import qualified Algebra.Module              as Module+import qualified Algebra.Field               as Field+-- import qualified Algebra.Ring                as Ring++import qualified Data.List as List++import PreludeBase (Ord, max, )+-- import NumericPrelude+import Prelude ()+++{- * dissection -}++{-# INLINE unzip #-}+unzip :: (Dim.C u) =>+   SigA.R s u y (yv0, yv1) ->+   (SigA.R s u y yv0, SigA.R s u y yv1)+unzip x =+   let (ss0,ss1) = Sig.unzip (SigA.samples x)+   in  (SigA.replaceSamples ss0 x, SigA.replaceSamples ss1 x)++{-# INLINE unzip3 #-}+unzip3 :: (Dim.C u) =>+   SigA.R s u y (yv0, yv1, yv2) ->+   (SigA.R s u y yv0, SigA.R s u y yv1, SigA.R s u y yv2)+unzip3 x =+   let (ss0,ss1,ss2) = Sig.unzip3 (SigA.samples x)+   in  (SigA.replaceSamples ss0 x, SigA.replaceSamples ss1 x, SigA.replaceSamples ss2 x)+++{-# INLINE leftFromStereo #-}+leftFromStereo :: (Dim.C u) =>+   SigA.R s u y (Stereo.T yv) -> SigA.R s u y yv+leftFromStereo = SigA.processSamples (Sig.map Stereo.left)++{-# INLINE rightFromStereo #-}+rightFromStereo :: (Dim.C u) =>+   SigA.R s u y (Stereo.T yv) -> SigA.R s u y yv+rightFromStereo = SigA.processSamples (Sig.map Stereo.right)++++{- * glueing -}++{- |+Similar to @foldr1 append@ but more efficient and accurate,+because it reduces the number of amplifications.+Does not work for infinite lists,+because no maximum amplitude can be computed.+-}+{-# INLINE concat #-}+concat ::+   (Ord y, Field.C y, Dim.C u,+    Module.C y yv) =>+   [SigA.R s u y yv] -> SigA.R s u y yv+concat xs =+   concatVolume (List.maximum (List.map SigA.amplitude xs)) xs++{- |+Give the output volume explicitly.+Does also work for infinite lists.+-}+{-# INLINE concatVolume #-}+concatVolume ::+   (Field.C y, Dim.C u,+    Module.C y yv) =>+   DN.T u y -> [SigA.R s u y yv] -> SigA.R s u y yv+concatVolume amp xs =+   let smps = List.map (SigA.vectorSamples (toAmplitudeScalar z)) xs+       z = SigA.fromSamples amp (Sig.concat smps)+   in  z+++{-# INLINE merge #-}+merge ::+   (Ord y, Field.C y, Dim.C u,+    Module.C y yv0, Module.C y yv1) =>+   (Sig.T yv0 -> Sig.T yv1 -> Sig.T yv2) ->+   SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y yv2+merge f x0 x1 =+   mergeVolume f (max (SigA.amplitude x0) (SigA.amplitude x1)) x0 x1++{-# INLINE mergeVolume #-}+mergeVolume ::+   (Field.C y, Dim.C u,+    Module.C y yv0, Module.C y yv1) =>+   (Sig.T yv0 -> Sig.T yv1 -> Sig.T yv2) ->+   DN.T u y ->+   SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y yv2+mergeVolume f amp x y =+   let sampX = SigA.vectorSamples (toAmplitudeScalar z) x+       sampY = SigA.vectorSamples (toAmplitudeScalar z) y+       z = SigA.fromSamples amp (f sampX sampY)+   in  z+++{-# INLINE append #-}+append ::+   (Ord y, Field.C y, Dim.C u,+    Module.C y yv) =>+   SigA.R s u y yv -> SigA.R s u y yv -> SigA.R s u y yv+append = merge Sig.append++{-# INLINE appendVolume #-}+appendVolume ::+   (Field.C y, Dim.C u,+    Module.C y yv) =>+   DN.T u y ->+   SigA.R s u y yv -> SigA.R s u y yv -> SigA.R s u y yv+appendVolume = mergeVolume Sig.append+++{-# INLINE zip #-}+zip ::+   (Ord y, Field.C y, Dim.C u,+    Module.C y yv0, Module.C y yv1) =>+   SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y (yv0,yv1)+zip = merge Sig.zip++{-# INLINE zipVolume #-}+zipVolume ::+   (Field.C y, Dim.C u,+    Module.C y yv0, Module.C y yv1) =>+   DN.T u y ->+   SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y (yv0,yv1)+zipVolume = mergeVolume Sig.zip++++{-# INLINE mergeStereo #-}+mergeStereo ::+   (Ord y, Field.C y, Dim.C u,+    Module.C y yv) =>+   SigA.R s u y yv -> SigA.R s u y yv -> SigA.R s u y (Stereo.T yv)+mergeStereo = merge (Sig.zipWith Stereo.cons)++{-# INLINE mergeStereoVolume #-}+mergeStereoVolume ::+   (Field.C y, Dim.C u,+    Module.C y yv) =>+   DN.T u y ->+   SigA.R s u y yv -> SigA.R s u y yv -> SigA.R s u y (Stereo.T yv)+mergeStereoVolume = mergeVolume (Sig.zipWith Stereo.cons)++++{-# INLINE zip3 #-}+zip3 ::+   (Ord y, Field.C y, Dim.C u,+    Module.C y yv0, Module.C y yv1, Module.C y yv2) =>+   SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y yv2 ->+   SigA.R s u y (yv0,yv1,yv2)+zip3 x0 x1 x2 =+   zip3Volume+      (SigA.amplitude x0 `max` SigA.amplitude x1 `max` SigA.amplitude x2)+      x0 x1 x2++{-# INLINE zip3Volume #-}+zip3Volume ::+   (Field.C y, Dim.C u,+    Module.C y yv0, Module.C y yv1, Module.C y yv2) =>+   DN.T u y ->+   SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y yv2 ->+   SigA.R s u y (yv0,yv1,yv2)+zip3Volume amp x0 x1 x2 =+   let sampX0 = SigA.vectorSamples (toAmplitudeScalar z) x0+       sampX1 = SigA.vectorSamples (toAmplitudeScalar z) x1+       sampX2 = SigA.vectorSamples (toAmplitudeScalar z) x2+       z = SigA.fromSamples amp (Sig.zip3 sampX0 sampX1 sampX2)+   in  z+++{-# INLINE selectBool #-}+selectBool ::+   (Ord y, Field.C y, Dim.C u,+    Module.C y yv) =>+   SigA.R s u y yv {- ^ False -} ->+   SigA.R s u y yv {- ^ True -} ->+   SigS.Binary s ->+   SigA.R s u y yv+selectBool xf xt cs =+   SigA.processSamples+      (Sig.zipWith (\c (xfi,xti) -> if c then xti else xfi) (SigS.toSamples cs))+      (zip xf xt)
+ src/Synthesizer/Dimensional/Amplitude/Displacement.hs view
@@ -0,0 +1,125 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Dimensional.Amplitude.Displacement (+   mix, mixVolume,+   mixMulti, mixMultiVolume,+   raise, distort,+   ) where++import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind++import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+import Synthesizer.Dimensional.Amplitude.Signal (toAmplitudeScalar)++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++-- import Number.DimensionTerm ((&*&))++import qualified Synthesizer.State.Displacement as Disp+import qualified Synthesizer.State.Signal  as Sig++import qualified Algebra.Module         as Module+import qualified Algebra.Field          as Field+import qualified Algebra.Real           as Real+-- import qualified Algebra.Ring           as Ring+import qualified Algebra.Additive       as Additive++import Algebra.Module ((*>))++import PreludeBase+import NumericPrelude+import Prelude ()+++{- * Mixing -}++{- |+Mix two signals.+In contrast to 'zipWith' the result has the length of the longer signal.+-}+{-# INLINE mix #-}+mix ::+   (Real.C y, Field.C y, Module.C y yv, Dim.C u) =>+      SigA.R s u y yv+   -> SigA.R s u y yv+   -> SigA.R s u y yv+mix x y =+   mixVolume (DN.abs (SigA.amplitude x) + DN.abs (SigA.amplitude y)) x y++{-# INLINE mixVolume #-}+mixVolume ::+   (Real.C y, Field.C y, Module.C y yv, Dim.C u) =>+      DN.T u y+   -> SigA.R s u y yv+   -> SigA.R s u y yv+   -> SigA.R s u y yv+mixVolume v x y =+   let z = SigA.fromSamples v+              (SigA.vectorSamples (toAmplitudeScalar z) x ++               SigA.vectorSamples (toAmplitudeScalar z) y)+   in  z++{- |+Mix one or more signals.+-}+{-# INLINE mixMulti #-}+mixMulti ::+   (Real.C y, Field.C y, Module.C y yv, Dim.C u) =>+      [SigA.R s u y yv]+   ->  SigA.R s u y yv+mixMulti x =+   mixMultiVolume (sum (map (DN.abs . SigA.amplitude) x)) x++{-# INLINE mixMultiVolume #-}+mixMultiVolume ::+   (Real.C y, Field.C y, Module.C y yv, Dim.C u) =>+      DN.T u y+   -> [SigA.R s u y yv]+   ->  SigA.R s u y yv+mixMultiVolume v x =+   let z = SigA.fromSamples v+              (foldr (\y -> (SigA.vectorSamples (toAmplitudeScalar z) y +)) Sig.empty x)+   in  z++{- |+Add a number to all of the signal values.+This is useful for adjusting the center of a modulation.+-}+{-# INLINE raise #-}+raise :: (Ind.C w, Field.C y, Module.C y yv, Dim.C u) =>+      DN.T u y+   -> yv+   -> w (SigA.S u y) yv+   -> w (SigA.S u y) yv+raise y' yv x =+   SigA.processSamples+      (Disp.raise (toAmplitudeScalar x y' *> yv)) x++{- |+Distort the signal using a flat function.+The first signal gives the scaling of the function.+If the scaling is c and the input sample is y,+then @c * f(y/c)@ is output.+This way we can use an (efficient) flat function+and have a simple, yet dimension conform, way of controlling the distortion.+E.g. if the distortion function is @tanh@+then the value @c@ controls the saturation level.+-}+{-# INLINE distort #-}+distort :: (Field.C y, Module.C y yv, Dim.C u) =>+      (yv -> yv)+   -> SigA.R s u y y+   -> SigA.R s u y yv+   -> SigA.R s u y yv+distort f cs xs =+   SigA.processSamples+      (Sig.zipWith+          (\c y -> c *> f (recip c *> y))+          (SigA.scalarSamples (toAmplitudeScalar xs) cs)) xs
+ src/Synthesizer/Dimensional/Amplitude/Filter.hs view
@@ -0,0 +1,102 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Dimensional.Amplitude.Filter (+   {- * Non-recursive -}++   {- ** Amplification -}+   amplify,+   amplifyDimension,+   negate,+   envelope,+   envelopeVector,+   envelopeVectorDimension,+ ) where+++import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind+import qualified Synthesizer.Dimensional.Abstraction.Homogeneous as Hom+import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat++import qualified Synthesizer.Dimensional.RatePhantom as RP++-- import qualified Synthesizer.Dimensional.Straight.Signal      as SigS+import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+-- import Synthesizer.Dimensional.Amplitude.Signal (toAmplitudeScalar)++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import Number.DimensionTerm ((&*&))++-- import qualified Synthesizer.State.Signal              as Sig+import qualified Synthesizer.State.Filter.NonRecursive as FiltNR++-- import qualified Algebra.Transcendental as Trans+-- import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring+import qualified Algebra.Additive       as Additive+import qualified Algebra.Module         as Module++-- import NumericPrelude hiding (negate)+-- import PreludeBase as P+import Prelude (($))+++{- | The amplification factor must be positive. -}+{-# INLINE amplify #-}+amplify :: (Ind.C w, Ring.C y, Dim.C u) =>+      y+   -> w (SigA.S u y) yv+   -> w (SigA.S u y) yv+amplify volume x =+   SigA.replaceAmplitude (DN.scale volume $ SigA.amplitude x) x++{-# INLINE amplifyDimension #-}+amplifyDimension :: (Ind.C w, Ring.C y, Dim.C u, Dim.C v) =>+      DN.T v y+   -> w (SigA.S u y) yv+   -> w (SigA.S (Dim.Mul v u) y) yv+amplifyDimension volume x =+   SigA.replaceAmplitude (volume &*& SigA.amplitude x) x++-- FIXME: move to Dimensional.Straight+{-# INLINE negate #-}+negate :: (Ind.C w, Hom.C sig, Additive.C yv) =>+      w sig yv+   -> w sig yv+negate =+   Ind.processSignal (Hom.unwrappedProcessSamples Additive.negate)++-- FIXME: move to Dimensional.Straight+{-# INLINE envelope #-}+envelope :: (Hom.C sig, Flat.C flat y0, Ring.C y0) =>+      RP.T s flat y0   {- ^ the envelope -}+   -> RP.T s sig y0    {- ^ the signal to be enveloped -}+   -> RP.T s sig y0+envelope y =+   Hom.processSamples (FiltNR.envelope (Flat.toSamples y))++-- FIXME: move to Dimensional.Straight+{-# INLINE envelopeVector #-}+envelopeVector :: (Hom.C sig, Flat.C flat y0, Module.C y0 yv) =>+      RP.T s flat y0   {- ^ the envelope -}+   -> RP.T s sig yv    {- ^ the signal to be enveloped -}+   -> RP.T s sig yv+envelopeVector y =+   Hom.processSamples (FiltNR.envelopeVector (Flat.toSamples y))++{-# INLINE envelopeVectorDimension #-}+envelopeVectorDimension :: (Module.C y0 yv, Ring.C y, Dim.C u, Dim.C v) =>+      SigA.R s v y y0  {- ^ the envelope -}+   -> SigA.R s u y yv  {- ^ the signal to be enveloped -}+   -> SigA.R s (Dim.Mul v u) y yv+envelopeVectorDimension y x =+   SigA.fromSamples+      (SigA.amplitude y &*& SigA.amplitude x)+      (FiltNR.envelopeVector (SigA.samples y) (SigA.samples x))
+ src/Synthesizer/Dimensional/Amplitude/Signal.hs view
@@ -0,0 +1,232 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Signals equipped with a volume information that may carry a unit.+Is the approach with separated volume information still appropriate?+Actually it simplifies reusing code from "Synthesizer.State.Signal"+because we do not have to replace @(*)@ by @(&*&)@.+-}+module Synthesizer.Dimensional.Amplitude.Signal where++import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Format as Format+import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind++import qualified Synthesizer.Dimensional.RatePhantom as RP+import qualified Synthesizer.Dimensional.Straight.Signal as SigS++import qualified Synthesizer.State.Filter.NonRecursive as Filt+import qualified Synthesizer.State.Signal as Sig++import qualified Synthesizer.Generic.Filter.NonRecursive as FiltG+import qualified Synthesizer.Generic.Signal as SigG++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import qualified Algebra.Module         as Module+import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring++-- import Number.DimensionTerm ((&/&))+++import NumericPrelude+import PreludeBase as P+import Prelude ()+++data T amp sig yv =+   Cons {+        privateAmplitude :: amp     {-^ scaling of the values -}+      , signal           :: sig yv  {-^ the embedded signal -}+     }+--   deriving (Eq, Show)++instance (Show amp, Format.C sig) => Format.C (T amp sig) where+   format p (Cons amp sig) =+      showParen (p >= 10)+         (showString "amplitudeSignal " . showsPrec 11 amp .+          showString " " . Format.format 11 sig)++instance (Show amp, Show yv, Format.C sig) => Show (T amp sig yv) where+   showsPrec = Format.format++type R s v y yv = RP.T s (S v y) yv+type S v y = D v y SigS.S  -- kind * -> *+type D v y = T (DN.T v y)++{-+We removed that instance because 'fmap' is too dangerous for application code.+You may write functions that depend on the particular amplitude scaling.++instance Dim.C v => Functor (D v y s) where+   fmap f (Cons amp ss) = Cons amp (map f ss)+-}++{-# INLINE amplitude #-}+amplitude :: (Ind.C w, Dim.C v) =>+   w (D v y sig) yv -> DN.T v y+amplitude = privateAmplitude . Ind.toSignal++{-# INLINE samples #-}+samples :: (Ind.C w, Dim.C v) =>+   w (D v y (SigS.T sig)) yv -> sig yv+samples = privateSamples . Ind.toSignal++{-# INLINE privateSamples #-}+privateSamples :: (Amp.C amp) =>+   T amp (SigS.T sig) yv -> sig yv+privateSamples = SigS.samples . signal++{-# INLINE phantomSignal #-}+phantomSignal ::+   RP.T s (D v y sig) yv -> RP.T s sig yv+phantomSignal =+   RP.fromSignal . signal . RP.toSignal+++{-# INLINE toAmplitudeScalar #-}+toAmplitudeScalar :: (Ind.C w, Field.C y, Dim.C v) =>+   w (D v y sig) yv -> DN.T v y -> y+toAmplitudeScalar sig y =+   DN.divToScalar y (amplitude sig)++{-# INLINE scalarSamples #-}+{-+scalarSamples :: (Ind.C w, Ring.C y, Dim.C v) =>+   (DN.T v y -> y) -> w (S v y) y -> Sig.T y+-}+scalarSamples :: (Ind.C w, Ring.C y, Amp.C amp) =>+   (amp -> y) -> w (T amp SigS.S) y -> Sig.T y+scalarSamples toAmpScalar =+   scalarSamplesPrivate toAmpScalar . Ind.toSignal++{-# INLINE scalarSamplesGeneric #-}+scalarSamplesGeneric ::+   (Ind.C w, Ring.C y, Dim.C v, SigG.Transform sig y) =>+   (DN.T v y -> y) -> w (D v y (SigS.T sig)) y -> sig y+scalarSamplesGeneric toAmpScalar =+   scalarSamplesPrivateGeneric toAmpScalar . Ind.toSignal++{-# INLINE vectorSamples #-}+vectorSamples :: (Ind.C w, Module.C y yv, Dim.C v) =>+   (DN.T v y -> y) -> w (S v y) yv -> Sig.T yv+vectorSamples toAmpScalar =+   vectorSamplesPrivate toAmpScalar . Ind.toSignal+++{-# INLINE rewriteDimension #-}+rewriteDimension :: (Dim.C v0, Dim.C v1) =>+   (v0 -> v1) -> D v0 y sig yv -> D v1 y sig yv+rewriteDimension f (Cons amp ss) =+   Cons (DN.rewriteDimension f amp) ss+++{-# INLINE fromSignal #-}+-- fromSignal :: DN.T v y -> SigS.R s yv -> R s v y yv+fromSignal :: amp -> SigS.R s yv -> RP.T s (T amp SigS.S) yv+fromSignal amp  =  RP.fromSignal . Cons amp . RP.toSignal+++{-# INLINE toScalarSignal #-}+toScalarSignal :: (Ind.C w, Field.C y, Dim.C v) =>+   DN.T v y -> w (S v y) y -> w SigS.S y+toScalarSignal amp  =+   Ind.processSignal+      (SigS.Cons . scalarSamplesPrivate (flip DN.divToScalar amp))++{-# INLINE toVectorSignal #-}+toVectorSignal :: (Ind.C w, Field.C y, Module.C y yv, Dim.C v) =>+   DN.T v y -> w (S v y) yv -> w SigS.S yv+toVectorSignal amp  =+   Ind.processSignal+      (SigS.Cons . vectorSamplesPrivate (flip DN.divToScalar amp))+++{-# INLINE scalarSamplesPrivate #-}+{-+scalarSamplesPrivate :: (Ring.C y, Dim.C v) =>+   (DN.T v y -> y) -> S v y y -> Sig.T y+-}+scalarSamplesPrivate :: (Ring.C y, Amp.C amp) =>+   (amp -> y) -> T amp SigS.S y -> Sig.T y+scalarSamplesPrivate toAmpScalar sig =+   let y = toAmpScalar (privateAmplitude sig)+   in  Filt.amplify y (privateSamples sig)++{-# INLINE scalarSamplesPrivateGeneric #-}+scalarSamplesPrivateGeneric ::+   (Ring.C y, Dim.C v, SigG.Transform sig y) =>+   (DN.T v y -> y) -> D v y (SigS.T sig) y -> sig y+scalarSamplesPrivateGeneric toAmpScalar sig =+   let y = toAmpScalar (privateAmplitude sig)+   in  FiltG.amplify y (privateSamples sig)++{-# INLINE vectorSamplesPrivate #-}+vectorSamplesPrivate :: (Module.C y yv, Dim.C v) =>+   (DN.T v y -> y) -> S v y yv -> Sig.T yv+vectorSamplesPrivate toAmpScalar sig =+   let y = toAmpScalar (privateAmplitude sig)+   in  y *> privateSamples sig+++{-# INLINE fromSamples #-}+-- fromSamples :: (Dim.C v) => DN.T v y -> Sig.T yv -> R s v y yv+fromSamples :: {- (Amp.C amp) => -} amp -> Sig.T yv -> RP.T s (T amp SigS.S) yv+fromSamples amp  =  fromSignal amp . SigS.fromSamples++{-# INLINE fromScalarSamples #-}+fromScalarSamples :: {- (Amp.C amp) => -}+   amp -> Sig.T y -> RP.T s (T amp SigS.S) y+fromScalarSamples  =  fromSamples++{-# INLINE fromVectorSamples #-}+fromVectorSamples :: {- (Amp.C amp) => -}+   amp -> Sig.T yv -> RP.T s (T amp SigS.S) yv+fromVectorSamples  =  fromSamples++{-# INLINE replaceAmplitude #-}+replaceAmplitude :: (Ind.C w, Dim.C v0, Dim.C v1) =>+   DN.T v1 y -> w (D v0 y sig) yv -> w (D v1 y sig) yv+replaceAmplitude amp  =  Ind.processSignal (replaceAmplitudePrivate amp)++{-# INLINE replaceSamples #-}+replaceSamples :: (Ind.C w, Dim.C v) =>+   sig1 yv1 -> w (D v y sig0) yv0 -> w (D v y (SigS.T sig1)) yv1+replaceSamples ss  =  Ind.processSignal (replaceSamplesPrivate ss)++{-# INLINE replaceAmplitudePrivate #-}+replaceAmplitudePrivate :: (Dim.C v0, Dim.C v1) =>+   DN.T v1 y -> D v0 y sig yv -> D v1 y sig yv+replaceAmplitudePrivate amp  =  Cons amp . signal++{-# INLINE replaceSamplesPrivate #-}+replaceSamplesPrivate :: (Dim.C v) =>+   sig1 yv1 -> D v y sig0 yv0 -> D v y (SigS.T sig1) yv1+replaceSamplesPrivate ss x  =  Cons (privateAmplitude x) (SigS.Cons ss)+++{-# INLINE processSamples #-}+processSamples :: (Ind.C w, Dim.C v) =>+   (sig0 yv0 -> sig1 yv1) ->+   w (D v y (SigS.T sig0)) yv0 -> w (D v y (SigS.T sig1)) yv1+processSamples f =+   Ind.processSignal (processSamplesPrivate f)++{-# INLINE processSamplesPrivate #-}+processSamplesPrivate :: (Dim.C v) =>+   (sig0 yv0 -> sig1 yv1) ->+   D v y (SigS.T sig0) yv0 -> D v y (SigS.T sig1) yv1+processSamplesPrivate f (Cons amp sig) =+   Cons amp (SigS.processSamplesPrivate f sig)+++{-# INLINE asTypeOfAmplitude #-}+asTypeOfAmplitude :: y -> w (D v y sig) yv -> y+asTypeOfAmplitude = const
+ src/Synthesizer/Dimensional/Arrow.hs view
@@ -0,0 +1,140 @@+{- |+Adaption of "Control.Arrow" to signal processes involving amplitudes.+This class unifies "Synthesizer.Dimensional.Map"+and "Synthesizer.Dimensional.Causal.Process".+-}+module Synthesizer.Dimensional.Arrow where++import qualified Synthesizer.Dimensional.Map as Map+import Data.Tuple.HT (mapFst, mapSnd, mapPair, )++import qualified Prelude as P+import Prelude hiding (map, id, fst, snd, )+++class C arrow where+   map ::+      Map.T amp0 amp1 yv0 yv1 ->+      arrow amp0 amp1 yv0 yv1+   (>>>) ::+      arrow amp0 amp1 yv0 yv1 ->+      arrow amp1 amp2 yv1 yv2 ->+      arrow amp0 amp2 yv0 yv2+   first ::+      arrow amp0 amp1 yv0 yv1 ->+      arrow (amp0, amp) (amp1, amp) (yv0, yv) (yv1, yv)+   second ::+      arrow amp0 amp1 yv0 yv1 ->+      arrow (amp, amp0) (amp, amp1) (yv, yv0) (yv, yv1)+   (***) ::+      arrow amp0 amp1 yv0 yv1 ->+      arrow amp2 amp3 yv2 yv3 ->+      arrow (amp0, amp2) (amp1, amp3) (yv0, yv2) (yv1, yv3)+   (&&&) ::+      arrow amp amp0 yv yv0 ->+      arrow amp amp1 yv yv1 ->+      arrow amp (amp0, amp1) yv (yv0, yv1)++   {-# INLINE second #-}+   second arr = Map.swap ^<< first arr <<^ Map.swap+   {-# INLINE (***) #-}+   f *** g = first f <<< second g+   {-# INLINE (&&&) #-}+   f &&& g = f***g <<^ Map.double+++instance C Map.T where+   map = P.id+   (Map.Cons f) >>> (Map.Cons g) =+      Map.Cons $ \x ->+         let (y, h) = f x+             (z, k) = g y+         in  (z, k . h)+   first (Map.Cons f) =+      Map.Cons $ \(x,z) ->+         let (y, g) = f x+         in  ((y,z), mapFst g)+   second (Map.Cons f) =+      Map.Cons $ \(z,x) ->+         let (y, g) = f x+         in  ((z,y), mapSnd g)+   (Map.Cons f) *** (Map.Cons g) =+      Map.Cons $ \(x,y) ->+         let (z, h) = f x+             (w, k) = g y+         in  ((z,w), mapPair (h,k))+   (Map.Cons f) &&& (Map.Cons g) =+      Map.Cons $ \x ->+         let (y, h) = f x+             (z, k) = g x+         in  ((y,z), \s -> (h s, k s))+++infixr 3 ***+infixr 3 &&&+infixr 1 >>>, ^>>, >>^+infixr 1 <<<, ^<<, <<^+++{-# INLINE compose #-}+compose :: (C arrow) =>+   arrow amp0 amp1 yv0 yv1 ->+   arrow amp1 amp2 yv1 yv2 ->+   arrow amp0 amp2 yv0 yv2+compose = (>>>)++{-# INLINE (<<<) #-}+(<<<) :: (C arrow) =>+   arrow amp1 amp2 yv1 yv2 ->+   arrow amp0 amp1 yv0 yv1 ->+   arrow amp0 amp2 yv0 yv2+(<<<) = flip (>>>)+++{-# INLINE split #-}+split :: (C arrow) =>+   arrow amp0 amp1 yv0 yv1 ->+   arrow amp2 amp3 yv2 yv3 ->+   arrow (amp0, amp2) (amp1, amp3) (yv0, yv2) (yv1, yv3)+split = (***)++{-# INLINE fanout #-}+fanout :: (C arrow) =>+   arrow amp amp0 yv yv0 ->+   arrow amp amp1 yv yv1 ->+   arrow amp (amp0, amp1) yv (yv0, yv1)+fanout = (&&&)++-- * map functions++{-# INLINE (^>>) #-}+-- | Precomposition with a pure function.+(^>>) :: (C arrow) =>+   Map.T amp0 amp1 yv0 yv1 ->+   arrow amp1 amp2 yv1 yv2 ->+   arrow amp0 amp2 yv0 yv2+f ^>> a = map f >>> a++{-# INLINE (>>^) #-}+-- | Postcomposition with a pure function.+(>>^) :: (C arrow) =>+   arrow amp0 amp1 yv0 yv1 ->+   Map.T amp1 amp2 yv1 yv2 ->+   arrow amp0 amp2 yv0 yv2+a >>^ f = a >>> map f++{-# INLINE (<<^) #-}+-- | Precomposition with a pure function (right-to-left variant).+(<<^) :: (C arrow) =>+   arrow amp1 amp2 yv1 yv2 ->+   Map.T amp0 amp1 yv0 yv1 ->+   arrow amp0 amp2 yv0 yv2+a <<^ f = a <<< map f++{-# INLINE (^<<) #-}+-- | Postcomposition with a pure function (right-to-left variant).+(^<<) :: (C arrow) =>+   Map.T amp1 amp2 yv1 yv2 ->+   arrow amp0 amp1 yv0 yv1 ->+   arrow amp0 amp2 yv0 yv2+f ^<< a = map f <<< a
+ src/Synthesizer/Dimensional/Causal/ControlledProcess.hs view
@@ -0,0 +1,502 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Rank2Types #-}+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes (Flat)+++Basic definitions for causal signal processors+which are controlled by another signal.+Additionally to "Synthesizer.Dimensional.ControlledProcess"+you can convert those processes to plain causal processes+in the case of equal audio and control rates (synchronous control).++It is sensible to bundle the functions+"computation of internal parameters" and+"running the main process",+since computation of the internal parameters+depends on the sample rate of the main process+in case of frequency control values+even though the computation of internal parameters happens+at a different sample rate.++ToDo:+ - Is it better to provide the conversion method not by a record+   but by a type class?+   The difficulty with this is,+   how to handle global parameters like the filter order?+ - Note, that parameters might be computed by different ways.+   Thus a type class with functional dependencies+   for automatic selection of input types and conversion+   will not always be flexible enough.+ - Is it possible and reasonable to hide the type parameter+   for the internal control parameter+   since the user does not need to know it?+ - The internal parameters that the converter generate+   usually depend on the sample rate of the (target) audio signal.+   However, it does not depend on the sample rate of control signal+   where it is applied to.+   How can we ensure that it is not used somewhere else?+   We could discourage access to it at all.+   But it might be sensible to define new external parameters+   in terms of existing ones.+   We could add a phantom 's' type parameter+   to internal control parameters.+   Would this do the trick? Is this convenient?+-}+module Synthesizer.Dimensional.Causal.ControlledProcess where++import qualified Synthesizer.Dimensional.Process as Proc+import qualified Synthesizer.Dimensional.Rate as Rate+import qualified Synthesizer.Dimensional.RatePhantom as RP+import qualified Synthesizer.Dimensional.RateWrapper as SigP+import qualified Synthesizer.Dimensional.Straight.Signal as SigS+import qualified Synthesizer.Dimensional.Straight.Displacement as DispS+import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Causal.Process as CausalD+import qualified Synthesizer.Dimensional.Map as MapD+import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Causal.Process       as Causal+import qualified Synthesizer.Causal.Interpolation as Interpolation+import qualified Synthesizer.Interpolation.Class as Interpol+import qualified Synthesizer.State.Signal as Sig+import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++-- import Synthesizer.Dimensional.Process (($:), ($#), )+-- import Synthesizer.Dimensional.RateAmplitude.Signal (($-))++-- import Number.DimensionTerm ((*&), ) -- ((&*&), (&/&))++import qualified Algebra.RealField      as RealField+-- import qualified Algebra.Field          as Field+-- import qualified Algebra.Ring           as Ring+import qualified Algebra.Additive       as Additive++import Foreign.Storable.Newtype as Store+import Foreign.Storable (Storable(..))++import NumericPrelude+import PreludeBase as P+++{- |+This is quite analogous to Dimensional.Causal.Process+but adds the @conv@ parameter for conversion+from intuitive external parameters to internal parameters.+-}+data T conv proc = Cons {+      converter :: conv,+      processor :: proc+   }+++{- |+The Functor instance allows+to define an allpass phaser as ControlledProcess,+reusing the allpass cascade provided as ControlledProcess.+It is also possible to define a lowpass filter+with resonance as ControlledProcess+based on the universal filter ControlledProcess.+-}+instance Functor (T conv) where+   fmap f proc =+      Cons (converter proc) (f $ processor proc)++{- |+@ecAmp@ is a set of physical units for the external control parameters,+@ec@ is the type for the external control parameters,+@ic@ for internal control parameters.+-}+type Converter s ecAmp ec ic =+   MapD.T ecAmp Amp.Flat ec (RateDep s ic)++newtype RateDep s ic = RateDep {unRateDep :: ic}++instance Interpol.C a ic => Interpol.C a (RateDep s ic) where+   scaleAndAccumulate =+      Interpol.makeMac RateDep unRateDep++instance Storable ic => Storable (RateDep s ic) where+   sizeOf = Store.sizeOf unRateDep+   alignment = Store.alignment unRateDep+   peek = Store.peek RateDep+   poke = Store.poke unRateDep+++{- |+This function is intended for implementing high-level dimensional processors+from low-level processors.+It introduces the sample rate tag @s@.+-}+{-# INLINE makeConverter #-}+makeConverter ::+   (ecAmp -> ec -> ic) -> Converter s ecAmp ec ic+makeConverter f =+   MapD.Cons $ (,) Amp.Flat . (RateDep.) . f++{-# INLINE causalFromConverter #-}+causalFromConverter ::+   Converter s ecAmp ec ic ->+   CausalD.T s ecAmp CausalD.Flat ec (RateDep s ic)+causalFromConverter = CausalD.map+++{-# INLINE joinSynchronousPlain #-}+joinSynchronousPlain ::+   T (Converter s ecAmp ec ic)+     (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut) ->+   CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut+joinSynchronousPlain p =+   processor p CausalD.<<<+   MapD.swap CausalD.^<<+   CausalD.first (causalFromConverter (converter p))++{-# INLINE joinSynchronous #-}+joinSynchronous ::+   Proc.T s u t+      (T (Converter s ecAmp ec ic)+         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+   Proc.T s u t (CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut)+joinSynchronous cp =+   fmap joinSynchronousPlain cp+++{-# INLINE joinFirstSynchronousPlain #-}+joinFirstSynchronousPlain ::+   T (Converter s ecAmp ec ic, a)+     (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut) ->+   T a+     (CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut)+joinFirstSynchronousPlain p =+   Cons {+      converter = snd (converter p),+      processor = joinSynchronousPlain (Cons (fst (converter p)) (processor p))+   }++{-+With this signature we deconstruct a right biased pair tree in the ampIn parameter of T+and build a left biased pair tree in the corresponding output parameter.+We could also use a pair of heterogeneous lists.+But the effect is always, that the list is reversed.+-}+{-# INLINE joinFirstSynchronous #-}+joinFirstSynchronous ::+   Proc.T s u t+      (T (Converter s ecAmp ec ic, a)+         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+   Proc.T s u t+      (T a+         (CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut))+joinFirstSynchronous cp =+   fmap joinFirstSynchronousPlain cp++{-+{-# INLINE runSynchronous #-}+runSynchronous ::+   Proc.T s u t (T s (Convert ecAmp ec ic) (CausalD.Flat, ampIn) ampOut (RateDep s ic, sampIn) sampOut) ->+   Proc.T s u t (CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut)+runSynchronous cp =+   do p <- cp+      return (processor p . converter p)+-}++{-# INLINE runSynchronous1 #-}+runSynchronous1 :: (Dim.C v) =>+   Proc.T s u t+      (T (Converter s (DN.T v ecAmp) ec ic)+         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+   Proc.T s u t+      (SigA.R s v ecAmp ec -> CausalD.T s ampIn ampOut sampIn sampOut)+runSynchronous1 =+   fmap CausalD.applyFst . joinSynchronous+++{-# INLINE runSynchronousPlain2 #-}+runSynchronousPlain2 :: (Dim.C v0, Dim.C v1) =>+   (T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)+      (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+   (SigA.R s v0 ecAmp0 ec0 ->+    SigA.R s v1 ecAmp1 ec1 ->+    CausalD.T s ampIn ampOut sampIn sampOut)+runSynchronousPlain2 causal =+   let causalPairs =+          joinSynchronousPlain causal CausalD.<<^ MapD.balanceLeft+   in  \x y ->+          (causalPairs `CausalD.applyFst` x) `CausalD.applyFst` y++{-# INLINE runSynchronous2 #-}+runSynchronous2 :: (Dim.C v0, Dim.C v1) =>+   Proc.T s u t+      (T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)+         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+   Proc.T s u t+      (SigA.R s v0 ecAmp0 ec0 ->+       SigA.R s v1 ecAmp1 ec1 ->+       CausalD.T s ampIn ampOut sampIn sampOut)+runSynchronous2 cp =+   fmap runSynchronousPlain2 cp++{-+{-# INLINE runSynchronous3 #-}+runSynchronous3 ::+   Proc.T s u t (T s (RP.T s sig0 ec0, RP.T s sig1 ec1, RP.T s sig2 ec2) ic a) ->+   Proc.T s u t (RP.T s sig0 ec0 -> RP.T s sig1 ec1 -> RP.T s sig2 ec2 -> a)+runSynchronous3 =+   fmap (\f x y z -> f (x,y,z)) . runSynchronous+-}+++{-# INLINE runAsynchronous #-}+runAsynchronous ::+   (Dim.C u, RealField.C t) =>+   Interpolation.T t (RateDep s ic) ->+   Proc.T s u t+      (T (Converter s ecAmp ec ic)+         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+   Rate.T r u t ->+   SigS.R r (RateDep s ic) ->+   Proc.T s u t+      (CausalD.T s ampIn ampOut sampIn sampOut)+runAsynchronous ip cp srcRate sig =+   do p <- cp+      k <- fmap+              (DN.divToScalar (Rate.toDimensionNumber srcRate))+              Proc.getSampleRate+      return $+         CausalD.applyFlatFst (processor p CausalD.<<^ MapD.swap) $+         RP.fromSignal $+         Causal.apply+            (Interpolation.relativeConstantPad ip zero (SigS.toSamples sig))+            (Sig.repeat k)++{-# INLINE runAsynchronousBuffered #-}+runAsynchronousBuffered ::+   (Dim.C u, RealField.C t) =>+   Interpolation.T t (RateDep s ic) ->+   Proc.T s u t+      (T (Converter s ecAmp ec ic)+         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+   Rate.T r u t ->+   SigS.R r (RateDep s ic) ->+   Proc.T s u t+      (CausalD.T s ampIn ampOut sampIn sampOut)+runAsynchronousBuffered ip cp srcRate sig =+   do p <- cp+      k <- fmap+              (DN.divToScalar (Rate.toDimensionNumber srcRate))+              Proc.getSampleRate+      return $+         CausalD.applyFlatFst (processor p CausalD.<<^ MapD.swap) $+         RP.fromSignal $+         Causal.apply+            (Interpolation.relativeConstantPad ip zero+                (Sig.fromList $ Sig.toList $ SigS.toSamples sig))+            (Sig.repeat k)+++{-# INLINE applyConverter1 #-}+applyConverter1 :: (Dim.C v) =>+   Converter s (DN.T v ecAmp) ec ic ->+   SigA.R s v ecAmp ec -> SigS.R s (RateDep s ic)+applyConverter1 (MapD.Cons f) x =+   DispS.map (snd $ f (SigA.amplitude x)) (SigA.phantomSignal x)++{-# INLINE runAsynchronous1 #-}+runAsynchronous1 ::+   (Dim.C u, Dim.C v, RealField.C t) =>+   Interpolation.T t (RateDep s ic) ->+   Proc.T s u t+      (T (Converter s (DN.T v ecAmp) ec ic)+         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+   SigP.T u t (SigA.S v ecAmp) ec ->+   Proc.T s u t+      (CausalD.T s ampIn ampOut sampIn sampOut)+runAsynchronous1 ip cp x =+   let (srcRate,sig) = SigP.toSignal x+   in  do p <- cp+          runAsynchronous ip cp srcRate (applyConverter1 (converter p) sig)++{-# INLINE processAsynchronous1 #-}+processAsynchronous1 ::+   (Dim.C u, Dim.C v, RealField.C t) =>+   Interpolation.T t (RateDep s ic) ->+   Proc.T s u t+      (T (Converter s (DN.T v ecAmp) ec ic)+         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+   DN.T (Dim.Recip u) t ->+   (forall r. Proc.T r u t (SigA.R r v ecAmp ec)) ->+   Proc.T s u t+      (CausalD.T s ampIn ampOut sampIn sampOut)+processAsynchronous1 ip cp rate x =+   let sig = RP.fromSignal $ Proc.run rate (fmap RP.toSignal x)+   in  do p <- cp+          runAsynchronous ip cp (Rate.fromDimensionNumber rate)+             (applyConverter1 (converter p) sig)+++{-# INLINE applyConverter2 #-}+applyConverter2 :: (Dim.C v0, Dim.C v1) =>+   Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic ->+   SigA.R s v0 ecAmp0 ec0 ->+   SigA.R s v1 ecAmp1 ec1 ->+   SigS.R s (RateDep s ic)+applyConverter2 (MapD.Cons f) x y =+   SigS.fromSamples $+   Sig.map (snd $ f (SigA.amplitude x, SigA.amplitude y)) $+   Sig.zip (SigA.samples x) (SigA.samples y)++{- |+Using two SigP.T's as input has the disadvantage+that their rates must be compared dynamically.+It is not possible with our data structures+to use one rate for multiple signals.+We could also allow the input of a Rate.T and two Proc.T's,+since this is the form we get from the computation routines.+But this way we lose sharing.+-}+{-# INLINE runAsynchronous2 #-}+runAsynchronous2 ::+   (Dim.C u, Dim.C v0, Dim.C v1, RealField.C t) =>+   Interpolation.T t (RateDep s ic) ->+   Proc.T s u t+      (T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)+         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+   SigP.T u t (SigA.S v0 ecAmp0) ec0 ->+   SigP.T u t (SigA.S v1 ecAmp1) ec1 ->+   Proc.T s u t+      (CausalD.T s ampIn ampOut sampIn sampOut)+runAsynchronous2 ip cp x y =+   let (srcRateX,sigX) = SigP.toSignal x+       (srcRateY,sigY) = SigP.toSignal y+       srcRate = Rate.common "ControlledProcess.runAsynchronous2" srcRateX srcRateY+   in  do p <- cp+          runAsynchronous ip cp srcRate+             (applyConverter2 (converter p) sigX sigY)+++{- |+This function will be more commonly used than 'runAsynchronous2',+but it disallows sharing of control signals.+It can be easily defined in terms of 'runAsynchronous2' and 'SigP.runProcess',+but the implementation here does not need the check for equal sample rates.+-}+{-# INLINE processAsynchronous2 #-}+processAsynchronous2 ::+   (Dim.C u, Dim.C v0, Dim.C v1, RealField.C t) =>+   Interpolation.T t (RateDep s ic) ->+   Proc.T s u t+      (T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)+         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+   DN.T (Dim.Recip u) t ->+   (forall r. Proc.T r u t (SigA.R r v0 ecAmp0 ec0)) ->+   (forall r. Proc.T r u t (SigA.R r v1 ecAmp1 ec1)) ->+   Proc.T s u t+      (CausalD.T s ampIn ampOut sampIn sampOut)+processAsynchronous2 ip cp rate x y =+   let sigX = RP.fromSignal $ Proc.run rate (fmap RP.toSignal x)+       sigY = RP.fromSignal $ Proc.run rate (fmap RP.toSignal y)+   in  do p <- cp+          runAsynchronous ip cp (Rate.fromDimensionNumber rate)+             (applyConverter2 (converter p) sigX sigY)+++{-# INLINE processAsynchronousNaive2 #-}+processAsynchronousNaive2 ::+   (Dim.C u, Dim.C v0, Dim.C v1, RealField.C t) =>+   Interpolation.T t (RateDep s ic) ->+   Proc.T s u t+      (T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)+         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+   DN.T (Dim.Recip u) t ->+   (forall r. Proc.T r u t (SigA.R r v0 ecAmp0 ec0)) ->+   (forall r. Proc.T r u t (SigA.R r v1 ecAmp1 ec1)) ->+   Proc.T s u t+      (CausalD.T s ampIn ampOut sampIn sampOut)+processAsynchronousNaive2 ip cp rate x y =+   runAsynchronous2 ip cp+      (SigP.runProcess rate x) (SigP.runProcess rate y)+++{-+This uses lazy StorableVector for buffering+of the internal control parameters.+This increases laziness granularity,+but it should be faster, since interpolation needs frequent look-ahead,+and this is faster on a Storable signal than on a plain stateful signal generator.+Since the look-ahead is constant,+it is interesting whether interpolation can be made more efficient+without Storable.++{-# INLINE processAsynchronousStorable2 #-}+processAsynchronousStorable2 ::+   (Dim.C u, Dim.C v0, Dim.C v1, Storable ic, RealField.C t) =>+   Interpolation.T t (RateDep s ic) ->+   Proc.T s u t+      (T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)+         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+   DN.T (Dim.Recip u) t ->+   (forall r. Proc.T r u t (SigA.R r v0 ecAmp0 ec0)) ->+   (forall r. Proc.T r u t (SigA.R r v1 ecAmp1 ec1)) ->+   Proc.T s u t+      (CausalD.T s ampIn ampOut sampIn sampOut)+processAsynchronousStorable2 ip cp rate x y =+   let sigX = RP.fromSignal $ Proc.run rate (fmap RP.toSignal x)+       sigY = RP.fromSignal $ Proc.run rate (fmap RP.toSignal y)+   in  do p <- cp+          runAsynchronous ip cp (Rate.fromDimensionNumber rate)+             (applyConverter2 (converter p) sigX sigY)+-}++{- |+This buffers internal control parameters before interpolation.+This should be faster, since interpolation needs frequent look-ahead,+and this is faster on a buffered signal than on a plain stateful signal generator.++Since the look-ahead is constant,+it is interesting whether interpolation can be made more efficient+without the inefficient intermediate list structure.+-}+{-# INLINE processAsynchronousBuffered2 #-}+processAsynchronousBuffered2 ::+   (Dim.C u, Dim.C v0, Dim.C v1, RealField.C t) =>+   Interpolation.T t (RateDep s ic) ->+   Proc.T s u t+      (T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)+         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+   DN.T (Dim.Recip u) t ->+   (forall r. Proc.T r u t (SigA.R r v0 ecAmp0 ec0)) ->+   (forall r. Proc.T r u t (SigA.R r v1 ecAmp1 ec1)) ->+   Proc.T s u t+      (CausalD.T s ampIn ampOut sampIn sampOut)+processAsynchronousBuffered2 ip cp rate x y =+   let sigX = RP.fromSignal $ Proc.run rate (fmap RP.toSignal x)+       sigY = RP.fromSignal $ Proc.run rate (fmap RP.toSignal y)+   in  do p <- cp+          runAsynchronousBuffered ip cp (Rate.fromDimensionNumber rate)+             (applyConverter2 (converter p) sigX sigY)+++{-+{-# INLINE runAsynchronous3 #-}+runAsynchronous3 ::+   (Dim.C u, RealField.C t) =>+   Interpolation.T t (RateDep s ic) ->+   Proc.T s u t (T s (RP.T r sig0 ec0, RP.T r sig1 ec1, RP.T r sig2 ec2) ic a) ->+   SigP.T u t sig0 ec0 ->+   SigP.T u t sig1 ec1 ->+   SigP.T u t sig2 ec2 ->+   Proc.T s u t a+runAsynchronous3 ip cp x y z =+   let (srcRateX,sigX) = SigP.toSignal x+       (srcRateY,sigY) = SigP.toSignal y+       (srcRateZ,sigZ) = SigP.toSignal z+       common = Rate.common "ControlledProcess.runAsynchronous3"+       srcRate = srcRateX `common` srcRateY `common` srcRateZ+   in  runAsynchronous ip cp srcRate (sigX,sigY,sigZ)+-}
+ src/Synthesizer/Dimensional/Causal/Displacement.hs view
@@ -0,0 +1,192 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Dimensional.Causal.Displacement (+   mix, mixVolume,+   fanoutAndMixMulti, fanoutAndMixMultiVolume,+   raise, distort,+   ) where++import qualified Synthesizer.Dimensional.Process as Proc++import qualified Synthesizer.Dimensional.Causal.Process as CausalD+import qualified Synthesizer.Causal.Process as Causal+import Control.Arrow ((^<<), (&&&), )++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import qualified Algebra.Module         as Module+import qualified Algebra.Field          as Field+import qualified Algebra.Real           as Real+-- import qualified Algebra.Ring           as Ring+-- import qualified Algebra.Additive       as Additive++-- import Algebra.Module ((*>))++import Control.Monad.Trans.Reader (Reader, runReader, ask, )++import PreludeBase+import NumericPrelude+import Prelude ()+++{- * Mixing -}++{- |+Mix two signals.+In contrast to 'zipWith' the result has the length of the longer signal.+-}+{-# INLINE mix #-}+mix :: (Real.C y, Field.C y, Module.C y yv, Dim.C v) =>+   Proc.T s u t (CausalD.T s (DN.T v y, DN.T v y) (DN.T v y) (yv,yv) yv)+mix =+   Proc.pure $+   fromAmplitudeReader $ \(amp0,amp1) ->+      (DN.abs amp0 + DN.abs amp1, mixCore amp0 amp1)++{-# INLINE mixVolume #-}+mixVolume ::+   (Field.C y, Module.C y yv, Dim.C v) =>+   DN.T v y ->+   Proc.T s u t (CausalD.T s (DN.T v y, DN.T v y) (DN.T v y) (yv,yv) yv)+mixVolume amp =+   Proc.pure $+   fromAmplitudeReader $ \(amp0,amp1) ->+      (amp, mixCore amp0 amp1)++{-# INLINE mixCore #-}+mixCore ::+   (Field.C y, Module.C y yv, Dim.C v) =>+   DN.T v y -> DN.T v y ->+   Reader (DN.T v y) (Causal.T (yv,yv) yv)+mixCore amp0 amp1 =+   do toSamp0 <- toAmplitudeVector amp0+      toSamp1 <- toAmplitudeVector amp1+      return $+         Causal.map (\(y0,y1) -> toSamp0 y0 + toSamp1 y1)++{- |+Mix one or more signals.+-}+{-# INLINE fanoutAndMixMulti #-}+fanoutAndMixMulti ::+   (Real.C y, Field.C y, Module.C y yv, Dim.C v) =>+   [Proc.T s u t (CausalD.T s ampIn (DN.T v y) yvIn yv)] ->+   Proc.T s u t (CausalD.T s ampIn (DN.T v y) yvIn yv)+fanoutAndMixMulti =+   fmap fanoutAndMixMultiPlain . sequence++{-# INLINE fanoutAndMixMultiPlain #-}+fanoutAndMixMultiPlain ::+   (Real.C y, Field.C y, Module.C y yv, Dim.C v) =>+   [CausalD.T s ampIn (DN.T v y) yvIn yv] ->+   CausalD.T s ampIn (DN.T v y) yvIn yv+fanoutAndMixMultiPlain cs =+   fromAmplitudeReader $ \ampIn ->+      let ampCs = map (\(CausalD.Cons f) -> f ampIn) cs+      in  (maximum (map fst ampCs),+           fanoutAndMixMultiVolumeCore ampCs)++{-# INLINE fanoutAndMixMultiVolume #-}+fanoutAndMixMultiVolume ::+   (Field.C y, Module.C y yv, Dim.C v) =>+   DN.T v y ->+   [Proc.T s u t (CausalD.T s ampIn (DN.T v y) yvIn yv)] ->+   Proc.T s u t (CausalD.T s ampIn (DN.T v y) yvIn yv)+fanoutAndMixMultiVolume amp =+   fmap (fanoutAndMixMultiVolumePlain amp) . sequence++{-# INLINE fanoutAndMixMultiVolumePlain #-}+fanoutAndMixMultiVolumePlain ::+   (Field.C y, Module.C y yv, Dim.C v) =>+   DN.T v y ->+   [CausalD.T s ampIn (DN.T v y) yvIn yv] ->+   CausalD.T s ampIn (DN.T v y) yvIn yv+fanoutAndMixMultiVolumePlain amp cs =+   fromAmplitudeReader $ \ampIn ->+      (amp, fanoutAndMixMultiVolumeCore $+               map (\(CausalD.Cons f) -> f ampIn) cs)++{-# INLINE fanoutAndMixMultiVolumeCore #-}+fanoutAndMixMultiVolumeCore ::+   (Field.C y, Module.C y yv, Dim.C v) =>+   [(DN.T v y, Causal.T yvIn yv)] ->+   Reader (DN.T v y) (Causal.T yvIn yv)+fanoutAndMixMultiVolumeCore cs =+   foldr+      (\(ampX,c) acc ->+         do toSamp <- toAmplitudeVector ampX+            rest   <- acc+            return $ uncurry (+) ^<< (toSamp ^<< c) &&& rest)+      (return $ Causal.map (const zero)) cs+++{- |+Add a number to all of the signal values.+This is useful for adjusting the center of a modulation.+-}+{-# INLINE raise #-}+raise :: (Field.C y, Module.C y yv, Dim.C v) =>+   DN.T v y ->+   yv ->+   Proc.T s u t (CausalD.T s (DN.T v y) (DN.T v y) yv yv)+raise y' yv =+   Proc.pure $+   fromAmplitudeReader $ \amp ->+      (amp, do toSamp <- toAmplitudeVector y'+               return $ Causal.map (toSamp yv +))++{- |+Distort the signal using a flat function.+The first signal gives the scaling of the function.+If the scaling is c and the input sample is y,+then @c * f(y/c)@ is output.+This way we can use an (efficient) flat function+and have a simple, yet dimension conform, way of controlling the distortion.+E.g. if the distortion function is @tanh@+then the value @c@ controls the saturation level.+-}+{-# INLINE distort #-}+distort :: (Field.C y, Module.C y yv, Dim.C v) =>+   (yv -> yv) ->+   Proc.T s u t (CausalD.T s (DN.T v y, DN.T v y) (DN.T v y) (y,yv) yv)+distort f =+   Proc.pure $+   fromAmplitudeReader $ \(ampCtrl,ampIn) ->+      (ampIn, do toSamp <- toAmplitudeScalar ampCtrl+                 return $+                    Causal.map (\(c,y) ->+                       let c' = toSamp c+                       in  c' *> f (recip c' *> y)))+++{-# INLINE toAmplitudeScalar #-}+toAmplitudeScalar ::+   (Field.C y, Dim.C u) =>+   DN.T u y -> Reader (DN.T u y) (y -> y)+toAmplitudeScalar ampIn =+   do ampOut <- ask+      return (DN.divToScalar ampIn ampOut *)++{-# INLINE toAmplitudeVector #-}+toAmplitudeVector ::+   (Module.C y yv, Field.C y, Dim.C u) =>+   DN.T u y -> Reader (DN.T u y) (yv -> yv)+toAmplitudeVector ampIn =+   do ampOut <- ask+      return (DN.divToScalar ampIn ampOut *> )++{-# INLINE fromAmplitudeReader #-}+fromAmplitudeReader ::+   (ampIn -> (ampOut, Reader ampOut (Causal.T yv0 yv1))) ->+   CausalD.T s ampIn ampOut yv0 yv1+fromAmplitudeReader f =+   CausalD.Cons $ \ampIn ->+      let (ampOut, rd) = f ampIn+      in  (ampOut, runReader rd ampOut)
+ src/Synthesizer/Dimensional/Causal/Filter.hs view
@@ -0,0 +1,708 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Dimensional.Causal.Filter (+   {- * Non-recursive -}++   {- ** Amplification -}+   amplify,+   amplifyDimension,+   negate,+   envelope,+   envelopeVector,+   envelopeVectorDimension,++   {- ** Filter operators from calculus -}+   differentiate,++{-+   {- ** Smooth -}+   meanStatic,+   mean,++   {- ** Delay -}+   delay,+   phaseModulation,+   frequencyModulation,+   frequencyModulationDecoupled,+   phaser,+   phaserStereo,+-}+++   {- * Recursive -}+   ResonantFilter,+   FrequencyFilter,++   {- ** Without resonance -}+   firstOrderLowpass,+   firstOrderHighpass,++   butterworthLowpass,+   butterworthHighpass,+   chebyshevALowpass,+   chebyshevAHighpass,+   chebyshevBLowpass,+   chebyshevBHighpass,++   butterworthLowpassPole,+   butterworthHighpassPole,+   chebyshevALowpassPole,+   chebyshevAHighpassPole,+   chebyshevBLowpassPole,+   chebyshevBHighpassPole,++   {- ** With resonance -}+   universal,+   highpassFromUniversal,+   bandpassFromUniversal,+   lowpassFromUniversal,+   bandlimitFromUniversal,+   moogLowpass,++   {- ** Allpass -}+   allpassCascade,+   allpassPhaser,+   FiltR.allpassFlangerPhase,++{-+   {- ** Reverb -}+   comb,+   combProc,+-}++   {- ** Filter operators from calculus -}+   integrate,+) where++import qualified Synthesizer.Dimensional.Process as Proc+-- import qualified Synthesizer.Dimensional.Rate as Rate+import qualified Synthesizer.Dimensional.Causal.ControlledProcess as CCProc+import qualified Synthesizer.Dimensional.Causal.Process as CausalD+import qualified Synthesizer.Causal.Process as Causal+import Control.Arrow ((<<^), (^<<), (&&&), )++-- import Synthesizer.Dimensional.Process ((.:), (.^), )++-- import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat++-- import qualified Synthesizer.State.Signal as Sig+import qualified Synthesizer.Plain.Modifier as Modifier+import Synthesizer.Plain.Signal (Modifier)++import Synthesizer.Dimensional.RateAmplitude.Signal+   ({- toTimeScalar, -} toFrequencyScalar, DimensionGradient, )++import qualified Synthesizer.Dimensional.Rate.Filter as FiltR++-- import qualified Synthesizer.Interpolation as Interpolation+-- import qualified Synthesizer.State.Filter.Delay as Delay+import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder  as Filt1+import qualified Synthesizer.Plain.Filter.Recursive.Allpass     as Allpass+import qualified Synthesizer.Plain.Filter.Recursive.Universal   as UniFilter+import qualified Synthesizer.Plain.Filter.Recursive.Moog        as Moog+import qualified Synthesizer.Plain.Filter.Recursive.Butterworth as Butter+import qualified Synthesizer.Plain.Filter.Recursive.Chebyshev   as Cheby+import qualified Synthesizer.State.Filter.Recursive.Integration as Integrate+-- import qualified Synthesizer.State.Filter.Recursive.MovingAverage as MA+import qualified Synthesizer.Plain.Filter.Recursive    as FiltRec+-- import qualified Synthesizer.State.Filter.NonRecursive as FiltNR++-- import qualified Synthesizer.Generic.Filter.Recursive.Comb as Comb+-- import qualified Synthesizer.Dimensional.Causal.Displacement as DispC++import Synthesizer.Utility (affineComb, )++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import Number.DimensionTerm ((&*&), (&/&))++import qualified Number.NonNegative     as NonNeg++import qualified Algebra.Transcendental as Trans+-- import qualified Algebra.RealField      as RealField+import qualified Algebra.Field          as Field+-- import qualified Algebra.Real           as Real+import qualified Algebra.Ring           as Ring+import qualified Algebra.Additive       as Additive+-- import qualified Algebra.VectorSpace    as VectorSpace+import qualified Algebra.Module         as Module++import Foreign.Storable (Storable)++-- import Control.Monad(liftM2)++import Data.Tuple.HT (swap, mapFst, )++import NumericPrelude hiding (negate)+import PreludeBase as P+import Prelude ()+++{- | The amplification factor must be positive. -}+{-# INLINE amplify #-}+amplify :: (Module.C y amp) =>+   y ->+   Proc.T s u t (CausalD.T s amp amp yv yv)+amplify volume =+   Proc.pure $ CausalD.mapAmplitudeSameType (volume *>)++{-# INLINE amplifyDimension #-}+amplifyDimension :: (Ring.C y, Dim.C u, Dim.C v0, Dim.C v1) =>+   DN.T v0 y ->+   Proc.T s u t (CausalD.T s (DN.T v1 y) (DN.T (Dim.Mul v0 v1) y) yv yv)+amplifyDimension volume =+   Proc.pure $ CausalD.mapAmplitude (volume &*&)+++{-# INLINE negate #-}+negate :: (Additive.C yv) =>+   Proc.T s u t (CausalD.T s amp amp yv yv)+negate =+   Proc.pure $ homogeneousMap Additive.negate+++{-# INLINE envelope #-}+envelope :: (Ring.C y) =>+   Proc.T s u t (CausalD.T s (CausalD.Flat, amp) amp (y,y) y)+envelope =+   Proc.pure $ CausalD.Cons $ \(CausalD.Flat, amp) ->+      (amp, Causal.map (uncurry (*)))++{-# INLINE envelopeVector #-}+envelopeVector :: (Module.C y yv) =>+   Proc.T s u t (CausalD.T s (CausalD.Flat, amp) amp (y,yv) yv)+envelopeVector =+   Proc.pure $ CausalD.Cons $ \(CausalD.Flat, amp) ->+      (amp, Causal.map (uncurry (*>)))++{-# INLINE envelopeVectorDimension #-}+envelopeVectorDimension ::+   (Module.C y0 yv, Ring.C y, Dim.C u, Dim.C v0, Dim.C v1) =>+   Proc.T s u t+      (CausalD.T s (DN.T v0 y, DN.T v1 y) (DN.T (Dim.Mul v0 v1) y) (y0,yv) yv)+envelopeVectorDimension =+   Proc.pure $ CausalD.Cons $ \(ampEnv, ampSig) ->+      (ampEnv &*& ampSig, Causal.map (uncurry (*>)))+++{-# INLINE differentiate #-}+differentiate :: (Additive.C yv, Ring.C q, Dim.C u, Dim.C v) =>+   Proc.T s u q+      (CausalD.T s (DN.T v q) (DN.T (DimensionGradient u v) q) yv yv)+differentiate =+   do rate <- Proc.getSampleRate+      return $ CausalD.Cons $ \ amp ->+         (rate &*& amp,+          uncurry (-) ^<< Causal.id &&& Causal.consInit zero)+--          Causal.crochetL (\x0 x1 -> Just (x0-x1, x0)) zero)+++{-+{- | needs a good handling of boundaries, yet -}+{-# INLINE meanStatic #-}+meanStatic ::+   (RealField.C q, Module.C q yv, Dim.C u, Dim.C v) =>+      DN.T (Dim.Recip u) q   {- ^ cut-off freqeuncy -}+   -> Proc.T s u q (+        SigA.R s v q yv+     -> SigA.R s v q yv)+meanStatic time =+   FiltR.meanStatic time++meanStaticSeparateTY :: (Additive.C yv, Field.C y, RealField.C t,+         Module.C y yv, Dim.C u, Dim.C v) =>+      DN.T (Dim.Recip u) t   {- ^ cut-off freqeuncy -}+   -> Proc.T s u t (+        SigA.R s v y yv+     -> SigA.R s v y yv)+meanStaticSeparateTY time =+   -- FiltR.meanStatic time, means that 't' = 'y'+   do f <- toFrequencyScalar time+      return $ \ x ->+         let tInt  = round ((recip f - 1)/2)+             width = tInt*2+1+         in  SigA.processSamples+                ((SigA.asTypeOfAmplitude (recip (fromIntegral width)) x *> ) .+                 Delay.staticNeg tInt .+                 MA.sumsStaticInt width) x+++{- | needs a better handling of boundaries, yet -}+{-# INLINE mean #-}+mean :: (Additive.C yv, RealField.C q,+         Module.C q yv, Dim.C u, Dim.C v) =>+      DN.T (Dim.Recip u) q    {- ^ minimum cut-off freqeuncy -}+   -> Proc.T s u q (+        SigA.R s (Dim.Recip u) q q+                              {- v cut-off freqeuncies -}+     -> SigA.R s v q yv+     -> SigA.R s v q yv)+mean minFreq =+   FiltR.mean minFreq+++{-# INLINE delay #-}+delay :: (Additive.C yv, Field.C y, RealField.C t, Dim.C u, Dim.C v) =>+      DN.T u t+   -> Proc.T s u t (+        SigA.R s v y yv+     -> SigA.R s v y yv)+delay time =+   do t <- toTimeScalar time+      return $ SigA.processSamples (Delay.static (round t))+++{-# INLINE phaseModulation #-}+phaseModulation ::+   (Additive.C yv, RealField.C q, Dim.C u, Dim.C v,+    Sample.C q, Sample.C yv) =>+      Interpolation.T q yv+   -> DN.T u q+          {- ^ minDelay, minimal delay, may be negative -}+   -> DN.T u q+          {- ^ maxDelay, maximal delay, it must be @minDelay <= maxDelay@+               and the modulation must always be+               in the range [minDelay,maxDelay]. -}+   -> Proc.T s u q (+        SigA.R s u q q+          {- v delay control, positive numbers meanStatic delay,+               negative numbers meanStatic prefetch -}+     -> SigA.R s v q yv+     -> SigA.R s v q yv)+phaseModulation ip minDelay maxDelay =+   FiltR.phaseModulation ip minDelay maxDelay++{-# INLINE frequencyModulation #-}+frequencyModulation ::+   (Flat.C flat q, Additive.C yv, RealField.C q, Dim.C u, Dim.C v) =>+      Interpolation.T q yv+   -> Proc.T s u q (+        RP.T s flat q    {- v frequency factors -}+     -> SigA.R s v q yv+     -> SigA.R s v q yv)+frequencyModulation ip =+   Proc.pure $+      \ factors ->+          SigA.processSamples+             (FiltR.interpolateMultiRelativeZeroPad ip (Flat.toSamples factors))++{- |+Frequency modulation where the input signal can have a sample rate+different from the output.+(The sample rate values can differ, the unit must be the same.+We could lift that restriction,+but then the unit handling becomes more complicated,+and I didn't have a use for it so far.)++The function can be used for resampling.+-}+{-# INLINE frequencyModulationDecoupled #-}+frequencyModulationDecoupled ::+   (Flat.C flat q, Additive.C yv, RealField.C q, Dim.C u, Dim.C v) =>+      Interpolation.T q yv+   -> Proc.T s u q (+        RP.T s flat q    {- v frequency factors -}+     -> SigP.T u q (SigA.D v q SigS.S) yv+     -> SigA.R s v q yv)+frequencyModulationDecoupled ip =+   fmap+      (\toFreq factors y ->+         flip SigA.processSamples (RP.fromSignal (SigP.signal y)) $+            FiltR.interpolateMultiRelativeZeroPad ip+               (SigA.scalarSamples toFreq+                  (SigA.fromSamples (SigP.sampleRate y) (Flat.toSamples factors))))+      (Proc.withParam Proc.toFrequencyScalar)+++{- | symmetric phaser -}+{-# INLINE phaser #-}+phaser ::+   (Additive.C yv, RealField.C q,+    Module.C q yv, Dim.C u, Dim.C v,+    Sample.C q, Sample.C yv) =>+      Interpolation.T q yv+   -> DN.T u q  {- ^ maxDelay, must be positive -}+   -> Proc.T s u q (+        SigA.R s u q q+                {- v delay control -}+     -> SigA.R s v q yv+     -> SigA.R s v q yv)+phaser = FiltR.phaser++{-# INLINE phaserStereo #-}+phaserStereo ::+   (Additive.C yv, RealField.C q,+    Module.C q yv, Dim.C u, Dim.C v,+    Sample.C q, Sample.C yv) =>+      Interpolation.T q yv+   -> DN.T u q   {- ^ maxDelay, must be positive -}+   -> Proc.T s u q (+        SigA.R s u q q+                 {- v delay control -}+     -> SigA.R s v q yv+     -> SigA.R s v q (Stereo.T yv))+phaserStereo = FiltR.phaserStereo+-}+++type FrequencyFilter s u q ic amp yv0 yv1 =+   Proc.T s u q+      (CCProc.T+         (CCProc.Converter s+             (DN.T (Dim.Recip u) q)+             q     {- v signal for cut off and band center frequency -}+             ic)+         (CausalD.T s+             (amp, CausalD.Flat) amp+             (yv0, CCProc.RateDep s ic) yv1))++{-# INLINE firstOrderLowpass #-}+{-# INLINE firstOrderHighpass #-}+firstOrderLowpass, firstOrderHighpass ::+   (Trans.C q, Module.C q yv, Dim.C u) =>+   FrequencyFilter s u q (Filt1.Parameter q) amp yv yv+firstOrderLowpass  = firstOrderGen Filt1.lowpassModifier+firstOrderHighpass = firstOrderGen Filt1.highpassModifier++{-# INLINE firstOrderGen #-}+firstOrderGen ::+   (Trans.C q, Module.C q yv, Dim.C u) =>+      (Modifier yv (Filt1.Parameter q) yv yv)+--      (Sig.T (Filt1.Parameter q) -> Sig.T yv -> Sig.T yv)+   -> FrequencyFilter s u q (Filt1.Parameter q) amp yv yv+firstOrderGen modif =+   frequencyControl Filt1.parameter (Causal.fromSimpleModifier modif)++++{-# INLINE butterworthLowpass #-}+{-# INLINE butterworthHighpass #-}+{-# INLINE chebyshevALowpass #-}+{-# INLINE chebyshevAHighpass #-}+{-# INLINE chebyshevBLowpass #-}+{-# INLINE chebyshevBHighpass #-}++butterworthLowpass, butterworthHighpass ::+   (Trans.C a, Module.C a yv, Storable a, Storable yv, Dim.C u) =>+   NonNeg.Int   {- ^ Order of the filter, must be even,+                     the higher the order, the sharper is the separation of frequencies. -}  ->+   ResonantFilter s u a (Butter.Parameter a) amp yv yv++chebyshevALowpass, chebyshevAHighpass ::+   (Trans.C a, Module.C a yv, Storable a, Storable yv, Dim.C u) =>+   NonNeg.Int ->+   ResonantFilter s u a (Cheby.ParameterA a) amp yv yv++chebyshevBLowpass, chebyshevBHighpass ::+   (Trans.C a, Module.C a yv, Storable a, Storable yv, Dim.C u) =>+   NonNeg.Int ->+   ResonantFilter s u a (Cheby.ParameterB a) amp yv yv++butterworthLowpass  = higherOrderNoResoGen (Butter.parameter FiltRec.Lowpass)  Butter.causal+butterworthHighpass = higherOrderNoResoGen (Butter.parameter FiltRec.Highpass) Butter.causal+chebyshevALowpass   = higherOrderNoResoGen (Cheby.parameterA FiltRec.Lowpass)  Cheby.causalA+chebyshevAHighpass  = higherOrderNoResoGen (Cheby.parameterA FiltRec.Highpass) Cheby.causalA+chebyshevBLowpass   = higherOrderNoResoGen (Cheby.parameterB FiltRec.Lowpass)  Cheby.causalB+chebyshevBHighpass  = higherOrderNoResoGen (Cheby.parameterB FiltRec.Highpass) Cheby.causalB+++{- TODO:+initial value+-}+{-# INLINE higherOrderNoResoGen #-}+higherOrderNoResoGen ::+   (Field.C a, Module.C a yv, Storable a, Storable yv, Dim.C u) =>+   (Int -> FiltRec.Pole a -> param) ->+   (Int -> Causal.T (param, yv) yv) ->+   NonNeg.Int ->+   ResonantFilter s u a param amp yv yv++higherOrderNoResoGen mkParam causal order =+   let orderInt = NonNeg.toNumber order+   in  frequencyResonanceControl+          (mkParam orderInt)+          (causal orderInt)++++{-# INLINE butterworthLowpassPole #-}+{-# INLINE butterworthHighpassPole #-}+{-# INLINE chebyshevALowpassPole #-}+{-# INLINE chebyshevAHighpassPole #-}+{-# INLINE chebyshevBLowpassPole #-}+{-# INLINE chebyshevBHighpassPole #-}++butterworthLowpassPole, butterworthHighpassPole,+   chebyshevALowpassPole, chebyshevAHighpassPole,+   chebyshevBLowpassPole, chebyshevBHighpassPole ::+   (Trans.C q, Module.C q yv, Dim.C u) =>+   NonNeg.Int   {- ^ Order of the filter, must be even,+                     the higher the order, the sharper is the separation of frequencies. -}  ->+   ResonantFilter s u q (FiltRec.Pole q) amp yv yv++butterworthLowpassPole  = higherOrderNoResoGenPole Butter.lowpassCausalPole+butterworthHighpassPole = higherOrderNoResoGenPole Butter.highpassCausalPole+chebyshevALowpassPole   = higherOrderNoResoGenPole Cheby.lowpassACausalPole+chebyshevAHighpassPole  = higherOrderNoResoGenPole Cheby.highpassACausalPole+chebyshevBLowpassPole   = higherOrderNoResoGenPole Cheby.lowpassBCausalPole+chebyshevBHighpassPole  = higherOrderNoResoGenPole Cheby.highpassBCausalPole+++{- TODO:+initial value+-}+{-# INLINE higherOrderNoResoGenPole #-}+higherOrderNoResoGenPole ::+   (Field.C q, Dim.C u) =>+   (Int -> Causal.T (FiltRec.Pole q, yv) yv) ->+   NonNeg.Int ->+   ResonantFilter s u q (FiltRec.Pole q) amp yv yv++higherOrderNoResoGenPole filt order =+   let orderInt = NonNeg.toNumber order+   in  frequencyResonanceControl id (filt orderInt)+++++type ResonantFilter s u q ic amp yv0 yv1 =+   Proc.T s u q+      (CCProc.T+         (CCProc.Converter s+             (DN.Scalar q, DN.T (Dim.Recip u) q)+             (q,q)+                   {- v signal for resonance,+                        i.e. factor of amplification at the resonance frequency+                        relatively to the transition band. -}+                   {- v signal for cut off and band center frequency -}+             ic)+         (CausalD.T s+             (amp, CausalD.Flat) amp+             (yv0, CCProc.RateDep s ic) yv1))+++type ResonantFilterFlat s u q ic amp yv0 yv1 =+   Proc.T s u q+      (CCProc.T+         (CCProc.Converter s+             (CausalD.Flat, DN.T (Dim.Recip u) q)+             (q,q)+                   {- v signal for resonance,+                        i.e. factor of amplification at the resonance frequency+                        relatively to the transition band. -}+                   {- v signal for cut off and band center frequency -}+             ic)+         (CausalD.T s+             (amp, CausalD.Flat) amp+             (yv0, CCProc.RateDep s ic) yv1))++++{-# INLINE highpassFromUniversal #-}+{-# INLINE bandpassFromUniversal #-}+{-# INLINE lowpassFromUniversal #-}+{-# INLINE bandlimitFromUniversal #-}+highpassFromUniversal, lowpassFromUniversal,+  bandpassFromUniversal, bandlimitFromUniversal ::+   CausalD.T s amp amp (UniFilter.Result yv) yv+--   Proc.T s u q (CausalD.T s amp amp (UniFilter.Result yv) yv)+highpassFromUniversal  = homogeneousMap UniFilter.highpass+bandpassFromUniversal  = homogeneousMap UniFilter.bandpass+lowpassFromUniversal   = homogeneousMap UniFilter.lowpass+bandlimitFromUniversal = homogeneousMap UniFilter.bandlimit++homogeneousMap ::+   (yv0 -> yv1) ->+   CausalD.T s amp amp yv0 yv1+--   Proc.T s u t (CausalD.T s amp amp yv0 yv1)+homogeneousMap f =+   CausalD.homogeneous (Causal.map f)+--   Proc.pure (CausalD.homogeneous (Causal.map f))++{-# INLINE universal #-}+universal ::+   (Trans.C q, Module.C q yv, Dim.C u) =>+   ResonantFilter s u q (UniFilter.Parameter q) amp yv (UniFilter.Result yv)+universal =+   frequencyResonanceControl+      UniFilter.parameter+      UniFilter.causal++{-# INLINE moogLowpass #-}+moogLowpass ::+   (Trans.C q, Module.C q yv, Dim.C u) =>+      NonNeg.Int+   -> ResonantFilter s u q (Moog.Parameter q) amp yv yv+moogLowpass order =+   let orderInt = NonNeg.toNumber order+   in  frequencyResonanceControl+          (Moog.parameter orderInt)+          (Moog.lowpassCausal orderInt)+++{-# INLINE allpassCascade #-}+{- | the lowest comb frequency is used as the filter frequency -}+allpassCascade :: (Trans.C q, Module.C q yv, Dim.C u) =>+      NonNeg.Int  {- ^ order, number of filters in the cascade -}+   -> q           {- ^ the phase shift to be achieved for the given frequency -}+   -> FrequencyFilter s u q (Allpass.Parameter q) amp yv yv+allpassCascade order phase =+   let orderInt = NonNeg.toNumber order+   in  frequencyControl+          (Allpass.parameter orderInt phase)+          (Allpass.cascadeCausal orderInt)++{-# INLINE allpassPhaser #-}+{- |+We use the mixing ratio as resonance parameter.+Mixing ratio @r@ means:+Amplify input by @r@ and delayed signal by @1-r@.+Maximum effect is achieved for @r=0.5@.+-}+allpassPhaser :: (Trans.C q, Module.C q yv, Dim.C u) =>+      NonNeg.Int  {- ^ order, number of filters in the cascade -}+   -> ResonantFilter s u q (q, Allpass.Parameter q) amp yv yv+allpassPhaser order =+   let orderInt = NonNeg.toNumber order+   in  frequencyResonanceControl+          (\x ->+             (FiltRec.poleResonance x,+              Allpass.parameter orderInt Allpass.flangerPhase $+              FiltRec.poleFrequency x))+          (uncurry affineComb ^<<+           Causal.second (Causal.fanout+              (Allpass.cascadeCausal orderInt) (Causal.map snd))+            <<^ (\((r,p),x) -> (r,(p,x))))++{-+The handling of amplitudes is not efficient and the results may surprise.+Due to rounding errors the output amplitude may differ from input amplitude.+This problem can only be overcome by a specialised low-level routine.++allpassPhaser :: (Trans.C q, Module.C q yv, Dim.C u) =>+      NonNeg.Int  {- ^ order, number of filters in the cascade -}+   -> q           {- ^ mixing ratio @x@ means:+                       amplify input by @x@ and+                       amplify delayed signal by @1-x@.+                       Maximum effect is achieved for @x=0.5@. -}+   -> FrequencyFilter s u q (Allpass.Parameter q) amp yv yv+allpassPhaser order r =+-- incomplete+   fmap+      (fmap $ \ap ->+         mix CausalD.<<<+         CausalD.fanout+            (amplify r)+            (amplify (1-r) CausalD.<<< ap))+      (Filt.allpassCascade 20 Filt.allpassFlangerPhase)+-}+++{-# INLINE frequencyControl #-}+frequencyControl ::+   (Field.C q, Dim.C u) =>+   (q -> ic) ->+   Causal.T (ic, yv0) yv1 ->+   FrequencyFilter s u q ic amp yv0 yv1++frequencyControl mkParam filt =+   do toFreq <- Proc.withParam toFrequencyScalar+      return $ CCProc.Cons+         (CCProc.makeConverter $ \ freqAmp ->+            let k = toFreq freqAmp+            in  \ freq -> mkParam $ k*freq)+         (CausalD.Cons $ \ (xAmp, CausalD.Flat) ->+            (xAmp, filt <<^ mapFst CCProc.unRateDep . swap))+--         (\ params -> SigA.processSamples (filt params))+++{-# INLINE frequencyResonanceControl #-}+frequencyResonanceControl ::+   (Field.C q, Dim.C u) =>+   (FiltRec.Pole q -> ic) ->+   Causal.T (ic, yv0) yv1 ->+   ResonantFilter s u q ic amp yv0 yv1++frequencyResonanceControl mkParam filt =+   do toFreq <- Proc.withParam toFrequencyScalar+      return $ CCProc.Cons+         (CCProc.makeConverter $ \ (resoAmp, freqAmp) ->+            let k = toFreq freqAmp+            in  \ (reso, freq) -> mkParam $+                    FiltRec.Pole (DN.toNumber resoAmp * reso) (k*freq))+         (CausalD.Cons $ \ (xAmp, CausalD.Flat) ->+            (xAmp, filt <<^ mapFst CCProc.unRateDep . swap))+         -- CausalD.homogeneous almost fits, but it cannot handle the control input+++{-# INLINE frequencyResonanceControlFlat #-}+frequencyResonanceControlFlat ::+   (Field.C q, Dim.C u) =>+   (FiltRec.Pole q -> ic) ->+   Modifier.Simple state ic yv0 yv1 ->+   ResonantFilterFlat s u q ic amp yv0 yv1++frequencyResonanceControlFlat mkParam filt =+   do toFreq <- Proc.withParam toFrequencyScalar+      return $ CCProc.Cons+         (CCProc.makeConverter $ \ (CausalD.Flat, freqAmp) ->+            let k = toFreq freqAmp+            in  \ (reso, freq) ->+                    mkParam $ FiltRec.Pole reso (k*freq))+         (CausalD.Cons $ \ (xAmp, CausalD.Flat) ->+            (xAmp, Causal.fromSimpleModifier filt <<^ mapFst CCProc.unRateDep . swap))+         -- CausalD.homogeneous almost fits, but it cannot handle the control input+++{-+{- | Infinitely many equi-delayed exponentially decaying echos. -}+{-# INLINE comb #-}+comb :: (RealField.C t, Module.C y yv, Dim.C u, Dim.C v, Sample.C yv) =>+   DN.T u t -> y -> Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv)+comb = FiltR.comb+++{- | Infinitely many equi-delayed echos processed by an arbitrary time-preserving signal processor. -}+{-# INLINE combProc #-}+combProc ::+   (RealField.C t, Real.C y, Field.C y, Module.C y yv, Sample.C yv,+    Dim.C u, Dim.C v) =>+   DN.T u t ->+   Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv) ->+   Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv)+combProc time proc =+   do f <- proc+      t <- fmap round $ toTimeScalar time+      let chunkSize = SigSt.chunkSize t+      return $ \x ->+         SigA.processSamples+            (Sig.fromStorableSignal .+             Comb.runProc t+                (Sig.toStorableSignal chunkSize .+                 SigA.vectorSamples (SigA.toAmplitudeScalar x) .+                 f .+                 SigA.fromSamples (SigA.amplitude x) .+                 Sig.fromStorableSignal) .+             Sig.toStorableSignal chunkSize) x+-}+++{-# INLINE integrate #-}+integrate :: (Additive.C yv, Field.C q, Dim.C u, Dim.C v) =>+   Proc.T s u q+      (CausalD.T s (DN.T v q) (DN.T (Dim.Mul u v) q) yv yv)+integrate =+   do rate <- Proc.getSampleRate+      return $ CausalD.Cons $ \ amp ->+         (DN.rewriteDimension+              (Dim.commute . Dim.applyRightMul Dim.invertRecip) $+          amp &/& rate,+          Integrate.causal)
+ src/Synthesizer/Dimensional/Causal/Oscillator.hs view
@@ -0,0 +1,303 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE FlexibleContexts #-}+{- |+Copyright   :  (c) Henning Thielemann 2009+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++-}+module Synthesizer.Dimensional.Causal.Oscillator (+{-+   static,+   staticAntiAlias,+-}+   freqMod,+   freqModAntiAlias,+   phaseMod,+   phaseFreqMod,+   shapeMod,+   shapeFreqMod,+{-+   staticSample,+   freqModSample,+-}+--   shapeFreqModSample,+   shapeFreqModFromSampledTone,+   shapePhaseFreqModFromSampledTone,+   ) where++import qualified Synthesizer.Dimensional.Causal.Process as CausalD+import qualified Synthesizer.Causal.Process as Causal+import Control.Arrow ((<<^), (<<<), second, )++import qualified Synthesizer.Dimensional.Abstraction.HomogeneousGen as Hom+import qualified Synthesizer.Dimensional.RateWrapper as SigP+import qualified Synthesizer.Dimensional.Rate as Rate++import qualified Synthesizer.Causal.Oscillator as Osci++import qualified Synthesizer.Generic.Signal as SigG++import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth+import qualified Synthesizer.Basic.Wave         as Wave+import qualified Synthesizer.Basic.Phase        as Phase++-- import qualified Synthesizer.Dimensional.Straight.Signal as SigS+-- import qualified Synthesizer.Dimensional.Cyclic.Signal as SigC++-- import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Process as Proc+import Synthesizer.Dimensional.Process (toFrequencyScalar, )++import qualified Synthesizer.Interpolation as Interpolation++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim+-- import Number.DimensionTerm ((&*&))++import qualified Algebra.RealField          as RealField+import qualified Algebra.Field              as Field+import qualified Algebra.Ring               as Ring++import NumericPrelude+import PreludeBase as P+++{-+{- | oscillator with a functional waveform with constant frequency -}+{-# INLINE static #-}+static :: (RealField.C t, Dim.C u) =>+      Wave.T t y   {- ^ waveform -}+   -> Phase.T t    {- ^ start phase -}+   -> DN.T (Dim.Recip u) t+                   {- ^ frequency -}+   -> Proc.T s u t (SigS.R s y)+static wave phase =+   staticAuxHom (SigS.fromSamples . Osci.static wave phase)++{- | oscillator with a functional waveform with constant frequency -}+{-# INLINE staticAntiAlias #-}+staticAntiAlias :: (RealField.C t, Dim.C u) =>+      WaveSmooth.T t y+                   {- ^ waveform -}+   -> Phase.T t    {- ^ start phase -}+   -> DN.T (Dim.Recip u) t+                   {- ^ frequency -}+   -> Proc.T s u t (SigS.R s y)+staticAntiAlias wave phase =+   staticAuxHom (SigS.fromSamples . Osci.staticAntiAlias wave phase)+-}++{- | oscillator with a functional waveform with modulated frequency -}+{-# INLINE freqMod #-}+freqMod :: (RealField.C t, Dim.C u, Hom.C amp (Wave.T t) wave) =>+      wave y   {- ^ waveform -}+   -> Phase.T t    {- ^ start phase -}+   -> Proc.T s u t+         (CausalD.T s (DN.T (Dim.Recip u) t) amp t y)+freqMod wave phase =+   staticAuxHom wave $ \toFreq freqAmp w ->+      Osci.freqMod w phase <<< amplify (toFreq freqAmp)++{- | oscillator with a functional waveform with modulated frequency -}+{-# INLINE freqModAntiAlias #-}+freqModAntiAlias :: (RealField.C t, Dim.C u, Hom.C amp (WaveSmooth.T t) wave) =>+      wave y+                   {- ^ waveform -}+   -> Phase.T t    {- ^ start phase -}+   -> Proc.T s u t+         (CausalD.T s (DN.T (Dim.Recip u) t) amp t y)+freqModAntiAlias wave phase =+   freqModAuxHom wave $ \scaleFreq freqAmp w ->+      Osci.freqModAntiAlias w phase <<< scaleFreq freqAmp++{- | oscillator with modulated phase -}+{-# INLINE phaseMod #-}+phaseMod :: (RealField.C t, Dim.C u, Hom.C amp (Wave.T t) wave) =>+      wave y       {- ^ waveform -}+   -> DN.T (Dim.Recip u) t+                   {- ^ frequency -}+   -> Proc.T s u t+         (CausalD.T s CausalD.Flat amp t y)+phaseMod wave freq =+   staticAuxHom wave $ \toFreq CausalD.Flat w ->+      Osci.phaseMod w $ toFreq freq++{- | oscillator with modulated shape -}+{-# INLINE shapeMod #-}+shapeMod :: (RealField.C t, Dim.C u) =>+      (c -> Wave.T t y)+                   {- ^ waveform -}+   -> Phase.T t    {- ^ phase -}+   -> DN.T (Dim.Recip u) t+                   {- ^ frequency -}+   -> Proc.T s u t+         (CausalD.T s CausalD.Flat CausalD.Flat c y)+shapeMod wave phase freq =+   staticAux $ \toFreq CausalD.Flat ->+      Osci.shapeMod wave phase $ toFreq freq+++{- | oscillator with a functional waveform with modulated phase and frequency -}+{-# INLINE phaseFreqMod #-}+phaseFreqMod :: (RealField.C t, Dim.C u, Hom.C amp (Wave.T t) wave) =>+      wave y   {- ^ waveform -}+   -> Proc.T s u t+         (CausalD.T s (CausalD.Flat, DN.T (Dim.Recip u) t) amp (t,t) y)+phaseFreqMod wave =+   freqModAuxHom wave $ \scaleFreq (CausalD.Flat, freqAmp) w ->+      Osci.phaseFreqMod w <<< second (scaleFreq freqAmp)++{- | oscillator with both shape and frequency modulation -}+{-# INLINE shapeFreqMod #-}+shapeFreqMod :: (RealField.C t, Dim.C u) =>+      (c -> Wave.T t y)+                   {- ^ waveform -}+   -> Phase.T t    {- ^ phase -}+   -> Proc.T s u t+         (CausalD.T s (CausalD.Flat, DN.T (Dim.Recip u) t) CausalD.Flat (c,t) y)+shapeFreqMod wave phase =+   freqModAux $ \scaleFreq (CausalD.Flat, freqAmp) ->+      Osci.shapeFreqMod wave phase <<< second (scaleFreq freqAmp)+++{-+We could decouple source time and target time which yields++      DN.T (Dim.Recip u0) t+                   {- ^ source frequency -}+   -> SigP.T u0 (SigA.D v y (SigS.T sig)) y+   -> t -> Phase.T t+   -> Proc.T s u1 t (+        CausalD.T s (DN.T (Dim.Div u0 u1) t, DN.T (Dim.Recip u1) t) CausalD.Flat (t,t) y)++but most oftenly we do not need the conversion of the time scale.+If we need it, we can use the frequency modulation function.++We could measure the shape parameter in multiples of the source wave period.+This would yield++      DN.T (Dim.Recip u0) t+                   {- ^ source frequency -}+   -> SigP.T u0 (SigA.D v y (SigS.T sig)) y+   -> t -> Phase.T t+   -> Proc.T s u1 t (+        CausalD.T s (DN.T (Dim.Recip u1) t, DN.T (Dim.Recip u1) t) CausalD.Flat (t,t) y)++but this way, adjustment of the shape parameter is coupled to the source period.+-}+{-# INLINE shapeFreqModFromSampledTone #-}+shapeFreqModFromSampledTone ::+    (RealField.C t, SigG.Transform storage yv, Dim.C u,+     Hom.C amp storage signal) =>+      Interpolation.T t yv+   -> Interpolation.T t yv+   -> DN.T (Dim.Recip u) t+                   {- ^ source frequency -}+   -> SigP.T u t signal yv+   -> t -> Phase.T t+   -> Proc.T s u t+         (CausalD.T s+             (CausalD.Flat, DN.T (Dim.Recip u) t) amp+             (t,t) yv)+shapeFreqModFromSampledTone+      ipLeap ipStep srcFreq sampledTone shape0 phase =+   let (srcRate, srcSignal) = SigP.toSignal sampledTone+       (amp, samples) = Hom.unwrap srcSignal+   in  do toFreq <- Proc.withParam toFrequencyScalar+          return $+             CausalD.Cons $ \(CausalD.Flat, freqAmp) ->+              (amp,+               Osci.shapeFreqModFromSampledTone+                  ipLeap ipStep+                  (DN.divToScalar (Rate.toDimensionNumber srcRate) srcFreq)+                  samples+                  shape0 phase+                <<< second (amplify (toFreq freqAmp)))+++{-# INLINE shapePhaseFreqModFromSampledTone #-}+shapePhaseFreqModFromSampledTone ::+    (RealField.C t, SigG.Transform storage yv, Dim.C u,+     Hom.C amp storage signal) =>+      Interpolation.T t yv+   -> Interpolation.T t yv+   -> DN.T (Dim.Recip u) t+                   {- ^ source frequency -}+   -> SigP.T u t signal yv+   -> t -> Phase.T t+   -> Proc.T s u t+         (CausalD.T s+             (CausalD.Flat, CausalD.Flat, DN.T (Dim.Recip u) t) amp+             (t,t,t) yv)+shapePhaseFreqModFromSampledTone+      ipLeap ipStep srcFreq sampledTone shape0 phase =+   let (srcRate, srcSignal) = SigP.toSignal sampledTone+       (amp, samples) = Hom.unwrap srcSignal+   in  do toFreq <- Proc.withParam toFrequencyScalar+          return $+             CausalD.Cons $ \(CausalD.Flat, CausalD.Flat, freqAmp) ->+              (amp,+               Osci.shapePhaseFreqModFromSampledTone+                  ipLeap ipStep+                  (DN.divToScalar (Rate.toDimensionNumber srcRate) srcFreq)+                  samples+                  shape0 phase+                <<^+                (\(s,p,f) -> (s,p, toFreq freqAmp * f)))+{-+                Causal.packTriple+                ^<<+                second (amplify (toFreq freqAmp))+                <<^+                Causal.unpackTriple+-}+++-- helper functions++{-# INLINE freqModAux #-}+freqModAux :: (Dim.C u, Field.C t) =>+   ((DN.T (Dim.Recip u) t -> Causal.T t t) -> amp0 -> Causal.T yv0 yv1) ->+   Proc.T s u t (CausalD.T s1 amp0 CausalD.Flat yv0 yv1)+freqModAux f =+   staticAux $ \toFreq amp -> f (amplify . toFreq) amp++{-# INLINE staticAux #-}+staticAux :: (Dim.C u, Field.C t) =>+   ((DN.T (Dim.Recip u) t -> t) -> amp0 -> Causal.T yv0 yv1) ->+   Proc.T s u t (CausalD.T s1 amp0 CausalD.Flat yv0 yv1)+staticAux f =+   do toFreq <- Proc.withParam toFrequencyScalar+      return $ CausalD.Cons $ \amp ->+         (CausalD.Flat, f toFreq amp)+++{-# INLINE freqModAuxHom #-}+freqModAuxHom :: (Dim.C u, Field.C t, Hom.C amp1 waveStore wave) =>+   wave y ->+   ((DN.T (Dim.Recip u) t -> Causal.T t t) ->+    amp0 -> waveStore y -> Causal.T yv0 yv1) ->+   Proc.T s u t (CausalD.T s1 amp0 amp1 yv0 yv1)+freqModAuxHom wave f =+   staticAuxHom wave $ \toFreq amp0 w -> f (amplify . toFreq) amp0 w++{-# INLINE staticAuxHom #-}+staticAuxHom :: (Dim.C u, Field.C t, Hom.C amp1 waveStore wave) =>+   wave y ->+   ((DN.T (Dim.Recip u) t -> t) ->+    amp0 -> waveStore y -> Causal.T yv0 yv1) ->+   Proc.T s u t (CausalD.T s1 amp0 amp1 yv0 yv1)+staticAuxHom wave f =+   let (amp1, w) = Hom.plainUnwrap wave+   in  do toFreq <- Proc.withParam toFrequencyScalar+          return $ CausalD.Cons $ \amp ->+             (amp1, f toFreq amp w)+++-- move to Causal.Filter+amplify :: (Ring.C a) => a -> Causal.T a a+amplify x = Causal.map (x Ring.*)
+ src/Synthesizer/Dimensional/Causal/Process.hs view
@@ -0,0 +1,372 @@+{-# LANGUAGE FlexibleContexts #-}+module Synthesizer.Dimensional.Causal.Process (+   module Synthesizer.Dimensional.Causal.Process,+   Flat(Flat),+   ) where++import qualified Synthesizer.Dimensional.Arrow as ArrowD+import qualified Synthesizer.Dimensional.Map as Map++import qualified Synthesizer.Dimensional.RatePhantom as RP+import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Abstraction.HomogeneousGen as Hom+import qualified Synthesizer.Dimensional.Amplitude as Amplitude+import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat++import Synthesizer.Dimensional.Amplitude (Flat(Flat))++import qualified Synthesizer.Causal.Process as Causal++import Control.Applicative (Applicative, liftA, liftA2, )++import qualified Synthesizer.State.Signal as Sig+import qualified Synthesizer.Generic.Signal2 as SigG2++import qualified Algebra.Module as Module+import qualified Algebra.Field  as Field+import qualified Algebra.Ring   as Ring+import Algebra.Module ((*>))++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import qualified Control.Arrow as Arrow++import Data.Tuple.HT as TupleHT (mapSnd, )++import NumericPrelude (one)+import Prelude hiding (map, id, fst, snd, )++++{-+TODO:+This differs from Rate.Process and Amplitude.Signal in the following way:+Here we expect, that @amp@ are types that contain physical units,+whereas Rate.Process.T has separate type variables for unit and values.+Thus Rate.Process.T is limited to DimensionalTerm numbers.+We need the additional flexibility here+because @amp@ can also be a pair of amplitudes+or a more complicated ensemble of amplitudes.++Should the 's' parameter be provided by a RatePhantom?+There are causal processes, namely @map@s,+which do not depend on the sample rate.+For these it would make sense to omit the 's'.+On the other hand what other wrappers could be useful?+RateWrapper around T is not sensible,+since it provides the sample rate as value,+not as an input parameter.+Note, that RatePhantom has the signal element type as parameter.+This would accidentally match here, but is it sensible?+-}+newtype T s amp0 amp1 yv0 yv1 =+   Cons (amp0 -> (amp1, Causal.T yv0 yv1))++instance ArrowD.C (T s) where+   map = map+   (>>>) = (>>>)+   first = first+   second = second+   (***) = (***)+   (&&&) = (&&&)+++{-# INLINE apply #-}+apply ::+   (Hom.C amp0 Sig.T signal0, Hom.C amp1 Sig.T signal1) =>+   T s amp0 amp1 yv0 yv1 ->+   RP.T s signal0 yv0 -> RP.T s signal1 yv1+apply (Cons f) x =+   let (xAmp, samples) = Hom.unwrap x+       (yAmp, causal) = f xAmp+   in  Hom.wrap (yAmp, Causal.apply causal samples)++{-# INLINE applyGeneric #-}+applyGeneric ::+   (Hom.C amp0 storage signal0, Hom.C amp1 storage signal1,+    SigG2.Transform storage yv0 yv1) =>+   T s amp0 amp1 yv0 yv1 ->+   RP.T s signal0 yv0 -> RP.T s signal1 yv1+applyGeneric (Cons f) x =+   let (xAmp, samples) = Hom.unwrap x+       (yAmp, causal) = f xAmp+   in  Hom.wrap (yAmp, Causal.applyGeneric causal samples)+++{-# INLINE applyConst #-}+applyConst :: (Dim.C v0, Dim.C v1, Ring.C y0) =>+   T s (DN.T v0 y0) (DN.T v1 y1) y0 yv1 ->+   DN.T v0 y0 -> SigA.R s v1 y1 yv1+applyConst (Cons f) x =+   let (yAmp, causal) = f x+   in  SigA.fromSamples yAmp (Causal.applyConst causal one)+++infixl 0 $/:, $/-++{-# INLINE ($/:) #-}+($/:) :: (Dim.C v0, Dim.C v1, Applicative f) =>+   f (T s (DN.T v0 y0) (DN.T v1 y1) yv0 yv1) ->+   f (SigA.R s v0 y0 yv0) -> f (SigA.R s v1 y1 yv1)+($/:) = liftA2 apply++{-# INLINE ($/-) #-}+($/-) :: (Dim.C v0, Dim.C v1, Applicative f, Ring.C y0) =>+   f (T s (DN.T v0 y0) (DN.T v1 y1) y0 yv1) ->+   DN.T v0 y0 -> f (SigA.R s v1 y1 yv1)+($/-) p x = liftA (flip applyConst x) p+++infixl 9 `apply`, `applyFst`, `applyFlat`, `applyFlatFst`++{-# INLINE applyFst #-}+applyFst, applyFst' :: (Dim.C v) =>+   T s (DN.T v y, restAmpIn) restAmpOut (yv, restSampIn) restSampOut ->+   SigA.R s v y yv ->+   T s restAmpIn restAmpOut restSampIn restSampOut+applyFst c x = c <<< feedFst x++applyFst' (Cons f) x =+   Cons $ \yAmp ->+      let (zAmp, causal) = f (SigA.amplitude x, yAmp)+      in  (zAmp, Causal.applyFst causal (SigA.samples x))+++{-# INLINE feedFst #-}+feedFst :: (Dim.C v) =>+   SigA.R s v y yv ->+   T s restAmp (DN.T v y, restAmp) restSamp (yv, restSamp)+feedFst x =+   Cons $ \yAmp ->+      ((SigA.amplitude x, yAmp), Causal.feedFst (SigA.samples x))+++{-# INLINE applyFlat #-}+applyFlat :: (Dim.C v1, Flat.C sig yv0) =>+   T s Flat (DN.T v1 y1) yv0 yv1 ->+   RP.T s sig yv0 -> SigA.R s v1 y1 yv1+applyFlat (Cons f) x =+   let (yAmp, causal) = f Flat+   in  SigA.fromSamples yAmp (Causal.apply causal (Flat.toSamples x))+++{-# INLINE applyFlatFst #-}+applyFlatFst, applyFlatFst' :: (Flat.C sig yv) =>+   T s (Flat, restAmpIn) restAmpOut (yv, restSampIn) restSampOut ->+   RP.T s sig yv ->+   T s restAmpIn restAmpOut restSampIn restSampOut+applyFlatFst f x =+   f <<< feedFlatFst x++applyFlatFst' (Cons f) x =+   Cons $ \yAmp ->+      let (zAmp, causal) = f (Flat, yAmp)+      in  (zAmp, Causal.applyFst causal (Flat.toSamples x))++{-# INLINE feedFlatFst #-}+feedFlatFst :: (Flat.C sig yv) =>+   RP.T s sig yv ->+   T s restAmp (Flat, restAmp) restSamp (yv, restSamp)+feedFlatFst x =+   Cons $ \yAmp ->+      ((Flat, yAmp), Causal.feedFst (Flat.toSamples x))++++{-# INLINE map #-}+map ::+   Map.T amp0 amp1 yv0 yv1 ->+   T s amp0 amp1 yv0 yv1+map (Map.Cons f) =+   Cons $ mapSnd Causal.map . f+++{- |+We restrict the amplitude types to those of class 'Amplitude'.+Otherwise 'mapAmplitude' could be abused+for bringing amplitudes and respective sample values out of sync.+For mapping amplitudes that are nested in some pairs,+use it in combination with 'first' and 'second'.+-}+{-# INLINE mapAmplitude #-}+mapAmplitude ::+   (Amplitude.C amp0, Amplitude.C amp1) =>+   (amp0 -> amp1) ->+   T s amp0 amp1 yv yv+mapAmplitude f =+   Cons $ \ xAmp -> (f xAmp, Causal.id)++{-# INLINE mapAmplitudeSameType #-}+mapAmplitudeSameType ::+   (amp -> amp) ->+   T s amp amp yv yv+mapAmplitudeSameType f =+   Cons $ \ xAmp -> (f xAmp, Causal.id)++{- |+Lift a low-level homogeneous process to a dimensional one.++Note that the @amp@ type variable is unrestricted.+This way we show, that the amplitude is not touched,+which also means that the underlying low-level process must be homogeneous.+-}+{-# INLINE homogeneous #-}+homogeneous ::+   Causal.T yv0 yv1 ->+   T s amp amp yv0 yv1+homogeneous c =+   Cons $ \ xAmp -> (xAmp, c)+++infixr 3 ***+infixr 3 &&&+infixr 1 >>>, ^>>, >>^+infixr 1 <<<, ^<<, <<^+++{-# INLINE compose #-}+{-# INLINE (>>>) #-}+compose, (>>>) ::+   T s amp0 amp1 yv0 yv1 ->+   T s amp1 amp2 yv1 yv2 ->+   T s amp0 amp2 yv0 yv2+compose (Cons f) (Cons g) =+   Cons $ \ xAmp ->+      let (yAmp, causalXY) = f xAmp+          (zAmp, causalYZ) = g yAmp+      in  (zAmp, Causal.compose causalXY causalYZ)++(>>>) = compose++{-# INLINE (<<<) #-}+(<<<) ::+   T s amp1 amp2 yv1 yv2 ->+   T s amp0 amp1 yv0 yv1 ->+   T s amp0 amp2 yv0 yv2+(<<<) = flip (>>>)+++{-# INLINE first #-}+first ::+   T s amp0 amp1 yv0 yv1 ->+   T s (amp0, amp) (amp1, amp) (yv0, yv) (yv1, yv)+first (Cons f) =+   Cons $ \ (xAmp, amp) ->+      let (yAmp, causal) = f xAmp+      in  ((yAmp, amp), Causal.first causal)++{-# INLINE second #-}+second ::+   T s amp0 amp1 yv0 yv1 ->+   T s (amp, amp0) (amp, amp1) (yv, yv0) (yv, yv1)+second (Cons f) =+   Cons $ \ (amp, xAmp) ->+      let (yAmp, causal) = f xAmp+      in  ((amp, yAmp), Causal.second causal)++{-# INLINE split #-}+{-# INLINE (***) #-}+split, (***) ::+   T s amp0 amp1 yv0 yv1 ->+   T s amp2 amp3 yv2 yv3 ->+   T s (amp0, amp2) (amp1, amp3) (yv0, yv2) (yv1, yv3)+split f g =+   compose (first f) (second g)++(***) = split++{-# INLINE fanout #-}+{-# INLINE (&&&) #-}+fanout, (&&&) ::+   T s amp amp0 yv yv0 ->+   T s amp amp1 yv yv1 ->+   T s amp (amp0, amp1) yv (yv0, yv1)+fanout f g =+   compose (map Map.double) (split f g)++(&&&) = fanout+++-- * map functions++{-# INLINE (^>>) #-}+-- | Precomposition with a pure function.+(^>>) ::+   Map.T amp0 amp1 yv0 yv1 ->+   T s amp1 amp2 yv1 yv2 ->+   T s amp0 amp2 yv0 yv2+f ^>> a = map f >>> a++{-# INLINE (>>^) #-}+-- | Postcomposition with a pure function.+(>>^) ::+   T s amp0 amp1 yv0 yv1 ->+   Map.T amp1 amp2 yv1 yv2 ->+   T s amp0 amp2 yv0 yv2+a >>^ f = a >>> map f++{-# INLINE (<<^) #-}+-- | Precomposition with a pure function (right-to-left variant).+(<<^) ::+   T s amp1 amp2 yv1 yv2 ->+   Map.T amp0 amp1 yv0 yv1 ->+   T s amp0 amp2 yv0 yv2+a <<^ f = a <<< map f++{-# INLINE (^<<) #-}+-- | Postcomposition with a pure function (right-to-left variant).+(^<<) ::+   Map.T amp1 amp2 yv1 yv2 ->+   T s amp0 amp1 yv0 yv1 ->+   T s amp0 amp2 yv0 yv2+f ^<< a = map f <<< a++++{-# INLINE loop #-}+-- loop :: a (b, d) (c, d) -> a b c+loop ::+   (Field.C y, Module.C y yv, Dim.C v) =>+   DN.T v y ->+   T s (restAmpIn, DN.T v y) (restAmpOut, DN.T v y) (restSampIn, yv) (restSampOut, yv) ->+   T s restAmpIn restAmpOut restSampIn restSampOut+loop ampIn (Cons f) =+   Cons $ \restAmpIn ->+      let ((restAmpOut, ampOut), causal) = f (restAmpIn, ampIn)+      in  (restAmpOut,+           Causal.loop (causal Arrow.>>^+              mapSnd (DN.divToScalar ampOut ampIn *>)))++{-# INLINE loop2 #-}+-- loop2 :: a (b, (d,e)) (c, (d,e)) -> a b c+loop2 (amp0,amp1) p =+   loop amp0 $+   loop amp1 $+   (Map.balanceRight ^>> p >>^ Map.balanceLeft)++loop2, loop2' ::+   (Field.C y0, Module.C y0 yv0, Dim.C v0,+    Field.C y1, Module.C y1 yv1, Dim.C v1) =>+   (DN.T v0 y0, DN.T v1 y1) ->+   T s+     (restAmpIn,  (DN.T v0 y0, DN.T v1 y1))+     (restAmpOut, (DN.T v0 y0, DN.T v1 y1))+     (restSampIn,  (yv0,yv1))+     (restSampOut, (yv0,yv1)) ->+   T s restAmpIn restAmpOut restSampIn restSampOut+loop2' ampIn@(ampIn0,ampIn1) (Cons f) =+   Cons $ \restAmpIn ->+      let ((restAmpOut, (ampOut0,ampOut1)), causal) = f (restAmpIn, ampIn)+      in  (restAmpOut,+           Causal.loop (causal Arrow.>>^+              Arrow.second ((DN.divToScalar ampOut0 ampIn0 *>) Arrow.***+                            (DN.divToScalar ampOut1 ampIn1 *>))))++++{-# INLINE id #-}+id ::+   T s amp amp yv yv+id =+   homogeneous Causal.id
+ src/Synthesizer/Dimensional/ControlledProcess.hs view
@@ -0,0 +1,158 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  Haskell 98+++Basic definitions for signal processors+which are controlled by another signal.+If a control curve is expensive to compute,+or, what happens more frequently,+the conversion from natural control parameters+to internal control parameters is expensive,+then it can be more efficient to compute the control curve at a lower rate+and interpolate the internal control parameters of a particular process.+CSound and SuperCollider have a sample rate+that is common to all control curves,+the ratio between audio and control rate must be integral,+and they use constant interpolation exclusively.+With some more sophisticated interpolation+one may choose a larger gap between control and audio rate.+-}+module Synthesizer.Dimensional.ControlledProcess where++import qualified Synthesizer.Dimensional.Process as Proc+import qualified Synthesizer.Dimensional.Rate as Rate+import qualified Synthesizer.Dimensional.RatePhantom as RP+import qualified Synthesizer.Dimensional.RateWrapper as SigP+-- import qualified Synthesizer.Dimensional.Straight.Signal as SigS+-- import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+import qualified Synthesizer.Causal.Process       as Causal+import qualified Synthesizer.Causal.Interpolation as Interpolation+import qualified Synthesizer.State.Signal as Sig+import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++-- import Synthesizer.Dimensional.Process (($:), ($#), )+-- import Synthesizer.Dimensional.RateAmplitude.Signal (($-))++-- import Number.DimensionTerm ((*&), ) -- ((&*&), (&/&))++import qualified Algebra.RealField      as RealField+-- import qualified Algebra.Field          as Field+-- import qualified Algebra.Ring           as Ring+import qualified Algebra.Additive       as Additive++{-+import Control.Monad (liftM2, )+import qualified Control.Applicative as App+import Control.Applicative (Applicative)+-}++import NumericPrelude+{-+import PreludeBase as P+-}+++{- |+@ec@ is the type for the curve of external control parameters,+@ic@ for internal control parameters.+-}+data T s ec ic a = Cons {+      converter :: ec -> Sig.T ic,+      processor :: Sig.T ic -> a+   }+++{-# INLINE runSynchronous #-}+runSynchronous ::+   Proc.T s u t (T s ec ic a) ->+   Proc.T s u t (ec -> a)+runSynchronous cp =+   do p <- cp+      return (processor p . converter p)++{-# INLINE runSynchronous1 #-}+runSynchronous1 ::+   Proc.T s u t (T s (RP.T s sig0 ec0) ic a) ->+   Proc.T s u t (RP.T s sig0 ec0 -> a)+runSynchronous1 = runSynchronous++{-# INLINE runSynchronous2 #-}+runSynchronous2 ::+   Proc.T s u t (T s (RP.T s sig0 ec0, RP.T s sig1 ec1) ic a) ->+   Proc.T s u t (RP.T s sig0 ec0 -> RP.T s sig1 ec1 -> a)+runSynchronous2 = fmap curry . runSynchronous++{-# INLINE runSynchronous3 #-}+runSynchronous3 ::+   Proc.T s u t (T s (RP.T s sig0 ec0, RP.T s sig1 ec1, RP.T s sig2 ec2) ic a) ->+   Proc.T s u t (RP.T s sig0 ec0 -> RP.T s sig1 ec1 -> RP.T s sig2 ec2 -> a)+runSynchronous3 =+   fmap (\f x y z -> f (x,y,z)) . runSynchronous++++{-# INLINE runAsynchronous #-}+runAsynchronous ::+   (Dim.C u, Additive.C ic, RealField.C t) =>+   Interpolation.T t ic ->+   Proc.T s u t (T s ec ic a) ->+   Rate.T r u t ->+   ec ->+   Proc.T s u t a+runAsynchronous ip cp srcRate sig =+   do p <- cp+      k <- fmap+              (DN.divToScalar (Rate.toDimensionNumber srcRate))+              Proc.getSampleRate+      return $+         processor p $+         Causal.apply+            (Interpolation.relativeConstantPad ip zero (converter p sig))+            (Sig.repeat k)++{-# INLINE runAsynchronous1 #-}+runAsynchronous1 ::+   (Dim.C u, Additive.C ic, RealField.C t) =>+   Interpolation.T t ic ->+   Proc.T s u t (T s (RP.T r sig0 ec0) ic a) ->+   SigP.T u t sig0 ec0 ->+   Proc.T s u t a+runAsynchronous1 ip cp x =+   uncurry (runAsynchronous ip cp) (SigP.toSignal x)++{-# INLINE runAsynchronous2 #-}+runAsynchronous2 ::+   (Dim.C u, Additive.C ic, RealField.C t) =>+   Interpolation.T t ic ->+   Proc.T s u t (T s (RP.T r sig0 ec0, RP.T r sig1 ec1) ic a) ->+   SigP.T u t sig0 ec0 ->+   SigP.T u t sig1 ec1 ->+   Proc.T s u t a+runAsynchronous2 ip cp x y =+   let (srcRateX,sigX) = SigP.toSignal x+       (srcRateY,sigY) = SigP.toSignal y+       srcRate = Rate.common "ControlledProcess.runAsynchronous2" srcRateX srcRateY+   in  runAsynchronous ip cp srcRate (sigX,sigY)++{-# INLINE runAsynchronous3 #-}+runAsynchronous3 ::+   (Dim.C u, Additive.C ic, RealField.C t) =>+   Interpolation.T t ic ->+   Proc.T s u t (T s (RP.T r sig0 ec0, RP.T r sig1 ec1, RP.T r sig2 ec2) ic a) ->+   SigP.T u t sig0 ec0 ->+   SigP.T u t sig1 ec1 ->+   SigP.T u t sig2 ec2 ->+   Proc.T s u t a+runAsynchronous3 ip cp x y z =+   let (srcRateX,sigX) = SigP.toSignal x+       (srcRateY,sigY) = SigP.toSignal y+       (srcRateZ,sigZ) = SigP.toSignal z+       common = Rate.common "ControlledProcess.runAsynchronous3"+       srcRate = srcRateX `common` srcRateY `common` srcRateZ+   in  runAsynchronous ip cp srcRate (sigX,sigY,sigZ)
+ src/Synthesizer/Dimensional/Cyclic/Signal.hs view
@@ -0,0 +1,95 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Signals equipped with a phantom type parameter that reflects the sample rate.+-}+module Synthesizer.Dimensional.Cyclic.Signal where++import qualified Synthesizer.Format as Format+import qualified Synthesizer.Dimensional.RatePhantom as RP++import qualified Synthesizer.Dimensional.Straight.Signal as SigS+import qualified Synthesizer.State.Signal as Sig++-- import qualified Number.DimensionTerm        as DN+-- import qualified Algebra.DimensionTerm       as Dim++{-+import qualified Algebra.Module         as Module+import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring+-}+import qualified Algebra.Additive       as Additive++-- import Number.DimensionTerm ((&/&))+++import NumericPrelude+import PreludeBase+import Prelude ()+++newtype T seq yv =+   Cons {+       samples :: seq yv   {-^ the sampled values -}+     }+--   deriving (Eq, Show)++instance Functor seq => Functor (T seq) where+   fmap f = Cons . fmap f . samples++instance Format.C seq => Format.C (T seq) where+   format p = Format.format p . samples++instance (Format.C seq, Show y) => Show (T seq y) where+   showsPrec = Format.format+++type R s yv = RP.T s (T Sig.T) yv+++{-+replaceSamples :: Sig.T yv1 -> R s yv0 -> R s yv1+replaceSamples ss _  =  fromSamples ss+++processSamples ::+   (Sig.T yv0 -> Sig.T yv1) -> R s yv0 -> R s yv1+processSamples f x =+   replaceSamples (f $ samples $ RP.toSignal x) x+-}+++{-# INLINE fromPeriod #-}+fromPeriod :: Sig.T yv -> R s yv+fromPeriod  =  RP.fromSignal . Cons++{-# INLINE fromPeriodList #-}+fromPeriodList :: [yv] -> R s yv+fromPeriodList  =  fromPeriod . Sig.fromList++{-# INLINE toPeriod #-}+toPeriod :: R s yv -> Sig.T yv+toPeriod  =  samples . RP.toSignal+++{- |+Periodization of a straight signal.+-}+{-# INLINE fromSignal #-}+fromSignal :: Additive.C yv => Int -> SigS.R s yv -> R s yv+fromSignal n  =+   fromPeriod . sum . Sig.sliceVert n . SigS.toSamples++{- |+Convert a cyclic signal to a straight signal containing a loop.+-}+{-# INLINE toSignal #-}+toSignal :: Additive.C yv => R s yv -> SigS.R s yv+toSignal  =+   SigS.fromSamples . Sig.cycle . toPeriod
+ src/Synthesizer/Dimensional/Map.hs view
@@ -0,0 +1,91 @@+{- |+Maps that handle pairs of amplitudes and sampled values.+They are a special form of arrows.+-}+module Synthesizer.Dimensional.Map where++{-+import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim+-}++import qualified Data.Tuple as Tuple+import Data.Tuple.HT as TupleHT (swap, )++import Prelude hiding (map, id, fst, snd, )++++{- |+This type shall ensure, that you do not accidentally+bring amplitudes and the corresponding low-level signal values out of sync.+We also use it for generation of internal control parameters+in "Synthesizer.Dimensional.Causal.ControlledProcess".+In principle this could also be 'Causal.T',+but maps are not bound to a sampling rate,+and thus do not need the @s@ type parameter.+-}+newtype T amp0 amp1 yv0 yv1 =+   Cons (amp0 -> (amp1, yv0 -> yv1))++independent ::+   (amp0 -> amp1) -> (yv0 -> yv1) ->+   T amp0 amp1 yv0 yv1+independent f g =+   Cons (\amp -> (f amp, g))++double ::+   T amp (amp, amp)+     y (y, y)+double =+   let aux = \x -> (x, x)+   in  independent aux aux++fst ::+   T (amp0,amp1) amp0+     (y0,y1) y0+fst =+   let aux = Tuple.fst+   in  independent aux aux++snd ::+   T (amp0,amp1) amp1+     (y0,y1) y1+snd =+   let aux = Tuple.snd+   in  independent aux aux++swap ::+   T (amp0,amp1) (amp1,amp0)+     (y0,y1) (y1,y0)+swap =+   let aux = TupleHT.swap+   in  independent aux aux++balanceRight ::+   T ((amp0,amp1), amp2) (amp0, (amp1,amp2))+     ((y0,y1), y2) (y0, (y1,y2))+balanceRight =+   let aux = \((a,b), c) -> (a, (b,c))+   in  independent aux aux++balanceLeft ::+   T (amp0, (amp1,amp2)) ((amp0,amp1), amp2)+     (y0, (y1,y2)) ((y0,y1), y2)+balanceLeft =+   let aux = \(a, (b,c)) -> ((a,b), c)+   in  independent aux aux++packTriple ::+   T (amp0,(amp1,amp2)) (amp0,amp1,amp2)+     (y0,(y1,y2)) (y0,y1,y2)+packTriple =+   let aux = \(a,(b,c)) -> (a,b,c)+   in  independent aux aux++unpackTriple ::+   T (amp0,amp1,amp2) (amp0,(amp1,amp2))+     (y0,y1,y2) (y0,(y1,y2))+unpackTriple =+   let aux = \(a,b,c) -> (a,(b,c))+   in  independent aux aux
+ src/Synthesizer/Dimensional/Process.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE Rank2Types #-}+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+               and local universal quantification+++Light-weight sample parameter inference which will fit most needs.+We only do \"poor man's inference\", only for sample rates.+The sample rate will be provided as an argument of a special type 'T'.+This argument will almost never be passed explicitly+but should be handled by operators analogous to '($)' and '(.)'.++In contrast to the run-time inference approach,+we have the static guarantee that the sample rate is fixed+before passing a signal to the outside world.+However we still need to make it safe that signals+that are rendered for one sample rate+are not processed with another sample rate.+-}+module Synthesizer.Dimensional.Process (+      T(..),+      run, {-share,-} withParam, getSampleRate,+      toTimeScalar,    toFrequencyScalar,+      toTimeDimension, toFrequencyDimension,+      loop, pure,+      ($:), ($::), ($^), ($#),+      (.:), (.^),+      liftP, liftP2, liftP3, liftP4,+   ) where++import qualified Synthesizer.Dimensional.Rate as Rate+import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import Number.DimensionTerm ((*&), ) -- ((&*&), (&/&))++import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring++import Control.Monad.Fix (MonadFix(mfix), )+-- import Control.Monad.Trans.Reader ()+import Synthesizer.ApplicativeUtility+import qualified Control.Applicative as App+import Control.Applicative (Applicative)+++{-+import NumericPrelude+import PreludeBase as P+-}+++{- |+This wraps a function which computes a sample rate dependent result.+Sample rate tells how many values per unit are stored+for representation of a signal.++The process is labeled with a type variable @s@ which is part the signals.+This way we can ensure that signals are only used+with the sample rate they are created for.+-}+newtype T s u t a = Cons {process :: Rate.T s u t -> a}++instance Functor (T s u t) where+   fmap f (Cons g) = Cons (f . g)++instance Applicative (T s u t) where+   pure  = pure+   (<*>) = apply++instance Monad (T s u t) where+   return = pure+   (>>=)  = bind++instance MonadFix (T s u t) where+   mfix = loop . withParam+++{-# INLINE pure #-}+pure :: a -> T s u t a+pure = Cons . const++{-# INLINE apply #-}+apply :: T s u t (a -> b) -> T s u t a -> T s u t b+apply (Cons f) arg = Cons $ \sr -> f sr (process arg sr)+++{- |+Get results from the Process monad.+You can obtain only signals (or other values)+that do not implicitly depend on the sample rate,+that is value without the @s@ type parameter.+-}+{-# INLINE run #-}+run :: (Dim.C u) => DN.T (Dim.Recip u) t -> (forall s. T s u t a) -> a+run sampleRate f = process f (Rate.fromDimensionNumber sampleRate)++{-+{- |+You can write+@x >>= (\x0 -> Cut.zip $# x0 $# x0)@+or+@share x (\x0 -> Cut.zip $: x0 $: x0)@.+'share' allows for more consistent usage of @($:)@.+-}+share :: T s u t a -> (T s u t a -> T s u t b) -> T s u t b+share x y  =  y . return =<< x+-}++{-# INLINE bind #-}+bind :: T s u t a -> (a -> T s u t b) -> T s u t b+bind (Cons f) mg =+   Cons $ \ sr -> process (mg (f sr)) sr++-- same as Inference.Reader.Process.injectParam+{-# INLINE withParam #-}+withParam :: (a -> T s u t b) -> T s u t (a -> b)+withParam f = Cons (\sr a -> process (f a) sr)+++{-# INLINE getSampleRate #-}+getSampleRate :: Dim.C u => T s u t (DN.T (Dim.Recip u) t)+getSampleRate = Cons Rate.toDimensionNumber+++{-# INLINE toTimeScalar #-}+toTimeScalar {- , (~*&) -} :: (Ring.C t, Dim.C u) =>+   DN.T u t -> T s u t t+toTimeScalar time =+   fmap (DN.mulToScalar time) getSampleRate++{-# INLINE toFrequencyScalar #-}+toFrequencyScalar {- , (~/&) -} :: (Field.C t, Dim.C u) =>+   DN.T (Dim.Recip u) t -> T s u t t+toFrequencyScalar freq =+   fmap (DN.divToScalar freq) getSampleRate+++{-# INLINE toTimeDimension #-}+toTimeDimension :: (Field.C t, Dim.C u) =>+   t -> T s u t (DN.T u t)+toTimeDimension t =+   fmap (\sampleRate -> t *& DN.unrecip sampleRate) getSampleRate++{-# INLINE toFrequencyDimension #-}+toFrequencyDimension :: (Ring.C t, Dim.C u) =>+   t -> T s u t (DN.T (Dim.Recip u) t)+toFrequencyDimension f =+   fmap (\sampleRate -> f *& sampleRate) getSampleRate+++{-+infixl 7 ~*&, ~/&++(~*&) = toTimeScalar+(~/&) = toFrequencyScalar+-}
+ src/Synthesizer/Dimensional/Rate.hs view
@@ -0,0 +1,79 @@+{- |++Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++++Light-weight sample parameter inference which will fit most needs.+We only do \"poor man's inference\", only for sample rates.+The sample rate will be provided as an argument of a special type 'T'.+This argument will almost never be passed explicitly+but should be handled by operators analogous to '($)' and '(.)'.++In contrast to the run-time inference approach,+we have the static guarantee that the sample rate is fixed+before passing a signal to the outside world.+However we still need to make it safe that signals+that are rendered for one sample rate+are not processed with another sample rate.+We should wrap @T s u t -> a@ in a @Reader@ monad, but that's not all.+We must investigate a little more here.+Maybe we need another type parameter for the sample rate and the signals+in order to show that they belong together,+like it is done in the ST monad.+-}+module Synthesizer.Dimensional.Rate where++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import qualified Synthesizer.Utility as Util++{-+import NumericPrelude+import PreludeBase as P+-}+++{- |+This wraps a function which computes a sample rate dependent result.+Sample rate tells how many values per unit are stored+for representation of a signal.+-}+newtype T s u t = Cons {decons :: DN.T (Dim.Recip u) t}+   deriving (Eq, Ord, Show)+++{-# INLINE fromNumber #-}+fromNumber :: Dim.C u => Dim.Recip u -> t -> T s u t+fromNumber u = Cons . DN.fromNumberWithDimension u++{- |+This function is somehow dangerous+because it drops the 's' parameter.+-}+{-# INLINE toNumber #-}+toNumber :: Dim.C u => Dim.Recip u -> T s u t -> t+toNumber u = DN.toNumberWithDimension u . decons++{-# INLINE fromDimensionNumber #-}+fromDimensionNumber :: Dim.C u => DN.T (Dim.Recip u) t -> T s u t+fromDimensionNumber = Cons++{- |+This function is somehow dangerous+because it drops the 's' parameter.+-}+{-# INLINE toDimensionNumber #-}+toDimensionNumber :: Dim.C u => T s u t -> DN.T (Dim.Recip u) t+toDimensionNumber = decons++{-# INLINE common #-}+common :: Eq t => String -> T s u t -> T s u t -> T s u t+common funcName =+   Util.common ("Sample rates differ in " ++ funcName)
+ src/Synthesizer/Dimensional/Rate/Analysis.hs view
@@ -0,0 +1,79 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Dimensional.Rate.Analysis (+    centroid,+    length,++    centroidProc,+    lengthProc,+  ) where++import qualified Synthesizer.Dimensional.Straight.Signal as SigS+import qualified Synthesizer.Dimensional.RateWrapper     as SigP++import qualified Synthesizer.State.Analysis as Ana+import qualified Synthesizer.State.Signal   as Sig++import qualified Synthesizer.Dimensional.Process as Proc++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import Number.DimensionTerm ((*&))++import qualified Algebra.Field               as Field+-- import qualified Algebra.Real                as Real+-- import qualified Algebra.Ring                as Ring+++import PreludeBase ((.), ($), )+import NumericPrelude+import Prelude ()++++{-# INLINE centroid #-}+centroid :: (Field.C q, Dim.C u) =>+   SigP.T u q SigS.S q -> DN.T u q+centroid = makePhysicalLength Ana.centroid++{-# INLINE length #-}+length :: (Field.C t, Dim.C u) =>+   SigP.T u t SigS.S yv -> DN.T u t+length = makePhysicalLength (fromIntegral . Sig.length)++{-# INLINE makePhysicalLength #-}+makePhysicalLength :: (Field.C t, Dim.C u) =>+   (Sig.T y -> t) ->+   SigP.T u t SigS.S y -> DN.T u t+makePhysicalLength f x =+   f (SigS.samples (SigP.signal x))  *&  DN.unrecip (SigP.sampleRate x)+++{-# DEPRECATED #-}+{-# INLINE centroidProc #-}+centroidProc :: (Field.C y, Dim.C u) =>+   Proc.T s u y (SigS.R s y -> DN.T u y)+centroidProc = makePhysicalLengthProc Ana.centroid++{-# DEPRECATED #-}+{-# INLINE lengthProc #-}+lengthProc :: (Field.C y, Dim.C u) =>+   Proc.T s u y (SigS.R s y -> DN.T u y)+lengthProc = makePhysicalLengthProc (fromIntegral . Sig.length)++{-# INLINE makePhysicalLengthProc #-}+makePhysicalLengthProc :: (Field.C t, Dim.C u) =>+   (Sig.T y -> t) ->+   Proc.T s u t (+     SigS.R s y ->+     DN.T u t)+makePhysicalLengthProc f =+   Proc.withParam $+      Proc.toTimeDimension . f . SigS.toSamples
+ src/Synthesizer/Dimensional/Rate/Control.hs view
@@ -0,0 +1,83 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+++Control curves which can be used+as envelopes, for controlling filter parameters and so on.+-}+module Synthesizer.Dimensional.Rate.Control+   ({- * Primitives -}+    constant, linear, exponential, exponential2, )+   where++import qualified Synthesizer.Dimensional.Straight.Signal as SigS++import qualified Synthesizer.State.Control as Ctrl+-- import qualified Synthesizer.State.Signal  as Sig++import qualified Synthesizer.Dimensional.Process as Proc++-- import Synthesizer.Dimensional.Process (($#), )++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++-- import Number.DimensionTerm ((&*&))++import qualified Algebra.Transcendental     as Trans+import qualified Algebra.Field              as Field+-- import qualified Algebra.Real               as Real+import qualified Algebra.Ring               as Ring+-- import qualified Algebra.Additive           as Additive++import NumericPrelude+import PreludeBase+import Prelude ()+++{-# INLINE constant #-}+constant :: (Ring.C y, Dim.C u) =>+   Proc.T s u t (SigS.R s y)+constant = Proc.pure $ SigS.fromSamples $ Ctrl.constant one++{- |+Caution: This control curve can contain samples+with an absolute value greater than 1.+The linear curve starts with zero.+-}+{-# INLINE linear #-}+linear ::+   (Field.C q, Dim.C u) =>+      DN.T u q {-^ distance until curve reaches one -}+   -> Proc.T s u q (SigS.R s q)+linear dist =+   fmap+      (SigS.fromSamples . Ctrl.linearMultiscaleNeutral . recip)+      (Proc.toTimeScalar dist)++{-# INLINE exponential #-}+exponential :: (Trans.C q, Dim.C u) =>+      DN.T u q {-^ time where the function reaches 1\/e of the initial value -}+   -> Proc.T s u q (SigS.R s q)+exponential time =+   fmap+      (SigS.fromSamples . Ctrl.exponentialMultiscaleNeutral)+      (Proc.toTimeScalar time)++{-+  take 1000 $ show (run (fixSampleRate 100 (exponential 0.1 1)) :: SigDouble)+-}++{-# INLINE exponential2 #-}+exponential2 :: (Trans.C q, Dim.C u) =>+      DN.T u q {-^ half life, time where the function reaches 1\/2 of the initial value -}+   -> Proc.T s u q (SigS.R s q)+exponential2 time =+   fmap+      (SigS.fromSamples . Ctrl.exponential2MultiscaleNeutral)+      (Proc.toTimeScalar time)
+ src/Synthesizer/Dimensional/Rate/Cut.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Dimensional.Rate.Cut (+     take, drop,+   ) where++import qualified Synthesizer.Dimensional.Abstraction.Homogeneous as Hom++import qualified Synthesizer.Dimensional.RatePhantom as RP++import qualified Synthesizer.Dimensional.Process as Proc+-- import qualified Synthesizer.Dimensional.Rate as Rate++-- import Synthesizer.Dimensional.Process ((.:), (.^), )++import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA+import qualified Synthesizer.State.Signal as Sig++import Synthesizer.Dimensional.RateAmplitude.Signal+   (toTimeScalar, )++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++-- import qualified Number.NonNegative     as NonNeg++import qualified Algebra.RealField      as RealField+-- import qualified Algebra.Field          as Field+++import NumericPrelude hiding (negate)+-- import PreludeBase as P+import Prelude hiding (take, drop, )+++{-# INLINE take #-}+take :: (Hom.C sig, RealField.C t, Dim.C u) =>+   DN.T u t -> Proc.T s u t (RP.T s sig y -> RP.T s sig y)+take t' =+   do t <- toTimeScalar t'+      return $ Hom.processSamples (Sig.take (RealField.round t))++{-# INLINE drop #-}+drop :: (Hom.C sig, RealField.C t, Dim.C u) =>+   DN.T u t -> Proc.T s u t (RP.T s sig y -> RP.T s sig y)+drop t' =+   do t <- toTimeScalar t'+      return $ Hom.processSamples (Sig.drop (RealField.round t))
+ src/Synthesizer/Dimensional/Rate/Dirac.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE FlexibleContexts #-}+module Synthesizer.Dimensional.Rate.Dirac where++import qualified Synthesizer.Generic.Cut as Cut++import qualified Synthesizer.Dimensional.RatePhantom as RP+import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Straight.Signal  as SigS+import qualified Synthesizer.Dimensional.Process as Proc++import qualified Data.Monoid as Mn++-- import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++-- import qualified Algebra.Field              as Field+import qualified Algebra.Ring               as Ring++import Data.Tuple.HT (mapPair, mapSnd, )++import NumericPrelude (zero, one, )+++{- |+We want to represent streams of discrete events+in a manner that is more safe than plain @[Bool]@.+Each peak can be imagined as a Dirac impulse.++A @[Bool]@ could be used accidentally for 'Synthesizer.Dimensional.Amplitude.Cut.selectBool',+where @selectBool@ is intended for piecewise constant control curves.++You may think that a type like @Peak = Peak Bool@ as sample type+in @T s Peak@ would also do the job.+Actually, this wouldn't be a good idea+since you can apply constant interpolation on it,+which obviously fools the idea of a peak.+-}+newtype T s sig = Cons {decons :: sig Bool}++instance Mn.Monoid (sig Bool) => Mn.Monoid (T s sig) where+   mempty = Cons Mn.mempty+   mappend (Cons x) (Cons y) = Cons (Mn.mappend x y)++instance Cut.Read (sig Bool) => Cut.Read (T s sig) where+   {-# INLINE null #-}+   null = Cut.null . decons+   {-# INLINE length #-}+   length = Cut.length . decons++instance Cut.Transform (sig Bool) => Cut.Transform (T s sig) where+   {-# INLINE take #-}+   take n = Cons . Cut.take n . decons+   {-# INLINE drop #-}+   drop n = Cons . Cut.drop n . decons+   {-# INLINE splitAt #-}+   splitAt n = mapPair (Cons, Cons) . Cut.splitAt n . decons+   {-# INLINE dropMarginRem #-}+   dropMarginRem n m = mapSnd Cons . Cut.dropMarginRem n m . decons+   {-# INLINE reverse #-}+   reverse = Cons . Cut.reverse . decons++{- |+This is the most frequently needed transformation+of a stream of peaks, if not the only one.+It converts to a signal of peaks with area 1.+This convention is especially useful for smoothing filters+that produce frequency progress curves from zero crossings.+-}+{-# INLINE toAmplitudeSignal #-}+toAmplitudeSignal ::+   (Ring.C q, Dim.C u, Functor sig) =>+   Proc.T s u q (T s sig -> RP.T s (SigA.D (Dim.Recip u) q (SigS.T sig)) q)+toAmplitudeSignal =+   fmap+      (\rate ->+         RP.fromSignal . SigA.Cons rate . SigS.Cons .+         fmap (\c -> if c then one else zero) .+         decons)+      Proc.getSampleRate
+ src/Synthesizer/Dimensional/Rate/Filter.hs view
@@ -0,0 +1,623 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Dimensional.Rate.Filter (+   {- * Non-recursive -}++   {- ** Amplification -}+   negate,+   envelope,+   envelopeVector,+   convolveVector,++   {- ** Smooth -}+   mean,+   meanStatic,++   {- ** Delay -}+   delay,+   phaseModulation,+   phaser,+   phaserStereo,+   frequencyModulation,+   frequencyModulationDecoupled,+++   {- * Recursive -}++   {- ** Without resonance -}+   firstOrderLowpass,+   firstOrderHighpass,+   butterworthLowpass,+   butterworthHighpass,+   chebyshevALowpass,+   chebyshevAHighpass,+   chebyshevBLowpass,+   chebyshevBHighpass,+   {- ** With resonance -}+   universal,+   highpassFromUniversal,+   bandpassFromUniversal,+   lowpassFromUniversal,+   bandlimitFromUniversal,+   moogLowpass,++   {- ** Allpass -}+   allpassCascade,+   allpassFlangerPhase,++   {- ** Reverb -}+   comb,++   {- * Helper functions -}+   interpolateMultiRelativeZeroPad,+) where++-- import qualified Synthesizer.Dimensional.Abstraction.Linear as Lin+import qualified Synthesizer.Dimensional.Abstraction.Homogeneous as Hom+import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind+import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat++import qualified Synthesizer.Dimensional.RatePhantom as RP++import qualified Synthesizer.Dimensional.Amplitude.Filter       as FiltV+import qualified Synthesizer.Dimensional.Process as Proc+-- import qualified Synthesizer.Dimensional.Rate as Rate++-- import Synthesizer.Dimensional.Process ((.:), (.^), )++import qualified Synthesizer.Dimensional.Straight.Signal      as SigS+import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA+import qualified Synthesizer.Dimensional.RateWrapper      as SigP+import qualified Synthesizer.State.Signal as Sig+import Synthesizer.Plain.Signal (Modifier, )++import Synthesizer.Dimensional.RateAmplitude.Signal+   (toTimeScalar, toFrequencyScalar, )++import qualified Synthesizer.Causal.Process       as Causal+import qualified Synthesizer.Causal.Interpolation as Interpolation+import qualified Synthesizer.State.Displacement as Disp+import qualified Synthesizer.State.Filter.Delay as Delay+import qualified Synthesizer.State.Filter.Recursive.MovingAverage as MA+import qualified Synthesizer.State.Filter.NonRecursive as FiltNR++import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder  as Filt1+import qualified Synthesizer.Plain.Filter.Recursive.Allpass     as Allpass+import qualified Synthesizer.Plain.Filter.Recursive.Universal   as UniFilter+import qualified Synthesizer.Plain.Filter.Recursive.Moog        as Moog+import qualified Synthesizer.Plain.Filter.Recursive.Butterworth as Butter+import qualified Synthesizer.Plain.Filter.Recursive.Chebyshev   as Cheby+import qualified Synthesizer.Plain.Filter.Recursive             as FiltRec++import qualified Synthesizer.Storable.Signal as SigSt+import qualified Synthesizer.Generic.Filter.Recursive.Comb as Comb++-- import qualified Synthesizer.Generic.Interpolation as InterpolationG+import qualified Synthesizer.Generic.Filter.Recursive.MovingAverage as MAG+import qualified Synthesizer.Generic.Filter.NonRecursive as FiltG+import qualified Synthesizer.Generic.Filter.Delay as DelayG+import qualified Synthesizer.Generic.Signal  as SigG+import qualified Synthesizer.Generic.Signal2 as SigG2++import qualified Synthesizer.Frame.Stereo as Stereo++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import qualified Number.NonNegative     as NonNeg++import qualified Algebra.Transcendental as Trans+import qualified Algebra.RealField      as RealField+import qualified Algebra.Field          as Field+-- import qualified Algebra.Real           as Real+import qualified Algebra.Ring           as Ring+import qualified Algebra.Additive       as Additive+-- import qualified Algebra.VectorSpace    as VectorSpace+import qualified Algebra.Module         as Module++import Foreign.Storable (Storable, )++-- import qualified Data.List as List++-- import Control.Monad(liftM2)++import NumericPrelude hiding (negate)+import PreludeBase as P+import Prelude ()+++{-# INLINE negate #-}+negate :: (Hom.C sig, Additive.C yv, Dim.C u) =>+      Proc.T s u t (+        RP.T s sig yv+     -> RP.T s sig yv)+negate = Proc.pure FiltV.negate+++{-# INLINE envelope #-}+envelope :: (Hom.C sig, Flat.C flat y0, Ring.C y0, Dim.C u) =>+      Proc.T s u t (+        RP.T s flat y0        {- v the envelope -}+     -> RP.T s sig y0         {- v the signal to be enveloped -}+     -> RP.T s sig y0)+envelope = Proc.pure FiltV.envelope++{-# INLINE envelopeVector #-}+envelopeVector ::+   (Hom.C sig, Flat.C flat y0, Module.C y0 yv, Dim.C u) =>+      Proc.T s u t (+        RP.T s flat y0        {- v the envelope -}+     -> RP.T s sig yv         {- v the signal to be enveloped -}+     -> RP.T s sig yv)+envelopeVector = Proc.pure FiltV.envelopeVector++{-# INLINE convolveVector #-}+convolveVector ::+   (Hom.C sig, Module.C q yv, Field.C q, Dim.C u) =>+      Proc.T s u q (+        SigA.R s (Dim.Recip u) q q+                              {- v the filter window -}+     -> RP.T s sig yv         {- v the signal to be enveloped -}+     -> RP.T s sig yv)+convolveVector =+   do toFreq <- Proc.withParam toFrequencyScalar+      return $ \ window ->+         Hom.processSamples+            (FiltNR.generic (SigA.scalarSamples toFreq window))+++{- | needs a better handling of boundaries, yet -}+{-# INLINE meanStatic #-}+meanStatic :: (Hom.C sig, Additive.C yv, RealField.C q,+         Module.C q yv, Dim.C u) =>+      DN.T (Dim.Recip u) q    {- ^ cut-off freqeuncy -}+   -> Proc.T s u q (+        RP.T s sig yv+     -> RP.T s sig yv)+meanStatic freq =+   do f <- toFrequencyScalar freq+      return $+         let tInt  = round ((recip f - 1)/2)+             width = tInt*2+1+         in  Hom.processSamples+                ((asTypeOf (recip (fromIntegral width)) f *> ) .+                 Delay.staticNeg tInt .+                 MA.sumsStaticInt width)++{- | needs a better handling of boundaries, yet -}+{-# INLINE mean #-}+mean :: (Hom.C sig, Additive.C yv, RealField.C q,+         Module.C q yv, Dim.C u, Storable q, Storable yv) =>+      DN.T (Dim.Recip u) q    {- ^ minimum cut-off freqeuncy -}+   -> Proc.T s u q (+        SigA.R s (Dim.Recip u) q q+                              {- v cut-off freqeuncies -}+     -> RP.T s sig yv+     -> RP.T s sig yv)+mean minFreq =+   do mf <- toFrequencyScalar minFreq+      frequencyControl $ \ freqs ->+         let tMax   = ceiling (recip (2*mf))+             err    = error "Filter.mean: frequencies must be positive"+             widths = Sig.map (\f -> if f>0 then recip (2*f) else err) freqs+         in  Hom.processSamples+                (fromStorable .+--                 MAG.sumsStaticInt tMax .+                 MAG.modulatedFrac tMax (toStorable widths) .+                 toStorable)++{-# INLINE delay #-}+delay :: (Hom.C sig, Additive.C yv, RealField.C t, Dim.C u) =>+      DN.T u t+   -> Proc.T s u t (+        RP.T s sig yv+     -> RP.T s sig yv)+delay time =+   do t <- toTimeScalar time+      return $ Hom.processSamples (Delay.static (round t))+++{-# INLINE toStorable #-}+toStorable :: (Storable a) => Sig.T a -> SigSt.T a+toStorable = Sig.toStorableSignal SigSt.defaultChunkSize++{-# INLINE fromStorable #-}+fromStorable :: (Storable a) => SigSt.T a -> Sig.T a+fromStorable = Sig.fromStorableSignal++{-# INLINE phaseModulation #-}+phaseModulation ::+   (Hom.C sig, Additive.C yv, RealField.C q, Dim.C u,+    Storable q, Storable yv) =>+      Interpolation.T q yv+   -> DN.T u q+          {- ^ minimal deviation from current time, usually negative -}+   -> DN.T u q+          {- ^ maximal deviation, it must be @minDev <= maxDev@+               and the modulation must always be+               in the range [minDev,maxDev]. -}+   -> Proc.T s u q (+        SigA.R s u q q+          {- v deviation control,+               positive numbers meanStatic prefetch,+               negative numbers meanStatic delay -}+     -> RP.T s sig yv+     -> RP.T s sig yv)+phaseModulation ip minDev maxDev =+   fmap+      (\f devs ->+         Hom.processSamples+            (Sig.fromStorableSignal .+             f (SigA.processSamples toStorable devs) .+             toStorable))+      (phaseModulationGeneric ip minDev maxDev)++{-# INLINE phaseModulationGeneric #-}+phaseModulationGeneric ::+   (Additive.C yv, RealField.C q, Dim.C u,+    SigG2.Transform sig q yv, SigG.Write sig yv) =>+      Interpolation.T q yv+   -> DN.T u q+          {- ^ minimal deviation from current time, usually negative -}+   -> DN.T u q+          {- ^ maximal deviation, it must be @minDev <= maxDev@+               and the modulation must always be+               in the range [minDev,maxDev]. -}+   -> Proc.T s u q (+        RP.T s (SigA.D u q (SigS.T sig)) q+          {- v deviation control,+               positive numbers meanStatic prefetch,+               negative numbers meanStatic delay -}+     -> sig yv+     -> sig yv)+phaseModulationGeneric ip minDev _maxDev =+   fmap+      (\toTime devs ->+          let t0    = toTime minDev+              tInt0 = floor t0+          in  DelayG.modulated ip tInt0+                 (SigG.map (max t0) (SigA.scalarSamplesGeneric toTime devs)))+      (Proc.withParam toTimeScalar)+++{-+FIXME: move to Dimensional.Straight+-}+{-# INLINE frequencyModulation #-}+frequencyModulation ::+   (Hom.C sig, Flat.C flat t,+    Additive.C yv, RealField.C t, Dim.C u) =>+      Interpolation.T t yv+   -> Proc.T s u t (+        RP.T s flat t    {- v frequency factors -}+     -> RP.T s sig yv+     -> RP.T s sig yv)+frequencyModulation ip =+   Proc.pure $+      \ factors ->+          Hom.processSamples+             (interpolateMultiRelativeZeroPad ip (Flat.toSamples factors))++{- |+Frequency modulation where the input signal can have a sample rate+different from the output.+(The sample rate values can differ, the unit must be the same.+We could lift that restriction,+but then the unit handling becomes more complicated,+and I didn't have a use for it so far.)++The function can be used for resampling.+-}+{-# INLINE frequencyModulationDecoupled #-}+frequencyModulationDecoupled ::+   (Hom.C sig, Flat.C flat t,+    Additive.C yv, RealField.C t, Dim.C u) =>+      Interpolation.T t yv+   -> SigP.T u t sig yv+                   {- ToDo: We could also allow any signal from Generic.Read class. -}+   -> Proc.T s u t (+        RP.T s flat t {- v frequency factors -}+     -> RP.T s sig yv)+frequencyModulationDecoupled ip y =+   fmap+      (\toFreq factors ->+         RP.fromSignal $+         flip Hom.unwrappedProcessSamples (SigP.signal y) $+         interpolateMultiRelativeZeroPad ip $+         SigA.scalarSamples toFreq $+         SigA.fromSamples (SigP.sampleRate y) $+         Flat.toSamples factors)+      (Proc.withParam Proc.toFrequencyScalar)++++{-# INLINE interpolateMultiRelativeZeroPad #-}+interpolateMultiRelativeZeroPad ::+    (RealField.C q, Additive.C yv) =>+    Interpolation.T q yv+    -> Sig.T q+    -> Sig.T yv+    -> Sig.T yv+interpolateMultiRelativeZeroPad ip k x =+    Causal.apply (Interpolation.relativeZeroPad zero ip zero x) k++{- | symmetric phaser -}+{-# INLINE phaser #-}+phaser ::+   (Hom.C sig, Additive.C yv, RealField.C q,+    Module.C q yv, Dim.C u,+    Storable q, Storable yv) =>+      Interpolation.T q yv+   -> DN.T u q  {- ^ maxDev, must be positive -}+   -> Proc.T s u q (+        SigA.R s u q q+                {- v delay control -}+     -> RP.T s sig yv+     -> RP.T s sig yv)+phaser ip maxDev =+   fmap+      (\p devs ->+         Hom.processSamples+            (FiltNR.amplifyVector (SigA.asTypeOfAmplitude 0.5 devs) .+             uncurry Disp.mix . p devs))+      (phaserCore ip maxDev)++{-# INLINE phaserStereo #-}+phaserStereo ::+   (Hom.C sig, Additive.C yv, RealField.C q,+    Module.C q yv, Dim.C u,+    Storable q, Storable yv) =>+      Interpolation.T q yv+   -> DN.T u q   {- ^ maxDev, must be positive -}+   -> Proc.T s u q (+        SigA.R s u q q+                 {- v delay control -}+     -> RP.T s sig yv+     -> RP.T s sig (Stereo.T yv))+phaserStereo ip maxDev =+   fmap+      (\p devs ->+            Hom.processSamples (uncurry (Sig.zipWith Stereo.cons) . p devs))+      (phaserCore ip maxDev)++{-# INLINE phaserCore #-}+phaserCore ::+   (Additive.C yv, RealField.C q,+    Module.C q yv, Dim.C u,+    Storable q, Storable yv) =>+      Interpolation.T q yv+   -> DN.T u q   {- ^ maxDev, must be positive -}+   -> Proc.T s u q (+        SigA.R s u q q+                 {- v delay control -}+     -> Sig.T yv+     -> (Sig.T yv, Sig.T yv))+phaserCore ip maxDev =+   do let minDev  = Additive.negate maxDev+      pm <- phaseModulationGeneric ip minDev maxDev+      return $ \ devs x ->+         let devsPos = SigA.processSamples toStorable devs+             devsNeg = SigA.processSamples FiltG.negate devsPos+             xst     = toStorable x+         in  (fromStorable (pm devsPos xst),+              fromStorable (pm devsNeg xst))+++{-# INLINE firstOrderLowpass #-}+{-# INLINE firstOrderHighpass #-}+firstOrderLowpass, firstOrderHighpass ::+   (Hom.C sig, Trans.C q, Module.C q yv, Dim.C u) =>+      Proc.T s u q (+        SigA.R s (Dim.Recip u) q q+                    {- v Control signal for the cut-off frequency. -}+     -> RP.T s sig yv+                    {- v Input signal -}+     -> RP.T s sig yv)+firstOrderLowpass  = firstOrderGen Filt1.lowpassModifier+firstOrderHighpass = firstOrderGen Filt1.highpassModifier++{-# INLINE firstOrderGen #-}+firstOrderGen ::+   (Hom.C sig, Trans.C q, Module.C q yv, Dim.C u) =>+      (Modifier yv (Filt1.Parameter q) yv yv)+   -> Proc.T s u q (+        SigA.R s (Dim.Recip u) q q+     -> RP.T s sig yv+     -> RP.T s sig yv)+firstOrderGen modif =+   frequencyControl $ \ freqs ->+      modifyModulated Filt1.parameter modif freqs+++{-# INLINE butterworthLowpass #-}+{-# INLINE butterworthHighpass #-}+{-# INLINE chebyshevALowpass #-}+{-# INLINE chebyshevAHighpass #-}+{-# INLINE chebyshevBLowpass #-}+{-# INLINE chebyshevBHighpass #-}++butterworthLowpass, butterworthHighpass,+   chebyshevALowpass, chebyshevAHighpass,+   chebyshevBLowpass, chebyshevBHighpass ::+      (Hom.C sig, Flat.C flat q, Trans.C q, Module.C q yv, Dim.C u) =>+      NonNeg.Int   {- ^ Order of the filter, must be even,+                        the higher the order, the sharper is the separation of frequencies. -}+   -> Proc.T s u q (+        RP.T s flat q {- v The attenuation at the cut-off frequency.+                           Should be between 0 and 1. -}+     -> SigA.R s (Dim.Recip u) q q+                      {- v Control signal for the cut-off frequency. -}+     -> RP.T s sig yv {- v Input signal -}+     -> RP.T s sig yv)++butterworthLowpass  = higherOrderNoResoGen Butter.lowpassPole+butterworthHighpass = higherOrderNoResoGen Butter.highpassPole+chebyshevALowpass   = higherOrderNoResoGen Cheby.lowpassAPole+chebyshevAHighpass  = higherOrderNoResoGen Cheby.highpassAPole+chebyshevBLowpass   = higherOrderNoResoGen Cheby.lowpassBPole+chebyshevBHighpass  = higherOrderNoResoGen Cheby.highpassBPole+++{-# INLINE higherOrderNoResoGen #-}+higherOrderNoResoGen ::+   (Hom.C sig, Flat.C flat q, Field.C q, Dim.C u) =>+      (Int -> [q] -> [q] -> [yv] -> [yv])+   -> NonNeg.Int+   -> Proc.T s u q (+        RP.T s flat q+     -> SigA.R s (Dim.Recip u) q q+     -> RP.T s sig yv+     -> RP.T s sig yv)+higherOrderNoResoGen filt order =+   fmap flip $ frequencyControl $ \ freqs ratios ->+      Hom.processSampleList+         (filt (NonNeg.toNumber order) (Sig.toList (Flat.toSamples ratios)) (Sig.toList freqs))++++{-# INLINE highpassFromUniversal #-}+{-# INLINE bandpassFromUniversal #-}+{-# INLINE lowpassFromUniversal #-}+{-# INLINE bandlimitFromUniversal #-}+highpassFromUniversal, lowpassFromUniversal,+  bandpassFromUniversal, bandlimitFromUniversal ::+   (Hom.C sig) =>+        RP.T s sig (UniFilter.Result yv)+     -> RP.T s sig yv+{-+   (Hom.C sig, Dim.C u) =>+      Proc.T s u q (+        RP.T s sig (UniFilter.Result yv)+     -> RP.T s sig yv)+-}+highpassFromUniversal  = homogeneousMap UniFilter.highpass+bandpassFromUniversal  = homogeneousMap UniFilter.bandpass+lowpassFromUniversal   = homogeneousMap UniFilter.lowpass+bandlimitFromUniversal = homogeneousMap UniFilter.bandlimit++homogeneousMap ::+   (Hom.C sig, Ind.C w) =>+   (y0 -> y1) ->+   w sig y0 -> w sig y1+homogeneousMap f =+   Ind.processSignal (Hom.unwrappedProcessSamples (Sig.map f))++{-+homogeneousMap0 :: (Hom.C sig) =>+   (y0 -> y1) ->+   RP.T s sig y0 -> RP.T s sig y1+homogeneousMap0 f =+   Hom.processSamples (Sig.map f)++homogeneousMap1 :: (Hom.C sig) =>+   (y0 -> y1) ->+   Proc.T s1 u t (RP.T s sig y0 -> RP.T s sig y1)+homogeneousMap1 f =+   Proc.pure (Hom.processSamples (Sig.map f))+-}+++{-# INLINE universal #-}+universal ::+   (Hom.C sig, Flat.C flat q, Trans.C q, Module.C q yv, Dim.C u) =>+      Proc.T s u q (+        RP.T s flat q+                    {- v signal for resonance,+                         i.e. factor of amplification at the resonance frequency+                         relatively to the transition band. -}+     -> SigA.R s (Dim.Recip u) q q+                    {- v signal for cut off and band center frequency -}+     -> RP.T s sig yv+                    {- v input signal -}+     -> RP.T s sig (UniFilter.Result yv))+                    {- ^ highpass, bandpass, lowpass filter -}+universal =+   fmap flip $ frequencyControl $ \ freqs reso ->+      let resos = Flat.toSamples reso+      in  modifyModulated+             UniFilter.parameter+             UniFilter.modifier+             (Sig.zipWith FiltRec.Pole resos freqs)++{-# INLINE moogLowpass #-}+moogLowpass :: (Hom.C sig, Flat.C flat q, Trans.C q, Module.C q yv, Dim.C u) =>+      NonNeg.Int+   -> Proc.T s u q (+        RP.T s flat q+                   {- v signal for resonance,+                        i.e. factor of amplification at the resonance frequency+                        relatively to the transition band. -}+     -> SigA.R s (Dim.Recip u) q q+                   {- v signal for cut off frequency -}+     -> RP.T s sig yv+     -> RP.T s sig yv)+moogLowpass order =+   fmap flip $ frequencyControl $ \ freqs reso ->+      let resos = Flat.toSamples reso+          orderInt = NonNeg.toNumber order+      in  modifyModulated+             (Moog.parameter orderInt)+             (Moog.lowpassModifier orderInt)+             (Sig.zipWith FiltRec.Pole resos freqs)+++{-# INLINE allpassCascade #-}+allpassCascade :: (Hom.C sig, Trans.C q, Module.C q yv, Dim.C u) =>+      NonNeg.Int  {- ^ order, number of filters in the cascade -}+   -> q           {- ^ the phase shift to be achieved for the given frequency -}+   -> Proc.T s u q (+        SigA.R s (Dim.Recip u) q q {- v lowest comb frequency -}+     -> RP.T s sig yv+     -> RP.T s sig yv)+allpassCascade order phase =+   frequencyControl $ \ freqs ->+      let orderInt = NonNeg.toNumber order+      in  modifyModulated+             (Allpass.parameter orderInt phase)+             (Allpass.cascadeModifier orderInt)+             freqs++{-# INLINE allpassFlangerPhase #-}+allpassFlangerPhase :: Trans.C a => a+allpassFlangerPhase = Allpass.flangerPhase+++{- | Infinitely many equi-delayed exponentially decaying echos. -}+{-# INLINE comb #-}+comb :: (Hom.C sig, RealField.C t, Module.C y yv, Dim.C u, Storable yv) =>+   DN.T u t -> y -> Proc.T s u t (RP.T s sig yv -> RP.T s sig yv)+comb time gain =+   do t <- toTimeScalar time+      return $ Hom.processSamples+         (fromStorable . Comb.run (round t) gain . toStorable)+++-- * auxiliary functions++{-# INLINE frequencyControl #-}+frequencyControl :: (Dim.C u, Field.C y) =>+      (Sig.T y -> t)+   -> Proc.T s u y (+        SigA.R s (Dim.Recip u) y y+     -> t)+frequencyControl f =+   do toFreq <- Proc.withParam toFrequencyScalar+      return $ \ freq -> f (SigA.scalarSamples toFreq freq)+++{-# INLINE modifyModulated #-}+modifyModulated :: Hom.C sig =>+   (param -> ctrl) ->+   Modifier state ctrl y0 y1 ->+   Sig.T param ->+   RP.T s sig y0 ->+   RP.T s sig y1+modifyModulated makeParam modif params =+   Hom.processSamples (Sig.modifyModulated modif (Sig.map makeParam params))
+ src/Synthesizer/Dimensional/Rate/Oscillator.hs view
@@ -0,0 +1,378 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{- |+Copyright   :  (c) Henning Thielemann 2008, 2009+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++-}+module Synthesizer.Dimensional.Rate.Oscillator (+   {- * Oscillators with constant waveforms -}+   static,+   staticAntiAlias,+   freqMod,+   freqModAntiAlias,+   phaseMod,+   phaseFreqMod,+   shapeMod,+   shapeFreqMod,+   staticSample,+   freqModSample,+--   shapeFreqModSample,+   shapeFreqModFromSampledTone,+   shapePhaseFreqModFromSampledTone,+   ) where++import qualified Synthesizer.Dimensional.Abstraction.HomogeneousGen as Hom+import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat++import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.RatePhantom as RP+import qualified Synthesizer.Dimensional.RateWrapper as SigP++import qualified Synthesizer.State.Oscillator as Osci+import qualified Synthesizer.State.Signal as Sig++import qualified Synthesizer.Dimensional.Causal.Process as CausalD+import qualified Synthesizer.Dimensional.Causal.Oscillator as OsciC+import qualified Synthesizer.Dimensional.Map as MapD++import qualified Synthesizer.Generic.Signal as SigG++import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth+import qualified Synthesizer.Basic.Wave         as Wave+import qualified Synthesizer.Basic.Phase        as Phase++import qualified Synthesizer.Dimensional.Straight.Signal as SigS+import qualified Synthesizer.Dimensional.Cyclic.Signal as SigC++import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Process as Proc+import Synthesizer.Dimensional.Process (toFrequencyScalar, )++import qualified Synthesizer.Interpolation as Interpolation++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim+-- import Number.DimensionTerm ((&*&))++import qualified Algebra.RealField          as RealField+import qualified Algebra.Field              as Field++-- import NumericPrelude+import PreludeBase as P++{- |+This class is similar to the Homogeneous class+in the implementation,+but it is even more strict semantically.+It requires that values from the waveform+go untouched to the output signal,+whereas Homogeneous class still allows homogeneous+(aka amplitude-unit-independent) operations.++We could use the Homogeneous constraints+immediately in the oscillator functions,+but with the functional dependencies+we get more from type inference.+This way, the compiler knows,+that when we apply an oscillator to a flat wave,+that we want a flat signal as output.+-}+class (Hom.C amp (Wave.T t) wave, Hom.C amp Sig.T signal) =>+      Simple amp t wave signal+      | wave -> t, signal t -> wave, wave -> signal,+        signal -> amp, wave -> amp where++instance Simple CausalD.Flat t (Wave.T t) (SigS.T Sig.T) where++instance (Amp.C amp) =>+   Simple amp t (SigA.T amp (Wave.T t)) (SigA.T amp (SigS.T Sig.T)) where+++class (Hom.C amp (WaveSmooth.T t) wave, Hom.C amp Sig.T signal) =>+      Smooth amp t wave signal+      | wave -> t, signal t -> wave, wave -> signal,+        signal -> amp, wave -> amp where++instance Smooth CausalD.Flat t (WaveSmooth.T t) (SigS.T Sig.T) where++instance (Amp.C amp) =>+   Smooth amp t (SigA.T amp (WaveSmooth.T t)) (SigA.T amp (SigS.T Sig.T)) where+++withWave ::+   (Hom.C amp waveStore wave, Hom.C amp Sig.T sig) =>+   wave y -> (waveStore y -> Sig.T y) -> RP.T s sig y+withWave w f =+   RP.fromSignal $ Hom.plainProcessSamples f w+++{- * Oscillators with constant waveforms -}++{- | oscillator with a functional waveform with constant frequency -}+{-# INLINE static #-}+static ::+   (RealField.C t, Dim.C u,+    Simple amp t wave sig) =>+      wave y       {- ^ waveform -}+   -> Phase.T t    {- ^ start phase -}+   -> DN.T (Dim.Recip u) t+                   {- ^ frequency -}+   -> Proc.T s u t (RP.T s sig y)+static wave phase =+   staticAux (\freq -> withWave wave $ \w -> Osci.static w phase freq)++{- | oscillator with a functional waveform with constant frequency -}+{-# INLINE staticAntiAlias #-}+staticAntiAlias ::+   (RealField.C t, Dim.C u,+    Smooth amp t wave sig) =>+      wave y+                   {- ^ waveform -}+   -> Phase.T t    {- ^ start phase -}+   -> DN.T (Dim.Recip u) t+                   {- ^ frequency -}+   -> Proc.T s u t (RP.T s sig y)+staticAntiAlias wave phase =+   staticAux (\freq -> withWave wave $ \w -> Osci.staticAntiAlias w phase freq)++{- | oscillator with a functional waveform with modulated frequency -}+{-# INLINE freqMod #-}+freqMod ::+   (RealField.C t, Dim.C u,+    Simple amp t wave sig) =>+      wave y       {- ^ waveform -}+   -> Phase.T t    {- ^ start phase -}+   -> Proc.T s u t (+        SigA.R s (Dim.Recip u) t t+                   {- v frequency control -}+     -> RP.T s sig y)+freqMod wave phase =+   freqModAux (\t -> withWave wave $ \w -> Osci.freqMod w phase t)++{- | oscillator with a functional waveform with modulated frequency -}+{-# INLINE freqModAntiAlias #-}+freqModAntiAlias ::+   (RealField.C t, Dim.C u,+    Smooth amp t wave sig) =>+      wave y+                   {- ^ waveform -}+   -> Phase.T t    {- ^ start phase -}+   -> Proc.T s u t (+        SigA.R s (Dim.Recip u) t t+                   {- v frequency control -}+     -> RP.T s sig y)+freqModAntiAlias wave phase =+   freqModAux (\t -> withWave wave $ \w -> Osci.freqModAntiAlias w phase t)++{- | oscillator with modulated phase -}+{-# INLINE phaseMod #-}+phaseMod ::+   (Flat.C flat t, RealField.C t, Dim.C u,+    Simple amp t wave sig) =>+      wave y       {- ^ waveform -}+   -> DN.T (Dim.Recip u) t+                   {- ^ frequency -}+   -> Proc.T s u t (+        RP.T s flat t+                   {- v phase modulation, phases must have no unit -}+     -> RP.T s sig y)+phaseMod wave =+   staticAux (\freq sig ->+      withWave wave $ \w -> Osci.phaseMod w freq . Flat.toSamples $ sig)++{- | oscillator with modulated shape -}+{-# INLINE shapeMod #-}+shapeMod ::+   (Flat.C flat c, RealField.C t, Dim.C u) =>+      (c -> Wave.T t y)+                   {- ^ waveform -}+   -> Phase.T t    {- ^ phase -}+   -> DN.T (Dim.Recip u) t+                   {- ^ frequency -}+   -> Proc.T s u t (+        RP.T s flat c {- v shape control -}+     -> SigS.R s y)+shapeMod wave phase =+   staticAux (\freq -> SigS.fromSamples . Osci.shapeMod wave phase freq . Flat.toSamples)+++{- | oscillator with a functional waveform with modulated phase and frequency -}+{-# INLINE phaseFreqMod #-}+phaseFreqMod ::+   (Flat.C flat t, RealField.C t, Dim.C u,+    Simple amp t wave sig) =>+      wave y       {- ^ waveform -}+   -> Proc.T s u t (+        RP.T s flat t+                     {- v phase control -}+     -> SigA.R s (Dim.Recip u) t t+                     {- v frequency control -}+     -> RP.T s sig y)+phaseFreqMod wave =+   fmap flip $+      freqModAux (\ freqs phases ->+         withWave wave $ \w ->+            Osci.phaseFreqMod w (Flat.toSamples phases) freqs)++{- | oscillator with both shape and frequency modulation -}+{-# INLINE shapeFreqMod #-}+shapeFreqMod :: (Flat.C flat c, RealField.C t, Dim.C u) =>+      (c -> Wave.T t y)+                   {- ^ waveform -}+   -> Phase.T t    {- ^ phase -}+   -> Proc.T s u t (+        RP.T s flat c+                     {- v shape control -}+     -> SigA.R s (Dim.Recip u) t t+                     {- v frequency control -}+     -> SigS.R s y)+shapeFreqMod wave phase =+   fmap flip $+      freqModAux+         (\ freqs parameters ->+              SigS.fromSamples $ Osci.shapeFreqMod wave phase (Flat.toSamples parameters) freqs)+++{- |+oscillator with a sampled waveform with constant frequency+This is essentially an interpolation with cyclic padding.+You can also achieve this with a waveform constructed by 'Wave.sample'.+-}+{-# INLINE staticSample #-}+staticSample :: (RealField.C t, Dim.C u) =>+      Interpolation.T t y+   -> SigC.R r y   {- ^ waveform -}+   -> Phase.T t    {- ^ start phase -}+   -> DN.T (Dim.Recip u) t+                   {- ^ frequency -}+   -> Proc.T s u t (SigS.R s y)+staticSample ip wave phase =+   staticAux (SigS.fromSamples . Osci.staticSample ip (SigC.toPeriod wave) phase)++{- |+oscillator with a sampled waveform with modulated frequency+Should behave homogenously for different types of interpolation.+-}+{-# INLINE freqModSample #-}+freqModSample :: (RealField.C t, Dim.C u) =>+      Interpolation.T t y+   -> SigC.R r y   {- ^ waveform -}+   -> Phase.T t    {- ^ start phase -}+   -> Proc.T s u t (+        SigA.R s (Dim.Recip u) t t+                   {- v frequency control -}+     -> SigS.R s y)+freqModSample ip wave phase =+   freqModAux (SigS.fromSamples . Osci.freqModSample ip (SigC.toPeriod wave) phase)+++{-+{-# INLINE shapeFreqModSample #-}+shapeFreqModSample :: (RealField.C c, RealField.C t) =>+      Interpolation.T c (Wave.T t y)+   -> sig (Wave.T t y)+   -> c -> Phase.T t+   -> Proc.T s u t (+        RP.T s flat c+                   {- v shape control -}+     -> SigA.R s (Dim.Recip u) t t+                   {- v frequency control -}+     -> SigS.R s y)+shapeFreqModSample ip waves shape0 phase =+    uncurry Wave.apply ^<<+       (InterpolationC.relativeConstantPad ip shape0 waves ***+        freqsToPhases phase)+-}++{-# INLINE shapeFreqModFromSampledTone #-}+shapeFreqModFromSampledTone ::+    (RealField.C t, SigG.Transform storage yv, Dim.C u,+     Hom.C amp storage input, Hom.C amp Sig.T output,+     Flat.C flat t) =>+      Interpolation.T t yv+   -> Interpolation.T t yv+   -> DN.T (Dim.Recip u) t+                   {- ^ source frequency -}+   -> SigP.T u t input yv+   -> t -> Phase.T t+   -> Proc.T s u t (+        RP.T s flat t+                   {- v shape control -}+     -> SigA.R s (Dim.Recip u) t t+                   {- v frequency control -}+     -> RP.T s output yv)+shapeFreqModFromSampledTone+      ipLeap ipStep srcFreq sampledTone shape0 phase =+   flip fmap+      (OsciC.shapeFreqModFromSampledTone+         ipLeap ipStep srcFreq sampledTone shape0 phase)+      (\osci ->+         \shapes freqs ->+            osci+            `CausalD.applyFlatFst`+            shapes+            `CausalD.apply`+            freqs)+++{-# INLINE shapePhaseFreqModFromSampledTone #-}+shapePhaseFreqModFromSampledTone ::+    (RealField.C t, SigG.Transform storage yv, Dim.C u,+     Hom.C amp storage input, Hom.C amp Sig.T output,+     Flat.C flatS t, Flat.C flatP t) =>+      Interpolation.T t yv+   -> Interpolation.T t yv+   -> DN.T (Dim.Recip u) t+                   {- ^ source frequency -}+   -> SigP.T u t input yv+   -> t -> Phase.T t+   -> Proc.T s u t (+        RP.T s flatS t+                   {- v shape control -}+     -> RP.T s flatP t+                   {- v phase control -}+     -> SigA.R s (Dim.Recip u) t t+                   {- v frequency control -}+     -> RP.T s output yv)+shapePhaseFreqModFromSampledTone+      ipLeap ipStep srcFreq sampledTone shape0 phase =+   flip fmap+      (OsciC.shapePhaseFreqModFromSampledTone+         ipLeap ipStep srcFreq sampledTone shape0 phase)+      (\osci ->+         \shapes phaseDistort freqs ->+            (osci CausalD.<<^ MapD.packTriple)+            `CausalD.applyFlatFst`+            shapes+            `CausalD.applyFlatFst`+            phaseDistort+            `CausalD.apply`+            freqs)+++{-# INLINE freqModAux #-}+freqModAux :: (Field.C t, Dim.C u) =>+      (Sig.T t -> c)+   -> Proc.T s u t (+        SigA.R s (Dim.Recip u) t t+     -> c)+freqModAux f =+   fmap+      (\toFreq -> f . SigA.scalarSamples toFreq)+      (Proc.withParam toFrequencyScalar)++{-# INLINE staticAux #-}+staticAux :: (Dim.C u, Field.C t) =>+      (t -> c)+   -> DN.T (Dim.Recip u) t+   -> Proc.T s u t c+staticAux f freq =+   fmap f (toFrequencyScalar freq)
+ src/Synthesizer/Dimensional/RateAmplitude/Analysis.hs view
@@ -0,0 +1,358 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Dimensional.RateAmplitude.Analysis (+    centroid,+    length,++    normMaximum,      normVectorMaximum,+    normEuclideanSqr, normVectorEuclideanSqr,+    normSum,          normVectorSum,++    normMaximumProc,      normVectorMaximumProc,+    normEuclideanSqrProc, normVectorEuclideanSqrProc,+    normSumProc,          normVectorSumProc,++    histogram,+    zeros,++    toFrequencySpectrum, fromFrequencySpectrum,+  ) where++import qualified Synthesizer.State.Analysis as Ana+import qualified Synthesizer.State.Signal   as Sig++-- import qualified Synthesizer.Dimensional.Rate                 as Rate+import qualified Synthesizer.Dimensional.Process              as Proc+import qualified Synthesizer.Dimensional.Amplitude.Analysis   as AnaA+import qualified Synthesizer.Dimensional.Amplitude.Signal     as SigA+import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigRA+import qualified Synthesizer.Dimensional.Straight.Signal      as SigS+import qualified Synthesizer.Dimensional.Cyclic.Signal        as SigC+import qualified Synthesizer.Dimensional.RateWrapper          as SigP+import qualified Synthesizer.Dimensional.Rate.Dirac           as Dirac++import Synthesizer.Dimensional.RateAmplitude.Signal (DimensionGradient)++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import Number.DimensionTerm ((&*&), (*&), )++import qualified Number.Complex as Complex++import qualified Algebra.NormedSpace.Maximum   as NormedMax+import qualified Algebra.NormedSpace.Euclidean as NormedEuc+import qualified Algebra.NormedSpace.Sum       as NormedSum++import qualified Algebra.Transcendental      as Trans+import qualified Algebra.Algebraic           as Algebraic+import qualified Algebra.Field               as Field+import qualified Algebra.RealField           as RealField+import qualified Algebra.Ring                as Ring+import qualified Algebra.Real                as Real+++import PreludeBase (Ord, ($), (.), return, fmap, id, )+import NumericPrelude ((+), negate, (/), sqr, abs, fromIntegral, pi, )+import Prelude (Int, )+++{- * Positions -}++{-# INLINE centroid #-}+centroid :: (Field.C q, Dim.C u, Dim.C v) =>+   SigP.T u q (SigA.S v y) q -> DN.T u q+centroid = makePhysicalLength Ana.centroid++{-# INLINE length #-}+length :: (Field.C t, Dim.C u, Dim.C v) =>+   SigP.T u t (SigA.S v y) yv -> DN.T u t+length = makePhysicalLength (fromIntegral . Sig.length)++{-# INLINE makePhysicalLength #-}+makePhysicalLength :: (Field.C t, Dim.C u, Dim.C v) =>+   (Sig.T yv -> t) ->+   SigP.T u t (SigA.S v y) yv -> DN.T u t+makePhysicalLength f x =+   f (SigA.samples x)  *&  DN.unrecip (SigP.sampleRate x)++{-# INLINE period #-}+period :: (Field.C t, Dim.C u, Dim.C v) =>+   SigP.T u t (SigA.D v y (SigC.T Sig.T)) yv -> DN.T u t+period = makePhysicalPeriod (fromIntegral . Sig.length)++{-# INLINE makePhysicalPeriod #-}+makePhysicalPeriod :: (Field.C t, Dim.C u, Dim.C v) =>+   (Sig.T yv -> t) ->+   SigP.T u t (SigA.D v y (SigC.T Sig.T)) yv -> DN.T u t+makePhysicalPeriod f x =+   f (SigC.samples (SigA.signal (SigP.signal x)))+       *&  DN.unrecip (SigP.sampleRate x)+++{- * Norms -}++{- |+Manhattan norm.+-}+{-# INLINE normMaximum #-}+normMaximum :: (Real.C y, Dim.C u, Dim.C v) =>+   SigP.T u t (SigA.S v y) y -> DN.T v y+normMaximum =+   AnaA.volumeMaximum++{- |+Square of energy norm.++Could also be called @variance@.+-}+{-# INLINE normEuclideanSqr #-}+normEuclideanSqr :: (Algebraic.C q, Dim.C u, Dim.C v) =>+   SigP.T u q (SigA.S v q) q ->+   DN.T (Dim.Mul u (Dim.Sqr v)) q+normEuclideanSqr =+   normAux DN.sqr (Sig.sum . Sig.map sqr)++{- |+Sum norm.+-}+{-# INLINE normSum #-}+normSum :: (Field.C q, Real.C q, Dim.C u, Dim.C v) =>+   SigP.T u q (SigA.S v q) q ->+   DN.T (Dim.Mul u v) q+normSum =+   normAux id (Sig.sum . Sig.map abs)++++{- |+Manhattan norm.+-}+{-# INLINE normVectorMaximum #-}+normVectorMaximum ::+   (NormedMax.C q yv, Ord q, Dim.C u, Dim.C v) =>+   SigP.T u q (SigA.S v q) yv ->+   DN.T v q+normVectorMaximum =+   AnaA.volumeVectorMaximum -- NormedMax.norm++{- |+Energy norm.+-}+{-# INLINE normVectorEuclideanSqr #-}+normVectorEuclideanSqr ::+   (NormedEuc.C q yv, Algebraic.C q, Dim.C u, Dim.C v) =>+   SigP.T u q (SigA.S v q) yv ->+   DN.T (Dim.Mul u (Dim.Sqr v)) q+normVectorEuclideanSqr =+   normAux DN.sqr (Sig.sum . Sig.map NormedEuc.normSqr)++{- |+Sum norm.+-}+{-# INLINE normVectorSum #-}+normVectorSum ::+   (NormedSum.C q yv, Field.C q, Dim.C u, Dim.C v) =>+   SigP.T u q (SigA.S v q) yv ->+   DN.T (Dim.Mul u v) q+normVectorSum =+   normAux id (Sig.sum . Sig.map NormedSum.norm)+++{-# INLINE normAux #-}+normAux :: (Dim.C v0, Dim.C v1, Dim.C u, Field.C t) =>+   (DN.T v0 y -> DN.T v1 t) ->+   (Sig.T yv -> t) ->+   SigP.T u t (SigA.D v0 y SigS.S) yv ->+   DN.T (Dim.Mul u v1) t+normAux amp norm x =+   norm (SigA.samples x)+       *& DN.unrecip (SigP.sampleRate x)+      &*& amp (SigA.amplitude x)+++++{-# DEPRECATED #-}+{- |+Manhattan norm.+-}+{-# INLINE normMaximumProc #-}+normMaximumProc :: (Real.C y, Dim.C u, Dim.C v) =>+   Proc.T s u y (SigA.R s v y y -> DN.T v y)+normMaximumProc =+   Proc.pure AnaA.volumeMaximum++{-# DEPRECATED #-}+{- |+Square of energy norm.++Could also be called @variance@.+-}+{-# INLINE normEuclideanSqrProc #-}+normEuclideanSqrProc :: (Algebraic.C q, Dim.C u, Dim.C v) =>+   Proc.T s u q (+      SigA.R s v q q ->+      DN.T (Dim.Mul u (Dim.Sqr v)) q)+normEuclideanSqrProc =+   normAuxProc DN.sqr (Sig.sum . Sig.map sqr)++{-# DEPRECATED #-}+{- |+Sum norm.+-}+{-# INLINE normSumProc #-}+normSumProc :: (Field.C q, Real.C q, Dim.C u, Dim.C v) =>+   Proc.T s u q (+      SigA.R s v q q ->+      DN.T (Dim.Mul u v) q)+normSumProc =+   normAuxProc id (Sig.sum . Sig.map abs)++++{-# DEPRECATED #-}+{- |+Manhattan norm.+-}+{-# INLINE normVectorMaximumProc #-}+normVectorMaximumProc ::+   (NormedMax.C y yv, Ord y, Dim.C u, Dim.C v) =>+   Proc.T s u y (+      SigA.R s v y yv ->+      DN.T v y)+normVectorMaximumProc =+   Proc.pure AnaA.volumeVectorMaximum -- NormedMax.norm++{-# DEPRECATED #-}+{- |+Energy norm.+-}+{-# INLINE normVectorEuclideanSqrProc #-}+normVectorEuclideanSqrProc ::+   (NormedEuc.C y yv, Algebraic.C y, Dim.C u, Dim.C v) =>+   Proc.T s u y (+      SigA.R s v y yv ->+      DN.T (Dim.Mul u (Dim.Sqr v)) y)+normVectorEuclideanSqrProc =+   normAuxProc DN.sqr (Sig.sum . Sig.map NormedEuc.normSqr)++{-# DEPRECATED #-}+{- |+Sum norm.+-}+{-# INLINE normVectorSumProc #-}+normVectorSumProc ::+   (NormedSum.C y yv, Field.C y, Dim.C u, Dim.C v) =>+   Proc.T s u y (+      SigA.R s v y yv ->+      DN.T (Dim.Mul u v) y)+normVectorSumProc =+   normAuxProc id (Sig.sum . Sig.map NormedSum.norm)+++{-# INLINE normAuxProc #-}+normAuxProc :: (Dim.C v0, Dim.C v1, Dim.C u, Field.C t) =>+   (DN.T v0 y -> DN.T v1 t) ->+   (Sig.T yv -> t) ->+   Proc.T s u t (+      SigA.R s v0 y yv ->+      DN.T (Dim.Mul u v1) t)+normAuxProc amp norm =+   Proc.withParam $ \ x ->+   fmap+      (&*& amp (SigA.amplitude x))+      (Proc.toTimeDimension (norm (SigA.samples x)))++++++{- * Miscellaneous -}++{-# INLINE histogram #-}+histogram :: (RealField.C q, Dim.C u, Dim.C v) =>+   SigP.T u q (SigA.S v q) q ->+   Proc.T s v q (Int, SigA.R s (DimensionGradient v u) q q)+histogram xs =+   do rateY <- Proc.getSampleRate+      toTime <- Proc.withParam Proc.toTimeScalar+      return $+         let (offset, hist) =+                 Ana.histogramLinearIntMap+                    (SigA.scalarSamples toTime xs)+         in  (offset,+              SigA.fromSamples+                 (rateY &*& DN.unrecip (SigP.sampleRate xs))+                 hist)++{- |+Detects zeros (sign changes) in a signal.+This can be used as a simple measure of the portion+of high frequencies or noise in the signal.+The result has a frequency as amplitude.+If you smooth it, you will get a curve that represents a frequency progress.+It ca be used as voiced\/unvoiced detector in a vocoder.++The result will be one value shorter than the input.+-}+{-# INLINE zeros #-}+zeros :: (Ord q, Ring.C q, Dim.C u, Dim.C v) =>+   Proc.T s u q (SigA.R s v q q -> SigA.R s (Dim.Recip u) q q)+zeros =+   fmap+      (\fp -> fp . Dirac.Cons . Ana.zeros . SigA.samples)+      Dirac.toAmplitudeSignal++++{- |+Fourier analysis+-}+{-# INLINE toFrequencySpectrum #-}+toFrequencySpectrum :: (Trans.C q, Dim.C u, Dim.C v) =>+   SigP.T u q (SigA.D v q (SigC.T Sig.T)) (Complex.T q) ->+   SigP.T (Dim.Recip u) q (SigA.D (Dim.Mul u v) q (SigC.T Sig.T)) (Complex.T q)+toFrequencySpectrum x =+   let len = DN.rewriteDimension Dim.doubleRecip (period x)+       amp = SigA.amplitude x+       ss  = SigC.samples (SigA.signal (SigP.signal x))+       n   = Sig.length ss+       z = Complex.cis (negate (pi+pi) / fromIntegral n)+       newAmp = DN.unrecip (SigP.sampleRate x) &*& amp+   in  SigP.Cons len+          (SigA.Cons newAmp+              (SigC.Cons (Sig.take n (Ana.chirpTransform z ss))))+{-+toFrequencySpectrum $ SigP.Cons (DN.frequency (4::Prelude.Double)) (SigA.Cons (DN.voltage (1::Prelude.Double)) (SigC.Cons [1, 0 Number.Complex.+: (1::Prelude.Double), -1, 0 Number.Complex.+: (-1)]))+toFrequencySpectrum $ SigP.Cons (DN.frequency (4::Prelude.Double)) (SigA.Cons (DN.voltage (1::Prelude.Double)) (SigC.Cons [0 Number.Complex.+: (1::Prelude.Double), -1, 0 Number.Complex.+: (-1), 1]))+toFrequencySpectrum $ SigP.Cons (DN.frequency (4::Prelude.Double)) (SigA.Cons (DN.voltage (1::Prelude.Double)) (SigC.Cons [1, -1,1, (-1) Number.Complex.+: (0::Prelude.Double)]))+-}+++{- |+Fourier synthesis+-}+{-# INLINE fromFrequencySpectrum #-}+fromFrequencySpectrum :: (Trans.C q, Dim.C u, Dim.C v) =>+   SigP.T (Dim.Recip u) q (SigA.D (Dim.Mul u v) q (SigC.T Sig.T)) (Complex.T q) ->+   SigP.T u q (SigA.D v q (SigC.T Sig.T)) (Complex.T q)+fromFrequencySpectrum x =+   let len = period x+       amp = SigA.amplitude x+       ss  = SigC.samples (SigA.signal (SigP.signal x))+       n   = Sig.length ss+       z = Complex.cis ((pi+pi) / fromIntegral n)+       newAmp =+          DN.rewriteDimension+             (Dim.identityLeft . Dim.applyLeftMul Dim.cancelLeft . Dim.associateLeft)+             (DN.unrecip (SigP.sampleRate x) &*& amp)+   in  SigP.Cons len+          (SigA.Cons newAmp+              (SigC.Cons (Sig.take n (Ana.chirpTransform z ss))))
+ src/Synthesizer/Dimensional/RateAmplitude/Control.hs view
@@ -0,0 +1,332 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+++Control curves which can be used+as envelopes, for controlling filter parameters and so on.+-}+module Synthesizer.Dimensional.RateAmplitude.Control+   ({- * Primitives -}+    constant, constantVector,+    linear, line,+    exponential, exponential2, exponentialFromTo,+    cubicHermite,+    {- * Piecewise -}+    stepPiece, linearPiece, exponentialPiece, cosinePiece, cubicPiece,+    piecewise, piecewiseVolume, Piece, Piecewise,+    (-|#), ( #|-), (=|#), ( #|=), (|#), ( #|),  -- spaces before # for Haddock+    {- * Preparation -}+    mapLinearDimension, mapExponentialDimension, )+   where++import qualified Synthesizer.Dimensional.Amplitude.Control as CtrlA+import qualified Synthesizer.State.Control as Ctrl+import qualified Synthesizer.Dimensional.Straight.Signal as SigS++import qualified Synthesizer.Piecewise as Piecewise+import Synthesizer.Piecewise ((-|#), ( #|-), (=|#), ( #|=), (|#), ( #|), )++import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Process as Proc+-- import Synthesizer.Dimensional.Process (($:), ($#), )+import Synthesizer.Dimensional.RateAmplitude.Signal+          (toTimeScalar, toAmplitudeScalar, toGradientScalar, DimensionGradient)++import qualified Synthesizer.State.Signal as Sig++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++-- import Number.DimensionTerm ((&*&))++-- import qualified Algebra.Module             as Module+import qualified Algebra.Transcendental     as Trans+import qualified Algebra.RealField          as RealField+import qualified Algebra.Field              as Field+import qualified Algebra.Real               as Real+-- import qualified Algebra.Ring               as Ring+import qualified Algebra.Additive           as Additive++-- import Control.Monad.Fix (mfix, )+import Control.Monad (liftM3, )++import NumericPrelude+import PreludeBase+import Prelude ()++++{-# INLINE constant #-}+constant :: (Real.C y, Dim.C u, Dim.C v) =>+      DN.T v y {-^ value -}+   -> Proc.T s u t (SigA.R s v y y)+constant y = Proc.pure $ CtrlA.constant y++{- |+The amplitude must be positive!+This is not checked.+-}+{-# INLINE constantVector #-}+constantVector :: -- (Field.C y', Real.C y', Dim.C v) =>+      DN.T v y {-^ amplitude -}+   -> yv       {-^ value -}+   -> Proc.T s u t (SigA.R s v y yv)+constantVector y yv = Proc.pure $ CtrlA.constantVector y yv++{- Using the 'Ctrl.linear' instead of 'Ctrl.linearStable'+   the type class constraints would be weaker.+linear :: (Additive.C y, Field.C y', Real.C y', Dim.C v) =>+-}++{- |+Caution: This control curve can contain samples+with an absolute value greater than 1.++Linear curves starting with zero are impossible.+Maybe you prefer using 'line'.+-}+{-# INLINE linear #-}+linear ::+   (Field.C q, Real.C q, Dim.C u, Dim.C v) =>+      DN.T (DimensionGradient u v) q+               {-^ slope of the curve -}+   -> DN.T v q {-^ initial value -}+   -> Proc.T s u q (SigA.R s v q q)+linear slope y0 =+   let (amp,sgn) = DN.absSignum y0+   in  do steep <- toGradientScalar amp slope+          return (SigA.fromSamples amp (Ctrl.linearMultiscale steep sgn))++{- |+Generates a finite ramp.+-}+{-# INLINE line #-}+line ::+   (RealField.C q, Dim.C u, Dim.C v) =>+      DN.T u q      {-^ duration of the ramp -}+   -> (DN.T v q, DN.T v q)+                    {-^ initial and final value -}+   -> Proc.T s u q (SigA.R s v q q)+line dur' (y0',y1') =+   (toTimeScalar dur') >>= \dur -> return $+      let amp = max (DN.abs y0') (DN.abs y1')+          y0  = toAmplitudeScalar z y0'+          y1  = toAmplitudeScalar z y1'+          z = SigA.fromSamples amp+                 (Sig.take (floor dur)+                    (Ctrl.linearMultiscale ((y1-y0)/dur) y0))+      in  z++{-# INLINE exponential #-}+exponential :: (Trans.C q, Real.C q, Dim.C u, Dim.C v) =>+      DN.T u q {-^ time where the function reaches 1\/e of the initial value -}+   -> DN.T v q {-^ initial value -}+   -> Proc.T s u q (SigA.R s v q q)+exponential time y0 =+   (toTimeScalar time) >>= \t -> return $+      let (amp,sgn) = DN.absSignum y0+      in  SigA.fromSamples amp (Ctrl.exponentialMultiscale t sgn)++{-+  take 1000 $ show (run (fixSampleRate 100 (exponential 0.1 1)) :: SigDouble)+-}++{-# INLINE exponential2 #-}+exponential2 :: (Trans.C q, Real.C q, Dim.C u, Dim.C v) =>+      DN.T u q {-^ half life, time where the function reaches 1\/2 of the initial value -}+   -> DN.T v q {-^ initial value -}+   -> Proc.T s u q (SigA.R s v q q)+exponential2 time y0 =+   (toTimeScalar time) >>= \t -> return $+      let (amp,sgn) = DN.absSignum y0+      in  SigA.fromSamples amp (Ctrl.exponential2Multiscale t sgn)++{- |+Generate an exponential curve through two nodes.+-}+{-# INLINE exponentialFromTo #-}+exponentialFromTo ::+   (Trans.C q, RealField.C q, Dim.C u, Dim.C v) =>+      DN.T u q      {-^ duration of the ramp -}+   -> (DN.T v q, DN.T v q)+                    {-^ initial and final value -}+   -> Proc.T s u q (SigA.R s v q q)+exponentialFromTo dur' (y0',y1') =+   (toTimeScalar dur') >>= \dur -> return $+      let amp = max (DN.abs y0') (DN.abs y1')+          y0  = toAmplitudeScalar z y0'+          y1  = toAmplitudeScalar z y1'+          z = SigA.fromSamples amp+                 (Sig.take (floor dur)+                    (Ctrl.exponentialFromTo dur y0 y1))+      in  z++++{-# INLINE cubicHermite #-}+cubicHermite ::+   (Field.C q, Real.C q, Dim.C u, Dim.C v) =>+      (DN.T u q, (DN.T v q, DN.T (DimensionGradient u v) q))+   -> (DN.T u q, (DN.T v q, DN.T (DimensionGradient u v) q))+   -> Proc.T s u q (SigA.R s v q q)+cubicHermite (t0', (y0',dy0')) (t1', (y1',dy1')) =+   let amp = max (DN.abs y0') (DN.abs y1')+   in  do t0  <- toTimeScalar t0'+          t1  <- toTimeScalar t1'+          dy0 <- toGradientScalar amp dy0'+          dy1 <- toGradientScalar amp dy1'+          return $+             let y0 = toAmplitudeScalar z y0'+                 y1 = toAmplitudeScalar z y1'+                 z = SigA.fromSamples amp (Ctrl.cubicHermite (t0, (y0,dy0)) (t1, (y1,dy1)))+              in z+++++-- * piecewise curves++type Piece s u v q =+   Piecewise.Piece+      (DN.T u q) (DN.T v q)+      (DN.T v q -> q -> Proc.T s u q (SigS.R s q))++type Piecewise s u v q =+   Piecewise.T+      (DN.T u q) (DN.T v q)+      (DN.T v q -> q -> Proc.T s u q (SigS.R s q))+++{- |+Since this function looks for the maximum node value,+and since the signal parameter inference phase must be completed before signal processing,+infinite descriptions cannot be used here.+-}+{-# INLINE piecewise #-}+piecewise :: (Trans.C q, RealField.C q, Dim.C u, Dim.C v) =>+      Piecewise s u v q+   -> Proc.T s u q (SigA.R s v q q)+piecewise cs =+   let amplitude = maximum+         (map (\c -> max (DN.abs (Piecewise.pieceY0 c))+                         (DN.abs (Piecewise.pieceY1 c))) cs)+   in  piecewiseVolume cs amplitude+++{-# INLINE piecewiseVolume #-}+piecewiseVolume ::+   (Trans.C q, RealField.C q, Dim.C u, Dim.C v) =>+      Piecewise s u v q+   -> DN.T v q+   -> Proc.T s u q (SigA.R s v q q)+piecewiseVolume cs amplitude =+   -- it would be nice if we could re-use Ctrl.piecewise+   do ts0 <- mapM (toTimeScalar . Piecewise.pieceDur) cs+      fmap (SigA.fromSamples amplitude . Sig.concat) $+         sequence $ zipWith+            (\(n,t) (Piecewise.PieceData c yi0 yi1 d) ->+                 fmap (Sig.take n . SigS.toSamples) $+                 Piecewise.computePiece c yi0 yi1 d amplitude t)+            (Ctrl.splitDurations ts0)+            cs+++{-# INLINE makePiece #-}+makePiece :: (Field.C q, Dim.C u, Dim.C v) =>+   Ctrl.Piece q -> Piece s u v q+makePiece piece =+   Piecewise.pieceFromFunction $ \ y0 y1 d amplitude t0 ->+      flip fmap (toTimeScalar d) (\d' ->+         let za = SigA.fromSignal amplitude z+             z  = SigS.fromSamples $+                  Piecewise.computePiece piece+                     (toAmplitudeScalar za y0)+                     (toAmplitudeScalar za y1)+                     d' t0+         in  z)++{-# INLINE stepPiece #-}+stepPiece :: (Field.C q, Dim.C u, Dim.C v) => Piece s u v q+stepPiece =+   makePiece Ctrl.stepPiece++{-# INLINE linearPiece #-}+linearPiece :: (Field.C q, Dim.C u, Dim.C v) => Piece s u v q+linearPiece =+   makePiece Ctrl.linearPiece++{-# INLINE exponentialPiece #-}+exponentialPiece :: (Trans.C q, Dim.C u, Dim.C v) =>+   DN.T v q -> Piece s u v q+exponentialPiece saturation =+   Piecewise.pieceFromFunction $ \ y0 y1 d amplitude t0 ->+      flip fmap (toTimeScalar d) (\d' ->+         let za = SigA.fromSignal amplitude z+             z  = SigS.fromSamples $+                  Piecewise.computePiece+                     (Ctrl.exponentialPiece (toAmplitudeScalar za saturation))+                     (toAmplitudeScalar za y0)+                     (toAmplitudeScalar za y1)+                     d' t0+         in  z)++{-# INLINE cosinePiece #-}+cosinePiece :: (Trans.C q, Dim.C u, Dim.C v) => Piece s u v q+cosinePiece =+   makePiece Ctrl.cosinePiece++{-# INLINE cubicPiece #-}+cubicPiece :: (Field.C q, Dim.C u, Dim.C v) =>+   DN.T (DimensionGradient u v) q ->+   DN.T (DimensionGradient u v) q ->+   Piece s u v q+cubicPiece yd0 yd1 =+   Piecewise.pieceFromFunction $ \ y0 y1 d amplitude t0 ->+      liftM3 (\d' yd0' yd1' ->+         let za = SigA.fromSignal amplitude z+             z  = SigS.fromSamples $+                  Piecewise.computePiece+                     (Ctrl.cubicPiece yd0' yd1')+                     (toAmplitudeScalar za y0)+                     (toAmplitudeScalar za y1)+                     d' t0+         in  z)+            (toTimeScalar d)+            (toGradientScalar amplitude yd0)+            (toGradientScalar amplitude yd1)+++-- * convert values to different graduations++{- |+Map a control curve without amplitude unit+by a linear (affine) function with a unit.+-}+{-# INLINE mapLinearDimension #-}+mapLinearDimension :: (Field.C y, Real.C y, Dim.C u, Dim.C v) =>+      DN.T v y              {- ^ range: one is mapped to @center + range * ampX@ -}+   -> DN.T (Dim.Mul v u) y  {- ^ center: zero is mapped to @center@ -}+   -> Proc.T s u t (+        SigA.R s u y y+     -> SigA.R s (Dim.Mul v u) y y)+mapLinearDimension range center =+   Proc.pure $ CtrlA.mapLinearDimension range center++{- |+Map a control curve without amplitude unit+exponentially to one with a unit.+-}+{-# INLINE mapExponentialDimension #-}+mapExponentialDimension :: (Trans.C y, Dim.C u) =>+      y         {- ^ range: one is mapped to @center*range@, must be positive -}+   -> DN.T u y  {- ^ center: zero is mapped to @center@ -}+   -> Proc.T s u t (+        SigA.R s Dim.Scalar y y+     -> SigA.R s u y y)+mapExponentialDimension range center =+   Proc.pure $ CtrlA.mapExponential range center
+ src/Synthesizer/Dimensional/RateAmplitude/Cut.hs view
@@ -0,0 +1,289 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Dimensional.RateAmplitude.Cut (+   {- * dissection -}+   splitAt,+   take,+   drop,+   takeUntilPause,+   unzip,+   unzip3,+   leftFromStereo, rightFromStereo,++   {- * glueing -}+   concat,      concatVolume,+   append,      appendVolume,+   zip,         zipVolume,+   zip3,        zip3Volume,+   mergeStereo, mergeStereoVolume,+   arrange,     arrangeVolume,+  ) where++import qualified Synthesizer.Dimensional.Amplitude.Cut as CutV+import qualified Synthesizer.Dimensional.Rate.Cut as CutR+import qualified Synthesizer.State.Cut as CutS+import qualified Synthesizer.State.Signal as Sig++import qualified Synthesizer.Frame.Stereo as Stereo+import Foreign.Storable (Storable, )++import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Process as Proc+import Synthesizer.Dimensional.Process (($#))+import Synthesizer.Dimensional.RateAmplitude.Signal+   (toTimeScalar, toAmplitudeScalar)++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++-- import Number.DimensionTerm ((&*&))++import qualified Data.EventList.Relative.TimeBody as EventList+import qualified Numeric.NonNegative.Class as NonNeg++import qualified Algebra.NormedSpace.Maximum as NormedMax+import qualified Algebra.Module              as Module+import qualified Algebra.RealField           as RealField+import qualified Algebra.Field               as Field+import qualified Algebra.Ring                as Ring++import qualified Data.List as List++import PreludeBase ((.), ($), Ord, (<=), map, return, )+-- import NumericPrelude+import Prelude (RealFrac)+++{- * dissection -}++{-# INLINE splitAt #-}+splitAt :: (RealField.C t, Dim.C u, Dim.C v, Storable yv) =>+   DN.T u t -> Proc.T s u t (SigA.R s v y yv -> (SigA.R s v y yv, SigA.R s v y yv))+splitAt t' =+   do t <- toTimeScalar t'+      return $ \x ->+         let (ss0,ss1) = Sig.splitAt (RealField.round t) (SigA.samples x)+         in  (SigA.replaceSamples ss0 x,+              SigA.replaceSamples ss1 x)++{-# INLINE take #-}+take :: (RealField.C t, Dim.C u, Dim.C v) =>+   DN.T u t -> Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv)+take t' =+   CutR.take t'+   -- fmap (fst.) $ splitAt t+   {-+   do t <- toTimeScalar t'+      return $ SigA.processSamples (Sig.take (RealField.round t))+   -}++{-# INLINE drop #-}+drop :: (RealField.C t, Dim.C u, Dim.C v) =>+   DN.T u t -> Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv)+drop t' =+   CutR.drop t'+   -- fmap (snd.) $ splitAt t+   {-+   do t <- toTimeScalar t'+      return $ SigA.processSamples (Sig.drop (RealField.round t))+   -}++{-# INLINE takeUntilPause #-}+takeUntilPause ::+  (RealField.C t, Dim.C u,+   Field.C y, NormedMax.C y yv, Dim.C v) =>+   DN.T v y -> DN.T u t -> Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv)+takeUntilPause y' t' =+   do t <- toTimeScalar t'+      return $ \x ->+         let y = toAmplitudeScalar x y'+         in  SigA.processSamples+                (CutS.takeUntilInterval ((<=y) . NormedMax.norm)+                    (RealField.ceiling t)) x+++{-# INLINE unzip #-}+unzip :: (Dim.C u, Dim.C v) =>+   Proc.T s u t+      (SigA.R s v y (yv0, yv1) ->+       (SigA.R s v y yv0, SigA.R s v y yv1))+unzip = Proc.pure CutV.unzip++{-# INLINE unzip3 #-}+unzip3 :: (Dim.C u, Dim.C v) =>+   Proc.T s u t+      (SigA.R s v y (yv0, yv1, yv2) ->+       (SigA.R s v y yv0, SigA.R s v y yv1, SigA.R s v y yv2))+unzip3 = Proc.pure CutV.unzip3+++{-# INLINE leftFromStereo #-}+leftFromStereo :: (Dim.C u) =>+   Proc.T s u t+      (SigA.R s u y (Stereo.T yv) -> SigA.R s u y yv)+leftFromStereo = Proc.pure CutV.leftFromStereo++{-# INLINE rightFromStereo #-}+rightFromStereo :: (Dim.C u) =>+   Proc.T s u t+      (SigA.R s u y (Stereo.T yv) -> SigA.R s u y yv)+rightFromStereo = Proc.pure CutV.rightFromStereo++++{- * glueing -}++{- |+Similar to @foldr1 append@ but more efficient and accurate,+because it reduces the number of amplifications.+Does not work for infinite lists,+because no maximum amplitude can be computed.+-}+{-# INLINE concat #-}+concat ::+   (Ord y, Field.C y, Dim.C v,+    Module.C y yv) =>+   Proc.T s u t ([SigA.R s v y yv] -> SigA.R s v y yv)+concat = Proc.pure $ CutV.concat++{- |+Give the output volume explicitly.+Does also work for infinite lists.+-}+{-# INLINE concatVolume #-}+concatVolume ::+   (Field.C y, Dim.C v,+    Module.C y yv) =>+   DN.T v y -> Proc.T s u t ([SigA.R s v y yv] -> SigA.R s v y yv)+concatVolume amp = Proc.pure $ CutV.concatVolume amp+++{-# INLINE append #-}+append ::+   (Ord y, Field.C y, Dim.C v,+    Module.C y yv) =>+   Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv -> SigA.R s v y yv)+append = Proc.pure $ CutV.append++{-# INLINE appendVolume #-}+appendVolume ::+   (Field.C y, Dim.C v,+    Module.C y yv) =>+   DN.T v y ->+   Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv -> SigA.R s v y yv)+appendVolume amp = Proc.pure $ CutV.appendVolume amp+++{-# INLINE zip #-}+zip ::+   (Ord y, Field.C y, Dim.C v,+    Module.C y yv0, Module.C y yv1) =>+   Proc.T s u t (SigA.R s v y yv0 -> SigA.R s v y yv1 -> SigA.R s v y (yv0,yv1))+zip = Proc.pure $ CutV.zip++{-# INLINE zipVolume #-}+zipVolume ::+   (Field.C y, Dim.C v,+    Module.C y yv0, Module.C y yv1) =>+   DN.T v y ->+   Proc.T s u t (SigA.R s v y yv0 -> SigA.R s v y yv1 -> SigA.R s v y (yv0,yv1))+zipVolume amp = Proc.pure $ CutV.zipVolume amp+++{-# INLINE mergeStereo #-}+mergeStereo ::+   (Ord y, Field.C y, Dim.C v,+    Module.C y yv) =>+   Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv -> SigA.R s v y (Stereo.T yv))+mergeStereo = Proc.pure $ CutV.mergeStereo++{-# INLINE mergeStereoVolume #-}+mergeStereoVolume ::+   (Field.C y, Dim.C v,+    Module.C y yv) =>+   DN.T v y ->+   Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv -> SigA.R s v y (Stereo.T yv))+mergeStereoVolume amp = Proc.pure $ CutV.mergeStereoVolume amp++++{-# INLINE zip3 #-}+zip3 ::+   (Ord y, Field.C y, Dim.C v,+    Module.C y yv0, Module.C y yv1, Module.C y yv2) =>+   Proc.T s u t (+      SigA.R s v y yv0 -> SigA.R s v y yv1 -> SigA.R s v y yv2 ->+      SigA.R s v y (yv0,yv1,yv2))+zip3 = Proc.pure $ CutV.zip3++{-# INLINE zip3Volume #-}+zip3Volume ::+   (Field.C y, Dim.C v,+    Module.C y yv0, Module.C y yv1, Module.C y yv2) =>+   DN.T v y ->+   Proc.T s u t (+      SigA.R s v y yv0 -> SigA.R s v y yv1 -> SigA.R s v y yv2 ->+      SigA.R s v y (yv0,yv1,yv2))+zip3Volume amp = Proc.pure $ CutV.zip3Volume amp+++{- |+Uses maximum input volume as output volume.+-}+{-# INLINE arrange #-}+arrange ::+   (Ring.C t, Dim.C u,+    RealFrac t, NonNeg.C t,+    Ord y, Field.C y, Dim.C v,+    Module.C y yv) =>+      DN.T u t  {-^ Dim of the time values in the time ordered list. -}+   -> Proc.T s u t (+         EventList.T t (SigA.R s v y yv)+               {- v A list of pairs: (relative start time, signal part),+                    The start time is relative+                    to the start time of the previous event. -}+      -> SigA.R s v y yv)+               {- ^ The mixed signal. -}+arrange unit' =+   Proc.withParam $ \sched ->+      let amp = List.maximum (map SigA.amplitude (EventList.getBodies sched))+      in  arrangeVolume amp unit' $# sched+++{- |+Given a list of signals with time stamps,+mix them into one signal as they occur in time.+Ideally for composing music.+Infinite schedules are not supported.+Does not work for infinite lists,+because no maximum amplitude can be computed.+-}+{-# INLINE arrangeVolume #-}+arrangeVolume ::+   (Ring.C t, Dim.C u,+    RealFrac t, NonNeg.C t,+    Field.C y, Dim.C v,+    Module.C y yv) =>+      DN.T v y  {- ^ Output volume. -}+   -> DN.T u t  {- ^ Dim of the time values in the time ordered list. -}+   -> Proc.T s u t (+         EventList.T t (SigA.R s v y yv)+            {- v A list of pairs: (relative start time, signal part),+                 The start time is relative+                 to the start time of the previous event. -}+      -> SigA.R s v y yv)+            {- ^ The mixed signal. -}+arrangeVolume amp unit' =+   do unit <- toTimeScalar unit'+      return $ \sched' ->+         let sched =+                EventList.mapBody (SigA.vectorSamples (toAmplitudeScalar z)) sched'+             z = SigA.fromSamples amp+                    (CutS.arrange (EventList.resample unit sched))+         in  z
+ src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs view
@@ -0,0 +1,810 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ExistentialQuantification #-}+module Synthesizer.Dimensional.RateAmplitude.Demonstration where++import qualified Synthesizer.Dimensional.Rate.Oscillator as Osci+import qualified Synthesizer.Dimensional.Rate.Filter     as Filt+import qualified Synthesizer.Dimensional.RateAmplitude.Displacement as Disp+import qualified Synthesizer.Dimensional.RateAmplitude.Noise      as Noise+-- import qualified Synthesizer.SampleRateDimension.Filter.Recursive    as FiltR+-- import qualified Synthesizer.SampleRateDimension.Filter.NonRecursive as FiltNR+import qualified Synthesizer.Dimensional.RateAmplitude.Filter     as FiltA+import qualified Synthesizer.Dimensional.RateAmplitude.Cut        as Cut+import qualified Synthesizer.Dimensional.Rate.Cut                 as CutR++import qualified Synthesizer.Dimensional.RateAmplitude.Control    as Ctrl+import qualified Synthesizer.Dimensional.Rate.Control             as CtrlR++import qualified Synthesizer.Dimensional.Straight.Displacement as DispS++import qualified Synthesizer.Dimensional.Causal.Filter            as FiltC+import qualified Synthesizer.Dimensional.Causal.Displacement      as DispC+import qualified Synthesizer.Dimensional.Causal.Process           as CausalD+import qualified Synthesizer.Dimensional.Causal.ControlledProcess as CProc++import qualified Synthesizer.Dimensional.Process as Proc+import qualified Synthesizer.Dimensional.Straight.Signal as SigS+import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA++import qualified Synthesizer.Dimensional.RateAmplitude.File as File+-- import qualified Synthesizer.Dimensional.RateAmplitude.Play as Play+-- import qualified Synthesizer.Dimensional.RateWrapper as SigP++import Synthesizer.Dimensional.Causal.Process (($/:))+import Synthesizer.Dimensional.RateAmplitude.Signal (($-), (&*^), )+import Synthesizer.Dimensional.Process (($:), ($::), ($^), )+import Synthesizer.Dimensional.Amplitude.Control (mapLinear, mapExponential, )+import Synthesizer.Dimensional.RateAmplitude.Instrument (wasp, )++import qualified Synthesizer.Frame.Stereo as Stereo+import Foreign.Storable (Storable, )++import qualified Synthesizer.Interpolation.Custom as Interpolation+import qualified Synthesizer.Interpolation.Module as IpMod+import qualified Synthesizer.Interpolation.Class  as Interpol+import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth+import qualified Synthesizer.Basic.Wave         as Wave+import qualified Synthesizer.Basic.Phase        as Phase++import qualified Algebra.DimensionTerm as Dim+import qualified Number.DimensionTerm  as DN++import Number.DimensionTerm ((*&))++import qualified Algebra.Transcendental as Trans+import qualified Algebra.Module         as Module+import qualified Algebra.RealField      as RealField+import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring++import System.Time (getClockTime, diffClockTimes, tdSec, tdPicosec, )+import System.IO (hFlush, stdout, )+import System.Exit (ExitCode)++import System.Random (Random, randomRs, mkStdGen, )++import Data.Tuple.HT (snd3, )++import PreludeBase+import NumericPrelude+++++{-# INLINE sineLow #-}+sineLow ::+   (RealField.C q, Trans.C q, Module.C q q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+sineLow =+   DN.voltage 1 &*^+       Osci.static Wave.sine zero (DN.frequency 440)++{-# INLINE sineHigh #-}+sineHigh ::+   (RealField.C q, Trans.C q, Module.C q q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+sineHigh =+   DN.voltage 1 &*^+       Osci.static Wave.sine zero (DN.frequency 660)++{-# INLINE sineMix #-}+sineMix ::+   (RealField.C q, Trans.C q, Module.C q q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+sineMix =+   FiltA.amplify 0.5 $: (Disp.mix $: sineLow $: sineHigh)+++{-# INLINE exponential #-}+exponential ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigS.R s q)+exponential =+   CtrlR.exponential (DN.time 0.3)+++{-# INLINE ping #-}+ping ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+ping =+   Filt.envelope+      $: exponential+      $: sineLow++++{-# INLINE sawWave #-}+sawWave :: (RealField.C a) => Wave.T a a+sawWave = Wave.triangleAsymmetric (-0.9)++{-+{-# INLINE saw #-}+saw ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+saw =+   DN.voltage 1 &*^ Osci.static sawWave zero (DN.frequency 440)+-}++{-# INLINE sawVibrato #-}+sawVibrato ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+sawVibrato =+   DN.voltage 1 &*^+      (Osci.freqMod sawWave zero+         $: (mapLinear 0.01 (DN.frequency 440) $^ Osci.static Wave.sine zero (DN.frequency 5)))++{-# INLINE sawChorus #-}+sawChorus ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+sawChorus =+   let v = DN.voltage (1/4)+   in  Disp.mixMulti+         $:: (v &*^ Osci.static sawWave (Phase.fromRepresentative 0.00) (DN.frequency 442.0) :+              v &*^ Osci.static sawWave (Phase.fromRepresentative 0.25) (DN.frequency 441.2) :+              v &*^ Osci.static sawWave (Phase.fromRepresentative 0.50) (DN.frequency 438.7) :+              v &*^ Osci.static sawWave (Phase.fromRepresentative 0.75) (DN.frequency 438.1) :+              [])+++++{-# INLINE amplitudeModulationChirp #-}+amplitudeModulationChirp ::+   (RealField.C q, Trans.C q) =>+   Proc.T s Dim.Time q (SigS.R s q)+amplitudeModulationChirp =+   Filt.envelope+      $: (Osci.static Wave.sine zero (DN.frequency 440))+      $: (Osci.freqMod Wave.sine zero+             $: (Ctrl.exponentialFromTo+                   (DN.time 10)+                   (DN.frequency 1, DN.frequency 1000)))+++{-# INLINE airplane #-}+airplane ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+airplane =+   SigA.share+      (Noise.white (DN.frequency 20000) (DN.voltage 0.2))+      (\noise ->+          Cut.take (DN.time 5) $: (Disp.mix+             $: noise+             $: (Filt.frequencyModulation IpMod.linear+                    $- DN.scalar 1.001+                    $: noise)))++{-# INLINE airplaneFade #-}+airplaneFade ::+   Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double)+airplaneFade =+   Filt.envelope+      $: (DispS.map (\t -> recip (1 + 30*(t-1)^2)) $^ CtrlR.linear (DN.time 5))+--      $: Osci.static Wave.sine zero (DN.recip (DN.time 20))+      $: (Filt.phaser Interpolation.linear (DN.time 0.01)+            $: Ctrl.exponentialFromTo+                  (DN.time 10)+                  (DN.unrecip (DN.frequency 5000), DN.unrecip (DN.frequency 100))+            $: Noise.white (DN.frequency 20000) (DN.voltage 0.5))+++{-# INLINE wind #-}+wind ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+wind =+   Filt.lowpassFromUniversal $^+      (Filt.universal+         $- DN.scalar 20+         $: (mapExponential 2 (DN.frequency 1000) $^+               (Disp.mix+                   $: DN.scalar 0.5 &*^ Osci.static Wave.sine zero (DN.frequency 0.2)+                   $: DN.scalar 1.0 &*^ Osci.static Wave.sine zero (DN.frequency (sqrt 0.2))))+         $: Noise.white (DN.frequency 20000) (DN.voltage 0.2))++{-# INLINE windStereo #-}+windStereo ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q (Stereo.T q))+windStereo =+   SigA.share+      wind+      (\w -> Cut.mergeStereo $: w $: (Cut.drop (DN.time 0.5) $: w))++++{-# INLINE sweepFrequency #-}+sweepFrequency ::+   (Trans.C q, RealField.C q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Frequency q q)+sweepFrequency =+   mapExponential 2 (DN.frequency 1000) $^+   Osci.static Wave.sine zero (DN.frequency 0.2)++{-# INLINE deepSaw #-}+deepSaw ::+   (RealField.C q) =>+   Proc.T s Dim.Time q (SigS.R s q)+deepSaw =+   Osci.static Wave.saw zero (DN.frequency 110)++{-# INLINE universalLowpassDirect #-}+universalLowpassDirect ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+universalLowpassDirect =+   Filt.lowpassFromUniversal $^+      (Filt.universal+         $- DN.scalar 20+         $: sweepFrequency+         $: DN.voltage 0.2 &*^ deepSaw)++{-# INLINE universalLowpassSync #-}+universalLowpassSync ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+universalLowpassSync =+   Filt.lowpassFromUniversal $^+      (CProc.runSynchronous2 FiltC.universal+         $- DN.scalar 20+         $: sweepFrequency+         $/: DN.voltage 0.2 &*^ deepSaw)++{-# INLINE universalLowpassAsyncLinear #-}+universalLowpassAsyncLinear ::+   (RealField.C q, Trans.C q, Module.C q q, Interpol.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+universalLowpassAsyncLinear =+   Filt.lowpassFromUniversal $^+      (CProc.processAsynchronousBuffered2 Interpolation.linear FiltC.universal+         (DN.frequency 10)+--         (Rate.fromNumber Dim.frequency 100)+         (Ctrl.constant (DN.scalar 20))+         sweepFrequency+         $/: DN.voltage 0.2 &*^ deepSaw)++{-# INLINE universalLowpassAsyncConstant #-}+universalLowpassAsyncConstant ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+universalLowpassAsyncConstant =+   Filt.lowpassFromUniversal $^+      (CProc.processAsynchronousBuffered2 Interpolation.constant FiltC.universal+         (DN.frequency 100)+--         (Rate.fromNumber Dim.frequency 100)+         (Ctrl.constant (DN.scalar 20))+         sweepFrequency+         $/: DN.voltage 0.2 &*^ deepSaw)+++{-# INLINE allpassPhaserDirect #-}+allpassPhaserDirect ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+allpassPhaserDirect =+   let tone = DN.voltage 0.5 &*^ deepSaw+   in  Disp.mix+          $: (Filt.allpassCascade 20 Filt.allpassFlangerPhase+                $: sweepFrequency+                $: tone)+          $: tone++{-# INLINE allpassPhaserCausal #-}+allpassPhaserCausal ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+allpassPhaserCausal =+   let tone = DN.voltage 0.5 &*^ deepSaw+       phaser =+          do mix     <- DispC.mix+             apcCtrl <- CProc.joinSynchronous (FiltC.allpassCascade 20 FiltC.allpassFlangerPhase)+             ctrl    <- sweepFrequency+             return $+                mix CausalD.<<<+                CausalD.fanout CausalD.id (CausalD.applyFst apcCtrl ctrl)+   in  phaser $/: tone+++{-# INLINE moogSawDirect #-}+moogSawDirect ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+moogSawDirect =+   Filt.moogLowpass 10+      $- DN.scalar 20+      $: sweepFrequency+      $: DN.voltage 0.2 &*^ deepSaw++{-# INLINE moogSawCausal #-}+moogSawCausal ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+moogSawCausal =+   CProc.runSynchronous2 (FiltC.moogLowpass 10)+      $- DN.scalar 20+      $: sweepFrequency+      $/: DN.voltage 0.2 &*^ deepSaw+++data Filter a v =+   forall param. Interpol.C a param => Filter {+      filterResonance :: a,+      filterDirect :: forall s. Proc.T s Dim.Time a+         (-- SigS.R s a ->+          SigA.R s Dim.Scalar a a ->+          SigA.R s Dim.Frequency a a ->+          SigA.R s Dim.Voltage a v ->+          SigA.R s Dim.Voltage a v),+      filterCausal :: forall s.+         FiltC.ResonantFilter s Dim.Time a param (DN.Voltage a) v v}++++{- |+We do not create noise at a low sampling and resample it by intention.+Resampling is intended for maintaining maximum quality+and not for relying on the bad quality of constant interpolation.+Instead we generate a piecewise constant function manually.+-}+{-# INLINE glissandoControl #-}+glissandoControl ::+   (RealField.C q, Trans.C q, Module.C q q, Random q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Scalar q q)+glissandoControl =+   Filt.firstOrderLowpass+      $- DN.frequency 4+      $: (Cut.concatVolume (DN.scalar 1) $:+          mapM (\p ->+             Cut.take (DN.time (1/6))+              $: Ctrl.constant (DN.scalar (fromInteger p / 12)))+              (randomRs (0,24) (mkStdGen 3141)))+++{-# INLINE bassFilter #-}+bassFilter ::+   (RealField.C q, Trans.C q, Module.C q q, Random q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q (Stereo.T q))+bassFilter =+   Filt.lowpassFromUniversal $^+      (Filt.universal+         $- DN.scalar 5+{-+         $- DN.frequency 440+-}+         $: (mapExponential 2 (DN.frequency 440) $^+               glissandoControl)+{-+         $: (mapExponential 10 (DN.frequency 440) $^+               Osci.static Wave.sine zero (DN.frequency 0.2))+-}+         $: (Cut.mergeStereo+               $: DN.voltage 1 &*^ Osci.static Wave.saw zero (DN.frequency 55.0)+               $: DN.voltage 1 &*^ Osci.static Wave.saw zero (DN.frequency 55.1)))++++{-# INLINE noiseLowpass #-}+noiseLowpass ::+   (RealField.C q, Trans.C q, Module.C q q, Random q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+noiseLowpass =+   let noise = Noise.white (DN.frequency 20000) (DN.voltage 0.1)+       control =+          Ctrl.exponentialFromTo+            (DN.time 5)+            (DN.frequency 10000, DN.frequency 10)+   in  Filt.firstOrderLowpass+          $: control+          $: noise+++{-# INLINE noiseHighpass #-}+noiseHighpass ::+   (RealField.C q, Trans.C q, Module.C q q, Random q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+noiseHighpass =+   let noise = Noise.white (DN.frequency 20000) (DN.voltage 0.1)+       control =+          Ctrl.exponentialFromTo+            (DN.time 5)+            (DN.frequency 10000, DN.frequency 10)+   in  Filt.firstOrderHighpass+          $: control+          $: noise+++{-# INLINE bubbles #-}+bubbles ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+bubbles =+   let delay = 0.24+   in  Filt.comb (DN.time delay) (0.5 `asTypeOf` delay) $:+       (DN.voltage 0.5 &*^+        (Osci.freqMod Wave.sine zero $:+         (mapExponential 0.5 (DN.frequency 440) $^+            (Disp.mix+               $: DN.scalar 1.5 &*^ Osci.static Wave.saw zero (DN.frequency 0.5)+               $: DN.scalar 0.5 &*^ Osci.static Wave.saw zero (DN.frequency 10)))))+++{-# INLINE bubblesStereo #-}+bubblesStereo ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q (Stereo.T q))+bubblesStereo =+   let delay = 0.24+       {-# INLINE channel #-}+       channel f =+          DN.voltage 0.5 &*^+           (Osci.freqMod Wave.sine zero $:+            (mapExponential 0.5 (DN.frequency 440) $^+               (Disp.mix+                  $: DN.scalar 1.5 &*^ Osci.static Wave.saw zero (DN.frequency 0.5)+                  $: DN.scalar 0.5 &*^ Osci.static Wave.saw zero f)))+   in  Filt.comb (DN.time delay) (0.5 `asTypeOf` delay) $:+          (Cut.mergeStereo+              $: channel (DN.frequency 10)+              $: channel (DN.frequency 9.23))+++{-# INLINE dampedEcho #-}+dampedEcho ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+dampedEcho =+   FiltA.combProc (DN.time 0.2)+            (Filt.firstOrderLowpass $- DN.frequency 1000)+      $: (Filt.envelope+            $: CtrlR.exponential2 (DN.time 0.1)+            $: DN.voltage 1 &*^ Osci.static Wave.saw zero (DN.frequency 440))+++{-# INLINE trapezoid #-}+trapezoid ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+trapezoid =+   Filt.mean (DN.frequency 500)+      $: (mapExponential 4 (DN.frequency 2000) $^ Osci.static Wave.sine zero (DN.frequency 1))+      $: DN.voltage 0.7 &*^ Osci.static (Wave.trapezoid 0.9) zero (DN.frequency 440)+{-+   Filt.meanStatic (DN.frequency 440)+      $: DN.voltage 1 &*^ Osci.static Wave.square zero (DN.frequency 440)+-}++++{-# INLINE staticSine #-}+staticSine ::+   (RealField.C q, Trans.C q) =>+   Proc.T s Dim.Time q (SigS.R s q)+staticSine =+   CutR.take (DN.time 10)+      $: (Osci.static Wave.sine zero (DN.frequency 440))+++{-# INLINE harmonicTone #-}+harmonicTone ::+   (RealField.C q, Trans.C q, Module.C q q) =>+   [(DN.Frequency q, q, Phase.T q)] ->+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+harmonicTone hs =+   let k = recip (sum (map (abs . snd3) hs))+   in  Disp.mixMulti $::+          map (\(f, amp, phase) ->+                  DN.voltage (amp*k) &*^+                  Osci.static Wave.sine phase f) hs++newtype Sound q v =+   Sound {fromSound :: forall s. Proc.T s Dim.Time q (SigA.R s Dim.Voltage q v)}++{-# INLINE harmonicExamples #-}+harmonicExamples ::+   (RealField.C q, Trans.C q, Module.C q q) =>+   [(FilePath, Sound q q)]+harmonicExamples =+   do expo <- [0,1,2]+      (harmName,harm)+           <- [("all", take 10 [1 ..]), ("odd", take 10 [1,3 ..])]+      (phaseName,phase)+           <- [("sin", Phase.fromRepresentative 0),+               ("cos", Phase.fromRepresentative (1/4))]+      return+         ("power" ++ show expo ++ harmName ++ "-" ++ phaseName,+          Sound+             (harmonicTone+                (map ((\n -> (n *& DN.frequency 440,+                             recip (n ^ expo),+                             phase))+                      . fromIntegral)+                     (harm::[Int]))))++{- |+Morphing shapes with constant sound.+By shifting the frequency of all harmonics up by an constant amount,+the periods of the harmonic do no longer match+and recombine only afte a period that depends on the frequency shift.+At the beginning we have the waveform of mixed sines,+after a quarter period of the shift frequency we have mixed cosines and so on.+-}+{-# INLINE harmonicMorph #-}+harmonicMorph ::+   (RealField.C q, Trans.C q, Module.C q q) =>+   [(FilePath, Sound q q)]+harmonicMorph =+   do expo <- [0,1,2]+      (harmName,harm)+           <- [("all", take 10 [1 ..]), ("odd", take 10 [1,3 ..])]+      return+         ("power" ++ show expo ++ harmName ++ "-shift",+          Sound+             (harmonicTone+                (map ((\n -> (n *& DN.frequency 440 + DN.frequency 1,+                             recip (n ^ expo),+                             zero))+                      . fromIntegral)+                     (harm::[Int]))))+++{-# INLINE waveforms #-}+waveforms ::+   (RealField.C q, Trans.C q, Module.C q q) =>+   [(FilePath, Sound q q)]+waveforms =+   do (name,wave)+           <- ("square",   Wave.trapezoid 0.9) :+              ("triangle", Wave.triangle) :+              ("saw",      sawWave) :+              []+      return+         (name,+          Sound+             (DN.voltage 1 &*^ Osci.static wave zero (DN.frequency 440)))+++{-# INLINE waveformsBandlimited #-}+waveformsBandlimited ::+   (RealField.C q, Trans.C q, Module.C q q) =>+   [(FilePath, Sound q q)]+waveformsBandlimited =+   do (name,wave)+           <- ("square",   WaveSmooth.square) :+              ("triangle", WaveSmooth.triangle) :+              ("saw",      WaveSmooth.saw) :+              ("sine",     WaveSmooth.sine) :+              ("harmonic", WaveSmooth.composedHarmonics $+                  let k = 0.5+                  in  [WaveSmooth.harmonic zero 0,+                       WaveSmooth.harmonic zero k,+                       WaveSmooth.harmonic zero (k/2),+                       WaveSmooth.harmonic zero (k/3),+                       WaveSmooth.harmonic zero (k/4)]) :+              []+      return+         (name++"-antialias-chirp",+          Sound+             (DN.voltage 1 &*^ (Osci.freqModAntiAlias wave zero $:+                 Ctrl.line (DN.time 10) (DN.frequency (-30000), DN.frequency 30000))))+++measureTime :: String -> IO ExitCode -> IO ()+measureTime name act =+   do putStr (name++": ")+      hFlush stdout+      timeA <- getClockTime+      act+      timeB <- getClockTime+      let td = diffClockTimes timeB timeA+      print (fromIntegral (tdSec td) ++             fromInteger (tdPicosec td) * 1e-12 :: Double)++renderToAIFF :: (Ring.C a) =>+   (DN.Frequency a -> String -> t -> IO ExitCode) ->+   String ->+   t ->+   IO ()+renderToAIFF render name sound =+   measureTime name $+   render (DN.frequency 44100) (name++".aiff") sound+++main :: IO ()+main =+   do+{-+      Play.timeVoltageMonoDoubleR (DN.frequency 44100) bubbles+-}+{-+      File.writeTimeVoltage "chirp"+         (SigP.runProcess+             (DN.frequency (44100::Double))+             (DN.voltage 1 &*^ amplitudeModulationChirp))+-}+      mapM_+         (\(name, sound) ->+             renderToAIFF+             File.renderTimeVoltageStereoDoubleToInt16+             name (fromSound sound)) $++         ("bass-filter", Sound (Cut.take (DN.time 15) $: bassFilter)) :+         ("wind",        Sound (Cut.take (DN.time 10) $: windStereo)) :+         ("bubbles",     Sound (Cut.take (DN.time 10) $: bubblesStereo)) :+         []++      mapM_+         (\(name, filt@(Filter _filtResonance _filtDirect filtCausal)) ->+              let render :: String -> (forall s. Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double)) -> IO ()+                  render ext sound =+                     let subName = name ++ "-" ++ ext+                     in  renderToAIFF+                         File.renderTimeVoltageMonoDoubleToInt16+                         subName+                         (Cut.take (DN.time 10) $: sound)+              in  do render "direct"+                        (filterDirect filt+                           $- DN.scalar (filterResonance filt)+                           $: sweepFrequency+                           $: DN.voltage 1 &*^ deepSaw)+                     render "sync"+                        (CProc.runSynchronous2 (filtCausal)+                           $- DN.scalar (filterResonance filt)+                           $: sweepFrequency+                           $/: DN.voltage 1 &*^ deepSaw)+                     render "async-constant"+                        (CProc.processAsynchronousBuffered2 Interpolation.constant (filtCausal)+                           (DN.frequency 100)+                           (Ctrl.constant (DN.scalar (filterResonance filt)))+                           sweepFrequency+                           $/: DN.voltage 1 &*^ deepSaw)+                     render "async-linear"+                        (CProc.processAsynchronousBuffered2 Interpolation.linear (filtCausal)+                           (DN.frequency 10)+                           (Ctrl.constant (DN.scalar (filterResonance filt)))+                           sweepFrequency+                           $/: DN.voltage 1 &*^ deepSaw)) $+         ("allpass-phaser",+              Filter 0.5+--                 (Filt.allpassPhaser 10)+                 (fmap (\p q f -> CausalD.apply (p q f)) $+                  CProc.runSynchronous2 (FiltC.allpassPhaser 10))+                 (FiltC.allpassPhaser 10)) :+         ("moog-lowpass",+              Filter 20+                 (Filt.moogLowpass 10)+                 (FiltC.moogLowpass 10)) :+         ("universal-lowpass",+              Filter 20+                 (fmap (\p r f -> Filt.lowpassFromUniversal . p r f) $+                  Filt.universal)+                 (fmap (fmap (\p -> FiltC.lowpassFromUniversal CausalD.<<< p)) $+                  FiltC.universal)) :+         ("butterworth-lowpass",+              Filter 0.5+                 (Filt.butterworthLowpass 10)+                 (FiltC.butterworthLowpass 10)) :+         ("butterworth-highpass",+              Filter 0.5+                 (Filt.butterworthHighpass 10)+                 (FiltC.butterworthHighpass 10)) :+         ("chebyshev-a-lowpass",+              Filter 0.5+                 (Filt.chebyshevALowpass 10)+                 (FiltC.chebyshevALowpass 10)) :+         ("chebyshev-a-highpass",+              Filter 0.5+                 (Filt.chebyshevAHighpass 10)+                 (FiltC.chebyshevAHighpass 10)) :+         ("chebyshev-b-lowpass",+              Filter 0.5+                 (Filt.chebyshevBLowpass 10)+                 (FiltC.chebyshevBLowpass 10)) :+         ("chebyshev-b-highpass",+              Filter 0.5+                 (Filt.chebyshevBHighpass 10)+                 (FiltC.chebyshevBHighpass 10)) :+         []++      mapM_+         (\(name, sound) ->+             renderToAIFF+             File.renderTimeVoltageMonoDoubleToInt16+             name (fromSound sound)) $++         {-+         Moog, Allpass, Universal.lowPass are redundant here,+         but we leave them for demonstration purposes.+         -}+         ("moog-saw-direct",+                         Sound (Cut.take (DN.time 10) $: moogSawDirect)) :+         ("moog-saw-causal",+                         Sound (Cut.take (DN.time 10) $: moogSawCausal)) :++         ("allpass-phaser-direct",+                         Sound (Cut.take (DN.time 10) $: allpassPhaserDirect)) :+         ("allpass-phaser-causal",+                         Sound (Cut.take (DN.time 10) $: allpassPhaserCausal)) :++         ("universal-lowpass",+                         Sound (Cut.take (DN.time 10) $: universalLowpassDirect)) :+         ("universal-lowpass-sync",+                         Sound (Cut.take (DN.time 10) $: universalLowpassSync)) :+         ("universal-lowpass-async-linear",+                         Sound (Cut.take (DN.time 10) $: universalLowpassAsyncLinear)) :+         ("universal-lowpass-async-constant",+                         Sound (Cut.take (DN.time 10) $: universalLowpassAsyncConstant)) :++         ("sine-low",    Sound (Cut.take (DN.time 1) $: sineLow)) :+         ("sine-high",   Sound (Cut.take (DN.time 1) $: sineHigh)) :+         ("sine-mix",    Sound (Cut.take (DN.time 1) $: sineMix)) :+         ("exponential", Sound (Cut.take (DN.time 1) $: DN.voltage 1 &*^ exponential)) :+         ("ping",        Sound (Cut.take (DN.time 1) $: ping)) :++--         ("saw",         Sound (Cut.take (DN.time 2) $: saw)) :+         ("saw-vibrato", Sound (Cut.take (DN.time 2) $: sawVibrato)) :+         ("saw-chorus",  Sound (Cut.take (DN.time 2) $: sawChorus)) :++         ("wasp",        Sound (Cut.take (DN.time  5) $: wasp (DN.frequency 110))) :+         ("trapezoid",   Sound (Cut.take (DN.time  5) $: trapezoid)) :+         ("damped-echo", Sound (Cut.take (DN.time  4) $: dampedEcho)) :+         ("chirp",       Sound (DN.voltage 1 &*^ amplitudeModulationChirp)) :+         ("airplane",        Sound airplane) :+         {- This becomes considerably faster, if other effects are not rendered.+            This is obviously an optimizer bug. -}+         ("airplane-fade",   Sound airplaneFade) :++         ("noise-lowpass1",  Sound noiseLowpass) :+         ("noise-highpass1", Sound noiseHighpass) :+         []++      flip mapM_ waveformsBandlimited $+         \(fileName, tone) ->+            renderToAIFF+            File.renderTimeVoltageMonoDoubleToInt16+            fileName+            (fromSound tone)++      flip mapM_ (harmonicExamples ++ harmonicMorph ++ waveforms) $+         \(fileName, tone) ->+            renderToAIFF+            File.renderTimeVoltageMonoDoubleToInt16+            fileName+            (Cut.take (DN.time 1) $: fromSound tone)+++{-+import installed synthesizer package++ghc-core -f html -- -o dist/build/demonstration/demonstration -Wall -O2 -fexcess-precision -fvia-C -optc-O2 -package synthesizer src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs >dist/build/demonstration/demonstration.html++ghc -o dist/build/demonstration/demonstration -Wall -O2 -fexcess-precision -fvia-C -optc-O2 -ddump-simpl-stats -package synthesizer src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs++ghc -o dist/build/demonstration/demonstration -O -Wall -fexcess-precision -ddump-simpl-stats -package synthesizer src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs++ghc -o dist/build/demonstration/demonstration -O -Wall -fexcess-precision -ddump-simpl -package synthesizer src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs >dist/build/Demonstration.log+++with assembly output++ghc -o dist/build/fusiontest/fusiontest -O -Wall -fexcess-precision -ddump-simpl-stats -ddump-asm -package synthesizer speedtest/DemonstrationInlineMono.hs >dist/build/Demonstration.asm+++with make and no explicit package specification:++ghc -Idist/build -o dist/build/demonstration/demonstration --make -Wall -O -fexcess-precision -ddump-simpl-stats -i -idist/build/autogen -isrc -odir dist/build/demonstration/demonstration-tmp -hidir dist/build/demonstration/demonstration-tmp src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs+++with make and explicit package specification:++ghc --make -Idist/build -o dist/build/demonstration/demonstration -Wall -O -fexcess-precision -ddump-simpl-stats -ddump-simpl-iterations -i -idist/build/autogen -isrc -idist/build/demonstration/demonstration-tmp -odir dist/build/demonstration/demonstration-tmp -hidir dist/build/demonstration/demonstration-tmp -package base-1.0 -package mtl-1.0 -package non-negative-0.0.2 -package numeric-prelude-0.0.3 -package event-list-0.0.7 -package bytestring-0.9.0.5 -package binary-0.4.1 -package storablevector-0.1  src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs >src/Synthesizer/Dimensional/RateAmplitude/Demonstration.log++without make and with detailed simplifier report:++ghc -Idist/build -o dist/build/demonstration/demonstration -Wall -O -fexcess-precision -ddump-simpl-stats -ddump-simpl-iterations -i -idist/build/autogen -isrc -idist/build/demonstration/demonstration-tmp -odir dist/build/demonstration/demonstration-tmp -hidir dist/build/demonstration/demonstration-tmp -package base-1.0 -package mtl-1.0 -package non-negative-0.0.2 -package numeric-prelude-0.0.3 -package event-list-0.0.7 -package HTam-0.0 -package numeric-quest-0.1 -package bytestring-0.9.0.5 -package binary-0.4.1 -package storablevector-0.1 dist/build/HSsynthesizer*.o src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs  >src/Synthesizer/Dimensional/RateAmplitude/Demonstration.log+-}
+ src/Synthesizer/Dimensional/RateAmplitude/Displacement.hs view
@@ -0,0 +1,108 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Dimensional.RateAmplitude.Displacement (+   mix, mixVolume,+   mixMulti, mixMultiVolume,+   raise, distort,+   ) where++import qualified Synthesizer.Dimensional.Amplitude.Displacement as DispV++import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Process as Proc++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import qualified Algebra.Module         as Module+import qualified Algebra.Field          as Field+import qualified Algebra.Real           as Real+-- import qualified Algebra.Ring           as Ring+-- import qualified Algebra.Additive       as Additive++-- import Algebra.Module ((*>))++import PreludeBase+-- import NumericPrelude+import Prelude ()+++{- * Mixing -}++{-| Mix two signals.+    In opposition to 'zipWith' the result has the length of the longer signal. -}+{-# INLINE mix #-}+mix :: (Real.C y, Field.C y, Module.C y yv, Dim.C v) =>+      Proc.T s u t (+        SigA.R s v y yv+     -> SigA.R s v y yv+     -> SigA.R s v y yv)+mix = Proc.pure DispV.mix++{-# INLINE mixVolume #-}+mixVolume ::+   (Real.C y, Field.C y, Module.C y yv, Dim.C v) =>+      DN.T v y+   -> Proc.T s u t (+        SigA.R s v y yv+     -> SigA.R s v y yv+     -> SigA.R s v y yv)+mixVolume v = Proc.pure $ DispV.mixVolume v++{- |+Mix one or more signals.+-}+{-# INLINE mixMulti #-}+mixMulti ::+   (Real.C y, Field.C y, Module.C y yv, Dim.C v) =>+      Proc.T s u t (+        [SigA.R s v y yv]+     ->  SigA.R s v y yv)+mixMulti = Proc.pure DispV.mixMulti++{-# INLINE mixMultiVolume #-}+mixMultiVolume ::+   (Real.C y, Field.C y, Module.C y yv, Dim.C v) =>+      DN.T v y+   -> Proc.T s u t (+        [SigA.R s v y yv]+     ->  SigA.R s v y yv)+mixMultiVolume v = Proc.pure $ DispV.mixMultiVolume v++{- |+Add a number to all of the signal values.+This is useful for adjusting the center of a modulation.+-}+{-# INLINE raise #-}+raise :: (Field.C y, Module.C y yv, Dim.C v) =>+      DN.T v y+   -> yv+   -> Proc.T s u t (+        SigA.R s v y yv+     -> SigA.R s v y yv)+raise y' yv = Proc.pure $ DispV.raise y' yv++{- |+Distort the signal using a flat function.+The first signal gives the scaling of the function.+If the scaling is c and the input sample is y,+then @c * f(y/c)@ is output.+This way we can use an (efficient) flat function+and have a simple, yet dimension conform, way of controlling the distortion.+E.g. if the distortion function is @tanh@+then the value @c@ controls the saturation level.+-}+{-# INLINE distort #-}+distort :: (Field.C y, Module.C y yv, Dim.C v) =>+      (yv -> yv)+   -> Proc.T s u t (+        SigA.R s v y y+     -> SigA.R s v y yv+     -> SigA.R s v y yv)+distort f = Proc.pure $ DispV.distort f
+ src/Synthesizer/Dimensional/RateAmplitude/File.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Rank2Types #-}+module Synthesizer.Dimensional.RateAmplitude.File (+   write,+   writeTimeVoltage,+   writeTimeVoltageMonoDoubleToInt16,+   writeTimeVoltageStereoDoubleToInt16,+   renderTimeVoltageMonoDoubleToInt16,+   renderTimeVoltageStereoDoubleToInt16,+  ) where++import qualified Sound.Sox.Write as Write+import qualified Sound.Sox.Option.Format as SoxOpt+import qualified Sound.Sox.Frame as Frame+import qualified Synthesizer.Basic.Binary as BinSmp+import qualified Data.StorableVector.Lazy.Builder as Builder+import Foreign.Storable (Storable, )++import qualified Synthesizer.Dimensional.Process as Proc++import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigRA+import qualified Synthesizer.Dimensional.RateWrapper as SigP++import qualified Synthesizer.Frame.Stereo as Stereo++import qualified Synthesizer.Storable.Signal as SigSt++-- import qualified Synthesizer.Dimensional.Straight.Signal as SigS+import qualified Synthesizer.State.Signal as Sig++import qualified Algebra.ToInteger      as ToInteger+-- import qualified Algebra.Transcendental as Trans+import qualified Algebra.Module         as Module+import qualified Algebra.RealField      as RealField+import qualified Algebra.Field          as Field+-- import qualified Algebra.Ring           as Ring++import qualified Algebra.DimensionTerm as Dim+import qualified Number.DimensionTerm  as DN+++import System.Exit(ExitCode)++import NumericPrelude+import PreludeBase++++{- |+The output format is determined by SoX by the file name extension.+The sample precision is determined by the provided 'Builder.Builder' function.++Example:++> import qualified Data.StorableVector.Lazy.Builder as Builder+>+> write (DN.frequency one) (DN.voltage one) (\i -> Builder.put (i::Int16)) "test.aiff" sound+-}+{-# INLINE write #-}+write ::+    (Bounded int, ToInteger.C int, Storable int, Frame.C int, BinSmp.C yv,+     Dim.C u, RealField.C t,+     Dim.C v, Module.C y yv, Field.C y) =>+   DN.T (Dim.Recip u) t ->+   DN.T v y ->+   (int -> Builder.Builder int) ->+   FilePath ->+   SigP.T u t (SigA.S v y) yv ->+--   SigP.T u t (SigA.D v y SigS.S) yv ->+   IO ExitCode+write freqUnit amp put name sig =+   let opts =+          SoxOpt.numberOfChannels (BinSmp.numberOfSignalChannels sig)+       sampleRate =+          DN.divToScalar (SigP.sampleRate sig) freqUnit+   in  Write.extended SigSt.hPut opts SoxOpt.none name+          (round sampleRate)+          (Builder.toLazyStorableVector SigSt.defaultChunkSize $+           Sig.monoidConcatMap (BinSmp.outputFromCanonical put) $+           SigA.vectorSamples (flip DN.divToScalar amp) sig)+++{-# INLINE writeTimeVoltage #-}+writeTimeVoltage ::+    (Bounded int, ToInteger.C int, Storable int, Frame.C int, BinSmp.C yv,+     RealField.C t,+     Module.C y yv, Field.C y) =>+   (int -> Builder.Builder int) ->+   FilePath ->+   SigP.T Dim.Time t (SigA.S Dim.Voltage y) yv ->+--   SigP.T Dim.Time t (SigA.D Dim.Voltage y SigS.S) yv ->+   IO ExitCode+writeTimeVoltage =+   write (DN.frequency one) (DN.voltage one)++++{-# INLINE writeTimeVoltageMonoDoubleToInt16 #-}+writeTimeVoltageMonoDoubleToInt16 ::+   FilePath ->+   SigP.T Dim.Time Double (SigA.S Dim.Voltage Double) Double ->+--   SigP.T Dim.Time t (SigA.D Dim.Voltage y SigS.S) yv ->+   IO ExitCode+writeTimeVoltageMonoDoubleToInt16 name sig =+   let rate = DN.toNumberWithDimension Dim.frequency (SigP.sampleRate sig)+   in  Write.simple SigSt.hPut SoxOpt.none name (round rate)+          (SigP.signal (SigRA.toStorableInt16Mono sig))+++{-# INLINE writeTimeVoltageStereoDoubleToInt16 #-}+writeTimeVoltageStereoDoubleToInt16 ::+   FilePath ->+   SigP.T Dim.Time Double (SigA.S Dim.Voltage Double) (Stereo.T Double) ->+--   SigP.T Dim.Time t (SigA.D Dim.Voltage y SigS.S) yv ->+   IO ExitCode+writeTimeVoltageStereoDoubleToInt16 name sig =+   let rate = DN.toNumberWithDimension Dim.frequency (SigP.sampleRate sig)+   in  Write.simple SigSt.hPut SoxOpt.none name (round rate)+          (SigP.signal (SigRA.toStorableInt16Stereo sig))++{-# INLINE renderTimeVoltageMonoDoubleToInt16 #-}+renderTimeVoltageMonoDoubleToInt16 ::+   DN.T Dim.Frequency Double ->+   FilePath ->+   (forall s. Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double)) ->+   IO ExitCode+renderTimeVoltageMonoDoubleToInt16 rate name sig =+   writeTimeVoltageMonoDoubleToInt16 name (SigP.runProcess rate sig)++{-# INLINE renderTimeVoltageStereoDoubleToInt16 #-}+renderTimeVoltageStereoDoubleToInt16 ::+   DN.T Dim.Frequency Double ->+   FilePath ->+   (forall s. Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double))) ->+   IO ExitCode+renderTimeVoltageStereoDoubleToInt16 rate name sig =+   writeTimeVoltageStereoDoubleToInt16 name (SigP.runProcess rate sig)
+ src/Synthesizer/Dimensional/RateAmplitude/Filter.hs view
@@ -0,0 +1,584 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Dimensional.RateAmplitude.Filter (+   {- * Non-recursive -}++   {- ** Amplification -}+   amplify,+   amplifyDimension,+   negate,+   envelope,+   envelopeVector,+   envelopeVectorDimension,+   {- ** Filter operators from calculus -}+   differentiate,++   {- ** Smooth -}+   meanStatic,+   mean,++   {- ** Delay -}+   delay,+   phaseModulation,+   frequencyModulation,+   frequencyModulationDecoupled,+   phaser,+   phaserStereo,+++   {- * Recursive -}++   {- ** Without resonance -}+   firstOrderLowpass,+   firstOrderHighpass,+   butterworthLowpass,+   butterworthHighpass,+   chebyshevALowpass,+   chebyshevAHighpass,+   chebyshevBLowpass,+   chebyshevBHighpass,+   {- ** With resonance -}+   universal,+   FiltR.highpassFromUniversal,+   FiltR.bandpassFromUniversal,+   FiltR.lowpassFromUniversal,+   FiltR.bandlimitFromUniversal,+   moogLowpass,++   {- ** Allpass -}+   allpassCascade,+   FiltR.allpassFlangerPhase,++   {- ** Reverb -}+   comb,+   combProc,++   {- ** Filter operators from calculus -}+   integrate,+) where++import qualified Synthesizer.Dimensional.Rate.Filter as FiltR+import qualified Synthesizer.Dimensional.Amplitude.Filter       as FiltV+-- import qualified Synthesizer.Dimensional.Amplitude.Displacement as MiscV+-- import qualified Synthesizer.Dimensional.Amplitude.Cut          as CutV+import qualified Synthesizer.Dimensional.ControlledProcess as CProc+import qualified Synthesizer.Dimensional.Process as Proc+-- import qualified Synthesizer.Dimensional.Rate as Rate++-- import Synthesizer.Dimensional.Process ((.:), (.^), )++import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat+import qualified Synthesizer.Dimensional.Abstraction.Homogeneous as Hom++import qualified Synthesizer.Dimensional.Straight.Signal      as SigS+import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA+import qualified Synthesizer.Dimensional.RateWrapper          as SigP+import qualified Synthesizer.Dimensional.RatePhantom          as RP+-- import qualified Synthesizer.Dimensional.Amplitude.Signal as SigPA+import qualified Synthesizer.State.Signal as Sig+import Synthesizer.Plain.Signal (Modifier)++import Synthesizer.Dimensional.RateAmplitude.Signal+   (toTimeScalar, toFrequencyScalar, DimensionGradient, )++import qualified Synthesizer.Frame.Stereo as Stereo+import Foreign.Storable (Storable, )++-- import qualified Synthesizer.State.Displacement as Disp+import qualified Synthesizer.Interpolation as Interpolation+import qualified Synthesizer.State.Filter.Delay as Delay+import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder  as Filt1+import qualified Synthesizer.Plain.Filter.Recursive.Allpass     as Allpass+import qualified Synthesizer.Plain.Filter.Recursive.Universal   as UniFilter+import qualified Synthesizer.Plain.Filter.Recursive.Moog        as Moog+import qualified Synthesizer.Plain.Filter.Recursive.Butterworth as Butter+import qualified Synthesizer.Plain.Filter.Recursive.Chebyshev   as Cheby+import qualified Synthesizer.State.Filter.Recursive.Integration as Integrate+import qualified Synthesizer.State.Filter.Recursive.MovingAverage as MA+import qualified Synthesizer.Plain.Filter.Recursive    as FiltRec+import qualified Synthesizer.State.Filter.NonRecursive as FiltNR++import qualified Synthesizer.Storable.Signal as SigSt+import qualified Synthesizer.Generic.Filter.Recursive.Comb as Comb++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import Number.DimensionTerm ((&*&), (&/&))++import qualified Number.NonNegative     as NonNeg++import qualified Algebra.Transcendental as Trans+import qualified Algebra.RealField      as RealField+import qualified Algebra.Field          as Field+import qualified Algebra.Real           as Real+import qualified Algebra.Ring           as Ring+import qualified Algebra.Additive       as Additive+-- import qualified Algebra.VectorSpace    as VectorSpace+import qualified Algebra.Module         as Module++-- import Control.Monad(liftM2)++import NumericPrelude hiding (negate)+import PreludeBase as P+import Prelude ()+++{- | The amplification factor must be positive. -}+{-# INLINE amplify #-}+amplify :: (Ring.C y, Dim.C u, Dim.C v) =>+      y+   -> Proc.T s u t (+        SigA.R s v y yv+     -> SigA.R s v y yv)+amplify volume = Proc.pure $ FiltV.amplify volume++{-# INLINE amplifyDimension #-}+amplifyDimension :: (Ring.C y, Dim.C u, Dim.C v0, Dim.C v1) =>+      DN.T v0 y+   -> Proc.T s u t (+        SigA.R s v1 y yv+     -> SigA.R s (Dim.Mul v0 v1) y yv)+amplifyDimension volume = Proc.pure $ FiltV.amplifyDimension volume+++{-# INLINE negate #-}+negate :: (Additive.C yv, Dim.C u, Dim.C v) =>+      Proc.T s u t (+        SigA.R s v y yv+     -> SigA.R s v y yv)+negate = Proc.pure FiltV.negate+++{-# INLINE envelope #-}+envelope :: (Flat.C flat y0, Ring.C y0, Dim.C u, Dim.C v) =>+      Proc.T s u t (+        RP.T s flat y0   {- v the envelope -}+     -> SigA.R s v y y0  {- v the signal to be enveloped -}+     -> SigA.R s v y y0)+envelope = Proc.pure FiltV.envelope++{-# INLINE envelopeVector #-}+envelopeVector :: (Flat.C flat y0, Module.C y0 yv, Ring.C y, Dim.C u, Dim.C v) =>+      Proc.T s u t (+        RP.T s flat y0   {- v the envelope -}+     -> SigA.R s v y yv  {- v the signal to be enveloped -}+     -> SigA.R s v y yv)+envelopeVector = Proc.pure FiltV.envelopeVector++{-# INLINE envelopeVectorDimension #-}+envelopeVectorDimension ::+   (Module.C y0 yv, Ring.C y, Dim.C u, Dim.C v0, Dim.C v1) =>+      Proc.T s u t (+        SigA.R s v0 y y0  {-  the envelope -}+     -> SigA.R s v1 y yv  {-  the signal to be enveloped -}+     -> SigA.R s (Dim.Mul v0 v1) y yv)+envelopeVectorDimension = Proc.pure FiltV.envelopeVectorDimension+++{-# INLINE differentiate #-}+differentiate :: (Additive.C yv, Ring.C q, Dim.C u, Dim.C v) =>+      Proc.T s u q (+        SigA.R s v q yv+     -> SigA.R s (DimensionGradient u v) q yv)+differentiate =+   do rate <- Proc.getSampleRate+      return $ \ x ->+         SigA.fromSamples+            (rate &*& SigA.amplitude x)+            (FiltNR.differentiate (SigA.samples x))+++{- | needs a good handling of boundaries, yet -}+{-# INLINE meanStatic #-}+meanStatic ::+   (RealField.C q, Module.C q yv, Dim.C u, Dim.C v) =>+      DN.T (Dim.Recip u) q   {- ^ cut-off freqeuncy -}+   -> Proc.T s u q (+        SigA.R s v q yv+     -> SigA.R s v q yv)+meanStatic time =+   FiltR.meanStatic time++meanStaticSeparateTY :: (Additive.C yv, Field.C y, RealField.C t,+         Module.C y yv, Dim.C u, Dim.C v) =>+      DN.T (Dim.Recip u) t   {- ^ cut-off freqeuncy -}+   -> Proc.T s u t (+        SigA.R s v y yv+     -> SigA.R s v y yv)+meanStaticSeparateTY time =+   -- FiltR.meanStatic time, means that 't' = 'y'+   do f <- toFrequencyScalar time+      return $ \ x ->+         let tInt  = round ((recip f - 1)/2)+             width = tInt*2+1+         in  SigA.processSamples+                ((SigA.asTypeOfAmplitude (recip (fromIntegral width)) x *> ) .+                 Delay.staticNeg tInt .+                 MA.sumsStaticInt width) x+++{- | needs a better handling of boundaries, yet -}+{-# INLINE mean #-}+mean ::+   (Additive.C yv, RealField.C q,+    Module.C q yv, Dim.C u, Dim.C v,+    Storable q, Storable yv) =>+      DN.T (Dim.Recip u) q    {- ^ minimum cut-off freqeuncy -}+   -> Proc.T s u q (+        SigA.R s (Dim.Recip u) q q+                              {- v cut-off freqeuncies -}+     -> SigA.R s v q yv+     -> SigA.R s v q yv)+mean minFreq =+   FiltR.mean minFreq+++{-# INLINE delay #-}+delay :: (Additive.C yv, Field.C y, RealField.C t, Dim.C u, Dim.C v) =>+      DN.T u t+   -> Proc.T s u t (+        SigA.R s v y yv+     -> SigA.R s v y yv)+delay time =+   do t <- toTimeScalar time+      return $ SigA.processSamples (Delay.static (round t))+++{-# INLINE phaseModulation #-}+phaseModulation ::+   (Additive.C yv, RealField.C q, Dim.C u, Dim.C v,+    Storable q, Storable yv) =>+      Interpolation.T q yv+   -> DN.T u q+          {- ^ minDelay, minimal delay, may be negative -}+   -> DN.T u q+          {- ^ maxDelay, maximal delay, it must be @minDelay <= maxDelay@+               and the modulation must always be+               in the range [minDelay,maxDelay]. -}+   -> Proc.T s u q (+        SigA.R s u q q+          {- v delay control, positive numbers meanStatic delay,+               negative numbers meanStatic prefetch -}+     -> SigA.R s v q yv+     -> SigA.R s v q yv)+phaseModulation ip minDelay maxDelay =+   FiltR.phaseModulation ip minDelay maxDelay++{-# INLINE frequencyModulation #-}+frequencyModulation ::+   (Flat.C flat q, Additive.C yv, RealField.C q, Dim.C u, Dim.C v) =>+      Interpolation.T q yv+   -> Proc.T s u q (+        RP.T s flat q    {- v frequency factors -}+     -> SigA.R s v q yv+     -> SigA.R s v q yv)+frequencyModulation ip =+   Proc.pure $+      \ factors ->+          SigA.processSamples+             (FiltR.interpolateMultiRelativeZeroPad ip (Flat.toSamples factors))++{- |+Frequency modulation where the input signal can have a sample rate+different from the output.+(The sample rate values can differ, the unit must be the same.+We could lift that restriction,+but then the unit handling becomes more complicated,+and I didn't have a use for it so far.)++The function can be used for resampling.+-}+{-# INLINE frequencyModulationDecoupled #-}+frequencyModulationDecoupled ::+   (Flat.C flat q, Additive.C yv, RealField.C q, Dim.C u, Dim.C v) =>+      Interpolation.T q yv+   -> Proc.T s u q (+        RP.T s flat q    {- v frequency factors -}+     -> SigP.T u q (SigA.D v q SigS.S) yv+     -> SigA.R s v q yv)+frequencyModulationDecoupled ip =+   fmap+      (\toFreq factors y ->+         flip SigA.processSamples (RP.fromSignal (SigP.signal y)) $+            FiltR.interpolateMultiRelativeZeroPad ip+               (SigA.scalarSamples toFreq+                  (SigA.fromSamples (SigP.sampleRate y) (Flat.toSamples factors))))+      (Proc.withParam Proc.toFrequencyScalar)+++{- | symmetric phaser -}+{-# INLINE phaser #-}+phaser ::+   (Additive.C yv, RealField.C q,+    Module.C q yv, Dim.C u, Dim.C v,+    Storable q, Storable yv) =>+      Interpolation.T q yv+   -> DN.T u q  {- ^ maxDelay, must be positive -}+   -> Proc.T s u q (+        SigA.R s u q q+                {- v delay control -}+     -> SigA.R s v q yv+     -> SigA.R s v q yv)+phaser = FiltR.phaser+{-+phaser ip maxDelay =+   do p <- phaserCore ip maxDelay+      return $ \ delays x ->+         FiltV.amplify 0.5 .+         uncurry MiscV.mix . p delays $ x+-}++{-# INLINE phaserStereo #-}+phaserStereo ::+   (Additive.C yv, RealField.C q,+    Module.C q yv, Dim.C u, Dim.C v,+    Storable q, Storable yv) =>+      Interpolation.T q yv+   -> DN.T u q   {- ^ maxDelay, must be positive -}+   -> Proc.T s u q (+        SigA.R s u q q+                 {- v delay control -}+     -> SigA.R s v q yv+     -> SigA.R s v q (Stereo.T yv))+phaserStereo = FiltR.phaserStereo+{-+phaserStereo ip maxDelay =+   do p <- phaserCore ip maxDelay+      return $ \ delays -> uncurry CutV.zip . p delays+-}++{-+{-# INLINE phaserCore #-}+phaserCore ::+   (Additive.C yv, RealField.C q,+    Module.C q yv, Dim.C u, Dim.C v,+    Storable q, Storable yv) =>+      Interpolation.T q yv+   -> DN.T u q   {- ^ maxDelay, must be positive -}+   -> Proc.T s u q (+        SigA.R s u q q+                 {- v delay control -}+     -> SigA.R s v q yv+     -> (SigA.R s v q yv, SigA.R s v q yv))+phaserCore ip maxDelay =+   do let minDelay  = Additive.negate maxDelay+      pm <- phaseModulation ip minDelay maxDelay+      return $ \ delays x ->+         let negDelays = FiltV.negate delays+         in  (pm delays x,+              pm negDelays x)+-}+++type FrequencyFilter s u q r ic v yv0 yv1 =+   Proc.T s u q+      (CProc.T s+          (SigA.R r (Dim.Recip u) q q)+                    {- v Control signal for the cut-off frequency. -}+          ic+          (SigA.R s v q yv0 ->+                    {- v Input signal -}+           SigA.R s v q yv1))+                    {- v Output signal -}++{-# INLINE firstOrderLowpass #-}+{-# INLINE firstOrderHighpass #-}+firstOrderLowpass, firstOrderHighpass ::+   (Trans.C q, Module.C q yv, Dim.C u, Dim.C v) =>+   FrequencyFilter s u q r (Filt1.Parameter q) v yv yv+firstOrderLowpass  = firstOrderGen Filt1.lowpassModifier+firstOrderHighpass = firstOrderGen Filt1.highpassModifier++{-# INLINE firstOrderGen #-}+firstOrderGen ::+   (Trans.C q, Module.C q yv, Dim.C u, Dim.C v) =>+      (Modifier yv (Filt1.Parameter q) yv yv)+--      (Sig.T (Filt1.Parameter q) -> Sig.T yv -> Sig.T yv)+   -> FrequencyFilter s u q r (Filt1.Parameter q) v yv yv+firstOrderGen modif =+   frequencyControl Filt1.parameter+      (Sig.modifyModulated modif)++++{-# INLINE butterworthLowpass #-}+{-# INLINE butterworthHighpass #-}+{-# INLINE chebyshevALowpass #-}+{-# INLINE chebyshevAHighpass #-}+{-# INLINE chebyshevBLowpass #-}+{-# INLINE chebyshevBHighpass #-}++butterworthLowpass, butterworthHighpass,+   chebyshevALowpass, chebyshevAHighpass,+   chebyshevBLowpass, chebyshevBHighpass ::+      (Flat.C flat q, Trans.C q, Module.C q yv, Dim.C u, Dim.C v) =>+      NonNeg.Int   {- ^ Order of the filter, must be even,+                        the higher the order, the sharper is the separation of frequencies. -}+   -> ResonantFilter s u q r flat (FiltRec.Pole q) v yv yv++butterworthLowpass  = higherOrderNoResoGen Butter.lowpassPole+butterworthHighpass = higherOrderNoResoGen Butter.highpassPole+chebyshevALowpass   = higherOrderNoResoGen Cheby.lowpassAPole+chebyshevAHighpass  = higherOrderNoResoGen Cheby.highpassAPole+chebyshevBLowpass   = higherOrderNoResoGen Cheby.lowpassBPole+chebyshevBHighpass  = higherOrderNoResoGen Cheby.highpassBPole++{- FIXME:+currently only frequencies can be interpolated not the filter parameters,+this is not very efficient+-}+{- TODO:+initial value+-}+{-# INLINE higherOrderNoResoGen #-}+higherOrderNoResoGen ::+   (Flat.C flat q, Field.C q, Dim.C u, Dim.C v) =>+      (Int -> [q] -> [q] -> [yv] -> [yv])+   -> NonNeg.Int+   -> ResonantFilter s u q r flat (FiltRec.Pole q) v yv yv++higherOrderNoResoGen filt order =+   frequencyResonanceControl id+      (\ cs xs ->+          let csl = Sig.toList cs+          in  Sig.fromList (filt (NonNeg.toNumber order)+                 (map FiltRec.poleResonance csl)+                 (map FiltRec.poleFrequency csl)+                 (Sig.toList xs)))+++type ResonantFilter s u q r flat ic v yv0 yv1 =+   Proc.T s u q+      (CProc.T s+         (RP.T r flat q+                   {- v signal for resonance,+                        i.e. factor of amplification at the resonance frequency+                        relatively to the transition band. -},+          SigA.R r (Dim.Recip u) q q+                   {- v signal for cut off frequency -} )+         ic+         (SigA.R s v q yv0 ->+          SigA.R s v q yv1))+++{-# INLINE universal #-}+universal ::+   (Flat.C flat q, Trans.C q, Module.C q yv, Dim.C u, Dim.C v) =>+   ResonantFilter s u q r flat (UniFilter.Parameter q) v yv (UniFilter.Result yv)+universal =+   frequencyResonanceControl+      UniFilter.parameter+      (Sig.modifyModulated UniFilter.modifier)++{-# INLINE moogLowpass #-}+moogLowpass :: (Flat.C flat q, Trans.C q, Module.C q yv, Dim.C u, Dim.C v) =>+      NonNeg.Int+   -> ResonantFilter s u q r flat (Moog.Parameter q) v yv yv+moogLowpass order =+   let orderInt = NonNeg.toNumber order+   in  frequencyResonanceControl+          (Moog.parameter orderInt)+          (Sig.modifyModulated (Moog.lowpassModifier orderInt))+++{-# INLINE allpassCascade #-}+{- | the lowest comb frequency is used as the filter frequency -}+allpassCascade :: (Trans.C q, Module.C q yv, Dim.C u, Dim.C v) =>+      NonNeg.Int  {- ^ order, number of filters in the cascade -}+   -> q           {- ^ the phase shift to be achieved for the given frequency -}+   -> FrequencyFilter s u q r (Allpass.Parameter q) v yv yv+allpassCascade order phase =+   let orderInt = NonNeg.toNumber order+   in  frequencyControl+          (Allpass.parameter orderInt phase)+          (Sig.modifyModulated (Allpass.cascadeModifier orderInt))+++{-# INLINE frequencyControl #-}+frequencyControl ::+   (Field.C q, Dim.C u, Dim.C v) =>+   (q -> ic) ->+   (Sig.T ic -> Sig.T yv0 -> Sig.T yv1) ->+   FrequencyFilter s u q r ic v yv0 yv1++frequencyControl mkParam filt =+   do toFreq <- Proc.withParam toFrequencyScalar+      return $ CProc.Cons+         (\ freqs -> Sig.map mkParam (SigA.scalarSamples toFreq freqs))+         (\ params -> SigA.processSamples (filt params))+++{-# INLINE frequencyResonanceControl #-}+frequencyResonanceControl ::+   (Flat.C flat q, Field.C q, Dim.C u, Dim.C v) =>+   (FiltRec.Pole q -> ic) ->+   (Sig.T ic -> Sig.T yv0 -> Sig.T yv1) ->+   ResonantFilter s u q r flat ic v yv0 yv1++frequencyResonanceControl mkParam filt =+   do toFreq <- Proc.withParam toFrequencyScalar+      return $ CProc.Cons+         (\ (resos, freqs) ->+               Sig.map mkParam $+               Sig.zipWith FiltRec.Pole+                  (Flat.toSamples resos)+                  (SigA.scalarSamples toFreq freqs))+         (\ params -> SigA.processSamples (filt params))+++{- | Infinitely many equi-delayed exponentially decaying echos. -}+{-# INLINE comb #-}+comb :: (RealField.C t, Module.C y yv, Dim.C u, Dim.C v, Storable yv) =>+   DN.T u t -> y -> Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv)+comb = FiltR.comb+++{- | Infinitely many equi-delayed echos processed by an arbitrary time-preserving signal processor. -}+{-# INLINE combProc #-}+combProc ::+   (RealField.C t, Real.C y, Field.C y, Module.C y yv,+    Dim.C u, Dim.C v, Storable yv) =>+   DN.T u t ->+   Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv) ->+   Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv)+combProc time proc =+   do f <- proc+      t <- fmap round $ toTimeScalar time+      let chunkSize = SigSt.chunkSize t+      return $ \x ->+         SigA.processSamples+            (Sig.fromStorableSignal .+             Comb.runProc t+                (Sig.toStorableSignal chunkSize .+                 SigA.vectorSamples (SigA.toAmplitudeScalar x) .+                 f .+                 SigA.fromSamples (SigA.amplitude x) .+                 Sig.fromStorableSignal) .+             Sig.toStorableSignal chunkSize) x++{-+combProc time proc sr x =+   Rate.loop (\sr' y -> MiscV.mixVolume (SigA.amplitude x) x (delay time sr' (proc sr' y))) sr+-}+++{-# INLINE integrate #-}+integrate :: (Additive.C yv, Field.C q, Dim.C u, Dim.C v) =>+      Proc.T s u q (+        SigA.R s v q yv+     -> SigA.R s (Dim.Mul u v) q yv)+integrate =+   do rate <- Proc.getSampleRate+      return $ \ x ->+         SigA.replaceAmplitude+            (DN.rewriteDimension (Dim.commute . Dim.applyRightMul Dim.invertRecip) $+             SigA.amplitude x &/& rate)+            (Hom.processSamples Integrate.run x)
+ src/Synthesizer/Dimensional/RateAmplitude/Instrument.hs view
@@ -0,0 +1,543 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Synthesizer.Dimensional.RateAmplitude.Instrument where++import qualified Synthesizer.Dimensional.Rate.Oscillator as Osci+import qualified Synthesizer.Dimensional.Rate.Filter     as Filt+import qualified Synthesizer.Dimensional.RateAmplitude.Displacement as Disp+import qualified Synthesizer.Dimensional.RateAmplitude.Noise      as Noise+-- import qualified Synthesizer.SampleRateDimension.Filter.Recursive    as FiltR+-- import qualified Synthesizer.SampleRateDimension.Filter.NonRecursive as FiltNR+import qualified Synthesizer.Dimensional.RateAmplitude.Filter     as FiltA+import qualified Synthesizer.Dimensional.RateAmplitude.Cut        as Cut+import qualified Synthesizer.Dimensional.Amplitude.Cut            as CutA++import qualified Synthesizer.Dimensional.RateAmplitude.Control    as Ctrl+import qualified Synthesizer.Dimensional.Rate.Control             as CtrlR++import qualified Synthesizer.Dimensional.Straight.Displacement    as DispS++import qualified Synthesizer.Dimensional.Amplitude.Analysis       as Ana++import qualified Synthesizer.Dimensional.Process as Proc+import qualified Synthesizer.Dimensional.Cyclic.Signal   as SigC+import qualified Synthesizer.Dimensional.Straight.Signal as SigS+import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA++import Synthesizer.Dimensional.RateAmplitude.Signal (($-), ($&), (&*^), (&*>^), )+import Synthesizer.Dimensional.RateAmplitude.Control ((-|#), ( #|-), (|#), ( #|), )++import Synthesizer.Dimensional.Process (($:), ($::), ($^), (.^), ($#), )+import Synthesizer.Dimensional.Amplitude.Control (mapLinear, mapExponential, )++import Foreign.Storable (Storable, )++import qualified Algebra.DimensionTerm as Dim+import qualified Number.DimensionTerm  as DN++import Number.DimensionTerm ((*&), (&*&), )++import qualified Synthesizer.Interpolation.Module as Interpolation+import           Synthesizer.Plain.Instrument (choirWave)+import qualified Synthesizer.Basic.Wave       as Wave+import qualified Synthesizer.Basic.Phase      as Phase++import qualified Number.NonNegative     as NonNeg++import qualified Algebra.Transcendental as Trans+import qualified Algebra.Module         as Module+import qualified Algebra.RealField      as RealField+import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring++import System.Random (Random, randoms, randomRs, mkStdGen, )+import Synthesizer.Utility (randomRsBalanced, balanceLevel, )++import Data.List(zip4)++import PreludeBase+import NumericPrelude++++{-| Create a sound of a slightly changed frequency+    just as needed for a simple stereo sound. -}+{-# INLINE stereoPhaser #-}+stereoPhaser :: Ring.C a =>+      (DN.T Dim.Frequency a ->+       Proc.T s Dim.Time a (SigA.R s u b b))+           {- ^ A function mapping a frequency to a signal. -}+   -> a    {- ^ The factor to the frequency, should be close to 1. -}+   -> DN.T Dim.Frequency a+           {- ^ The base (undeviated) frequency of the sound. -}+   -> Proc.T s Dim.Time a (SigA.R s u b b)+stereoPhaser sound dif freq =+   sound (dif *& freq)++++{-+allpassPlain :: (RealField.C a, Trans.C a, Module.C a a) =>+                   a -> a -> a -> a -> [a]+allpassPlain sampleRate halfLife k freq =+    Filt.allpassCascade 10+        (map Filt.AllpassParam (exponential2 (halfLife*sampleRate) k))+        (simpleSaw sampleRate freq)+-}++{-# INLINE allpassDown #-}+allpassDown ::+   (RealField.C a, Trans.C a, Module.C a a) =>+      NonNeg.Int -> DN.T Dim.Time a ->+      DN.T Dim.Frequency a -> DN.T Dim.Frequency a ->+      Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+allpassDown order halfLife filterfreq freq =+   do x <- simpleSaw freq+      FiltA.amplify 0.3 $:+         (Disp.mix+             $# x+             $: (Filt.allpassCascade order Filt.allpassFlangerPhase+                    $: filterfreq &*^ CtrlR.exponential2 halfLife+                    $# x))+++{-# INLINE moogDown #-}+{-# INLINE moogReso #-}+moogDown, moogReso ::+   (RealField.C a, Trans.C a, Module.C a a) =>+      NonNeg.Int -> DN.T Dim.Time a ->+      DN.T Dim.Frequency a -> DN.T Dim.Frequency a ->+      Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+moogDown order halfLife filterfreq freq =+   Filt.moogLowpass order+      $- DN.fromNumber 10+      $: filterfreq &*^ CtrlR.exponential2 halfLife+      $: simpleSaw freq++moogReso order halfLife filterfreq freq =+   Filt.moogLowpass order+      $: DN.fromNumber 100 &*^ CtrlR.exponential2 halfLife+      $- filterfreq+      $: simpleSaw freq+++{-# INLINE bell #-}+bell :: (Trans.C a, RealField.C a, Module.C a a) =>+   DN.T Dim.Frequency a ->+   Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+bell freq =+   let halfLife = DN.time 0.5+   in  FiltA.amplify (1/3) $:+       (Disp.mixMulti $::+          (bellHarmonic 1 halfLife freq :+           bellHarmonic 4 halfLife freq :+           bellHarmonic 7 halfLife freq :+           []))++++{-# INLINE bellHarmonic #-}+bellHarmonic :: (Trans.C a, RealField.C a, Module.C a a) =>+   a -> DN.T Dim.Time a -> DN.T Dim.Frequency a ->+   Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+bellHarmonic n halfLife freq =+   Filt.envelope+      $: CtrlR.exponential2 (recip n *& halfLife)+      $: (DN.voltage 1+             &*^ (Osci.freqMod Wave.sine zero+                  $: (mapLinear 0.005 (DN.frequency 5)+                        $^ Osci.static Wave.sine zero (n *& freq))))+++{-# INLINE fastBell #-}+{-# INLINE squareBell #-}+{-# INLINE moogGuitar #-}+{-# INLINE moogGuitarSoft #-}+{-# INLINE fatSaw #-}++fastBell, squareBell, moogGuitar, moogGuitarSoft, fatSaw ::+   (RealField.C a, Trans.C a, Module.C a a) =>+   DN.T Dim.Frequency a -> Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+fastBell freq =+   Filt.envelope+      $: CtrlR.exponential2 (DN.time 0.2)+      $: (DN.voltage 1  &*^  Osci.static Wave.sine zero freq)++{-# INLINE filterSaw #-}+filterSaw :: (Module.C a a, Trans.C a, RealField.C a) =>+   DN.T Dim.Frequency a -> DN.T Dim.Frequency a ->+   Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+filterSaw filterFreq freq =+   FiltA.amplify 0.1 $:+   (Filt.lowpassFromUniversal $^+     (Filt.universal+         $- DN.fromNumber 10+         $: filterFreq &*^ CtrlR.exponential2 (DN.time 0.1)+         $: (DN.voltage 1  &*^  Osci.static Wave.saw zero freq)))+++squareBell freq =+   Filt.firstOrderLowpass+      $: DN.frequency 4000 &*^ CtrlR.exponential2 (DN.time (1/10))+--       (Osci.freqModSample Interpolation.cubic [0, 0.7, -0.3, 0.7, 0, -0.7, 0.3, -0.7] zero+      $: (DN.voltage 1  &*^+           (Osci.freqModSample Interpolation.linear+               (SigC.fromPeriodList [0, 0.5, 0.6, 0.8, 0, -0.5, -0.6, -0.8]) zero+               $: (mapLinear 0.01 freq+                      $^ (Osci.static Wave.sine zero (DN.frequency 5.0)))))+++{-# INLINE fmBell #-}+fmBell :: (RealField.C a, Trans.C a, Module.C a a) =>+   a -> a -> DN.T Dim.Frequency a ->+   Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+fmBell depth freqRatio freq =+   let modul =+          Filt.envelope+             $: CtrlR.exponential2 (DN.time 0.2)+             $: DN.fromNumber depth &*^ Osci.static Wave.sine zero (freqRatio *& freq)+   in  Filt.envelope+          $: CtrlR.exponential2 (DN.time 0.5)+          $: (DN.voltage 1 &*^ (Osci.phaseMod Wave.sine freq $& modul))+++moogGuitar freq =+   let filterControl =+          DN.frequency 4000 &*^ CtrlR.exponential2 (DN.time 0.5)+       tone =+          DN.voltage 1  &*^+          (Osci.freqMod Wave.saw zero+              $: (mapLinear 0.005 freq $^+                     Osci.static Wave.sine zero (DN.frequency 5)))+   in  Filt.moogLowpass 4 $- DN.fromNumber 10 $: filterControl $: tone++moogGuitarSoft freq =+   Filt.envelope+      $: (fmap (1-) $^ CtrlR.exponential2 (DN.time 0.003))+      $: moogGuitar freq+++{- |+Phase modulation using a ring modulated signal.+May be used as some kind of e-guitar.+-}+fmRing ::+   (RealField.C a, Trans.C a, Module.C a a) =>+   DN.T Dim.Frequency a -> Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+fmRing freq =+   DN.voltage 1 &*^+   (Osci.phaseMod (Wave.sineSawSmooth 1) freq+     $: (DN.fromNumber 1 &*^   -- 0.2 for no distortion+            (Filt.envelope+                $: CtrlR.exponential2 (DN.time 0.2)+                $: (Filt.envelope+                       $: Osci.static (Wave.raise one Wave.sine) (Phase.fromRepresentative 0.75) freq+                       $: Osci.static Wave.sine zero (5.001 *& freq)))))++fatPad ::+   (RealField.C a, Trans.C a, Module.C a a, Random a) =>+   DN.T Dim.Frequency a -> Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+fatPad freq =+   let env =+          Cut.append+             $: (Cut.take (DN.time 0.7) $:+                  Ctrl.cubicHermite+                   (DN.time 0,   (DN.fromNumber 0,   DN.frequency 1 &*& DN.fromNumber 5))+                   (DN.time 0.7, (DN.fromNumber 0.5, DN.frequency 1 &*& DN.fromNumber 0)))+             $: Ctrl.constant (DN.fromNumber 0.5)+       osci f =+          DN.voltage 0.3 &*^+          (Osci.phaseMod Wave.sine f+            $: (DN.fromNumber 2 &*^+                   (Filt.envelope+                       $: env+                       $: Osci.static (Wave.sineSawSmooth 1) zero f)))+       freqs = randomRsBalanced (mkStdGen 384) 3 1 0.03+   in  Disp.mixMulti $:: map (\k -> osci (k *& freq)) freqs+{-+renderTimeVoltageMonoDoubleToInt16 (DN.frequency 44100) "fat-pad" (Cut.take (DN.time 1.5) $: fatPad (DN.frequency 220))+-}+++brass ::+   (RealField.C a, Trans.C a, Module.C a a, Random a) =>+   DN.T Dim.Frequency a -> Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+brass freq =+   let blobEnv = Ctrl.piecewise+          (DN.fromNumber 0  |# (DN.time 0.05, Ctrl.cosinePiece) #|-+           DN.fromNumber 1 -|# (DN.time 0.05, Ctrl.cosinePiece) #|+           DN.fromNumber 0)+       adsr = Ctrl.piecewise+          (DN.fromNumber 0 |# (DN.time 0.1, Ctrl.cubicPiece (DN.frequency 1 &*& DN.fromNumber 10) (DN.frequency 1 &*& DN.fromNumber 0)) #|-+           DN.fromNumber 0.5 -|# (DN.time 1, Ctrl.stepPiece) #|-+           DN.fromNumber 0.5 -|# (DN.time 0.3, Ctrl.exponentialPiece (DN.fromNumber 0)) #|+           DN.fromNumber 0.01)+       osci b f =+          DN.voltage 0.5 &*^+          (Osci.freqMod Wave.saw zero $:+             (Disp.mix+                 $: (mapLinear 0.01 f $^ Osci.static Wave.sine zero (DN.frequency 2))+                 $: ((b *& f) &*^ blobEnv)))+       n = 4+       freqs = randomRsBalanced (mkStdGen 295) n 1 0.03+       blobAmps = balanceLevel 0 (take n (iterate (0.1+) 0))+   in  Filt.envelope+          $: adsr+          $: (Disp.mixMulti $:: zipWith (\b k -> osci b (k *& freq)) blobAmps freqs)+{-+Synthesizer.Dimensional.RateAmplitude.File.renderTimeVoltageMonoDoubleToInt16 (DN.frequency 44100) "brass" (brass (DN.frequency 440))+-}+++{-| low pass with resonance -}+{-# INLINE filterSweep #-}+filterSweep :: (Module.C a v, Trans.C a, RealField.C a) =>+   Phase.T a ->+   Proc.T s Dim.Time a (+      SigA.R s Dim.Voltage a v ->+      SigA.R s Dim.Voltage a v)+filterSweep phase =+   Filt.lowpassFromUniversal .^+    (Filt.universal+       $- DN.fromNumber 10+       $: (mapExponential 2 (DN.frequency 1800) $^+              Osci.static Wave.sine phase (DN.frequency (1/16))))+++{-# INLINE fatSawChordFilter #-}+{-# INLINE fatSawChord #-}+fatSawChordFilter, fatSawChord ::+   (RealField.C a, Trans.C a, Module.C a a) =>+   DN.T Dim.Frequency a -> Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)++fatSawChordFilter freq =+   FiltA.amplify (1/2) $:+   (Filt.lowpassFromUniversal $^+     (Filt.universal+         $- DN.fromNumber 10+         $: filterDown+         $: fatSawChord freq))++fatSawChord freq =+   FiltA.amplify (1/3) $:+   (Disp.mixMulti $::+       [fatSaw ( 1    *& freq),+        fatSaw ((5/4) *& freq),+        fatSaw ((3/2) *& freq)])++{-# INLINE filterDown #-}+filterDown :: (RealField.C a, Trans.C a) =>+   Proc.T s Dim.Time a (SigA.R s Dim.Frequency a a)+filterDown =+   DN.frequency 4000 &*^ CtrlR.exponential2 (DN.time (1/3))++{-# INLINE simpleSaw #-}+simpleSaw :: (Ring.C a, Dim.C u, RealField.C v) =>+   DN.T (Dim.Recip u) v ->+   Proc.T s u v (SigA.R s Dim.Voltage a v)+simpleSaw freq =+   DN.voltage 1 &*>^ Osci.static Wave.saw zero freq+++{-| accumulate multiple similar saw sounds and observe the increase of volume+    The oscillator @osc@ must accept relative frequencies. -}+{-# INLINE modulatedWave #-}+modulatedWave :: (Trans.C a, RealField.C a, Dim.C u) =>+   Proc.T s u a (SigA.R s (Dim.Recip u) a a -> SigA.R s Dim.Voltage a a) ->+   DN.T (Dim.Recip u) a ->+   a -> Phase.T a ->+   DN.T (Dim.Recip u) a ->+   Proc.T s u a (SigA.R s Dim.Voltage a a)+modulatedWave osc freq depth phase speed =+   osc $: (mapLinear depth freq $^+              Osci.static Wave.sine phase speed)+++{-# INLINE accumulationParameters #-}+accumulationParameters :: (Random a, Trans.C a, RealField.C a, Module.C a a) =>+   [(Phase.T a, a, Phase.T a, DN.T Dim.Frequency a)]+accumulationParameters =+   let starts = randoms           (mkStdGen 48251)+       depths = randomRs (0,0.02) (mkStdGen 12354)+       phases = randoms           (mkStdGen 74389)+       speeds = randomRs (DN.frequency 0.1, DN.frequency 0.3)+                                  (mkStdGen 03445)+   in  zip4 starts depths phases speeds++{-# INLINE accumulatedSaws #-}+{-# INLINE choir #-}+accumulatedSaws, choir ::+   (Random a, Trans.C a, RealField.C a, Module.C a a) =>+   DN.T Dim.Frequency a ->+   Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+accumulatedSaws freq =+    Disp.mixMulti $::+       (map+          (\(start, depth, phase, speed) ->+               modulatedWave+                  (ampVolt (Osci.freqMod Wave.saw start))+                  freq depth phase speed)+          accumulationParameters)++choir freq =+   FiltA.amplify 0.2 $: (Disp.mixMulti $::+      take 10+         (map+            (\(start, depth, phase, speed) ->+                modulatedWave+                  (ampVolt (Osci.freqModSample Interpolation.constant+                      (SigC.fromPeriodList choirWave) start))+                  freq depth phase speed)+            accumulationParameters))+++fatSaw freq =+    {- a simplified version of modulatedWave -}+    let partial depth modPhase modFreq =+           osciDoubleSaw $:+              (mapLinear depth freq $^+                  Osci.static Wave.sine (Phase.fromRepresentative modPhase) modFreq)+    in  Disp.mixMulti $::+            [partial 0.00311 0.0 (DN.frequency 20),+             partial 0.00532 0.3 (DN.frequency 17),+             partial 0.00981 0.9 (DN.frequency  6)]+++{-# INLINE wasp #-}+{- |+A good choice is @freq = DN.frequency 110@+-}+wasp ::+   (RealField.C q, Trans.C q, Module.C q q, Random q, Dim.C u) =>+   DN.T (Dim.Recip u) q ->+   Proc.T s u q (SigA.R s Dim.Voltage q q)+wasp freq =+   Filt.envelope+      $: (mapLinear 1 (DN.scalar 0.5) $^ Osci.static Wave.saw zero (recip 2.01 *& freq))+      $: DN.voltage 0.7 &*^ Osci.static Wave.saw zero freq+++{-# INLINE osciDoubleSaw #-}+osciDoubleSaw :: (RealField.C a, Module.C a a, Dim.C u) =>+   Proc.T s u a (+      SigA.R s (Dim.Recip u) a a ->+      SigA.R s Dim.Voltage a a)+osciDoubleSaw =+   ampVolt $+   Osci.freqModSample Interpolation.linear+      (SigC.fromPeriodList [-1, -0.2, 0.5, -0.5, 0.2, 1.0]) zero++{-# INLINE ampVolt #-}+ampVolt :: (Ring.C y, Dim.C u) =>+   Proc.T s u y (a -> SigS.R s y) ->+   Proc.T s u y (a -> SigA.R s Dim.Voltage y y)+ampVolt p =+   Proc.withParam $ \x ->+      DN.voltage 1 &*^ (p $# x)++{-|+A tone with a waveform with roughly the dependency @x -> x^?p@,+where the waveform is normalized to constant quadratic norm+-}+{-# INLINE osciSharp #-}+osciSharp :: (RealField.C a, Trans.C a) =>+   DN.T Dim.Frequency a ->+   Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+osciSharp freq =+   let control = DN.fromNumber 10 &*^ CtrlR.exponential2 (DN.time 0.01)+   in  DN.voltage 1 &*^+          (Osci.shapeMod Wave.powerNormed zero freq $& control)++{-|+Build a saw sound from its harmonics and modulate it.+Different to normal modulation+I modulate each harmonic with the same depth rather than a proportional one.+-}+{-# INLINE osciAbsModSaw #-}+osciAbsModSaw :: (RealField.C a, Trans.C a, Module.C a a) =>+   DN.T Dim.Frequency a ->+   Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+osciAbsModSaw freq =+   let harmonic n =+          DN.voltage (0.25 / fromInteger n)+              &*^ (Osci.freqMod Wave.sine zero+                $: (mapLinear 0.03 freq $^+                      (Osci.static Wave.sine zero (DN.frequency 1))))+   in  Disp.mixMulti $:: map harmonic [1..20]++{-|+Short pulsed Noise.white,+i.e. Noise.white amplified with pulses of varying H\/L ratio.+-}+{-# INLINE pulsedNoise #-}+pulsedNoise :: (Random a, RealField.C a, Trans.C a, Module.C a a) =>+   DN.T Dim.Frequency a   {-^ frequency of the pulses, interesting ones are around 100 Hz and below -} ->+   Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+pulsedNoise freq =+   let raisedSine = Wave.raise one Wave.sine+       c = Proc.pure Ana.lessOrEqual+              $: (DN.voltage 1.0 &*^ Osci.static raisedSine zero freq)+              $: (DN.voltage 0.2 &*^ Osci.static raisedSine zero (DN.frequency 0.1))+   in  Proc.pure CutA.selectBool+          $- DN.voltage 0+          $: Noise.white (DN.frequency 20000) (DN.voltage 1.0)+          $: c+++{-# INLINE noisePerc #-}+noisePerc :: (Random a, RealField.C a, Trans.C a) =>+   Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+noisePerc =+   Filt.envelope+      $: CtrlR.exponential2 (DN.time 0.1)+      $: Noise.white (DN.frequency 20000) (DN.voltage 1.0)++{-# INLINE noiseBass #-}+noiseBass :: (Random a, RealField.C a, Trans.C a, Module.C a a, Storable a) =>+   DN.T Dim.Frequency a ->+   Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+noiseBass freq =+   FiltA.combProc (DN.unrecip freq)+      (Filt.firstOrderLowpass $- DN.frequency 2000)+      $: noisePerc++{-|+Drum sound using the Karplus-Strong-Algorithm+This is a Noise.white enveloped by an exponential2+which is piped through the Karplus-Strong machine+for generating some frequency.+The whole thing is then frequency modulated+to give a falling frequency.+-}+{-# INLINE electroTom #-}+electroTom ::+   (Random a, RealField.C a, Trans.C a, Module.C a a, Storable a) =>+   Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)+electroTom =+   let ks =+         FiltA.combProc (DN.time (1/30))+            (Filt.firstOrderLowpass $- (DN.frequency 1000))+            $: noisePerc+   in  Filt.frequencyModulation Interpolation.linear+          $: CtrlR.exponential2 (DN.time 0.3)+          $: ks++{-# INLINE bassDrum #-}+bassDrum ::+   (RealField.C q, Trans.C q, Module.C q q, Random q) =>+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)+bassDrum =+   Cut.take (DN.time 0.15) $:+   (Disp.mix+    $: (Filt.firstOrderLowpass+          $- (DN.frequency 5000)+          $: (Filt.envelope+                $: (DispS.raise 0.03 $^ CtrlR.exponential2 (DN.time 0.002))+                $: (Noise.white (DN.frequency 20000) (DN.voltage 1))))+    $: (DN.voltage 0.5 &*^+         (Filt.envelope+            $: (CtrlR.exponential2 (DN.time 0.05))+            $: (Osci.freqMod Wave.sine zero+                   $: (Ctrl.exponential2+                         (DN.time 0.15) (DN.frequency 100))))))
+ src/Synthesizer/Dimensional/RateAmplitude/Noise.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++-}+module Synthesizer.Dimensional.RateAmplitude.Noise+  (white,    whiteBandEnergy,    randomPeeks,+   whiteGen, whiteBandEnergyGen, randomPeeksGen,+   ) where+++import qualified Synthesizer.State.NoiseCustom as Noise+import qualified Synthesizer.State.Signal as Sig++import qualified Synthesizer.RandomKnuth as Knuth++import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Rate.Dirac as Dirac+import qualified Synthesizer.Dimensional.Process as Proc++import Synthesizer.Dimensional.Process (($#), )++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim+import Number.DimensionTerm ((&*&))++import qualified Algebra.Algebraic          as Algebraic+import qualified Algebra.Field              as Field+import qualified Algebra.Ring               as Ring++import System.Random (Random, RandomGen, mkStdGen)++import NumericPrelude+import PreludeBase as P++++{-# INLINE white #-}+{- The Field.C constraint could be replaced by Ring.C+   if Noise instead of faster NoiseCustom would be used -}+white :: (Field.C yv, Random yv, Algebraic.C q, Dim.C u, Dim.C v) =>+      DN.T (Dim.Recip u) q+          {-^ width of the frequency band -}+   -> DN.T v q+          {-^ volume caused by the given frequency band -}+   -> Proc.T s u q (SigA.R s v q yv)+          {-^ noise -}+white =+   -- FIXME: there was a bug in GHC-6.4's standard random generator where genRange returned minBound::Int as lower bound but actually generated numbers were always positive+   -- this is fixed in GHC-6.6 and thus the standard generator can be used+   whiteGen (Knuth.cons 6746)+--   whiteGen (mkStdGen 6746)++{-# INLINE whiteGen #-}+whiteGen ::+   (Field.C yv, Random yv, RandomGen g, Algebraic.C q, Dim.C u, Dim.C v) =>+      g   {-^ random generator, can be used to choose a seed -}+   -> DN.T (Dim.Recip u) q+          {-^ width of the frequency band -}+   -> DN.T v q+          {-^ volume caused by the given frequency band -}+   -> Proc.T s u q (SigA.R s v q yv)+          {-^ noise -}+whiteGen gen bandWidth volume =+   do bw <- SigA.toFrequencyScalar bandWidth+      return $+         SigA.fromSamples+            (DN.scale (sqrt $ 3 / bw) volume)+            (Noise.whiteGen gen)+++{-# INLINE whiteBandEnergy #-}+whiteBandEnergy :: (Field.C yv, Random yv, Algebraic.C q, Dim.C u, Dim.C v) =>+      DN.T (Dim.Mul u (Dim.Sqr v)) q+          {-^ energy per frequency band -}+   -> Proc.T s u q (SigA.R s v q yv)+          {-^ noise -}+whiteBandEnergy = whiteBandEnergyGen (mkStdGen 6746)++{-# INLINE whiteBandEnergyGen #-}+whiteBandEnergyGen ::+   (Field.C yv, Random yv, RandomGen g, Algebraic.C q, Dim.C u, Dim.C v) =>+      g   {-^ random generator, can be used to choose a seed -}+   -> DN.T (Dim.Mul u (Dim.Sqr v)) q+          {-^ energy per frequency band -}+   -> Proc.T s u q (SigA.R s v q yv)+          {-^ noise -}+whiteBandEnergyGen gen energy =+   do rate <- Proc.getSampleRate+      return $+         SigA.fromSamples+            (DN.sqrt $ DN.scale 3 $+             DN.rewriteDimension+                (Dim.identityLeft . Dim.applyLeftMul Dim.cancelLeft .+                 Dim.associateLeft) $+             rate &*& energy)+            (Noise.whiteGen gen)+++{-+The Field.C q constraint could be lifted to Ring.C+if we would use direct division instead of toFrequencyScalar.+-}+{-# INLINE randomPeeks #-}+randomPeeks ::+   (Field.C q, Random q, Ord q, Dim.C u) =>+    Proc.T s u q (+       SigA.R s (Dim.Recip u) q q+          {- v instantaneous densities (frequency),+               @p@ means that there is about one peak+               in the time range of @1\/p@. -}+    -> SigA.R s (Dim.Recip u) q q)+          {- ^ Every occurrence is represented by a peak of area 1.+               If you smooth the input and the output signal to the same degree+               they should be rather similar. -}+randomPeeks =+   randomPeeksGen (mkStdGen 876)+++{-# INLINE randomPeeksGen #-}+randomPeeksGen ::+   (Field.C q, Random q, Ord q, Dim.C u,+    RandomGen g) =>+       g  {- ^ random generator, can be used to choose a seed -}+    -> Proc.T s u q (+         SigA.R s (Dim.Recip u) q q+          {- v momentary densities (frequency),+               @p@ means that there is about one peak+               in the time range of @1\/p@. -}+      -> SigA.R s (Dim.Recip u) q q)+          {- ^ Every occurrence is represented by a peak of area 1. -}+randomPeeksGen g =+   Proc.withParam $ \ dens ->+      do freq <- SigA.toFrequencyScalar (SigA.amplitude dens)+         Dirac.toAmplitudeSignal $#+            (Dirac.Cons $+             Sig.zipWith (<)+                (Noise.randomRs (0, recip freq) g)+                (SigA.samples dens))
+ src/Synthesizer/Dimensional/RateAmplitude/Play.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Rank2Types #-}+module Synthesizer.Dimensional.RateAmplitude.Play (+   auto,+   timeVoltage,+   timeVoltageMonoDoubleToInt16,+   timeVoltageStereoDoubleToInt16,+   renderTimeVoltageMonoDoubleToInt16,+   renderTimeVoltageStereoDoubleToInt16,+  ) where++import qualified Sound.Sox.Play as Play+import qualified Sound.Sox.Option.Format as SoxOpt+import qualified Sound.Sox.Frame as Frame+import qualified Synthesizer.Basic.Binary as BinSmp+import qualified Data.StorableVector.Lazy.Builder as Builder+import Foreign.Storable (Storable, )++import qualified Synthesizer.Dimensional.Process as Proc++import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigRA+import qualified Synthesizer.Dimensional.RateWrapper as SigP++import qualified Synthesizer.Storable.Signal as SigSt+import qualified Synthesizer.State.Signal as Sig++import qualified Synthesizer.Frame.Stereo as Stereo++import qualified Algebra.DimensionTerm as Dim+import qualified Number.DimensionTerm  as DN++import qualified Algebra.ToInteger      as ToInteger+-- import qualified Algebra.Transcendental as Trans+import qualified Algebra.Module         as Module+import qualified Algebra.RealField      as RealField+import qualified Algebra.Field          as Field+-- import qualified Algebra.Ring           as Ring++import System.Exit(ExitCode)++import NumericPrelude+import PreludeBase+++{-# INLINE auto #-}+auto ::+    (Bounded int, ToInteger.C int, Storable int, Frame.C int, BinSmp.C yv,+     Dim.C u, RealField.C t,+     Dim.C v, Module.C y yv, Field.C y) =>+   DN.T (Dim.Recip u) t ->+   DN.T v y ->+   (int -> Builder.Builder int) ->+   SigP.T u t (SigA.S v y) yv ->+--   SigP.T u t (SigA.D v y SigS.S) yv ->+   IO ExitCode+auto freqUnit amp put sig =+   let opts =+          SoxOpt.numberOfChannels (BinSmp.numberOfSignalChannels sig)+       sampleRate =+          DN.divToScalar (SigP.sampleRate sig) freqUnit+   in  Play.extended SigSt.hPut opts SoxOpt.none+          (round sampleRate)+          (Builder.toLazyStorableVector SigSt.defaultChunkSize $+           Sig.monoidConcatMap (BinSmp.outputFromCanonical put) $+           SigA.vectorSamples (flip DN.divToScalar amp) sig)+++{-# INLINE timeVoltage #-}+timeVoltage ::+    (Bounded int, ToInteger.C int, Storable int, Frame.C int, BinSmp.C yv,+     RealField.C t,+     Module.C y yv, Field.C y) =>+   (int -> Builder.Builder int) ->+   SigP.T Dim.Time t (SigA.S Dim.Voltage y) yv ->+--   SigP.T Dim.Time t (SigA.D Dim.Voltage y SigS.S) yv ->+   IO ExitCode+timeVoltage =+   auto (DN.frequency one) (DN.voltage one)+++{-# INLINE timeVoltageMonoDoubleToInt16 #-}+timeVoltageMonoDoubleToInt16 ::+   SigP.T Dim.Time Double (SigA.S Dim.Voltage Double) Double ->+   IO ExitCode+timeVoltageMonoDoubleToInt16 sig =+   let rate = DN.toNumberWithDimension Dim.frequency (SigP.sampleRate sig)+   in  Play.simple SigSt.hPut SoxOpt.none (round rate)+          (SigP.signal (SigRA.toStorableInt16Mono sig))+++{-# INLINE timeVoltageStereoDoubleToInt16 #-}+timeVoltageStereoDoubleToInt16 ::+   SigP.T Dim.Time Double (SigA.S Dim.Voltage Double) (Stereo.T Double) ->+--   SigP.T Dim.Time t (SigA.D Dim.Voltage y SigS.S) yv ->+   IO ExitCode+timeVoltageStereoDoubleToInt16 sig =+   let rate = DN.toNumberWithDimension Dim.frequency (SigP.sampleRate sig)+   in  Play.simple SigSt.hPut SoxOpt.none (round rate)+          (SigP.signal (SigRA.toStorableInt16Stereo sig))+++{-# INLINE renderTimeVoltageMonoDoubleToInt16 #-}+renderTimeVoltageMonoDoubleToInt16 ::+   DN.T Dim.Frequency Double ->+   (forall s. Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double)) ->+   IO ExitCode+renderTimeVoltageMonoDoubleToInt16 rate sig =+   timeVoltageMonoDoubleToInt16 (SigP.runProcess rate sig)++{-# INLINE renderTimeVoltageStereoDoubleToInt16 #-}+renderTimeVoltageStereoDoubleToInt16 ::+   DN.T Dim.Frequency Double ->+   (forall s. Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double))) ->+   IO ExitCode+renderTimeVoltageStereoDoubleToInt16 rate sig =+   timeVoltageStereoDoubleToInt16 (SigP.runProcess rate sig)
+ src/Synthesizer/Dimensional/RateAmplitude/Signal.hs view
@@ -0,0 +1,183 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++For a description see "Synthesizer.Dimensional.Process".+-}+module Synthesizer.Dimensional.RateAmplitude.Signal (+   D, R,+   Proc.toTimeScalar,+   Proc.toFrequencyScalar,+   toAmplitudeScalar,+   toGradientScalar,+   DimensionGradient,+   amplitude, samples,+   fromSignal, fromSamples,+   scalarSamples, fromScalarSamples, scalarSamplesGeneric,+   vectorSamples, fromVectorSamples,+   replaceAmplitude,+   replaceSamples,+   processSamples,+   asTypeOfAmplitude,+   ($-),  ($&),+   (&*^), (&*>^),+   cache, bindCached, share,++   toStorableInt16Mono,+   toStorableInt16Stereo,+   ) where++import Synthesizer.Dimensional.Process (($:), ($^), ($#), )+import qualified Synthesizer.Dimensional.Process as Proc++import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat+import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind+import qualified Synthesizer.Dimensional.RatePhantom as RP++import Synthesizer.Dimensional.Amplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Amplitude.Control as CtrlV+import qualified Synthesizer.Dimensional.Straight.Signal   as SigS+import qualified Synthesizer.State.Signal as Sig+import qualified Synthesizer.Storable.Signal as SigSt++import qualified Synthesizer.Frame.Stereo as Stereo+import qualified Synthesizer.Basic.Binary as BinSmp+import Data.Int (Int16)+import Foreign.Storable (Storable, )++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim+import Number.DimensionTerm ((&/&))++import qualified Algebra.Module         as Module+import qualified Algebra.RealField      as RealField+import qualified Algebra.Field          as Field+import qualified Algebra.Real           as Real+import qualified Algebra.Ring           as Ring++-- import qualified Data.List as List++-- import NumericPrelude (zero, one, )+-- import PreludeBase+import Prelude (($), (.), Bool, fmap, return, (=<<), )++++type DimensionGradient u v = Dim.Mul (Dim.Recip u) v++{-# INLINE toGradientScalar #-}+toGradientScalar :: (Field.C q, Dim.C u, Dim.C v) =>+   DN.T v q -> DN.T (DimensionGradient u v) q -> Proc.T s u q q+toGradientScalar amp steepness =+   Proc.toFrequencyScalar+   (DN.rewriteDimension (Dim.identityRight . Dim.applyRightMul Dim.cancelRight . Dim.associateRight) $+    steepness &/& amp)+++infixl 0 $-, $&++{- |+Take a scalar argument where a process expects a signal.+Only possible for non-negative values so far.+-}+{-# INLINE ($-) #-}+($-) :: (Field.C y, Real.C y, Dim.C u, Dim.C v) =>+    Proc.T s u t (R s v y y -> a) -> DN.T v y -> Proc.T s u t a+($-) f x = f $: Proc.pure (CtrlV.constant x)++{- |+Take a signal with 'DN.Scalar' unit in amplitude+where the process expects a plain 'Sig.T'.+This is no longer important+since the processes which expects those inputs+can use the Flat type class.+-}+{-# INLINE ($&) #-}+($&) :: (Ring.C y) =>+   Proc.T s u t (SigS.R s y -> a) ->+   Proc.T s u t (R s Dim.Scalar y y) ->+   Proc.T s u t a+($&) f arg =+   do x <- arg+      f $# SigS.fromSamples (scalarSamples DN.toNumber x)+--      f $# toScalarSignal one x+++infix 7 &*^, &*>^++{-# INLINE (&*^) #-}+(&*^) :: (Flat.C flat y) =>+   DN.T v y ->+   Proc.T s u t (RP.T s flat y) ->+   Proc.T s u t (R s v y y)+(&*^) v x = fromSamples v . Flat.toSamples $^ x++{-+{-# INLINE (&*^) #-}+(&*^) :: (Flat.C flat y) =>+   DN.T v y ->+   Proc.T s u t (SigS.R s y) ->+   Proc.T s u t (R s v y y)+(&*^) v x = fromSignal v $^ x+-}++{-# INLINE (&*>^) #-}+(&*>^) ::+   DN.T v y ->+   Proc.T s u t (SigS.R s yv) ->+   Proc.T s u t (R s v y yv)+(&*>^) v x = fromSignal v $^ x++{-# INLINE cache #-}+cache ::+   (Dim.C v, Ind.C w, Storable yv0) =>+   Proc.T s u t (w (D v y SigS.S) yv0) ->+   Proc.T s u t (w (D v y SigS.S) yv0)+cache =+   fmap (processSamples+      (Sig.fromStorableSignal . Sig.toStorableSignal SigSt.defaultChunkSize))++{-# INLINE bindCached #-}+bindCached ::+   (Dim.C v, Ind.C w, Storable yv0) =>+   Proc.T s u t (w (D v y SigS.S) yv0) ->+   (w (D v y SigS.S) yv0 -> Proc.T s u t b) ->+   Proc.T s u t b+bindCached x y =+   y =<< cache x++{-# INLINE share #-}+share ::+   (Dim.C v, Ind.C w, Storable yv0) =>+   Proc.T s u t (w (D v y SigS.S) yv0) ->+   (Proc.T s u t (w (D v y SigS.S) yv0) -> Proc.T s u t b) ->+   Proc.T s u t b+share x y = bindCached x (y . return)++++{-# INLINE toStorableInt16Mono #-}+toStorableInt16Mono ::+   (Ind.C w, RealField.C a) =>+   w (SigA.S Dim.Voltage a) a ->+   w SigSt.T Int16+toStorableInt16Mono =+   Ind.processSignal+      (Sig.toStorableSignal SigSt.defaultChunkSize .+       Sig.map BinSmp.int16FromCanonical .+       SigA.scalarSamplesPrivate (DN.toNumberWithDimension Dim.voltage))++{-# INLINE toStorableInt16Stereo #-}+toStorableInt16Stereo ::+   (Ind.C w, Module.C a a, RealField.C a) =>+   w (SigA.S Dim.Voltage a) (Stereo.T a) ->+   w SigSt.T (Stereo.T Int16)+toStorableInt16Stereo =+   Ind.processSignal+      (Sig.toStorableSignal SigSt.defaultChunkSize .+       Sig.map (Stereo.map BinSmp.int16FromCanonical) .+       SigA.vectorSamplesPrivate (DN.toNumberWithDimension Dim.voltage))
+ src/Synthesizer/Dimensional/RateAmplitude/Traumzauberbaum.hs view
@@ -0,0 +1,463 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Main (main) where+-- module Synthesizer.Dimensional.RateAmplitude.Traumzauberbaum where++-- import qualified Synthesizer.Dimensional.RateAmplitude.Instrument as Instr++import qualified Synthesizer.Dimensional.Rate.Oscillator as Osci+import qualified Synthesizer.Dimensional.Rate.Filter     as Filt+import qualified Synthesizer.Dimensional.RateAmplitude.Displacement as Disp+import qualified Synthesizer.Dimensional.RateAmplitude.Noise      as Noise+-- import qualified Synthesizer.SampleRateDimension.Filter.Recursive    as FiltR+-- import qualified Synthesizer.SampleRateDimension.Filter.NonRecursive as FiltNR+import qualified Synthesizer.Dimensional.RateAmplitude.Filter     as FiltA+import qualified Synthesizer.Dimensional.RateAmplitude.Cut        as Cut+-- import qualified Synthesizer.Dimensional.Amplitude.Cut            as CutA++import qualified Synthesizer.Dimensional.RateAmplitude.Control    as Ctrl+-- import qualified Synthesizer.Dimensional.Rate.Control             as CtrlR++-- import qualified Synthesizer.Dimensional.Straight.Displacement    as DispS++import qualified Synthesizer.Dimensional.Process as Proc+import qualified Synthesizer.Dimensional.Straight.Signal as SigS+import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA++import qualified Synthesizer.Dimensional.RateAmplitude.File as File+import qualified Synthesizer.Dimensional.RateAmplitude.Play as Play+import qualified Synthesizer.Dimensional.RateWrapper as SigP++import Synthesizer.Dimensional.RateAmplitude.Signal (($-), (&*^), )+import Synthesizer.Dimensional.Process (($:), ($::), ($^), ($#))+import Synthesizer.Dimensional.Amplitude.Control (mapExponential, )++import qualified Synthesizer.Frame.Stereo as Stereo++-- import qualified Synthesizer.Interpolation as Interpolation+import qualified Synthesizer.Basic.Wave as Wave++import qualified Algebra.DimensionTerm as Dim+import qualified Number.DimensionTerm  as DN++import Number.DimensionTerm ((*&))++-- import qualified Number.NonNegative     as NonNeg++-- import qualified Algebra.Transcendental as Trans+-- import qualified Algebra.Module         as Module+-- import qualified Algebra.RealField      as RealField+import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring++-- import System.Random (Random, randomRs, mkStdGen)++import PreludeBase+import NumericPrelude+++type PitchClass = Int++type Pitch = (PitchClass, Int)++c, d, e, f, g, a, h :: PitchClass+c =  0+d =  2+e =  4+f =  5+g =  7+a =  9+h = 11++melody :: [(Pitch, Int)]+melody =+   ((g,4),4) : ((g,4),2) : ((c,4),4) : ((d,4),2) : ((e,4),12) :+   ((g,4),4) : ((g,4),2) : ((c,4),4) : ((d,4),2) : ((e,4),12) :+   ((c,4),4) : ((c,4),2) : ((d,4),4) : ((d,4),2) : ((e,4),12) :+   ((c,4),4) : ((c,4),2) : ((d,4),4) : ((d,4),2) : ((e,4),12) :+   ((a,4),4) : ((a,4),2) : ((f,4),4) : ((f,4),2) : ((d,4),12) :+   ((g,4),4) : ((g,4),2) : ((c,4),4) : ((d,4),2) : ((e,4),12) :+   ((a,4),4) : ((a,4),2) : ((g,4),4) : ((g,4),2) : ((f,4),12) :+   ((g,4),4) : ((g,4),2) : ((c,4),4) : ((d,4),2) : ((c,4),12) :+   []+++type Chord = [Pitch]++chords :: [(Chord, Int)]+chords =+   ([(c,4),(e,4),(g,4)],  6) :+   ([(a,3),(c,4),(f,4)],  4) :+   ([(g,3),(h,3),(d,4)],  2) :+   ([(g,3),(c,4),(e,4)], 12) :++   ([(c,4),(e,4),(g,4)],  6) :+   ([(a,3),(c,4),(f,4)],  4) :+   ([(g,3),(h,3),(d,4)],  2) :+   ([(g,3),(c,4),(e,4)], 12) :++   ([(a,3),(c,4),(e,4)],  6) :+   ([(g,3),(h,3),(d,4)],  6) :+   ([(g,3),(c,4),(e,4)], 12) :++   ([(a,3),(c,4),(e,4)],  6) :+   ([(g,3),(h,3),(d,4)],  6) :+   ([(g,3),(c,4),(e,4)], 12) :++   ([(a,3),(c,4),(f,4)],  6) :+   ([(a,3),(d,4),(f,4)],  6) :+   ([(g,3),(h,3),(d,4)], 12) :++   ([(c,4),(e,4),(g,4)],  6) :+   ([(a,3),(c,4),(f,4)],  4) :+   ([(g,3),(h,3),(d,4)],  2) :+   ([(g,3),(c,4),(e,4)], 12) :++   ([(a,3),(c,4),(f,4)],  6) :+   ([(g,3),(h,3),(e,4)],  6) :+   ([(f,3),(a,3),(d,4)], 12) :++   ([(c,4),(e,4),(g,4)],  6) :+   ([(a,3),(c,4),(f,4)],  4) :+   ([(g,3),(h,3),(d,4)],  2) :+   ([(e,3),(g,3),(c,4)], 12) :++   []+++bass :: [(Pitch, Int)]+bass =+   ((c,5), 6) : ((f,4), 4) : ((g,4), 2) : ((c,5), 12) :+   ((c,5), 6) : ((f,4), 4) : ((g,4), 2) : ((c,5), 12) :+   ((a,4), 4) : ((a,4), 2) : ((g,4), 4) : ((g,4),  2) : ((c,5), 12) :+   ((a,4), 4) : ((a,4), 2) : ((g,4), 4) : ((g,4),  2) : ((c,5), 12) :+   ((f,4), 4) : ((f,4), 2) : ((d,4), 4) : ((d,4),  2) : ((g,4), 12) :+   ((c,5), 6) : ((f,4), 4) : ((g,4), 2) : ((c,5), 12) :+   ((f,5), 6) : ((e,5), 6) : ((d,5), 12) :+   ((c,5), 6) : ((f,4), 4) : ((g,4), 2) : ((c,4), 12) :+   []+++harmony :: [Pitch]+harmony =+   (c,4) : (g,4) : (c,5) : (f,3) : (c,4) : (g,3) :+   (c,4) : (g,4) : (c,5) : (c,4) : (g,4) : (c,5) :+   (c,4) : (g,4) : (c,5) : (f,3) : (c,4) : (g,3) :+   (c,4) : (g,4) : (c,5) : (c,4) : (g,4) : (c,5) :++   (a,3) : (e,4) : (a,4) : (g,3) : (d,4) : (g,4) :+   (c,4) : (g,4) : (c,5) : (c,4) : (g,4) : (c,5) :+   (a,3) : (e,4) : (a,4) : (g,3) : (d,4) : (g,4) :+   (c,4) : (g,4) : (c,5) : (c,4) : (g,4) : (c,5) :++   (f,3) : (c,4) : (f,4) : (a,3) : (d,4) : (a,4) :+   (g,3) : (d,4) : (g,4) : (g,3) : (d,4) : (g,4) :+   (c,4) : (g,4) : (c,5) : (f,3) : (c,4) : (g,3) :+   (c,4) : (g,4) : (c,5) : (c,4) : (g,4) : (c,5) :++   (f,3) : (c,4) : (f,4) : (e,3) : (h,3) : (e,4) :+   (d,3) : (a,3) : (d,4) : (a,3) : (d,4) : (a,4) :+   (c,4) : (g,4) : (c,5) : (f,3) : (c,4) : (g,3) :+   (c,4) : (g,4) : (c,5) : (c,4) : (c,4) : (c,4) :+--   (c,4) : (g,4) : (c,5) : (c,4) : (g,4) : (c,5) :++   []++++{-# INLINE assemblePitch #-}+assemblePitch :: Pitch -> Double+assemblePitch (pc, oct) =+   fromIntegral pc / 12 + fromIntegral oct - 4+++{-# INLINE timeUnit #-}+timeUnit :: DN.T Dim.Time Double+timeUnit = DN.time 0.2++{-# INLINE pitchControl #-}+pitchControl ::+   Proc.T s Dim.Time Double (SigA.R s Dim.Scalar Double Double)+--   Proc.T s Dim.Time Double (SigS.R s Double)+pitchControl =+   Cut.concatVolume (DN.scalar 1) $:+   (mapM (\(p,dur) ->+      Cut.take (fromIntegral dur *& timeUnit)+       $: Ctrl.constant (DN.scalar (assemblePitch p))) melody)+++{-# INLINE simpleMusic #-}+simpleMusic ::+   Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double)+simpleMusic =+   DN.voltage 1 &*^+   (Osci.freqMod (Wave.trapezoid 0.9) zero+      $: (mapExponential 2 (DN.frequency 440) $^ pitchControl))+++{-# INLINE filteredPitchControl #-}+filteredPitchControl ::+   Proc.T s Dim.Time Double (SigA.R s Dim.Scalar Double Double)+filteredPitchControl =+   Filt.lowpassFromUniversal $^+      (Filt.universal+         $- DN.scalar 3+         $- DN.frequency 4+         $: pitchControl)+++{-# INLINE envelope #-}+envelope ::+   Proc.T s Dim.Time Double (SigA.R s Dim.Scalar Double Double)+envelope =+   Filt.firstOrderLowpass+      $- DN.frequency 10+      $: (Filt.firstOrderHighpass+             $- DN.frequency 0.3+             $: pitchControl)+++{-# INLINE envelopedMelody #-}+envelopedMelody ::+   Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double)+envelopedMelody =+   DN.voltage 1 &*^+   (Filt.envelope $: envelope $:+    (Osci.freqMod (Wave.trapezoid 0.9) zero+       $: (mapExponential 2 (DN.frequency 440) $^ filteredPitchControl)))+++{-# INLINE filteredMusic #-}+filteredMusic ::+   Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double)+filteredMusic =+   Filt.lowpassFromUniversal $^+      (Filt.universal+         $- DN.scalar 10+         $: (mapExponential 20 (DN.frequency 100) $^ envelope)+         $: DN.voltage 1 &*^ (Osci.freqMod (Wave.trapezoid 0.9) zero+               $: (mapExponential 2 (DN.frequency 440) $^ pitchControl)))++++{-# INLINE makeChordPhaser #-}+makeChordPhaser ::+   Chord ->+   Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double))+makeChordPhaser chord =+   Disp.mixMulti $::+   (map (\p ->+       Cut.mergeStereo+          $: (DN.voltage 1 &*^+              Osci.static (Wave.triangleAsymmetric 0.9) zero+                 (2 ** assemblePitch p *& DN.frequency 439))+          $: (DN.voltage 1 &*^+              Osci.static (Wave.triangleAsymmetric 0.9) zero+                 (2 ** assemblePitch p *& DN.frequency 441)))+       chord)++{-# INLINE makeChord #-}+makeChord ::+   Chord ->+   Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double))+makeChord chord =+   Disp.mixMulti $::+   (map (\p ->+       let {-# INLINE tone #-}+           tone noise =+              DN.voltage 1 &*^+                 (Osci.freqMod (Wave.triangleAsymmetric 0.9) zero $:+--                 (Osci.freqMod (Wave.saw) zero $:+                    (mapExponential 2 (DN.frequency 440) $^+                        (Disp.raise (DN.scalar (assemblePitch p)) 1 $:+                           (Filt.firstOrderLowpass+                               $- DN.frequency 2+                               $: noise))))+{-+       in Cut.mergeStereo+             $: (tone (Ctrl.constant (DN.scalar 0.01)))+             $: (tone (Ctrl.constant (DN.scalar (-0.01)))))+-}+{-+       in Cut.mergeStereo+             $: (tone                (Noise.white (DN.frequency 10000) (DN.scalar 0.5)))+             $: (tone (Filt.negate $: Noise.white (DN.frequency 10000) (DN.scalar 0.5))))+-}+       in SigA.share+             (Noise.white (DN.frequency 10000) (DN.scalar 0.5))+             (\ns ->+                Cut.mergeStereo+                   $: (tone ns)+                   $: (tone (Filt.negate $: ns))))+{-+       in Cut.mergeStereo+             $: (tone (Noise.white (DN.frequency 10000) (DN.scalar 0.5)))+             $: (tone (Ctrl.constant (DN.scalar (-0.02)))))+-}+{-+       in Cut.mergeStereo+             $: (tone (DN.scalar   1  &*^ Osci.static Wave.sine zero (DN.frequency 3)))+             $: (tone (DN.scalar (-1) &*^ Osci.static Wave.sine zero (DN.frequency 3))))+-}+       chord)++{-# INLINE chordAccompaniment #-}+chordAccompaniment ::+   Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double))+chordAccompaniment =+   Cut.concat $::+   (map (\(chd,dur) -> Cut.take (fromIntegral dur *& timeUnit) $: makeChord chd) chords)++++{-# INLINE bassControl #-}+bassControl ::+   Proc.T s Dim.Time Double (SigA.R s Dim.Scalar Double Double)+--   Proc.T s Dim.Time Double (SigS.R s Double)+bassControl =+   Cut.concatVolume (DN.scalar 1) $::+   (map (\(p,dur) ->+      Cut.take (fromIntegral dur *& timeUnit)+       $: Ctrl.constant (DN.scalar (assemblePitch p))) bass)+{-+   Cut.concatVolume (DN.scalar 1) $:+   (mapM (\(p,dur) ->+      Cut.take (fromIntegral dur *& timeUnit)+       $: Ctrl.constant (DN.scalar (assemblePitch p))) bass)+-}++{-# INLINE bassPhaserSignal #-}+bassPhaserSignal ::+   Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double))+bassPhaserSignal =+   Cut.mergeStereo+      $: DN.voltage 1 &*^+            (Osci.freqMod (Wave.triangleAsymmetric 0.8) zero $:+               (mapExponential 2 (DN.frequency 54.7) $^ bassControl))+      $: DN.voltage 1 &*^+            (Osci.freqMod (Wave.triangleAsymmetric 0.8) zero $:+               (mapExponential 2 (DN.frequency 55.3) $^ bassControl))++{-# INLINE bassSignal #-}+bassSignal ::+   Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double))+bassSignal =+{-+   SigA.share+      (DN.voltage 1 &*^+          (Osci.freqMod (Wave.triangleAsymmetric 0.9) zero $:+             (mapExponential 2 (DN.frequency 110) $^ bassControl)))+      (\b -> Cut.mergeStereo $: b $: b)+-}+{-+   SigA.share+      bassControl+      (\b ->+          let {-# INLINE channel #-}+              channel p =+                 DN.voltage 1 &*^+                    (Osci.freqMod (Wave.triangleAsymmetric 0.9) zero $: p)+          in  Cut.mergeStereo+                 $: channel (mapExponential 2 (DN.frequency 109.7) $^ b)+                 $: channel (mapExponential 2 (DN.frequency 110.3) $^ b))+-}+{-+   SigA.share+      bassControl+      (\b ->+         Filt.envelopeVector+            $: (Osci.freqMod ((1+) . Wave.triangleAsymmetric 0.9) zero $:+                  (mapExponential 2 (DN.frequency 27.5) $^ b))+            $: (Cut.mergeStereo+                  $: DN.voltage 1 &*^+                        (Osci.freqMod (Wave.triangleAsymmetric 0.9) zero $:+                           (mapExponential 2 (DN.frequency 109.7) $^ b))+                  $: DN.voltage 1 &*^+                        (Osci.freqMod (Wave.triangleAsymmetric 0.9) zero $:+                           (mapExponential 2 (DN.frequency 110.3) $^ b))))+-}+   SigA.share+      (Filt.firstOrderLowpass $- DN.frequency 2 $: bassControl)+      (\b ->+         Filt.envelopeVector+            $: (Osci.freqMod (Wave.raise one $ Wave.triangleAsymmetric 0.9) zero $:+                  (mapExponential 2 (DN.frequency 27.5) $^ b))+            $: (let {-# INLINE channel #-}+                    channel p =+                       DN.voltage 1 &*^+                          (Osci.freqMod (Wave.triangleAsymmetric 0.9) zero $: p)+                in  Cut.mergeStereo+                       $: channel (mapExponential 2 (DN.frequency 109.7) $^ b)+                       $: channel (mapExponential 2 (DN.frequency 110.3) $^ b)))+++{-# INLINE accompaniment #-}+accompaniment ::+   Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double))+accompaniment =+   Disp.mix+      $: (FiltA.amplify 0.3 $: bassSignal)+      $: (FiltA.amplify 0.1 $: chordAccompaniment)+{-+   FiltA.amplify 0.1 $: chordAccompaniment+-}+{-+   FiltA.amplify 0.3 $: bassSignal+-}+++{-# INLINE filteredAccompaniment #-}+filteredAccompaniment ::+   Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double))+filteredAccompaniment =+   Filt.lowpassFromUniversal $^+      (Filt.universal+         $- DN.scalar 5+         $: (mapExponential 2 (DN.frequency 440) $^+               (Cut.concatVolume (DN.scalar 1) $:+                   (mapM (\p ->+                      Cut.take (2 *& timeUnit)+                         $: Ctrl.constant (DN.scalar (assemblePitch p))) harmony)))+         $: accompaniment)+++++{-# INLINE songSignal #-}+songSignal ::+   Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double))+songSignal =+   Disp.mixMulti $::+      (SigA.share envelopedMelody (\m -> Cut.mergeStereo $: m $: m)) :+      (FiltA.amplify 0.6 $: filteredAccompaniment) :+      []++++main :: IO ()+main =+   Play.renderTimeVoltageStereoDoubleToInt16+      (DN.frequency (44100::Double))+--      (Cut.take (DN.time 2) $: songSignal)+      songSignal+--      accompaniment+--      bassSignal+     >> return ()++{-+   File.renderTimeVoltageStereoDoubleToInt16 "traumzauberbaum"+      (DN.frequency (44100::Double))+      songSignal+     >> return ()+-}++{-+import installed synthesizer package++ghc -o dist/build/traumzauberbaum/traumzauberbaum -O -Wall -fexcess-precision -ddump-simpl-stats -package synthesizer src/Synthesizer/Dimensional/RateAmplitude/Traumzauberbaum.hs++ghc -o dist/build/traumzauberbaum/traumzauberbaum-prof -prof -auto-all -O -Wall -fexcess-precision -ddump-simpl-stats -package synthesizer src/Synthesizer/Dimensional/RateAmplitude/Traumzauberbaum.hs++ghc -o dist/build/traumzauberbaum/traumzauberbaum -O -Wall -fexcess-precision -ddump-simpl-iterations -package synthesizer src/Synthesizer/Dimensional/RateAmplitude/Traumzauberbaum.hs >dist/build/Traumzauberbaum.log++ghc-core -f html -- -o dist/build/traumzauberbaum/traumzauberbaum -O -Wall -fexcess-precision -fvia-C -optc-O2 -package synthesizer src/Synthesizer/Dimensional/RateAmplitude/Traumzauberbaum.hs >dist/build/traumzauberbaum/traumzauberbaum.html+-}
+ src/Synthesizer/Dimensional/RatePhantom.hs view
@@ -0,0 +1,62 @@+{- |++Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+++-}+module Synthesizer.Dimensional.RatePhantom where++import qualified Synthesizer.Format as Format+import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind++-- import qualified Number.DimensionTerm        as DN+-- import qualified Algebra.DimensionTerm       as Dim++{-+import NumericPrelude+import PreludeBase as P+-}+++{- |+Wraps a signal and adds a phantom type+that identifies signals of the same sample rate.+We provide the phantom type this way+in order to flexibly replace it by a material sample rate.+-}+newtype T s sig y = Cons {signal :: sig y}+--   deriving (Eq, Ord, Show)++instance Functor sig => Functor (T s sig) where+   fmap f = fromSignal . fmap f . toSignal++instance (Format.C sig) => Format.C (T s sig) where+   format p (Cons sig) =+      showParen (p >= 10)+         (showString "ratePhantom " . Format.format 11 sig)++instance (Format.C sig, Show y) => Show (T s sig y) where+   showsPrec = Format.format+++{-# INLINE fromSignal #-}+fromSignal :: sig y -> T s sig y+fromSignal = Cons++{-# INLINE toSignal #-}+toSignal :: T s sig y -> sig y+toSignal = signal++{-# INLINE processSignal #-}+processSignal :: (sig0 y0 -> sig1 y1) -> (T s sig0 y0 -> T s sig1 y1)+processSignal f = fromSignal . f . toSignal+++instance Ind.C (T s) where+   toSignal = signal+   processSignal = processSignal
+ src/Synthesizer/Dimensional/RateWrapper.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE Rank2Types #-}+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Signals equipped with a sample rate information that carry a physical dimension.+-}+module Synthesizer.Dimensional.RateWrapper where++import qualified Synthesizer.Format as Format+import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind++import qualified Synthesizer.Dimensional.RatePhantom as RP+-- import qualified Synthesizer.Dimensional.Straight.Signal  as SigS+-- import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Process as Proc+import qualified Synthesizer.Dimensional.Rate as Rate+-- import qualified Synthesizer.State.Signal as Sig++import Synthesizer.Dimensional.Process (($:), ($#), )++-- import qualified Synthesizer.State.Filter.NonRecursive as Filt++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++-- import Number.DimensionTerm ((&/&))++{-+import qualified Algebra.Module         as Module+import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring+-}++-- import NumericPrelude+import PreludeBase+import Prelude ()+++data T u t sig y =+   Cons {+        sampleRate :: DN.T (Dim.Recip u) t+                                 {-^ number of samples per unit -}+      , signal     :: sig y      {-^ the embedded signal -}+     }+--   deriving (Eq, Show)++instance Functor sig => Functor (T u t sig) where+   fmap f = processSignal (fmap f)++instance (Dim.C u, Show t, Format.C sig) => Format.C (T u t sig) where+   format p (Cons rate sig) =+      showParen (p >= 10)+         (showString "rateWrapper " . showsPrec 11 rate .+          showString " " . Format.format 11 sig)++instance (Dim.C u, Show t, Format.C sig, Show y) => Show (T u t sig y) where+   showsPrec = Format.format+++{-# INLINE fromProcess #-}+fromProcess :: (Dim.C u) =>+   Proc.T s u t (RP.T s sig yv -> T u t sig yv)+fromProcess =+   fmap+      (\rate -> Cons rate . RP.toSignal)+      Proc.getSampleRate+++{- |+Render a signal generated by a signal processor+at the given sample rate,+and leave the sample rate context.+If you want to render multiple signals,+then convert them with 'fromProcess'+and move them out of the sample rate context+all at once using 'Proc.run'.+-}+{-# INLINE runProcess #-}+runProcess :: (Dim.C u) =>+   DN.T (Dim.Recip u) t ->+   (forall s. Proc.T s u t (RP.T s sig yv)) ->+   T u t sig yv+runProcess rate p =+   Proc.run rate (fromProcess $: p)+++{-# INLINE runProcessOn #-}+runProcessOn :: (Dim.C u) =>+   (forall s. Proc.T s u t (RP.T s sig0 yv0 -> RP.T s sig1 yv1)) ->+   T u t sig0 yv0 -> T u t sig1 yv1+runProcessOn p x =+   runProcess+      (sampleRate x)+      (p $# RP.fromSignal (signal x))+++{-# INLINE toProcess #-}+toProcess :: (Dim.C u) =>+   (T u t sig yv -> a) ->+   Proc.T s u t (RP.T s sig yv -> a)+toProcess f =+   fmap (f.) fromProcess++{-+infixl 0 $%++Apply a process that depends on (at least) two physical signals.+It is checked dynamically whether the sample rates of both signals are equal.+If the sample rates differ, this is an runtime error.+For more than one physical signal as input you can apply this operator repeatedly.+Try to avoid it due to the dynamic check.++($%) ::+   Proc.T s u t (SigA.R s v0 y0 yv0 -> SigA.R s v1 y1 yv1 -> a) ->+   T u t v0 y0 yv0 ->+   Proc.T s u t (SigA.R s v1 y1 yv1 -> a)+($%)+-}+++{- |+internal function+-}++{-# INLINE fromSignal #-}+fromSignal :: (Dim.C u) =>+   Rate.T s u t -> RP.T s sig yv -> T u t sig yv+fromSignal rate x =+   Cons (Rate.toDimensionNumber rate) (RP.toSignal x)++{-# INLINE toSignal #-}+toSignal :: (Dim.C u) =>+   T u t sig yv -> (Rate.T s u t, RP.T s sig yv)+toSignal x =+   (Rate.fromDimensionNumber (sampleRate x),+    RP.fromSignal (signal x))+++{-+rewriteDimension :: (Dim.C v0, Dim.C v1) =>+   (v0 -> v1) -> T u t v0 y yv -> T u t v1 y yv+rewriteDimension f (Cons amp ss) =+   Cons (DN.rewriteDimension f amp) ss+++toScalarSignal :: (Field.C y, Dim.C v) =>+   DN.T v y -> T u t y y -> RP.T s sig y+toScalarSignal amp  =  SigS.cons . scalarSamples (flip DN.divToScalar amp)++toVectorSignal :: (Field.C y, Module.C y yv, Dim.C v) =>+   DN.T v y -> T u t y yv -> RP.T s sig yv+toVectorSignal amp  =  SigS.cons . vectorSamples (flip DN.divToScalar amp)+++cons :: DN.T v y -> Sig.T yv -> T u t y yv+cons  =  Cons++consScalar :: DN.T v y -> Sig.T y -> T u t y y+consScalar  =  cons++consVector :: DN.T v y -> Sig.T yv -> T u t y yv+consVector  =  cons++replaceAmplitude :: DN.T v1 y -> T u t v0 y yv -> T u t v1 y yv+replaceAmplitude amp (Cons _ ss)  =  Cons amp ss++replaceSamples :: Sig.T yv1 -> T u t y yv0 -> T u t y yv1+replaceSamples ss (Cons amp _)  =  Cons amp ss+++processSamples :: (Dim.C v) =>+   (Sig.T yv0 -> Sig.T yv1) -> T u t y yv0 -> T u t y yv1+processSamples f x =+   replaceSamples (f $ samples x) x+++asTypeOfAmplitude :: y -> T u t y yv -> y+asTypeOfAmplitude = const+-}++{-# INLINE processSignal #-}+processSignal ::+   (sig0 yv0 -> sig1 yv1) -> T u t sig0 yv0 -> T u t sig1 yv1+processSignal f x =+   Cons (sampleRate x) (f $ signal x)+++instance (Dim.C u) => Ind.C (T u t) where+   toSignal = signal+   processSignal = processSignal
+ src/Synthesizer/Dimensional/Straight/Displacement.hs view
@@ -0,0 +1,65 @@+module Synthesizer.Dimensional.Straight.Displacement where++import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind+import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat++import qualified Synthesizer.Dimensional.Straight.Signal as SigS+import qualified Synthesizer.State.Displacement as Disp+import qualified Synthesizer.State.Signal as Sig++import qualified Algebra.Additive              as Additive++-- import qualified Prelude as P+-- import PreludeBase+-- import NumericPrelude+++{- * Mixing -}++{-|+Mix two signals.+In opposition to 'zipWith' the result has the length of the longer signal.+-}+{-# INLINE mix #-}+mix :: (Additive.C v) => SigS.R s v -> SigS.R s v -> SigS.R s v+{- we can't assert equal sample rates of mixer inputs if 'w = RateWrapper'+mix :: (Ind.C w, Additive.C v) =>+   w SigS.S v -> w SigS.S v -> w SigS.S v+-}+mix x = SigS.processSamples (SigS.toSamples x Additive.+)++{-| Add a number to all of the signal values.+    This is useful for adjusting the center of a modulation. -}+{-# INLINE raise #-}+raise :: (Ind.C w, Additive.C v) =>+    v -> w SigS.S v -> w SigS.S v+raise x = SigS.processSamples (Disp.raise x)+++{- * Distortion -}++{-# INLINE map #-}+map :: (Ind.C w, Flat.C flat y0) =>+    (y0 -> y1) ->+    w flat y0 ->+    w SigS.S y1+map f =+   Ind.processSignal+      (SigS.Cons .+       Sig.map f .+       Flat.unwrappedToSamples)++{- |+In "Synthesizer.State.Distortion" you find a collection+of appropriate distortion functions.+-}+{-# INLINE distort #-}+distort :: (c -> a -> a) -> SigS.R s c -> SigS.R s a -> SigS.R s a+{- we can't assert equal sample rates of inputs if 'w = RateWrapper'+distort :: (Ind.C w) =>+   (c -> a -> a) ->+   w SigS.S c ->+   w SigS.S a ->+   w SigS.S a+-}+distort f c = SigS.processSamples (Disp.distort f (SigS.toSamples c))
+ src/Synthesizer/Dimensional/Straight/Signal.hs view
@@ -0,0 +1,90 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Signals equipped with a phantom type parameter that reflects the sample rate.+-}+module Synthesizer.Dimensional.Straight.Signal where++import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind++import qualified Synthesizer.Format as Format+import qualified Synthesizer.Dimensional.RatePhantom as RP++import qualified Synthesizer.State.Signal as Sig++-- import qualified Number.DimensionTerm        as DN+-- import qualified Algebra.DimensionTerm       as Dim++{-+import qualified Algebra.Module         as Module+import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring+-}++-- import Number.DimensionTerm ((&/&))+++-- import NumericPrelude+import PreludeBase+-- import Prelude ()+++newtype T seq yv =+   Cons {+       samples :: seq yv   {-^ the sampled values -}+     }+--   deriving (Eq, Show)++instance Functor seq => Functor (T seq) where+   fmap f = Cons . fmap f . samples++instance Format.C seq => Format.C (T seq) where+   format p = Format.format p . samples++instance (Format.C seq, Show y) => Show (T seq y) where+   showsPrec = Format.format+++type R s yv = RP.T s S yv+type S = T Sig.T++{- |+In contrast to 'Synthesizer.Dimensional.Rate.Dirac'+where only booleans are possible (peak or not peak)+we can also have signals of booleans or other enumerations.+In this case we consider the signal as piecewise constant.+-}+type Binary s = R s Bool++++{-# INLINE replaceSamples #-}+replaceSamples :: Sig.T yv1 -> R s yv0 -> R s yv1+replaceSamples ss _  =  fromSamples ss+++{-# INLINE processSamples #-}+processSamples :: Ind.C w =>+   (seq0 yv0 -> seq1 yv1) -> w (T seq0) yv0 -> w (T seq1) yv1+processSamples f =+   Ind.processSignal (processSamplesPrivate f)++{-# INLINE processSamplesPrivate #-}+processSamplesPrivate ::+   (seq0 yv0 -> seq1 yv1) -> T seq0 yv0 -> T seq1 yv1+processSamplesPrivate f =+   Cons . f . samples+++{-# INLINE fromSamples #-}+fromSamples :: Sig.T yv -> R s yv+fromSamples  =  RP.fromSignal . Cons++{-# INLINE toSamples #-}+toSamples :: Ind.C w => w (T seq) yv -> seq yv+toSamples  =  samples . Ind.toSignal
+ synthesizer-dimensional.cabal view
@@ -0,0 +1,136 @@+Name:           synthesizer-dimensional+Version:        0.2+License:        GPL+License-File:   LICENSE+Author:         Henning Thielemann <haskell@henning-thielemann.de>+Maintainer:     Henning Thielemann <haskell@henning-thielemann.de>+Homepage:       http://www.haskell.org/haskellwiki/Synthesizer+Category:       Sound+Synopsis:       Audio signal processing with static physical dimensions+Description:+   High-level functions which use physical units and+   abstract from the sample rate in a statically type safe way.+Stability:      Experimental+Tested-With:    GHC==6.4.1, GHC==6.8.2+Cabal-Version:  >=1.6+Build-Type:     Simple++-- Extra-Source-Files:+--   Makefile++Flag splitBase+  description: Choose the new smaller, split-up base package.++Flag optimizeAdvanced+  description: Enable advanced optimizations. They slow down compilation considerably.+  default:     True++Flag buildExamples+  description: Build example executables+  default:     False+++Source-Repository this+  Tag:         0.2+  Type:        darcs+  Location:    http://code.haskell.org/synthesizer/dimensional/++Source-Repository head+  Type:        darcs+  Location:    http://code.haskell.org/synthesizer/dimensional/++Library+  Build-Depends:+    synthesizer-core >=0.2 && <0.3,+    transformers >=0.0.1 && <0.2,+    event-list >=0.0.8 && <0.1,+    non-negative >=0.0.5 && <0.1,+    numeric-prelude >=0.1.1 && <0.2,+    utility-ht >=0.0.5 && <0.1,+    storable-record >=0.0.1 && <0.1,+    sox >=0.0 && <0.1,+    storablevector >=0.2.3 && <0.3,+    binary >=0.1 && <1,+    bytestring >= 0.9 && <0.10++  If flag(splitBase)+    Build-Depends:+      base >= 3 && <5,+      random >=1.0 && <2.0,+      old-time >=1.0 && <2,+      process >=1.0 && <1.1+  Else+    Build-Depends:+      base >= 1.0 && < 2,+      special-functors >= 1.0 && <1.1++  GHC-Options:    -Wall+  Hs-source-dirs: src+  Exposed-modules:+    Synthesizer.Dimensional.Abstraction.Flat+    Synthesizer.Dimensional.Abstraction.Homogeneous+    Synthesizer.Dimensional.Abstraction.HomogeneousGen+    Synthesizer.Dimensional.Abstraction.RateIndependent+    Synthesizer.Dimensional.Amplitude+    Synthesizer.Dimensional.Amplitude.Analysis+    Synthesizer.Dimensional.Amplitude.Cut+    Synthesizer.Dimensional.Amplitude.Control+    Synthesizer.Dimensional.Amplitude.Displacement+    Synthesizer.Dimensional.Amplitude.Filter+    Synthesizer.Dimensional.Amplitude.Signal+    Synthesizer.Dimensional.Arrow+    Synthesizer.Dimensional.Map+    Synthesizer.Dimensional.Causal.Process+    Synthesizer.Dimensional.Causal.ControlledProcess+    Synthesizer.Dimensional.Causal.Displacement+    Synthesizer.Dimensional.Causal.Filter+    Synthesizer.Dimensional.Causal.Oscillator+    Synthesizer.Dimensional.ControlledProcess+    Synthesizer.Dimensional.Cyclic.Signal+    Synthesizer.Dimensional.Process+    Synthesizer.Dimensional.Rate+    Synthesizer.Dimensional.RatePhantom+    Synthesizer.Dimensional.RateWrapper+    Synthesizer.Dimensional.Rate.Analysis+    Synthesizer.Dimensional.Rate.Control+    Synthesizer.Dimensional.Rate.Cut+    Synthesizer.Dimensional.Rate.Dirac+    Synthesizer.Dimensional.Rate.Filter+    Synthesizer.Dimensional.Rate.Oscillator+    Synthesizer.Dimensional.RateAmplitude.Analysis+    Synthesizer.Dimensional.RateAmplitude.Cut+    Synthesizer.Dimensional.RateAmplitude.Control+    Synthesizer.Dimensional.RateAmplitude.Displacement+    Synthesizer.Dimensional.RateAmplitude.File+    Synthesizer.Dimensional.RateAmplitude.Filter+    Synthesizer.Dimensional.RateAmplitude.Instrument+    Synthesizer.Dimensional.RateAmplitude.Noise+    Synthesizer.Dimensional.RateAmplitude.Play+    Synthesizer.Dimensional.RateAmplitude.Signal+    Synthesizer.Dimensional.Straight.Displacement+    Synthesizer.Dimensional.Straight.Signal++--  Other-Modules:+++Executable demonstration+  If !flag(buildExamples)+    Buildable: False+  GHC-Options: -Wall -fexcess-precision+  If flag(optimizeAdvanced)+    GHC-Options: -O2 -fvia-C -optc-O2+-- -ddump-simpl-stats+  Hs-Source-Dirs: src+  Main-Is:+    Demonstration.hs+  Other-Modules:+    Synthesizer.Dimensional.RateAmplitude.Demonstration++Executable traumzauberbaum+  If !flag(buildExamples)+    Buildable: False+  GHC-Options: -Wall -fexcess-precision+  If flag(optimizeAdvanced)+    GHC-Options: -O2 -fvia-C -optc-O2+  Hs-Source-Dirs: src+  Main-Is: Synthesizer/Dimensional/RateAmplitude/Traumzauberbaum.hs