packages feed

synthesizer-inference (empty) → 0.2

raw patch · 57 files changed

+8264/−0 lines, 57 filesdep +UniqueLogicNPdep +basedep +event-listsetup-changed

Dependencies added: UniqueLogicNP, base, event-list, non-negative, numeric-prelude, random, special-functors, 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
+ alinea/Alinea.hs view
@@ -0,0 +1,219 @@+{-# OPTIONS -fno-implicit-prelude -fglasgow-exts #-}+module Main where++import Number.SI      as SIValue+import Number.SI.Unit as SIUnit+   (yocto, zepto, atto, femto, pico, nano, micro, milli, centi, deci,+    one, deca, hecto, kilo, mega, giga, tera, peta, exa, zetta, yotta)++import qualified Synthesizer.Inference.Monad.SignalSeq as SigI+import qualified Synthesizer.Inference.Monad.File      as FileI+import qualified UniqueLogicNP.Explicit.Process   as ProcI++import qualified Synthesizer.Inference.Monad.SignalSeq.Control     as CtrlI+import qualified Synthesizer.Inference.Monad.SignalSeq.Cut         as CutI+import qualified Synthesizer.Inference.Monad.SignalSeq.Filter      as FiltI+import qualified Synthesizer.Inference.Monad.SignalSeq.Noise       as NoiseI+import qualified Synthesizer.Inference.Monad.SignalSeq.Oscillator  as OsciI+import qualified Synthesizer.Inference.Monad.SignalSeq.Displacement as SynI++import qualified Synthesizer.Plain.Interpolation as Interpolation+import qualified Synthesizer.Basic.Wave as Wave++import qualified Algebra.NormedSpace.Maximum as NormedMax+import qualified Algebra.VectorSpace as VectorSpace+import qualified Synthesizer.Basic.Binary as BinSmp++import System.Random(StdGen,mkStdGen)++import NumericPrelude+import PreludeBase as P++-- import Presentation (SIDouble, SigInfPhysDouble) from dafx package+type SIDouble  = SIValue.T Double Double+type SigInfPhysDouble = SigI.Process Double SIDouble Double+++c :: SIDouble -> SigInfPhysDouble+c = CtrlI.constant++noise :: SigInfPhysDouble+noise = noiseGen (mkStdGen 32954)++noiseGen :: StdGen -> SigInfPhysDouble+noiseGen g =+   NoiseI.whiteGen g (10 * kilo * hertz) (0.26*volt)++burst, click ::+   StdGen -> SigInfPhysDouble+burst g =+   CutI.take+      (100*milli*second)+      (noiseGen g)+click g =+   FiltI.envelope+      (CtrlI.exponential2 (20*milli*second) 1)+      (noiseGen g)++stereoNoise :: (StdGen -> SigInfPhysDouble) -> SigInfPhysDoubleStereo+stereoNoise sound =+   CutI.zip (sound (mkStdGen 1223)) (sound (mkStdGen 71))+++tonk :: SIDouble -> SIDouble -> SigInfPhysDouble+tonk excite detune =+   FiltI.envelope+      (CtrlI.exponential2 (10*milli*second) 1)+      (OsciI.phaseMod Wave.sine (0.5*volt) (200*hertz + detune)+          (FiltI.envelope+              (CtrlI.exponential2 (10*milli*second) excite)+              (OsciI.static Wave.sine 1 0 (200*hertz))))++tink, bloik, spring, glass, dropSnd, blob, whistle ::+   SIDouble -> SigInfPhysDouble+tink detune =+   FiltI.envelope+      (CtrlI.exponential2 (10*milli*second) 1)+      (SynI.mixMulti+          [OsciI.static Wave.sine (0.5*volt) 0 (2000*hertz + detune),+           OsciI.static Wave.sine (0.5*volt) 0 (3000*hertz + detune)])+bloik detune =+   FiltI.envelope+      (CtrlI.exponential2 (10*milli*second) 1)+      (OsciI.phaseFreqMod Wave.sine (1*volt)+          (FiltI.envelope+              (CtrlI.exponential2 (10*milli*second) 1)+              (OsciI.static Wave.sine 1 0 (200*hertz)))+          (CtrlI.mapExponential+              2 (100*hertz + detune)+              (CtrlI.exponential2 (10*milli*second) 1)))+spring detune =+   do freqCtrl <- ProcI.share+         (CtrlI.mapExponential+             2 (1000*hertz + detune)+             (CtrlI.linear (1/second) (-1)))+      FiltI.envelope+         (CtrlI.exponential2 (100*milli*second) 1)+         (OsciI.phaseFreqMod Wave.sine (1*volt)+             (FiltI.envelope+                 (CtrlI.exponential2 (100*milli*second) 1)+                 (OsciI.freqMod Wave.sine 1 0 freqCtrl))+             freqCtrl)+glass detune =+   FiltI.envelope+      (CtrlI.exponential2 (100*milli*second) 1)+      (OsciI.phaseMod Wave.sine (1*volt) (1000*hertz + detune)+          (FiltI.envelope+              (CtrlI.exponential2 (10*milli*second) 1)+              (OsciI.static Wave.sine 1 0 (1000*hertz + detune))))+dropSnd detune =+   FiltI.envelope+      (CtrlI.exponential2 (50*milli*second) 1)+      (OsciI.freqMod Wave.sine volt 0+         (FiltI.firstOrderLowpass+            (c (10*hertz))+--         (FiltI.butterworthLowpass+--            4 (c 0.5) (c (1*hertz))+            (CtrlI.exponential2 (50*milli*second) (2000*hertz + detune))))+blob detune =+   FiltI.envelope+      (CtrlI.exponential2 (30*milli*second) 1)+      (OsciI.freqMod Wave.sine volt 0+         (CtrlI.exponential2 (200*milli*second) (500*hertz + detune)))++whistle detune =+   CutI.take+      (0.4*second)+      (OsciI.freqMod Wave.sine volt 0+         (CtrlI.mapLinear (100*hertz) (2000*hertz + detune)+             (OsciI.static Wave.square 1 0 (40*hertz))))++stereoOsci :: (SIDouble -> SigInfPhysDouble) -> SigInfPhysDoubleStereo+stereoOsci sound =+   CutI.zip (sound (10*hertz)) (sound (-10*hertz))+++explosion, rocket, phaser ::+   SigInfPhysDoubleStereo+explosion =+   FiltI.envelope+      (CtrlI.exponential2 (0.3*second) 10)+      (FiltI.chebyshevBLowpass 4+          (c 0.02)+          (CtrlI.exponential2 (1*second) (500*hertz))+          (FiltI.phaserStereo Interpolation.constant (0.003*second)+              (CtrlI.exponential2 (0.5*second) (0.003*second))+              noise))++rocket =+   FiltI.envelope+      (CtrlI.exponential2 (0.5*second) 5)+      (FiltI.chebyshevALowpass 4+          (c 0.7)+          (CtrlI.exponential2 (2*second) (2000*hertz))+          (FiltI.phaserStereo Interpolation.constant (0.003*second)+              (CtrlI.exponential2 (0.5*second) (0.003*second))+              noise))++phaser =+   CutI.take+      (3*second)+      (FiltI.phaserStereo Interpolation.constant (0.001*second)+          (OsciI.static Wave.sine (0.001*second) 0 (0.5*hertz))+          noise)++++sounds :: [(FilePath, SigInfPhysDouble)]+sounds =+   ("burst",     burst (mkStdGen 123)) :+   ("click",     click (mkStdGen 123)) :+   ("tink",      tink    (0*hertz)) :+   ("bloik",     bloik   (0*hertz)) :+   ("spring",    spring  (0*hertz)) :+   ("glass",     glass   (0*hertz)) :+   ("tonk",      tonk  1 (0*hertz)) :+   ("zonk",      tonk  5 (0*hertz)) :+   ("drop",      dropSnd (0*hertz)) :+   ("blob",      blob    (0*hertz)) :+   ("whistle",   whistle (0*hertz)) :+   []+++type SigInfPhysDoubleStereo = SigI.Process Double SIDouble (Double,Double)++stereoSounds :: [(FilePath, SigInfPhysDoubleStereo)]+stereoSounds =+   ("burst",     stereoNoise burst) :+   ("click",     stereoNoise click) :+   ("tink",      stereoOsci tink   ) :+   ("bloik",     stereoOsci bloik  ) :+   ("spring",    stereoOsci spring ) :+   ("glass",     stereoOsci glass  ) :+   ("tonk",      stereoOsci (tonk 1)) :+   ("zonk",      stereoOsci (tonk 5)) :+   ("drop",      stereoOsci dropSnd) :+   ("blob",      stereoOsci blob   ) :+   ("whistle",   stereoOsci whistle) :+   ("explosion", explosion) :+   ("rocket",    rocket) :+   ("phaser",    phaser) :+   []+++writeSound ::+   (BinSmp.C v, VectorSpace.C Double v, NormedMax.C Double v) =>+      FilePath -> FilePath ->+         SigI.Process Double SIDouble v -> IO ()+writeSound path name signal =+   do FileI.writeToInt16 hertz volt (path++name)+         (SigI.fixSampleRate (44100*hertz)+             (CutI.takeUntilPause (0.01*volt) (10*milli*second) signal))+      return ()++++main :: IO ()+main =+   do mapM_ (uncurry (writeSound "alinea/stereo/")) stereoSounds+      mapM_ (uncurry (writeSound "alinea/mono/"))   sounds
+ src/Synthesizer/Amplitude/Control.hs view
@@ -0,0 +1,88 @@+{- |+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.Amplitude.Control+   ({- * Primitives -}+    constant, constantVector,+    {- * Preparation -}+    mapLinear, mapExponential,+   ) where++import qualified Synthesizer.Plain.Control as Ctrl++import qualified Synthesizer.Amplitude.Signal as SigV+import Synthesizer.Amplitude.Signal (toAmplitudeScalar)++import qualified Algebra.OccasionallyScalar as OccScalar+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 ()+++constant :: (Field.C y', Real.C y', OccScalar.C y y') =>+      y' {-^ value -}+   -> SigV.T y y' y+constant y =+   constantVector (abs y) (OccScalar.toScalar (signum y))++{- |+The amplitude must be positive!+This is not checked.+-}+constantVector :: -- (Field.C y', Real.C y', OccScalar.C y y') =>+      y' {-^ amplitude -}+   -> yv {-^ value -}+   -> SigV.T y y' yv+constantVector y yv =+   SigV.Cons y (Ctrl.constant yv)+++{- |+Map a control curve without amplitude unit+by a linear (affine) function with a unit.+-}+mapLinear :: (Ring.C y, Field.C y', Real.C y', OccScalar.C y y') =>+      y'  {- ^ range: one is mapped to @center+range@ -}+   -> y'  {- ^ center: zero is mapped to @center@ -}+   -> SigV.T y y' y+   -> SigV.T y y' y+mapLinear range center (SigV.Cons amp ss) =+   let absRange  = abs range * amp+       absCenter = abs center+       rng = toAmplitudeScalar z absRange+       cnt = toAmplitudeScalar z absCenter+       z = SigV.Cons+              (absRange + absCenter)+              (map (\y -> cnt + rng*y) ss)+   in  z+-- SynI.mapScalar 1 (absRange + absCenter) (\y -> cnt + rng*y) x++{- |+Map a control curve without amplitude unit+exponentially to one with a unit.+-}+mapExponential :: (Field.C y', Trans.C y, Module.C y y') =>+      y   {- ^ range: one is mapped to @center*range@, must be positive -}+   -> y'  {- ^ center: zero is mapped to @center@ -}+   -> SigV.T y y  y+   -> SigV.T y y' y+mapExponential range center (SigV.Cons amp ss) =+   let b = range**amp+   in  SigV.Cons (b*>center) (map (\x -> b**(x-one)) ss)+-- SynI.mapScalar 1 center (range**)
+ src/Synthesizer/Amplitude/Cut.hs view
@@ -0,0 +1,156 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Amplitude.Cut (+   {- * dissection -}+   unzip,+   unzip3,++   {- * glueing -}+   concat,   concatVolume,+   append,   appendVolume,+   zip,      zipVolume,+   zip3,     zip3Volume,+  ) where++import qualified Synthesizer.Amplitude.Signal as SigV+import Synthesizer.Amplitude.Signal (toAmplitudeScalar)++-- import qualified Algebra.NormedSpace.Maximum as NormedMax+import qualified Algebra.OccasionallyScalar  as OccScalar+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, map)+-- import NumericPrelude+import Prelude ()+++{- * dissection -}++unzip ::+   SigV.T y y' (yv0, yv1) ->+   (SigV.T y y' yv0, SigV.T y y' yv1)+unzip x =+   let (ss0,ss1) = List.unzip (SigV.samples x)+   in  (SigV.replaceSamples ss0 x, SigV.replaceSamples ss1 x)++unzip3 ::+   SigV.T y y' (yv0, yv1, yv2) ->+   (SigV.T y y' yv0, SigV.T y y' yv1, SigV.T y y' yv2)+unzip3 x =+   let (ss0,ss1,ss2) = List.unzip3 (SigV.samples x)+   in  (SigV.replaceSamples ss0 x, SigV.replaceSamples ss1 x, SigV.replaceSamples ss2 x)++++{- * 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.+-}+concat ::+   (Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv) =>+   [SigV.T y y' yv] -> SigV.T y y' yv+concat xs =+   concatVolume (List.maximum (map SigV.amplitude xs)) xs++{- |+Give the output volume explicitly.+Does also work for infinite lists.+-}+concatVolume ::+   (Field.C y', OccScalar.C y y',+    Module.C y yv) =>+   y' -> [SigV.T y y' yv] -> SigV.T y y' yv+concatVolume amp xs =+   let smps = map (SigV.vectorSamples (toAmplitudeScalar z)) xs+       z = SigV.Cons amp (List.concat smps)+   in  z+++merge ::+   (Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv0, Module.C y yv1) =>+   ([yv0] -> [yv1] -> [yv2]) ->+   SigV.T y y' yv0 -> SigV.T y y' yv1 -> SigV.T y y' yv2+merge f x0 x1 =+   mergeVolume f (max (SigV.amplitude x0) (SigV.amplitude x1)) x0 x1++mergeVolume ::+   (Field.C y', OccScalar.C y y',+    Module.C y yv0, Module.C y yv1) =>+   ([yv0] -> [yv1] -> [yv2]) ->+   y' ->+   SigV.T y y' yv0 -> SigV.T y y' yv1 -> SigV.T y y' yv2+mergeVolume f amp x y =+   let sampX = SigV.vectorSamples (toAmplitudeScalar z) x+       sampY = SigV.vectorSamples (toAmplitudeScalar z) y+       z = SigV.Cons amp (f sampX sampY)+   in  z+++append ::+   (Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv) =>+   SigV.T y y' yv -> SigV.T y y' yv -> SigV.T y y' yv+append = merge (List.++)++appendVolume ::+   (Field.C y', OccScalar.C y y',+    Module.C y yv) =>+   y' ->+   SigV.T y y' yv -> SigV.T y y' yv -> SigV.T y y' yv+appendVolume = mergeVolume (List.++)+++zip ::+   (Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv0, Module.C y yv1) =>+   SigV.T y y' yv0 -> SigV.T y y' yv1 -> SigV.T y y' (yv0,yv1)+zip = merge List.zip++zipVolume ::+   (Field.C y', OccScalar.C y y',+    Module.C y yv0, Module.C y yv1) =>+   y' ->+   SigV.T y y' yv0 -> SigV.T y y' yv1 -> SigV.T y y' (yv0,yv1)+zipVolume = mergeVolume List.zip++++zip3 ::+   (Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv0, Module.C y yv1, Module.C y yv2) =>+   SigV.T y y' yv0 -> SigV.T y y' yv1 -> SigV.T y y' yv2 ->+   SigV.T y y' (yv0,yv1,yv2)+zip3 x0 x1 x2 =+   zip3Volume+      (SigV.amplitude x0 `max` SigV.amplitude x1 `max` SigV.amplitude x2)+      x0 x1 x2++zip3Volume ::+   (Field.C y', OccScalar.C y y',+    Module.C y yv0, Module.C y yv1, Module.C y yv2) =>+   y' ->+   SigV.T y y' yv0 -> SigV.T y y' yv1 -> SigV.T y y' yv2 ->+   SigV.T y y' (yv0,yv1,yv2)+zip3Volume amp x0 x1 x2 =+   let sampX0 = SigV.vectorSamples (toAmplitudeScalar z) x0+       sampX1 = SigV.vectorSamples (toAmplitudeScalar z) x1+       sampX2 = SigV.vectorSamples (toAmplitudeScalar z) x2+       z = SigV.Cons amp (List.zip3 sampX0 sampX1 sampX2)+   in  z+
+ src/Synthesizer/Amplitude/Displacement.hs view
@@ -0,0 +1,88 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Amplitude.Displacement (+   mix, mixVolume,+   mixMulti, mixMultiVolume,+   raise,+   ) where++import qualified Synthesizer.Amplitude.Signal as SigV++import Synthesizer.Amplitude.Signal (toAmplitudeScalar)++import qualified Synthesizer.Plain.Displacement as Synthesizer++import qualified Algebra.OccasionallyScalar as OccScalar+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 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. -}+mix ::+   (Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>+      SigV.T y y' yv+   -> SigV.T y y' yv+   -> SigV.T y y' yv+mix x y =+   mixVolume (abs (SigV.amplitude x) + abs (SigV.amplitude y)) x y++mixVolume ::+   (Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>+      y'+   -> SigV.T y y' yv+   -> SigV.T y y' yv+   -> SigV.T y y' yv+mixVolume v x y =+   let z = SigV.Cons v+              (toAmplitudeScalar z (SigV.amplitude x) *> SigV.samples x ++               toAmplitudeScalar z (SigV.amplitude y) *> SigV.samples y)+   in  z++{-| Mix one or more signals. -}+mixMulti ::+   (Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>+      [SigV.T y y' yv]+   ->  SigV.T y y' yv+mixMulti x =+   mixMultiVolume (sum (map (abs . SigV.amplitude) x)) x++mixMultiVolume ::+   (Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>+      y'+   -> [SigV.T y y' yv]+   ->  SigV.T y y' yv+mixMultiVolume v x =+   let z = SigV.Cons v+              (foldr (\y -> (toAmplitudeScalar z (SigV.amplitude y) *>+                             SigV.samples y +)) [] x)+   in  z++{-| Add a number to all of the signal values.+    This is useful for adjusting the center of a modulation. -}+raise :: (Field.C y', Module.C y yv, OccScalar.C y y') =>+      y'+   -> yv+   -> SigV.T y y' yv+   -> SigV.T y y' yv+raise y' yv x =+   SigV.Cons (SigV.amplitude x)+      (Synthesizer.raise (toAmplitudeScalar x y' *> yv) (SigV.samples x))
+ src/Synthesizer/Amplitude/Filter.hs view
@@ -0,0 +1,58 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Amplitude.Filter (+   {- * Non-recursive -}++   {- ** Amplification -}+   amplify,+   negate,+   envelope,++) where+++import qualified Synthesizer.Amplitude.Signal as SigV++import qualified Synthesizer.Plain.Filter.NonRecursive as FiltNR++-- import qualified Algebra.OccasionallyScalar as OccScalar+-- 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. -}+amplify :: (Ring.C y') =>+      y'+   -> SigV.T y y' yv+   -> SigV.T y y' yv+amplify volume x =+   SigV.Cons (volume * SigV.amplitude x) (SigV.samples x)++negate :: (Additive.C yv) =>+      SigV.T y y' yv+   -> SigV.T y y' yv+negate x =+   SigV.Cons (SigV.amplitude x) (Additive.negate (SigV.samples x))+++envelope :: (Module.C y0 yv, Ring.C y') =>+      SigV.T y y' y0  {- ^ the envelope -}+   -> SigV.T y y' yv  {- ^ the signal to be enveloped -}+   -> SigV.T y y' yv+envelope y x =+   SigV.Cons+      (SigV.amplitude y * SigV.amplitude x)+      (FiltNR.envelopeVector (SigV.samples y) (SigV.samples x))
+ src/Synthesizer/Amplitude/Signal.hs view
@@ -0,0 +1,61 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes (OccasionallyScalar)++Signals equipped with a volume information that may carry a unit.+-}+module Synthesizer.Amplitude.Signal where++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.Module         as Module+import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring++import Algebra.OccasionallyScalar (toScalar)++import NumericPrelude+import PreludeBase as P+import Prelude ()+++data T y y' yv =+   Cons {+        amplitude  :: y'   {-^ scaling of the values -}+      , samples    :: [yv] {-^ the sampled values -}+     }+   deriving (Eq, Show)+++instance Functor (T y y') where+   fmap f (Cons amp ss) = Cons amp (map f ss)+++toAmplitudeScalar :: (Field.C y', OccScalar.C y y') =>+   T y y' yv -> y' -> y+toAmplitudeScalar sig y =+   toScalar (y / amplitude sig)+++scalarSamples :: (Ring.C y) =>+   (y' -> y) -> T y y' y -> [y]+scalarSamples toAmpScalar sig =+   let y = toAmpScalar (amplitude sig)+   in  map (y*) (samples sig)++vectorSamples :: (Module.C y yv) =>+   (y' -> y) -> T y y' yv -> [yv]+vectorSamples toAmpScalar sig =+   let y = toAmpScalar (amplitude sig)+   in  y *> samples sig++++replaceAmplitude :: y1' -> T y y0' yv -> T y y1' yv+replaceAmplitude amp (Cons _ ss)  =  Cons amp ss++replaceSamples :: [yv1] -> T y y' yv0 -> T y y' yv1+replaceSamples ss (Cons amp _)  =  Cons amp ss
+ src/Synthesizer/Inference/Fix.hs view
@@ -0,0 +1,399 @@+{- |+In this modules we try to infer sampling parameters+using the unique-logic package.++Every signal is equipped with input and output parameters+that allow inference of sampling parameters.+However, this way, signals are functions+and their body cannot easily be shared.+In general signals should not be used explicitly.+Instead you should combine small signal processors to larger signal processors.+In fact, this boils down to "Control.Arrow" operations,+although we cannot use the @Arrow@ class.+We can however use the same set of combinators adapted to our needs.+We even cannot hide the peano numbers of unique-logic in the arrows,+since the number of needed peano counters depends on the number of inputs+and outputs of an arrow.+-}++{-+Inference by expressing a 'let' construct by a fixed point.++@+let input  = ping+    output = mix input (delay output)+in  output+@++@+snd $ fix (\ ~(input, output) -> (ping, mix input (delay output)))+@+++Split into atomic equations which fit the equation solver framework.+@+let input         = ping+    delayedOutput = delay output+    output        = mix input delayedOutput+in  output+@++Enrich equations with information for the lazy knot.+Signal parameters for the function results+are included in the signals,+but signal parameters of the inputs are returned separately.+@+let input =+       ping [parametersOf input, inputParam0]+    (delayedOutput, outputParam0) =+       delay [parametersOf delayedOutput, delayOutputParam0] output+    (output, (inputParam0, delayOutputParam0)) =+       mix [parametersOf output, outputParam0] input delayedOutput+in  output+@++@+let input =+       ping input [inputParam0]+    (delayedOutput, outputParam0) =+       delay delayedOutput [delayOutputParam0] output+    (output, (inputParam0, delayOutputParam0)) =+       mix output [outputParam0] input delayedOutput+in  output+@++@+let input@(inputStream, inputParam0) =+       ping [inputParam0, inputParam1]+    (delayedOutput@(delayedOutputStream, delayedOutputParam0), outputParam1) =+       delay [delayedOutputParam0, delayOutputParam1] output+    (output@(outputStream, outputParam0), (inputParam1, delayOutputParam1)) =+       mix [outputParam0, outputParam1] input delayedOutput+in  output+@++The first list argument of each computation function contains signals,+but only the parameters are used and the data stream is ignored.+@+let input = ping [input]+    (delayedOutput, output0) =+       delay [delayedOutput, delayedOutput0] output+    (output, (input0,delayedOutput0)) =+       mix [output,output0] input delayedOutput+in  output+@++++++Develop a simpler example:++Work out+@+envelope exponential oscillator+@++@+\zp0 ->+  let x = exponential xp0+      y = oscillator yp0+      (z,(xp1,yp1)) = envelope zp0 x y+      xp0 = closeCycle xp1+      yp0 = closeCycle yp1+  in  z+@++Now with sharing of the 'exponential'.+The model is+@+let x = exponential+in  envelope x (oscillator x)+@+or+@+snd $ fix \ (x, _) ->+    (exponential, envelope x (oscillator x))+@++@+\zp0 ->+  let x       = exponential xp0+      (y,xp1) = oscillator yp0 x+      (z,(xp2,yp1)) = envelope zp0 (replaceParam xp1 x) y+      xp0 = closeCycle xp2+      yp0 = closeCycle yp1+  in  z+@++With fixed point operator+@+\((x,xp0), (_,zp0)) ->+  let (y,xp1) = oscillator yp0 x+      (z,(xp2,yp1)) = envelope zp0 (replaceParam xp1 x) y+      yp0 = closeCycle yp1+  in  ((xp2, exponential xp0), (undefined,z))+@++Many generators with the same sample rate+can be handled elegantly with the monad (SharedVariable a).+@+\zp0 -> evalSharing $ mdo+   x <- initial exponential+   y <- share (oscillator yp0) x+   (z,yp1) <- share (envelope zp0 y) x+   let yp0 = closeCycle yp1+   return z+@+-}++module Synthesizer.Inference.Fix where+++import qualified Synthesizer.Physical.Signal as SigP++import qualified UniqueLogicNP.Lazy.SingleStep as Logic+++-- * custom interface++type Parameter a = Logic.Variable a++type Result a = Parameter a++type Parameters t y = (Parameter t, Parameter y)++type Results t y = (Result t, Result y)++type InputSignal  t t' y y' yv = SigP.T t (Parameter t') y (Parameter y') yv++type OutputSignal t t' y y' yv = SigP.T t (Result t') y (Result y') yv++++infixr 9 .%, .%&+infixr 0 $%, $%%, $$%&++++{- |+Combinator function:+Since the interim signal is not seen anywhere else,+we know of all influences to its value.+These are the backward-constraints of @f@+and the forward-constraints of @g@+and we can simply fuse them using 'Logic.closeCycle'.++*** The order of input and output values should be flipped,+in order to match that of @(->)@.+-}+{-+(.%) ::+   ((Parameters tc' yc', InputSignal tb tb' yb yb' ybv) ->+       (OutputSignal tc tc' yc yc' ycv, Results tb' yb')) ->+   ((Parameters tb' yb', InputSignal ta ta' ya ya' yav) ->+       (OutputSignal tb tb' yb yb' ybv, Results ta' ya')) ->+   ((Parameters tc' yc', InputSignal ta ta' ya ya' yav) ->+       (OutputSignal tc tc' yc yc' ycv, Results ta' ya'))+-}+(.%) ::+   ((params, InputSignal ta ta' ya ya' yav) ->+       (output, Results ta' ya')) ->+   ((Parameters ta' ya', input) ->+       (OutputSignal ta ta' ya ya' yav, result)) ->+   ((params, input) ->+       (output, result))+(f .% g) (zParams, x) =+   let (y,xResults) = g (yParams,x)+       (z,yResults) = f (zParams,y)+       yParams = closeParameterCycles yResults+   in  (z,xResults)++($%) ::+   ((params, InputSignal ta ta' ya ya' yav) ->+       (output, Results ta' ya')) ->+   (Parameters ta' ya' ->+       OutputSignal ta ta' ya ya' yav) ->+   (params ->+       output)+(f $% g) zParams =+   let y            = g yParams+       (z,yResults) = f (zParams,y)+       yParams = closeParameterCycles yResults+   in  z++($%%) ::+   ((params, (InputSignal ta ta' ya ya' yav, InputSignal tb tb' yb yb' ybv)) ->+       (output, (Results ta' ya', Results tb' yb'))) ->+   (Parameters ta' ya' -> OutputSignal ta ta' ya ya' yav,+    Parameters tb' yb' -> OutputSignal tb tb' yb yb' ybv) ->+   (params ->+       output)+(f $%% (ga,gb)) zParams =+   let ya = ga yaParams+       yb = gb ybParams+       (z,(yaResults,ybResults)) =+            f (zParams,(ya,yb))+       yaParams = closeParameterCycles yaResults+       ybParams = closeParameterCycles ybResults+   in  z+++(.%&) ::+   ((params, (InputSignal ta ta' ya ya' yav, InputSignal tb tb' yb yb' ybv)) ->+       (output, (Results ta' ya', Results tb' yb'))) ->+   (((Parameters ta' ya', Parameters tb' yb'), input) ->+       ((OutputSignal ta ta' ya ya' yav, OutputSignal tb tb' yb yb' ybv), result)) ->+   ((params, input) ->+       (output, result))+(f .%& g) (zParams, x) =+   let ((ya,yb), xResults)       = g ((yaParams,ybParams),x)+       (z,(yaResults,ybResults)) = f (zParams,(ya,yb))+       yaParams = closeParameterCycles yaResults+       ybParams = closeParameterCycles ybResults+   in  (z,xResults)++{-+($%&) ::+   ((params, (InputSignal ta ta' ya ya' yav, InputSignal tb tb' yb yb' ybv)) ->+       (output, (Results ta' ya', Results tb' yb'))) ->+   ((Parameters ta' ya', Parameters tb' yb') ->+    (OutputSignal ta ta' ya ya' yav, OutputSignal tb tb' yb yb' ybv)) ->+   (params ->+       output)+(f $%& g) zParams =+   let ya                        = ga yaParams+       yb                        = gb ybParams+       (z,(yaResults,ybResults)) = f (zParams,(ya,yb))+       yaParams = closeParameterCycles yaResults+       ybParams = closeParameterCycles ybResults+   in  z+-}++($$%&) ::+   ((paramsA, InputSignal ta ta' ya ya' yav) ->+       (outputA, Results ta' ya'),+    (paramsB, InputSignal tb tb' yb yb' ybv) ->+       (outputB, Results tb' yb')) ->+   ((Parameters ta' ya', Parameters tb' yb') ->+       (OutputSignal ta ta' ya ya' yav, OutputSignal tb tb' yb yb' ybv)) ->+   ((paramsA,paramsB) ->+       (outputA,outputB))+((fa,fb) $$%& x) (yaParams,ybParams) =+   let (xa,xb) = x (xaParams,xbParams)+       (ya,xaResults) = fa (yaParams,xa)+       (yb,xbResults) = fb (ybParams,xb)+       xaParams = closeParameterCycles xaResults+       xbParams = closeParameterCycles xbResults+   in  (ya,yb)+++{-+   ((paramsA, InputSignal t t' y y' yv) ->+       (outputA, Results t' y')) ->+   ((paramsB, InputSignal t t' y y' yv) ->+       (outputB, Results t' y')) ->+   (Parameters t' y' ->+       OutputSignal t t' y y' yv) ->+   ((paramsA,paramsB) ->+       (outputA,outputB))+-}+{-+Is this function implemented correctly?+-}+share2 ::+   (Parameters t' y' ->+       OutputSignal t t' y y' yv) ->+   ((Parameters t' y', Parameters t' y') ->+       (OutputSignal t t' y y' yv, OutputSignal t t' y y' yv))+share2 x ((sr0,amp0),(sr1,amp1)) =+   let srResult  = Logic.merge sr0  sr1+       ampResult = Logic.merge amp0 amp1+       y = x (srResult, ampResult)+   in  (y, y)++share2' :: (Eq t', Eq y') =>+   (Parameters t' y' ->+       OutputSignal t t' y y' yv) ->+   ((Parameters t' y', Parameters t' y') ->+       (OutputSignal t t' y y' yv, OutputSignal t t' y y' yv))+share2' x ((sr0,amp0),(sr1,amp1)) =+   let (sr0Result,  sr1Result)  = Logic.equal sr0  sr1+       (amp0Result, amp1Result) = Logic.equal amp0 amp1+       y0 = x (sr0Result, amp0Result)+       y1 = x (sr1Result, amp1Result)+   in  (y0, SigP.replaceSamples (SigP.samples y0) y1)+++fix ::+   ((Parameters t' y', InputSignal t t' y y' yv) ->+       (OutputSignal t t' y y' yv, Results t' y')) ->+   (Parameters t' y' ->+       OutputSignal t t' y y' yv)+fix x (ySR,yAmp) =+   let (y,(zSR,zAmp)) = x ((xSR,xAmp), y)+       xSR  = Logic.closeCycle $ Logic.merge ySR  zSR+       xAmp = Logic.closeCycle $ Logic.merge yAmp zAmp+{-+       xSR  = Logic.merge ySR  zSR+       xAmp = Logic.merge yAmp zAmp+-}+   in  y++{-+Probably this needs a different interface (signature)+in order to be used flawlessly in a signal processing algorithm.+-}+fixSampleRate ::+   t' ->+     OutputSignal t t' y y' yv ->+     OutputSignal t t' y y' yv+fixSampleRate sr = SigP.replaceSampleRate (Logic.constant sr)+++run ::+   (Parameters t' y' ->+       OutputSignal t t' y y' yv) ->+   SigP.T t t' y y' yv+run x =+   let y = x (sr,amp)+       srResult  = SigP.sampleRate y+       ampResult = SigP.amplitude  y+       sr  = Logic.closeCycle srResult+       amp = Logic.closeCycle ampResult+   in  SigP.replaceParameters+          (Logic.variableValue srResult)+          (Logic.variableValue ampResult)+          y+++{-+Shall 'replaceParameter' check+whether the replaced variables have the same value?+-}++closeParameterCycles ::+   Results t' y' -> Parameters t' y'+closeParameterCycles ~(sr,amp) =+   (Logic.closeCycle sr, Logic.closeCycle amp)+++-- * arrow interface++newtype Processor inSignal results params outSignal =+   Processor ((params, inSignal) -> (outSignal, results))++infixr 1 <<<++{- |+The same as '(.%)'.+-}+(<<<) ::+   Processor+      (InputSignal t t' y y' yv) (Results t' y')+      params output ->+   Processor+      input result+      (Parameters t' y') (OutputSignal t t' y y' yv) ->+   Processor input result params output+Processor f <<< Processor g = Processor $ f .% g
+ src/Synthesizer/Inference/Fix/Cut.hs view
@@ -0,0 +1,282 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2007, 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  portable++Design test of Synthesizer.Inference.Fix for basic Cut functions.+This is still a copy of "Synthesizer.Inference.Func.Cut"+and I assume that I remove it some time in the future+because the underlying approach seems to be inferior+to that of "Synthesizer.SampleRateContext.Cut".+-}+module Synthesizer.Inference.Fix.Cut (+   {- * dissection -}+   -- splitAt,+   -- take,+   -- drop,+   takeUntilPause,+   -- unzip,+   -- unzip3,++   {- * glueing -}+   concat,+   concatVolume,+   append,+   zip,+   -- zip3,+   arrange,+   arrangeVolume,+  ) where++import qualified Synthesizer.Physical.Signal      as SigP+import qualified Synthesizer.Physical.Cut         as CutP+import qualified Synthesizer.Inference.Func.Signal as SigF++import qualified Synthesizer.SampleRateContext.Signal as SigC+import qualified Synthesizer.SampleRateContext.Rate as Rate+import qualified Synthesizer.SampleRateContext.Cut as CutC++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.OccasionallyScalar  as OccScalar+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 Control.Monad.Fix(mfix)++import PreludeBase hiding (zip, zip3, concat, )+-- import NumericPrelude+import Prelude (RealFrac)++{-+{- * dissection -}++splitAt :: (RealField.C a, Field.C q, OccScalar.C a q) =>+   q -> SigI.T a q v -> Process.T q (SigI.T a q v, SigI.T a q v)+splitAt t0 x@(Cons sr amp ss) =+   do t <- SigI.toTimeScalar x (Expr.constant t0)+      let (ss0,ss1) = List.splitAt (round t) ss+      return (Cons sr amp ss0, Cons sr amp ss1)++take :: (RealField.C a, Field.C q, OccScalar.C a q) =>+   q -> SigI.T a q v -> SigI.Process a q v+take t = fmap fst . splitAt t++drop :: (RealField.C a, Field.C q, OccScalar.C a q) =>+   q -> SigI.T a q v -> SigI.Process a q v+drop t = fmap snd . splitAt t+-}++takeUntilPause :: (RealField.C t, Ring.C t', OccScalar.C t t',+                   Field.C y', NormedMax.C y yv, OccScalar.C y y') =>+   y' -> t' -> SigF.T t t' y y' yv -> SigF.T t t' y y' yv+takeUntilPause y' t' x =+   SigF.cons $ \infered@(isr,iamp) ->+      let x' = SigF.eval x infered+          xp = SigP.replaceParameters isr iamp x'+          zp = CutP.takeUntilPause y' t' xp+      in  SigP.replaceParameters+             (SigP.sampleRate x') (SigP.amplitude x') zp+++{-+How can we assert sharing of the input signal+with the output signals?++unzip ::+       SigF.T t t' y y' (yv0, yv1)+   -> (SigF.T t t' y y' yv0, SigF.T t t' y y' yv1)+unzip x =+   (SigF.cons $ \inferedY@(isrY,iampY) -> ,+    SigF.cons $ \inferedZ@(isrZ,iampZ) -> )+++unzip3 ::+       SigF.T t t' y y' (yv0, yv1, yv2)+   -> (SigF.T t t' y y' yv0, SigF.T t t' y y' yv1, SigF.T t t' y y' yv2)+unzip3 = return . CutC.unzip3+-}+++{- * glueing -}++{- |+  Similar to @foldr1 append@ but more efficient and accurate,+  because it reduces the number of amplifications.+  Does not work for infinite lists,+  because in this case a maximum amplitude cannot be computed.+-}+concat ::+   (Eq t', Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>+      [SigF.T t t' y y' yv]+   ->  SigF.T t t' y y' yv+concat xs =+   SigF.cons $ \(isr,iamp) ->+      let xs' = zipWith (\x amp -> SigF.eval x (isr, amp)) xs amps+          amps = map SigF.guessAmplitude xs'+          xps = zipWith SigF.contextFixAmplitude amps xs'+          sampleRate = SigF.mergeSampleRates xs'+      in  SigF.fromContextCheckAmplitude sampleRate iamp+             (CutC.concat (Rate.fromNumber isr) xps)++{- |+  Like 'concat' but it expects a fixed output amplitude.+  This way it can also handle infinitely many inputs+  if one input or the output has a fixed sample rate.++  'concatVolume' is one reason for the complicated handling+  of sampling rates by lists of @Maybe@s.++  The problem of finding an apropriate sampling rate is that+  we must have an order of processing parallel signal processors+  which guarantees termination if termination is possible.+  Say @mix (concat infinitelist0) (concat infinitelist1)@.+  Either infinite list can have signal with fixed sample rate or not.+  There is no way to determine this a priori.+  The only safe way is to process them in parallel.+  That's why we must have a @[Maybe t']@ instead of @Maybe t'@.+  Also @[t']@ is not enough,+  because e.g. a concatenation of infinitely many sounds+  with undetermined sampling rate+  would have an empty list representing the sampling rate,+  but computing the empty list needs infinite time.+-}+concatVolume ::+   (Eq t', Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>+      [SigF.T t t' y y' yv]+   ->  SigF.T t t' y y' yv+concatVolume xs =+   SigF.cons $ \(isr,iamp) ->+      let xs' = zipWith (\x amp -> SigF.eval x (isr, amp)) xs amps+          amps = map SigF.guessAmplitude xs'+          xps = zipWith SigF.contextFixAmplitude amps xs'+          sampleRate = SigF.mergeSampleRates xs'+      in  SigF.fromContextFreeAmplitude sampleRate+             (CutC.concatVolume iamp (Rate.fromNumber isr) xps)+++merge :: (Eq t', Real.C y', Field.C y', OccScalar.C y y',+          Module.C y v0, Module.C y v1) =>+      (Rate.T t t' -> SigC.T y y' v0 -> SigC.T y y' v1 -> SigC.T y y' v2)+   -> SigF.T t t' y y' v0+   -> SigF.T t t' y y' v1+   -> SigF.T t t' y y' v2+merge f x y =+   SigF.cons $ \(isr,iamp) ->+      let x' = SigF.eval x (isr, ampX)+          y' = SigF.eval y (isr, ampY)+          ampX = SigF.guessAmplitude x'+          ampY = SigF.guessAmplitude y'+          xp = SigF.contextFixAmplitude ampX x'+          yp = SigF.contextFixAmplitude ampY y'+          sampleRate = SigF.mergeSampleRate x' y'+      in  SigF.fromContextCheckAmplitude sampleRate iamp+             (f (Rate.fromNumber isr) xp yp)+++append :: (Eq t', Real.C y', Field.C y', OccScalar.C y y',+         Module.C y yv) =>+      SigF.T t t' y y' yv+   -> SigF.T t t' y y' yv+   -> SigF.T t t' y y' yv+append = merge CutC.append+++zip :: (Eq t', Real.C y', Field.C y', OccScalar.C y y',+        Module.C y v0, Module.C y v1) =>+      SigF.T t t' y y' v0+   -> SigF.T t t' y y' v1+   -> SigF.T t t' y y' (v0,v1)+zip = merge CutC.zip++{-+zip3 :: (Real.C q, Field.C q, Ord q, OccScalar.C a q,+         Module.C a v0, Module.C a v1, Module.C a v2)+   => SigI.T a q v0+   -> SigI.T a q v1+   -> SigI.T a q v2+   -> SigI.Process a q (v0, v1, v2)+zip3 x0 x1 x2 =+   mfix (\z ->+      do sampleRate <- Process.equalValues+            [SigP.sampleRate x0, SigP.sampleRate x1, SigP.sampleRate x2]+         amplitude  <- Process.fromExpr+            (Expr.maximum [amplitudeExpr x0, amplitudeExpr x1, amplitudeExpr x2])+         samp0 <- SigI.vectorSamples (toAmplitudeScalar z) x0+         samp1 <- SigI.vectorSamples (toAmplitudeScalar z) x1+         samp2 <- SigI.vectorSamples (toAmplitudeScalar z) x2+         SigI.returnCons sampleRate amplitude+            (List.zip3 samp0 samp1 samp2))+-}++++scheduleToContext ::+      t'+   -> EventList.T time (SigF.T t t' y y' yv)+   -> (SigF.Parameter t',+       EventList.T time (SigC.T y y' yv))+scheduleToContext isr sched =+   let xps =+          EventList.mapBody+             (\x ->+                 let y = SigF.eval x (isr, amp)+                     amp = SigF.guessAmplitude y+                     z = SigF.contextFixAmplitude amp y+                 in  (y,z)) sched+       schedp = EventList.mapBody snd xps+       sampleRate = SigF.mergeSampleRates (map fst (EventList.getBodies xps))+   in  (sampleRate, schedp)+++{- |+  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,+  because no maximum amplitude can be computed.+-}+arrange ::+   (RealFrac t, NonNeg.C t, Eq t', Ring.C t, Ring.C t', OccScalar.C t t',+    Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv) =>+      t'+   -> EventList.T t (SigF.T t t' y y' yv)+          {-^ A list of pairs: (relative start time, signal part),+              The start time is relative+              to the start time of the previous event. -}+   -> SigF.T t t' y y' yv+          {-^ The mixed signal. -}+arrange unit sched =+   SigF.cons $ \(isr,iamp) ->+      let (sampleRate, schedp) = scheduleToContext isr sched+      in  SigF.fromContextCheckAmplitude sampleRate iamp+             (CutC.arrange unit (Rate.fromNumber isr) schedp)++arrangeVolume ::+   (RealFrac t, NonNeg.C t, Eq t', Ring.C t, Ring.C t', OccScalar.C t t',+    Field.C y', OccScalar.C y y',+    Module.C y yv) =>+      t'+   -> EventList.T t (SigF.T t t' y y' yv)+          {-^ A list of pairs: (relative start time, signal part),+              The start time is relative+              to the start time of the previous event. -}+   -> SigF.T t t' y y' yv+          {-^ The mixed signal. -}+arrangeVolume unit sched =+   SigF.cons $ \(isr,iamp) ->+      let (sampleRate, schedp) = scheduleToContext isr sched+      in  SigF.fromContextFreeAmplitude sampleRate+             (CutC.arrangeVolume iamp unit (Rate.fromNumber isr) schedp)
+ src/Synthesizer/Inference/Fix/Filter.hs view
@@ -0,0 +1,377 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Inference.Fix.Filter (+   {- * Non-recursive -}++   {- ** Amplification -}+   amplify,+   negate,+{-+   envelope,+-}+   {- ** Filter operators from calculus -}+   differentiate,++{-+   {- ** Smooth -}+   mean,++   {- ** Delay -}+   delay,+   phaseModulation,+   phaser,+   phaserStereo,+++   {- * Recursive -}++   {- ** Without resonance -}+   firstOrderLowpass,+   firstOrderHighpass,+   butterworthLowpass,+   butterworthHighpass,+   chebyshevALowpass,+   chebyshevAHighpass,+   chebyshevBLowpass,+   chebyshevBHighpass,+   {- ** With resonance -}+   universal,+   moogLowpass,+   {- ** Allpass -}+   allpassCascade,+   {- ** Reverb -}+   comb,+-}+   {- ** Filter operators from calculus -}+   integrate+) where++-- import qualified InferenceFix.Signal as SigF+import Synthesizer.Inference.Fix (InputSignal, OutputSignal, Parameters, Results)++import qualified UniqueLogicNP.Lazy.SingleStep as Logic++{-+import InferenceFix.Signal+   (toTimeScalar, toFrequencyScalar, sampleRateExpr,+    amplitudeExpr)+-}+++import qualified Synthesizer.Physical.Signal as SigP+{-+import qualified Synthesizer.Plain.Displacement as Syn+import qualified Synthesizer.Plain.Interpolation as Interpolation+import qualified Synthesizer.Plain.Filter.Delay.ST as Delay+import qualified Synthesizer.Plain.Filter.Recursive    as FiltR+-}+import qualified Synthesizer.Plain.Filter.Recursive.Integration as Integrate+import qualified Synthesizer.Plain.Filter.NonRecursive as FiltNR+{-+import qualified InferenceFunc.Synthesizer as SynI+import qualified Synthesizer.Inference.Func.Cut         as CutI++import Data.Ord.HT (limit)++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.VectorSpace    as VectorSpace+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(liftM2)++-- import NumericPrelude hiding (negate)+import PreludeBase as P+++{- | The amplification factor must be positive. -}+amplify :: (Eq t', Field.C y') =>+   y' ->+   (Parameters t' y', InputSignal t t' y y' yv) ->+   (OutputSignal t t' y y' yv, Results t' y')+amplify volume ((srY,ampY), sigX) =+   let (srYResult,  srXResult)  = Logic.equal srY (SigP.sampleRate sigX)+       (ampYResult, ampXResult) = Logic.scale volume ampY (SigP.amplitude sigX)+   in  (SigP.replaceParameters srYResult ampYResult sigX,+        (srXResult, ampXResult))++negate :: (Additive.C yv, Eq t', Eq y') =>+   (Parameters t' y', InputSignal t t' y y' yv) ->+   (OutputSignal t t' y y' yv, Results t' y')+negate ((srY,ampY), sigX) =+   let (srYResult,  srXResult)  = Logic.equal srY  (SigP.sampleRate sigX)+       (ampYResult, ampXResult) = Logic.equal ampY (SigP.amplitude  sigX)+   in  (SigP.cons srYResult ampYResult+          (Additive.negate (SigP.samples sigX)),+        (srXResult, ampXResult))+++{-+envelope :: (Module.C y v, Field.C q, Eq q) =>+      SigI.T a q y  {- ^ the envelope -}+   -> SigI.T a q v  {- ^ the signal to be enveloped -}+   -> SigI.Process a q v+envelope y x =+   do sampleRate <- Process.fromExpr (sampleRateExpr x =!= sampleRateExpr y)+      amplitude  <- Process.fromExpr (amplitudeExpr  x  *  amplitudeExpr  y)+      SigI.returnCons sampleRate amplitude+         (FiltNR.envelopeVector (SigP.samples y) (SigP.samples x))+-}+++{- |+Although the routine could derive the sample rate+from the ratio of amplitudes,+this seems to be not very sensible,+since the choice of amplitude value is quite arbitrary+and the choice of sample rates is not.+-}+differentiate :: (Eq ty', Field.C ty', Additive.C yv) =>+   (Parameters ty' ty', InputSignal t ty' y ty' yv) ->+   (OutputSignal t ty' y ty' yv, Results ty' ty')+differentiate ((srY,ampY), sigX) =+   let srX = SigP.sampleRate sigX+       (srYResult,  srXResult)  = Logic.equal srY srX+       (_, ampXResult, ampYResult) = Logic.mul srX (SigP.amplitude sigX) ampY+   in  (SigP.cons srYResult ampYResult (FiltNR.differentiate (SigP.samples sigX)),+        (srXResult, ampXResult))+++{-+{- | needs a good handling of boundaries, yet -}+mean :: (Additive.C v, Field.C q, Eq q, RealField.C a,+         Module.C a v, OccScalar.C a q) =>+      q            {- ^ time length of the window -}+   -> SigI.T a q v+   -> SigI.Process a q v+mean time x =+   do t <- toTimeScalar x (Expr.constant time)+      let tInt  = round ((t-1)/2)+      let width = tInt*2+1+      returnModified []+         ((SigP.asTypeOfAmplitude (recip (fromIntegral width)) x *> ) .+          Filt.sums width . FiltNR.delay tInt) x+++delay :: (Additive.C v, Field.C q, Eq q, RealField.C a, OccScalar.C a q) =>+      q+   -> SigI.T a q v+   -> SigI.Process a q v+delay time x =+   do t <- toTimeScalar x (Expr.constant time)+      returnModified [] (FiltNR.delay (round t)) x+++phaseModulation ::+         (Additive.C v, Field.C q, Eq q, RealField.C a, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ minDelay, minimal delay, may be negative -}+   -> q   {- ^ maxDelay, maximal delay, it must be @minDelay <= maxDelay@+               and the modulation must always be+               in the range [minDelay,maxDelay]. -}+   -> SigI.T a q a+          {- ^ delay control, positive numbers mean delay,+               negative numbers mean prefetch -}+   -> SigI.T a q v+   -> SigI.Process a q v+phaseModulation ip minDelay maxDelay delays x =+   do t0 <- toTimeScalar x (Expr.constant minDelay)+      t1 <- toTimeScalar x (Expr.constant maxDelay)+      let tInt0 = floor   t0+      let tInt1 = ceiling t1+      let tInt0Neg = Additive.negate tInt0+      ds <- SigI.scalarSamples (toTimeScalar delays) delays+      returnModified [SigP.sampleRate delays]+         (FiltNR.delay tInt0 .+             Delay.modulated ip (tInt1-tInt0+1)+               (FiltNR.delay tInt0Neg+                  (Syn.raise (fromIntegral tInt0Neg)+                     (map (limit (t0,t1)) ds)))) x+++{- | symmetric phaser -}+phaser :: (Additive.C v, Field.C q, Eq q, RealField.C a,+           Module.C a v, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ maxDelay, must be positive -}+   -> SigI.T a q a+          {- ^ delay control -}+   -> SigI.T a q v+   -> SigI.Process a q v+phaser ip maxDelay delays x =+   amplify (asTypeOf 0.5 maxDelay) =<<+      uncurry SynI.mix =<< phaserCore ip maxDelay delays x++phaserStereo :: (Additive.C v, Field.C q, Eq q, Real.C q, RealField.C a,+                 Module.C a v, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ maxDelay, must be positive -}+   -> SigI.T a q a+          {- ^ delay control -}+   -> SigI.T a q v+   -> SigI.Process a q (v,v)+phaserStereo ip maxDelay delays x =+   uncurry CutI.zip =<< phaserCore ip maxDelay delays x++phaserCore :: (Additive.C v, Field.C q, Eq q, RealField.C a,+               Module.C a v, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ maxDelay, must be positive -}+   -> SigI.T a q a+          {- ^ delay control -}+   -> SigI.T a q v+   -> Process.T q (SigI.T a q v, SigI.T a q v)+phaserCore ip maxDelay delays x =+   do let minDelay = Additive.negate maxDelay+      negDelays <- InferenceFunc.Filter.negate delays+      liftM2 (,)+         (phaseModulation ip minDelay maxDelay delays x)+         (phaseModulation ip minDelay maxDelay negDelays x)++++firstOrderLowpass, firstOrderHighpass ::+   (Trans.C a, Trans.C q, Eq q, Module.C a v, OccScalar.C a q) =>+      SigI.T a q a {- ^ Control signal for the cut-off frequency. -}+   -> SigI.T a q v {- ^ Input signal -}+   -> SigI.Process a q v+firstOrderLowpass  = firstOrderGen Syn.lowpass1stOrder+firstOrderHighpass = firstOrderGen Syn.highpass1stOrder++firstOrderGen :: (Trans.C a, Trans.C q, Eq q, Module.C a v, OccScalar.C a q) =>+      ([a] -> [v] -> [v])+   -> SigI.T a q a+   -> SigI.T a q v+   -> SigI.Process a q v+firstOrderGen filt freq x =+   do freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      returnModified [SigP.sampleRate freq]+         (filt (map Syn.lowpass1stOrderParam freqs)) x+++butterworthLowpass, butterworthHighpass,+   chebyshevALowpass, chebyshevAHighpass,+   chebyshevBLowpass, chebyshevBHighpass ::+      (Field.C q, Eq q, Trans.C a, VectorSpace.C a v, OccScalar.C a q) =>+      Int          {- ^ Order of the filter, must be even,+                        the higher the order, the sharper is the separation of frequencies. -}+   -> a            {- ^ The attenuation at the cut-off frequency.+                        Should be between 0 and 1. -}+   -> SigI.T a q a {- ^ Control signal for the cut-off frequency. -}+   -> SigI.T a q v {- ^ Input signal -}+   -> SigI.Process a q v++butterworthLowpass  = higherOrderNoResoGen Syn.butterworthLowpass+butterworthHighpass = higherOrderNoResoGen Syn.butterworthHighpass+chebyshevALowpass   = higherOrderNoResoGen Syn.chebyshevALowpass+chebyshevAHighpass  = higherOrderNoResoGen Syn.chebyshevAHighpass+chebyshevBLowpass   = higherOrderNoResoGen Syn.chebyshevBLowpass+chebyshevBHighpass  = higherOrderNoResoGen Syn.chebyshevBHighpass++higherOrderNoResoGen ::+   (Field.C q, Eq q, Ring.C a, OccScalar.C a q) =>+      (Int -> a -> [a] -> [v] -> [v])+   -> Int+   -> a+   -> SigI.T a q a+   -> SigI.T a q v+   -> SigI.Process a q v+higherOrderNoResoGen filt order ratio freq x =+   do freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      returnModified [SigP.sampleRate freq]+         (filt order ratio freqs) x++++universal :: (Trans.C a, Module.C a v, Field.C q, Eq q, OccScalar.C a q) =>+      SigI.T a q a {- ^ signal for resonance,+                        i.e. factor of amplification at the resonance frequency+                        relatively to the transition band. -}+   -> SigI.T a q a {- ^ signal for cut off and band center frequency -}+   -> SigI.T a q v {- ^ input signal -}+   -> SigI.Process a q (v,v,v) {- ^ highpass, bandpass, lowpass filter -}+universal reso freq x =+   do resos <- SigI.scalarSamples (Process.exprToScalar) reso+      freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      let params =+             map UniFilter.parameter+                 (zipWith Syn.Pole resos freqs)+      returnModified [SigP.sampleRate reso, SigP.sampleRate freq]+         (UniFilter.run params) x++moogLowpass :: (Trans.C a, Module.C a v, Field.C q, Eq q, OccScalar.C a q) =>+      Int+   -> SigI.T a q a {- ^ signal for resonance,+                        i.e. factor of amplification at the resonance frequency+                        relatively to the transition band. -}+   -> SigI.T a q a {- ^ signal for cut off and band center frequency -}+   -> SigI.T a q v+   -> SigI.Process a q v+moogLowpass order reso freq x =+   do resos <- SigI.scalarSamples (Process.exprToScalar) reso+      freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      let params =+             map (Moog.parameter order)+                 (zipWith Syn.Pole resos freqs)+      returnModified [SigP.sampleRate reso, SigP.sampleRate freq]+         (Moog.lowpass order params) x++allpassCascade :: (Trans.C a, Module.C a v, Field.C q, Eq q, OccScalar.C a q) =>+      Int          {- ^ order, number of filters in the cascade -}+   -> a            {- ^ the phase shift to be achieved for the given frequency -}+   -> SigI.T a q a {- ^ lowest comb frequency -}+   -> SigI.T a q v+   -> SigI.Process a q v+allpassCascade order phase freq x =+   do freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      let params = map (Syn.allpassCascadeParam order phase) freqs+      returnModified [SigP.sampleRate freq]+         (Syn.allpassCascade order params) x++++{- | Infinitely many equi-delayed exponentially decaying echos. -}+comb :: (RealField.C a, Field.C q, Eq q, OccScalar.C a q, Module.C a v) =>+   q -> a -> SigI.T a q v -> SigI.Process a q v+comb time gain x =+   do t <- toTimeScalar x (Expr.constant time)+      returnModified [] (FiltR.comb (round t) gain) x+-}+++integrate :: (Eq ty', Field.C ty', Additive.C yv) =>+   (Parameters ty' ty', InputSignal t ty' y ty' yv) ->+   (OutputSignal t ty' y ty' yv, Results ty' ty')+integrate ((srY,ampY), sigX) =+   let srX = SigP.sampleRate sigX+       (srYResult,  srXResult)  = Logic.equal srY srX+       (_, ampYResult, ampXResult) = Logic.mul srX ampY (SigP.amplitude sigX)+   in  (SigP.cons srYResult ampYResult (Integrate.run (SigP.samples sigX)),+        (srXResult, ampXResult))+++{-+returnModified :: (Eq q) =>+   [Process.Value q] -> ([v] -> [w]) -> SigI.T a q v -> SigI.Process a q w+returnModified sampleRates proc x =+   do let sampleRate = SigP.sampleRate x+      mapM_ (Process.equalValue sampleRate) sampleRates+      SigI.returnCons+         sampleRate (SigP.amplitude x)+         (proc (SigP.samples x))+-}
+ src/Synthesizer/Inference/Func/Cut.hs view
@@ -0,0 +1,276 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2006, 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Inference.Func.Cut (+   {- * dissection -}+   -- splitAt,+   -- take,+   -- drop,+   takeUntilPause,+   -- unzip,+   -- unzip3,++   {- * glueing -}+   concat,+   concatVolume,+   append,+   zip,+   -- zip3,+   arrange,+   arrangeVolume,+  ) where++import qualified Synthesizer.Physical.Signal      as SigP+import qualified Synthesizer.Physical.Cut         as CutP+import qualified Synthesizer.Inference.Func.Signal as SigF++import qualified Synthesizer.SampleRateContext.Signal as SigC+import qualified Synthesizer.SampleRateContext.Rate as Rate+import qualified Synthesizer.SampleRateContext.Cut as CutC++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.OccasionallyScalar  as OccScalar+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 Control.Monad.Fix(mfix)++import PreludeBase hiding (zip, zip3, concat, )+-- import NumericPrelude+import Prelude (RealFrac)++{-+{- * dissection -}++splitAt :: (RealField.C a, Field.C q, OccScalar.C a q) =>+   q -> SigI.T a q v -> Process.T q (SigI.T a q v, SigI.T a q v)+splitAt t0 x@(Cons sr amp ss) =+   do t <- SigI.toTimeScalar x (Expr.constant t0)+      let (ss0,ss1) = List.splitAt (round t) ss+      return (Cons sr amp ss0, Cons sr amp ss1)++take :: (RealField.C a, Field.C q, OccScalar.C a q) =>+   q -> SigI.T a q v -> SigI.Process a q v+take t = fmap fst . splitAt t++drop :: (RealField.C a, Field.C q, OccScalar.C a q) =>+   q -> SigI.T a q v -> SigI.Process a q v+drop t = fmap snd . splitAt t+-}++takeUntilPause :: (RealField.C t, Ring.C t', OccScalar.C t t',+                   Field.C y', NormedMax.C y yv, OccScalar.C y y') =>+   y' -> t' -> SigF.T t t' y y' yv -> SigF.T t t' y y' yv+takeUntilPause y' t' x =+   SigF.cons $ \infered@(isr,iamp) ->+      let x' = SigF.eval x infered+          xp = SigP.replaceParameters isr iamp x'+          zp = CutP.takeUntilPause y' t' xp+      in  SigP.replaceParameters+             (SigP.sampleRate x') (SigP.amplitude x') zp+++{-+How can we assert sharing of the input signal+with the output signals?++unzip ::+       SigF.T t t' y y' (yv0, yv1)+   -> (SigF.T t t' y y' yv0, SigF.T t t' y y' yv1)+unzip x =+   (SigF.cons $ \inferedY@(isrY,iampY) -> ,+    SigF.cons $ \inferedZ@(isrZ,iampZ) -> )+++unzip3 ::+       SigF.T t t' y y' (yv0, yv1, yv2)+   -> (SigF.T t t' y y' yv0, SigF.T t t' y y' yv1, SigF.T t t' y y' yv2)+unzip3 = return . CutC.unzip3+-}+++{- * glueing -}++{- |+  Similar to @foldr1 append@ but more efficient and accurate,+  because it reduces the number of amplifications.+  Does not work for infinite lists,+  because in this case a maximum amplitude cannot be computed.+-}+concat ::+   (Eq t', Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>+      [SigF.T t t' y y' yv]+   ->  SigF.T t t' y y' yv+concat xs =+   SigF.cons $ \(isr,iamp) ->+      let xs' = zipWith (\x amp -> SigF.eval x (isr, amp)) xs amps+          amps = map SigF.guessAmplitude xs'+          xps = zipWith SigF.contextFixAmplitude amps xs'+          sampleRate = SigF.mergeSampleRates xs'+      in  SigF.fromContextCheckAmplitude sampleRate iamp+             (CutC.concat (Rate.fromNumber isr) xps)++{- |+  Like 'concat' but it expects a fixed output amplitude.+  This way it can also handle infinitely many inputs+  if one input or the output has a fixed sample rate.++  'concatVolume' is one reason for the complicated handling+  of sampling rates by lists of @Maybe@s.++  The problem of finding an apropriate sampling rate is that+  we must have an order of processing parallel signal processors+  which guarantees termination if termination is possible.+  Say @mix (concat infinitelist0) (concat infinitelist1)@.+  Either infinite list can have signal with fixed sample rate or not.+  There is no way to determine this a priori.+  The only safe way is to process them in parallel.+  That's why we must have a @[Maybe t']@ instead of @Maybe t'@.+  Also @[t']@ is not enough,+  because e.g. a concatenation of infinitely many sounds+  with undetermined sampling rate+  would have an empty list representing the sampling rate,+  but computing the empty list needs infinite time.+-}+concatVolume ::+   (Eq t', Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>+      [SigF.T t t' y y' yv]+   ->  SigF.T t t' y y' yv+concatVolume xs =+   SigF.cons $ \(isr,iamp) ->+      let xs' = zipWith (\x amp -> SigF.eval x (isr, amp)) xs amps+          amps = map SigF.guessAmplitude xs'+          xps = zipWith SigF.contextFixAmplitude amps xs'+          sampleRate = SigF.mergeSampleRates xs'+      in  SigF.fromContextFreeAmplitude sampleRate+             (CutC.concatVolume iamp (Rate.fromNumber isr) xps)+++merge :: (Eq t', Real.C y', Field.C y', OccScalar.C y y',+          Module.C y v0, Module.C y v1) =>+      (Rate.T t t' -> SigC.T y y' v0 -> SigC.T y y' v1 -> SigC.T y y' v2)+   -> SigF.T t t' y y' v0+   -> SigF.T t t' y y' v1+   -> SigF.T t t' y y' v2+merge f x y =+   SigF.cons $ \(isr,iamp) ->+      let x' = SigF.eval x (isr, ampX)+          y' = SigF.eval y (isr, ampY)+          ampX = SigF.guessAmplitude x'+          ampY = SigF.guessAmplitude y'+          xp = SigF.contextFixAmplitude ampX x'+          yp = SigF.contextFixAmplitude ampY y'+          sampleRate = SigF.mergeSampleRate x' y'+      in  SigF.fromContextCheckAmplitude sampleRate iamp+             (f (Rate.fromNumber isr) xp yp)+++append :: (Eq t', Real.C y', Field.C y', OccScalar.C y y',+         Module.C y yv) =>+      SigF.T t t' y y' yv+   -> SigF.T t t' y y' yv+   -> SigF.T t t' y y' yv+append = merge CutC.append+++zip :: (Eq t', Real.C y', Field.C y', OccScalar.C y y',+        Module.C y v0, Module.C y v1) =>+      SigF.T t t' y y' v0+   -> SigF.T t t' y y' v1+   -> SigF.T t t' y y' (v0,v1)+zip = merge CutC.zip++{-+zip3 :: (Real.C q, Field.C q, Ord q, OccScalar.C a q,+         Module.C a v0, Module.C a v1, Module.C a v2)+   => SigI.T a q v0+   -> SigI.T a q v1+   -> SigI.T a q v2+   -> SigI.Process a q (v0, v1, v2)+zip3 x0 x1 x2 =+   mfix (\z ->+      do sampleRate <- Process.equalValues+            [SigP.sampleRate x0, SigP.sampleRate x1, SigP.sampleRate x2]+         amplitude  <- Process.fromExpr+            (Expr.maximum [amplitudeExpr x0, amplitudeExpr x1, amplitudeExpr x2])+         samp0 <- SigI.vectorSamples (toAmplitudeScalar z) x0+         samp1 <- SigI.vectorSamples (toAmplitudeScalar z) x1+         samp2 <- SigI.vectorSamples (toAmplitudeScalar z) x2+         SigI.returnCons sampleRate amplitude+            (List.zip3 samp0 samp1 samp2))+-}++++scheduleToContext ::+      t'+   -> EventList.T time (SigF.T t t' y y' yv)+   -> (SigF.Parameter t',+       EventList.T time (SigC.T y y' yv))+scheduleToContext isr sched =+   let xps =+          EventList.mapBody+             (\x ->+                 let y = SigF.eval x (isr, amp)+                     amp = SigF.guessAmplitude y+                     z = SigF.contextFixAmplitude amp y+                 in  (y,z)) sched+       schedp = EventList.mapBody snd xps+       sampleRate = SigF.mergeSampleRates (map fst (EventList.getBodies xps))+   in  (sampleRate, schedp)+++{- |+  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,+  because no maximum amplitude can be computed.+-}+arrange ::+   (RealFrac t, NonNeg.C t, Eq t', Ring.C t, Ring.C t', OccScalar.C t t',+    Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv) =>+      t'+   -> EventList.T t (SigF.T t t' y y' yv)+          {-^ A list of pairs: (relative start time, signal part),+              The start time is relative+              to the start time of the previous event. -}+   -> SigF.T t t' y y' yv+          {-^ The mixed signal. -}+arrange unit sched =+   SigF.cons $ \(isr,iamp) ->+      let (sampleRate, schedp) = scheduleToContext isr sched+      in  SigF.fromContextCheckAmplitude sampleRate iamp+             (CutC.arrange unit (Rate.fromNumber isr) schedp)++arrangeVolume ::+   (RealFrac t, NonNeg.C t, Eq t', Ring.C t, Ring.C t', OccScalar.C t t',+    Field.C y', OccScalar.C y y',+    Module.C y yv) =>+      t'+   -> EventList.T t (SigF.T t t' y y' yv)+          {-^ A list of pairs: (relative start time, signal part),+              The start time is relative+              to the start time of the previous event. -}+   -> SigF.T t t' y y' yv+          {-^ The mixed signal. -}+arrangeVolume unit sched =+   SigF.cons $ \(isr,iamp) ->+      let (sampleRate, schedp) = scheduleToContext isr sched+      in  SigF.fromContextFreeAmplitude sampleRate+             (CutC.arrangeVolume iamp unit (Rate.fromNumber isr) schedp)
+ src/Synthesizer/Inference/Func/Signal.hs view
@@ -0,0 +1,299 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |++Copyright   :  (c) Henning Thielemann 2006, 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++-}+module Synthesizer.Inference.Func.Signal where++import qualified Synthesizer.Physical.Signal as SigP+import qualified Synthesizer.SampleRateContext.Signal as SigC++-- import qualified Algebra.OccasionallyScalar as OccScalar+-- import qualified Algebra.Module         as Module+-- import qualified Algebra.Field          as Field+-- import qualified Algebra.Ring           as Ring++-- import Algebra.OccasionallyScalar (toScalar)++import Control.Monad.Fix (fix, )+import Data.Maybe (catMaybes, isJust, )+import Data.List  (transpose, )+import Data.List.HT (shearTranspose, )++-- import NumericPrelude+import PreludeBase as P++{- |+Each process must work the following way:+If the signal processor has a fixed sample rate or amplitude+either implied by its parameters or its inputs+then this parameter should be set as @Just@+in the corresponding fields of @SigP.T@.+These fields must be computed+independently from the function argument of type @(t',y')@.+This function argument is the pair of eventually used signal parameters+sample rate and amplitude.+If you set signal parameters to @Just@ with a value,+then you can expect that the corresponding pair member has the same value.+-}+newtype T t t' y y' yv =+   Cons {eval :: (t',y') -> Evaluated t t' y y' yv}++type Evaluated t t' y y' yv = SigP.T t (Parameter t') y (Parameter y') yv+{- |+Since all 'Just' values must contain the same value,+we could also use the data structure '(Peano, a)'+just like in the @unique-logic@ package.+-}+newtype Parameter a = Parameter {parameterDesc :: [Maybe a]}++liftParam2 ::+   ([Maybe a] -> [Maybe b] -> [Maybe c]) ->+   Parameter a -> Parameter b -> Parameter c+liftParam2 f (Parameter x) (Parameter y) = Parameter (f x y)++cons :: ((t',y') -> SigP.T t (Parameter t') y (Parameter y') yv) -> T t t' y y' yv+cons = Cons+++contextFixAmplitude ::+      y'+   -> Evaluated t t' y y' yv+   -> SigC.T y y' yv+contextFixAmplitude amp =+   SigC.replaceAmplitude amp . SigP.content++fromContextFreeAmplitude ::+      Parameter t'+   -> SigC.T y y' yv+   -> Evaluated t t' y y' yv+fromContextFreeAmplitude sr (SigC.Cons _amp ss) =+   SigP.cons sr anyParameter ss++fromContextCheckAmplitude :: (Eq y') =>+      Parameter t'+   -> y'+   -> SigC.T y y' yv+   -> Evaluated t t' y y' yv+fromContextCheckAmplitude sr iamp (SigC.Cons amp ss) =+   SigP.cons sr (justParameter amp)+      (if iamp==amp then ss else error "fromContextCheckAmplitude: amplitudes differ")+++anyParameter :: Parameter q+anyParameter = Parameter []++justParameter :: q -> Parameter q+justParameter x = Parameter [Just x]++inSampleRate :: (t',y') -> t'+inSampleRate = fst++inAmplitude :: (t',y') -> y'+inAmplitude = snd++++{-+vectorSamples :: (Eq t', Module.C y yv) =>+   (y' -> y) -> T t t' y y' yv -> (t' -> [yv])+vectorSamples toAmpScalar sig =+   \inferedSampleRate ->+      let x'   = eval sig (inferedSampleRate, amp')+          amp' = guessParameter+                    "vectorSamples: input amplitude"+                    (SigP.amplitude x')+          amp = toAmpScalar amp' `SigP.asTypeOfAmplitude` x'+      in  amp *> SigP.samples x'++scalarSamples :: (Eq t', Ring.C y) =>+   (y' -> y) -> T t t' y y' y -> (t' -> [y])+scalarSamples toAmpScalar sig =+   \inferedSampleRate ->+      let x'  = sig (inferParameter inferedSampleRate (SigP.sampleRate x'),+                     amp')+          amp' = fromMaybe (error "scalarSamples: undetermined input amplitude")+                           (SigP.amplitude x')+          amp = toAmpScalar amp' `SigP.asTypeOfAmplitude` x'+      in  map (amp*) (SigP.samples x')++++inferParameter :: Eq q => q -> Maybe q -> q+inferParameter infered =+   maybe infered+      (\x -> if x == infered+               then x+               else error ("inferParameter:" +++                           " requested value and infered one differ"))+-}++equalParameter :: Eq q => String -> Maybe q -> Maybe q -> Maybe q+equalParameter name x y =+   case (x,y) of+      (Nothing,_) -> y+      (_,Nothing) -> x+      (Just xv, Just yv) ->+         if xv == yv+           then Just xv+           else error ("equalParameter: " ++ name ++ " differ")++equalSampleRate :: Eq t' => Maybe t' -> Maybe t' -> Maybe t'+equalSampleRate = equalParameter "sample rate"+++zipJut :: (a -> a -> a) -> [a] -> [a] -> [a]+zipJut f =+   let aux (x:xs) (y:ys) = f x y : aux xs ys+       aux []     ys     = ys+       aux xs     []     = xs+   in  aux++{-|+  Merge the @Just@s of two lists.+  It does not check for validity of the data.+-}+mergeParameter :: Parameter q -> Parameter q -> Parameter q+mergeParameter =+   liftParam2 (zipJut (\x y -> if isJust x then x else y))++mergeSampleRate ::+   Evaluated t t' y0 y0' yv0 -> Evaluated t t' y1 y1' yv1 -> Parameter t'+mergeSampleRate x y =+   mergeParameter (SigP.sampleRate x) (SigP.sampleRate y)+++mergeParameterEq :: Eq q => String -> Parameter q -> Parameter q -> Parameter q+mergeParameterEq name =+   liftParam2 (zipJut (equalParameter name))++mergeSampleRateEq :: Eq t' => Parameter t' -> Parameter t' -> Parameter t'+mergeSampleRateEq = mergeParameterEq "sample rate"++-- cf. Examples.merge+merge :: [a] -> [a] -> [a]+merge (x:xs) ys = x : merge ys xs+merge []     ys = ys++propMerge :: Eq a => [a] -> [a] -> Bool+propMerge xs ys  =  merge xs ys == concat (transpose [xs,ys])++mergeParameter' :: Parameter t' -> Parameter t' -> Parameter t'+mergeParameter' = liftParam2 merge++checkParameter :: Eq q => String -> q -> Maybe q -> q+checkParameter name x =+   maybe x (\y -> if x == y+                    then x+                    else error ("checkParameter: deviation from common " ++ name))++checkSampleRate :: Eq t' => t' -> Maybe t' -> t'+checkSampleRate = checkParameter "sample rate"++checkAmplitude :: Eq y' => y' -> Maybe y' -> y'+checkAmplitude = checkParameter "amplitude"+++{-|+  This routine is prepared for infinite lists.+  In order to handle them we employ a Cantor diagonalization scheme.+  It does not check for validity of the data+  (i.e. equal @Just@ values)+  but it does only keep some @Just@s,+  and thus allows for a quick search of a guess of a parameter value.+-}+mergeParameters :: [Parameter q] -> Parameter q+mergeParameters =+   Parameter . map (head . (++[Nothing]) . filter isJust)+      . shearTranspose . map parameterDesc++mergeSampleRates :: [Evaluated t t' y y' yv] -> Parameter t'+mergeSampleRates =+   mergeParameters . map SigP.sampleRate++mergeParametersEq :: Eq q => String -> [Parameter q] -> Parameter q+mergeParametersEq name =+   Parameter . map (foldl (equalParameter name) Nothing)+      . shearTranspose . map parameterDesc++mergeSampleRatesEq :: Eq t' => [Parameter t'] -> Parameter t'+mergeSampleRatesEq = mergeParametersEq "sample rate"++{- |+This is a simple working version of 'mergeParameters',+which does not need @Eq@ constraint.+However, flattening a three-dimensional list+does handle different dimensions differently,+that is slower than the others.+-}+mergeParameters' :: [Parameter q] -> Parameter q+mergeParameters' =+   Parameter . concat . shearTranspose . map parameterDesc+++{-+equalParameters :: Eq q => String -> [Parameter q] -> Parameter q+equalParameters name xs =+   let cxs = catMaybes xs+   in  if and (zipWith (==) cxs (tail cxs))+         then listToMaybe cxs+         else error ("equalParameters: " ++ name ++ " differ")++equalSampleRates :: Eq t' => [Maybe t'] -> Maybe t'+equalSampleRates = equalParameters "sample rates"+-}++guessParameter :: String -> Parameter q -> q+guessParameter context =+   head . (++ error (context ++ " undetermined")) . catMaybes . parameterDesc++guessSampleRate :: Evaluated t t' y y' yv -> t'+guessSampleRate = guessParameter "sample rate" . SigP.sampleRate++guessAmplitude :: Evaluated t t' y y' yv -> y'+guessAmplitude = guessParameter "amplitude" . SigP.amplitude++++{- |+  A complex signal graph can be built without ever mentioning a sampling rate.+  However when it comes to playing or writing a file,+  we must determine the sampling rate eventually.+  This function simply passes a signal through+  while forcing it to the given sampling rate.+-}+fixSampleRate :: (Eq t') =>+      t'                {-^ sample rate -}+   -> T t t' y y' yv    {-^ passed through signal -}+   -> T t t' y y' yv+fixSampleRate forcedSampleRate input =+   Cons $ \infered ->+      let inputSig = eval input infered+      in  SigP.cons+             (justParameter forcedSampleRate)+             (SigP.amplitude inputSig)+             (if inSampleRate infered == forcedSampleRate+                then SigP.samples inputSig+                else error "fixSampleRate: sampleRates differ")++-- ***** Is this one correct? Has the usage of 'infered' a cycle?+{- | Create a loop (feedback) from one node to another one.+     That is, compute the fix point of a process iteration. -}+loop :: (Eq t') =>+      (T t t' y y' yv -> T t t' y y' yv)+                        {-^ process chain that shall be looped -}+   ->  T t t' y y' yv+loop f =+   fix (\x -> f (Cons $ \infered ->+          SigP.cons anyParameter anyParameter+                    (SigP.samples (eval x infered))))++-- example: loop (\y -> x + delay y)
+ src/Synthesizer/Inference/Monad/File.hs view
@@ -0,0 +1,21 @@+module Synthesizer.Inference.Monad.File where++import qualified Synthesizer.Basic.Binary as BinSmp++import qualified Synthesizer.Inference.Monad.Signal  as SigI+import qualified Synthesizer.Physical.File     as FileP++import System.Exit(ExitCode)++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.Algebraic          as Algebraic+import qualified Algebra.VectorSpace        as VectorSpace+import qualified Algebra.RealField          as RealField+++writeToInt16 ::+   (RealField.C a, Algebraic.C q, Ord q, BinSmp.C v,+    OccScalar.C a q, VectorSpace.C a v) =>+   q -> q -> FilePath -> SigI.Process a q v -> IO ExitCode+writeToInt16 freqUnit amp name proc =+   FileP.writeToInt16 freqUnit amp name (SigI.run proc)
+ src/Synthesizer/Inference/Monad/Play.hs view
@@ -0,0 +1,21 @@+module Synthesizer.Inference.Monad.Play where++import qualified Synthesizer.Basic.Binary as BinSmp++import qualified Synthesizer.Inference.Monad.Signal  as SigI+import qualified Synthesizer.Physical.Play     as PlayP++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.VectorSpace        as VectorSpace+import qualified Algebra.Field              as Field+import qualified Algebra.RealField          as RealField++import System.Exit(ExitCode)+++toInt16 ::+   (RealField.C a, Field.C q, Ord q, BinSmp.C v,+    OccScalar.C a q, VectorSpace.C a v) =>+   q -> q -> SigI.Process a q v -> IO ExitCode+toInt16 freqUnit amp proc =+   PlayP.toInt16 freqUnit amp (SigI.run proc)
+ src/Synthesizer/Inference/Monad/Signal.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |++Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++++This module provides processors like that in "UniqueLogicNP.Explicit.Process"+but is specialized to signals.++Signal processors which modify a signal have a signature+   @SigI.T a q v -> SigI.Process a q v@ .++This let you easily share the result of a computation.+@+do+   x <- generator+   proc x x+@+However you have to write everything with @do@ notation,+and you have to invent variable names,+or you use monadic composition '=<<' instead of '.'+and the 'Inference.MonadUtility.liftP' functions.++For a more functional style of processor composition see "Synthesizer.Inference.Monad.SignalSeq".+-}+module Synthesizer.Inference.Monad.Signal where++import qualified UniqueLogicNP.Explicit.Process    as ProcI+import qualified UniqueLogicNP.Explicit.Expression as Expr+import qualified UniqueLogicNP.Explicit.System     as IS++import UniqueLogicNP.Explicit.Process (Expr, Atom, )++import qualified Synthesizer.Physical.Signal as SigP++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.Module         as Module+import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring++import Algebra.OccasionallyScalar (toScalar)++import Control.Monad.Fix (mfix)+import Control.Monad.Trans.RWS (evalRWS)++import NumericPrelude+import PreludeBase as P+++type T       a q v = SigP.T a (Atom q) a (Atom q) v+type Process a q v = ProcI.T q (T a q v)++run :: (Eq q) =>+   Process a q v -> SigP.T a q a q v+run proc =+   let (sig, rules) =+              evalRWS proc dict 0+       dict = IS.resolve rules+       rate = IS.getValue dict (SigP.sampleRate sig)+       amp  = IS.getValue dict (SigP.amplitude  sig)+       ss   = SigP.samples    sig+   in  SigP.cons rate amp ss++returnCons :: Monad m =>+   t' -> y' -> [yv] -> m (SigP.T t t' y y' yv)+returnCons sr amp sig = return $ SigP.cons sr amp sig++sampleRateExpr :: SigP.T t (Atom t') y (Atom y') yv -> Expr t'+sampleRateExpr x = Expr.fromAtom (SigP.sampleRate x)++amplitudeExpr :: SigP.T t (Atom t') y (Atom y') yv -> Expr y'+amplitudeExpr x = Expr.fromAtom (SigP.amplitude x)+++{- |+This and the following function are quite the same as in "Synthesizer.Physical.Signal".+-}+toTimeScalar :: (Field.C t', OccScalar.C t t') =>+   SigP.T t (Atom t') y (Atom y') yv -> Expr t' -> ProcI.T t' t+toTimeScalar x t =+   do s <- ProcI.fromExpr (t * sampleRateExpr x)+      v <- ProcI.getValue s+      return (toScalar v `SigP.asTypeOfTime` x)++toFrequencyScalar :: (Field.C t', OccScalar.C t t') =>+   SigP.T t (Atom t') y (Atom y') yv -> Expr t' -> ProcI.T t' t+toFrequencyScalar x f =+   do s <- ProcI.fromExpr (f / sampleRateExpr x)+      v <- ProcI.getValue s+      return (toScalar v `SigP.asTypeOfTime` x)++toAmplitudeScalar :: (Field.C y', OccScalar.C y y') =>+   SigP.T t (Atom t') y (Atom y') yv -> Expr y' -> ProcI.T y' y+toAmplitudeScalar x y =+   do s <- ProcI.fromExpr (y / amplitudeExpr x)+      v <- ProcI.getValue s+      return (toScalar v `SigP.asTypeOfAmplitude` x)++toGradientScalar :: (Field.C q, OccScalar.C a q) =>+   T a q v -> Expr q -> ProcI.T q a+toGradientScalar x steepness =+   toFrequencyScalar x (steepness / amplitudeExpr x)+++vectorSamples :: (Module.C a v) =>+   (Expr q -> ProcI.T q a) -> T a q v -> ProcI.T q [v]+vectorSamples toAmpScalar sig =+   do y <- toAmpScalar (amplitudeExpr sig)+      return (y *> SigP.samples sig)++scalarSamples :: (Ring.C a) =>+   (Expr q -> ProcI.T q a) -> T a q a -> ProcI.T q [a]+scalarSamples toAmpScalar sig =+   do y <- toAmpScalar (amplitudeExpr sig)+      return (map (y*) (SigP.samples sig))+++{- |+  A complex signal graph can be built without ever mentioning a sampling rate.+  However when it comes to playing or writing a file,+  we must determine the sampling rate eventually.+  This function simply passes a signal through+  while forcing it to the given sampling rate.+-}+fixSampleRate :: (Eq q) =>+      q          {-^ sample rate -}+   -> T a q v    {-^ passed through signal -}+   -> Process a q v+fixSampleRate sampleRate x =+   do ProcI.equalValue (IS.constant sampleRate) (SigP.sampleRate x)+      return x++{- | Create a loop (feedback) from one node to another one.+     That is, compute the fix point of a process iteration. -}+loop :: (Eq q) =>+      (T a q v -> Process a q v) {-^ process chain that shall be looped -}+   -> Process a q v+loop f = mfix (\signalIn ->+   do sampleRateIn <- ProcI.newVariable+      amplitudeIn  <- ProcI.newVariable+      signalOut <- f (SigP.cons sampleRateIn amplitudeIn+                                (SigP.samples signalIn))+      ProcI.equalValue sampleRateIn (SigP.sampleRate signalOut)+      ProcI.equalValue amplitudeIn  (SigP.amplitude  signalOut)+      return signalOut)
+ src/Synthesizer/Inference/Monad/Signal/Control.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2006+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.Inference.Monad.Signal.Control+   ({- * Primitives -}+    constant, linear, exponential, exponential2,+    {- * Piecewise -}+    piecewise, Control(..), ControlPiece(..),+    (-|#), ( #|-), (=|#), ( #|=), (|#), ( #|),  -- spaces before # for Haddock+    {- * Preparation -}+    mapLinear, mapExponential)+   where+++import Synthesizer.Inference.Monad.Signal (toTimeScalar, toAmplitudeScalar, toGradientScalar)+import Synthesizer.Plain.Control+   (Control(..), ControlPiece(..), (-|#), ( #|-), (=|#), ( #|=), (|#), ( #|))++import qualified Synthesizer.Plain.Control as Ctrl+import qualified Synthesizer.Inference.Monad.Signal.Displacement as SynI++import qualified UniqueLogicNP.Explicit.Process    as Process+import qualified UniqueLogicNP.Explicit.Expression as Expr+import qualified UniqueLogicNP.Explicit.System     as IS+import qualified Synthesizer.Inference.Monad.Signal     as SigI++import qualified Algebra.OccasionallyScalar as OccScalar+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 Control.Monad (liftM, liftM2, liftM4)+import Control.Monad.Fix (mfix)++import NumericPrelude+import PreludeBase as P+++constant :: (Field.C q, Real.C q, OccScalar.C a q) =>+      q {-^ value -}+   -> SigI.Process a q a+constant y =+   do sampleRate <- Process.newVariable+      SigI.returnCons sampleRate (IS.constant (abs y))+         (Ctrl.constant (OccScalar.toScalar (signum y)))++{- Using the 'Ctrl.linear' instead of 'Ctrl.linearStable'+   the type class constraints would be weaker.+linear :: (Additive.C a, Field.C q, Real.C q, OccScalar.C a q) =>+-}++{- ***** problem: linear curves starting with zero are impossible+   better: Let the user tell a maximum value? -}++{- | Caution: This control curve can contain samples+     with an absolute value greater than 1. -}+linear :: (Field.C a, Field.C q, Real.C q, OccScalar.C a q) =>+      q {-^ steepness of the curve -}+   -> q {-^ initial value -}+   -> SigI.Process a q a+linear steepness y0 =+   mfix (\z ->+      do sampleRate <- Process.newVariable+         steep <- toGradientScalar z (Expr.constant steepness)+         SigI.returnCons sampleRate (IS.constant (abs y0))+            (Ctrl.linearStable steep (OccScalar.toScalar (signum y0))))++exponential :: (Trans.C a, Field.C q, Real.C q, OccScalar.C a q) =>+      q {-^ time where the function reaches 1\/e of the initial value -}+   -> q {-^ initial value -}+   -> SigI.Process a q a+exponential time y0 =+   mfix (\z ->+      do sampleRate <- Process.newVariable+         t <- toTimeScalar z (Expr.constant time)+         SigI.returnCons sampleRate (IS.constant (abs y0))+            (Ctrl.exponentialStable t (OccScalar.toScalar (signum y0))))++{-+  take 1000 $ show (run (fixSampleRate 100 (exponential 0.1 1)) :: SigDouble)+-}++exponential2 :: (Trans.C a, Field.C q, Real.C q, OccScalar.C a q) =>+      q {-^ half life, time where the function reaches 1\/2 of the initial value -}+   -> q {-^ initial value -}+   -> SigI.Process a q a+exponential2 time y0 =+   mfix (\z ->+      do sampleRate <- Process.newVariable+         t <- toTimeScalar z (Expr.constant time)+         SigI.returnCons sampleRate (IS.constant (abs y0))+            (Ctrl.exponential2Stable t (OccScalar.toScalar (signum y0))))++++{- |+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.+-}+piecewise :: (Trans.C a, RealField.C a,+              Real.C q, Field.C q, OccScalar.C a q) =>+      [ControlPiece q]+   -> SigI.Process a q a+piecewise cs =+   mfix (\z ->+      do sampleRate <- Process.newVariable+         let amplitude = maximum+                (map (\c -> max (abs (Ctrl.pieceY0 c))+                                (abs (Ctrl.pieceY1 c))) cs)+         ps <- mapM (\(Ctrl.ControlPiece typ y0 y1 d) ->+                         liftM4 Ctrl.ControlPiece+                            {- We cannot provide an default case,+                               because the returned constructors+                               have different parameter type. -}+                            (case typ of+                               CtrlStep -> return CtrlStep+                               CtrlLin  -> return CtrlLin+                               -- this may exceed value range (-1,1)+                               CtrlCubic d0 d1 ->+                                  liftM2 CtrlCubic+                                     (toGradientScalar z (Expr.constant d0))+                                     (toGradientScalar z (Expr.constant d1))+                               CtrlExp sat ->+                                  liftM CtrlExp+                                     (toAmplitudeScalar z+                                                      (Expr.constant sat))+                               CtrlCos  -> return CtrlCos)+                            (toAmplitudeScalar z (Expr.constant y0))+                            (toAmplitudeScalar z (Expr.constant y1))+                            (toTimeScalar      z (Expr.constant d))) cs+         SigI.returnCons+             sampleRate (IS.constant amplitude)+             (Ctrl.piecewise ps))++++{- |+Map a control curve without amplitude unit+by a linear (affine) function with a unit.+-}+mapLinear :: (Ring.C a, Field.C q, Real.C q, OccScalar.C a q) =>+      q  {- ^ range: one is mapped to @center+range@ -}+   -> q  {- ^ center: zero is mapped to @center@ -}+   -> SigI.T a q a+   -> SigI.Process a q a+mapLinear range center x =+   mfix (\z ->+      do let absRange  = abs range+         let absCenter = abs center+         rng <- toAmplitudeScalar z (Expr.constant absRange)+         cnt <- toAmplitudeScalar z (Expr.constant absCenter)+         SynI.mapScalar 1 (absRange + absCenter) (\y -> cnt + rng*y) x)++{- |+Map a control curve without amplitude unit+exponentially to one with a unit.++ToDo: sample values should remain in the range (-1,1)+-}+mapExponential :: (Field.C q, Trans.C a, OccScalar.C a q) =>+      a  {- ^ range: one is mapped to @center*range@ -}+   -> q  {- ^ center: zero is mapped to @center@ -}+   -> SigI.T a q a+   -> SigI.Process a q a+mapExponential range center =+   SynI.mapScalar 1 center (range**)
+ src/Synthesizer/Inference/Monad/Signal/Cut.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Inference.Monad.Signal.Cut (+   {- * dissection -}+   splitAt,+   take,+   drop,+   takeUntilPause,+   unzip,+   unzip3,++   {- * glueing -}+   concat,+   append,+   zip,+   zip3,+   arrange,+  ) where++import qualified UniqueLogicNP.Explicit.Process    as Process+import qualified UniqueLogicNP.Explicit.Expression as Expr+import qualified Synthesizer.Inference.Monad.Signal     as SigI++import qualified Synthesizer.Physical.Signal      as SigP+import qualified Synthesizer.Physical.Cut         as CutP++import qualified Synthesizer.Plain.Cut as CutS++import Synthesizer.Inference.Monad.Signal+   (toTimeScalar, toAmplitudeScalar,+    amplitudeExpr)++import qualified Algebra.NormedSpace.Maximum as NormedMax+import qualified Algebra.OccasionallyScalar  as OccScalar+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.EventList.Relative.TimeBody as EventList+import qualified Number.NonNegative as NonNeg++import qualified Data.List as List++import Control.Monad.Fix(mfix)+import PreludeBase (Ord, (<=), (.),+                    (>>), (>>=), fail, return, fmap, map, fst, snd, mapM)+import NumericPrelude+import Prelude (RealFrac)++{- * dissection -}++splitAt :: (RealField.C a, Field.C q, OccScalar.C a q) =>+   q -> SigI.T a q v -> Process.T q (SigI.T a q v, SigI.T a q v)+splitAt t0 x =+   do t <- SigI.toTimeScalar x (Expr.constant t0)+      let (ss0,ss1) = List.splitAt (round t) (SigP.samples x)+      return (SigP.replaceSamples ss0 x, SigP.replaceSamples ss1 x)++take :: (RealField.C a, Field.C q, OccScalar.C a q) =>+   q -> SigI.T a q v -> SigI.Process a q v+take t = fmap fst . splitAt t++drop :: (RealField.C a, Field.C q, OccScalar.C a q) =>+   q -> SigI.T a q v -> SigI.Process a q v+drop t = fmap snd . splitAt t++takeUntilPause :: (RealField.C a, Field.C q,+                   NormedMax.C a v, OccScalar.C a q) =>+   q -> q -> SigI.T a q v -> SigI.Process a q v+takeUntilPause y t x =+   do t' <- SigI.toTimeScalar      x (Expr.constant t)+      y' <- SigI.toAmplitudeScalar x (Expr.constant y)+      return (SigP.replaceSamples+         (CutS.takeUntilInterval+             ((<=y') . NormedMax.norm)+             (ceiling t')+             (SigP.samples x)) x)+++unzip ::+   SigI.T a q (v0, v1) -> Process.T q (SigI.T a q v0, SigI.T a q v1)+unzip = return . CutP.unzip++unzip3 ::+      SigI.T a q (v0, v1, v2)+   -> Process.T q (SigI.T a q v0, SigI.T a q v1, SigI.T a q v2)+unzip3 = return . CutP.unzip3++++{- * 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.+-}+concat :: (RealField.C q, Ord q, Ring.C q, OccScalar.C a q,+           Module.C a v) =>+   [SigI.T a q v] -> SigI.Process a q v+concat xs =+   mfix (\z ->+      do sampleRate <- Process.equalValues (map SigP.sampleRate xs)+         let ampExprs = List.map amplitudeExpr xs+         amplitude <- Process.fromExpr (Expr.maximum ampExprs)+         samps <- mapM (SigI.vectorSamples (toAmplitudeScalar z)) xs+         SigI.returnCons sampleRate amplitude+            (List.concat samps))++{-+This is the first one of several possible methods:++* Compute the maximum amplitude of the operands+  and amplify the other signal accordingly.+* Let the user specify an output volume.+* Expect a fixed output amplitude+  and amplify the inputs accordingly.+* Force input and output amplitudes to be equal.+  If this cannot be achieved,+  the user must insert amplifier processes.+-}+merge :: (Real.C q, Field.C q, Ord q, OccScalar.C a q,+         Module.C a v0, Module.C a v1) =>+   ([v0] -> [v1] -> [v2]) ->+   SigI.T a q v0 -> SigI.T a q v1 -> SigI.Process a q v2+merge f x y =+   mfix (\z ->+      do sampleRate <- Process.equalValues [SigP.sampleRate x, SigP.sampleRate y]+         amplitude  <- Process.fromExpr+                          (Expr.max (amplitudeExpr x) (amplitudeExpr  y))+         sampX <- SigI.vectorSamples (toAmplitudeScalar z) x+         sampY <- SigI.vectorSamples (toAmplitudeScalar z) y+         SigI.returnCons sampleRate amplitude+            (f sampX sampY))+++append :: (Real.C q, Field.C q, Ord q, OccScalar.C a q,+         Module.C a v) =>+   SigI.T a q v -> SigI.T a q v -> SigI.Process a q v+append = merge (List.++)+++zip :: (Real.C q, Field.C q, Ord q, OccScalar.C a q,+        Module.C a v0, Module.C a v1)+   => SigI.T a q v0+   -> SigI.T a q v1+   -> SigI.Process a q (v0, v1)+zip = merge List.zip++zip3 :: (Real.C q, Field.C q, Ord q, OccScalar.C a q,+         Module.C a v0, Module.C a v1, Module.C a v2)+   => SigI.T a q v0+   -> SigI.T a q v1+   -> SigI.T a q v2+   -> SigI.Process a q (v0, v1, v2)+zip3 x0 x1 x2 =+   mfix (\z ->+      do sampleRate <- Process.equalValues+            [SigP.sampleRate x0, SigP.sampleRate x1, SigP.sampleRate x2]+         amplitude  <- Process.fromExpr+            (Expr.maximum [amplitudeExpr x0, amplitudeExpr x1, amplitudeExpr x2])+         samp0 <- SigI.vectorSamples (toAmplitudeScalar z) x0+         samp1 <- SigI.vectorSamples (toAmplitudeScalar z) x1+         samp2 <- SigI.vectorSamples (toAmplitudeScalar z) x2+         SigI.returnCons sampleRate amplitude+            (List.zip3 samp0 samp1 samp2))+++{- |+  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.+-}+arrange :: (Field.C q, Ord q, OccScalar.C a q,+            RealFrac a, Module.C a v) =>+      q   {-^ Unit of the time values in the time ordered list. -}+   -> EventList.T a (SigI.T a q v)+          {-^ A list of pairs: (relative start time, signal part),+              The start time is relative+              to the start time of the previous event. -}+   -> SigI.Process a q v+          {-^ The mixed signal. -}+arrange unit sched =+   mfix (\z ->+      do let xs = EventList.getBodies sched+         sampleRate <- Process.equalValues+            (map SigP.sampleRate xs)+         unitRes <- SigI.toTimeScalar z (Expr.constant unit)+         let ampExprs = List.map amplitudeExpr xs+         amplitude <- Process.fromExpr (Expr.maximum ampExprs)+         schedRes <-+            EventList.mapBodyM+               (SigI.vectorSamples (toAmplitudeScalar z))+               (EventList.mapTime+                  (NonNeg.fromNumberMsg "Inference.Signal.Cut.arrange") sched)+         SigI.returnCons sampleRate amplitude+            (CutS.arrange+                (EventList.resample (NonNeg.fromNumber unitRes) schedRes)))
+ src/Synthesizer/Inference/Monad/Signal/Displacement.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++-}++module Synthesizer.Inference.Monad.Signal.Displacement (+   {- * Non-linearities -}+   mapScalar,+   mapVector,++   {- * Mixing -}+   mix,+   mixMulti,+) where+++import qualified UniqueLogicNP.Explicit.Process    as Process+import qualified UniqueLogicNP.Explicit.Expression as Expr+import qualified Synthesizer.Inference.Monad.Signal     as SigI+import qualified UniqueLogicNP.Explicit.System     as IS++import UniqueLogicNP.Explicit.Expression ((=!=))+import Synthesizer.Inference.Monad.Signal+   (toAmplitudeScalar,+    sampleRateExpr, amplitudeExpr)++import qualified Synthesizer.Physical.Signal as SigP+import qualified Synthesizer.Plain.Displacement as Syn++import qualified Algebra.OccasionallyScalar as OccScalar+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 Control.Monad.Fix (mfix)++import NumericPrelude+import PreludeBase+import qualified Data.List as List+++{- * Non-linearities -}++{- | Apply a function to the signal values.+     If input and output signal shall have the same global amplitude,+     then it must hold @rateX * ampY = 1@. -}+mapVector :: (Module.C a v0, Field.C q, OccScalar.C a q) =>+      q  {- ^ rateX: If @v@ is the physical value+                     which shall appear as 1 to @f@,+                     then choose @rateX * v == 1@. -}+   -> q  {- ^ ampY: The physical value of the output signal+                    which is associated with the value 1 of @f@. -}+   -> (v0 -> v1)+         {- ^ f, the mapping -}+   -> SigI.T a q v0+   -> SigI.Process a q v1+mapVector rateX ampY f x =+   do samples <- SigI.vectorSamples+         (Process.exprToScalar . (Expr.constant rateX *)) x+      SigI.returnCons (SigP.sampleRate x) (IS.constant ampY)+         (List.map f samples)++mapScalar :: (Ring.C a, Field.C q, OccScalar.C a q) =>+      q  {- ^ rateX: If @v@ is the physical value+                     which shall appear as 1 to @f@,+                     then choose @rateX * v == 1@. -}+   -> q  {- ^ ampY: The physical value of the output signal+                    which is associated with the value 1 of @f@. -}+   -> (a -> a)+         {- ^ f, the mapping -}+   -> SigI.T a q a+   -> SigI.Process a q a+mapScalar rateX ampY f x =+   do samples <- SigI.scalarSamples+         (Process.exprToScalar . (Expr.constant rateX *)) x+      SigI.returnCons (SigP.sampleRate x) (IS.constant ampY)+         (List.map f samples)+++{- * Mixing -}++{- | Mix two signals.+     In opposition to 'zipWith' the result has the length of the longer signal. -}+mix :: (Field.C q, Eq q, Module.C a v, OccScalar.C a q) =>+      SigI.T a q v+   -> SigI.T a q v+   -> SigI.Process a q v+mix x y =+   do sampleRate <- Process.fromExpr (sampleRateExpr x =!= sampleRateExpr y)+      amplitude  <- Process.fromExpr (amplitudeExpr  x  +  amplitudeExpr  y)+      mfix (\z ->+         do sampX <- SigI.vectorSamples (toAmplitudeScalar z) x+            sampY <- SigI.vectorSamples (toAmplitudeScalar z) y+            SigI.returnCons sampleRate amplitude+               (sampX + sampY))++{- | Mix one or more signals. -}+mixMulti :: (Field.C q, Eq q, Module.C a v, OccScalar.C a q) =>+      [SigI.T a q v]+   ->  SigI.Process a q v+mixMulti xs =+   do sampleRate <- Process.equalValues (List.map SigP.sampleRate xs)+      let ampExprs = List.map amplitudeExpr xs+      amplitude  <- Process.fromExpr (sum1 ampExprs)+         {- 'sum1' must be used, because 'sum' introduces a zero,+            which will probably have an incompatible unit. -}+      mfix (\z ->+         do samps <- mapM (SigI.vectorSamples (toAmplitudeScalar z)) xs+            SigI.returnCons sampleRate amplitude+               (Syn.mixMulti samps))
+ src/Synthesizer/Inference/Monad/Signal/Filter.hs view
@@ -0,0 +1,355 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Inference.Monad.Signal.Filter (+   {- * Non-recursive -}++   {- ** Amplification -}+   amplify,+   negate,+   envelope,+   {- ** Filter operators from calculus -}+   differentiate,++   {- ** Smooth -}+   mean,++   {- ** Delay -}+   delay,+   phaseModulation,+   phaser,+   phaserStereo,+++   {- * Recursive -}++   {- ** Without resonance -}+   firstOrderLowpass,+   firstOrderHighpass,+   butterworthLowpass,+   butterworthHighpass,+   chebyshevALowpass,+   chebyshevAHighpass,+   chebyshevBLowpass,+   chebyshevBHighpass,+   {- ** With resonance -}+   universal,+   moogLowpass,+   {- ** Allpass -}+   allpassCascade,+   {- ** Reverb -}+   comb,+   {- ** Filter operators from calculus -}+   integrate+) where+++import qualified UniqueLogicNP.Explicit.Process    as Process+import qualified UniqueLogicNP.Explicit.Expression as Expr+import qualified Synthesizer.Inference.Monad.Signal               as SigI+import qualified Synthesizer.Inference.Monad.Signal.Cut           as CutI+import qualified Synthesizer.Inference.Monad.Signal.Displacement as SynI++import UniqueLogicNP.Explicit.Expression ((=!=))+import Synthesizer.Inference.Monad.Signal+   (toTimeScalar, toFrequencyScalar, sampleRateExpr,+    amplitudeExpr)++import qualified Synthesizer.Physical.Signal as SigP+import qualified Synthesizer.Plain.Signal as Sig+import qualified Synthesizer.Plain.Displacement as Syn+import qualified Synthesizer.Plain.Interpolation as Interpolation+import qualified Synthesizer.Plain.Filter.Delay.ST 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.Comb        as Comb+import qualified Synthesizer.Plain.Filter.Recursive.Integration as Integrate+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 FiltR+import qualified Synthesizer.Plain.Filter.NonRecursive as FiltNR++import qualified Algebra.OccasionallyScalar as OccScalar+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.Module         as Module+import qualified Algebra.VectorSpace    as VectorSpace++import Control.Monad (liftM2, )++import Data.Ord.HT (limit, )++import NumericPrelude hiding (negate)+import PreludeBase as P+++{- | The amplification factor must be positive. -}+amplify :: (Field.C q) =>+      q+   -> SigI.T a q v+   -> SigI.Process a q v+amplify volume x =+   do amplitude <- Process.fromExpr (Expr.constant volume * amplitudeExpr x)+      SigI.returnCons (SigP.sampleRate x) amplitude (SigP.samples x)++negate :: (Additive.C v, Eq q) =>+      SigI.T a q v+   -> SigI.Process a q v+negate =+   returnModified [] Additive.negate+++envelope :: (Module.C y v, Field.C q, Eq q) =>+      SigI.T a q y  {- ^ the envelope -}+   -> SigI.T a q v  {- ^ the signal to be enveloped -}+   -> SigI.Process a q v+envelope y x =+   do sampleRate <- Process.fromExpr (sampleRateExpr x =!= sampleRateExpr y)+      amplitude  <- Process.fromExpr (amplitudeExpr  x  *  amplitudeExpr  y)+      SigI.returnCons sampleRate amplitude+         (FiltNR.envelopeVector (SigP.samples y) (SigP.samples x))+++differentiate :: (Additive.C v, Field.C q, Eq q) =>+      SigI.T a q v+   -> SigI.Process a q v+differentiate x =+   do amp <- Process.fromExpr (amplitudeExpr x * sampleRateExpr x)+      SigI.returnCons+         (SigP.sampleRate x) amp+         (FiltNR.differentiate (SigP.samples x))+++{- | needs a good handling of boundaries, yet -}+mean :: (Additive.C v, Field.C q, Eq q, RealField.C a,+         Module.C a v, OccScalar.C a q) =>+      q            {- ^ time length of the window -}+   -> SigI.T a q v+   -> SigI.Process a q v+mean time x =+   do t <- toTimeScalar x (Expr.constant time)+      let tInt  = round ((t-1)/2)+      let width = tInt*2+1+      returnModified []+         ((SigP.asTypeOfAmplitude (recip (fromIntegral width)) x *> ) .+          FiltNR.sums width . FiltNR.delay tInt) x+++delay :: (Additive.C v, Field.C q, Eq q, RealField.C a, OccScalar.C a q) =>+      q+   -> SigI.T a q v+   -> SigI.Process a q v+delay time x =+   do t <- toTimeScalar x (Expr.constant time)+      returnModified [] (FiltNR.delay (round t)) x+++phaseModulation ::+         (Additive.C v, Field.C q, Eq q, RealField.C a, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ minDelay, minimal delay, may be negative -}+   -> q   {- ^ maxDelay, maximal delay, it must be @minDelay <= maxDelay@+               and the modulation must always be+               in the range [minDelay,maxDelay]. -}+   -> SigI.T a q a+          {- ^ delay control, positive numbers mean delay,+               negative numbers mean prefetch -}+   -> SigI.T a q v+   -> SigI.Process a q v+phaseModulation ip minDelay maxDelay delays x =+   do t0 <- toTimeScalar x (Expr.constant minDelay)+      t1 <- toTimeScalar x (Expr.constant maxDelay)+      let tInt0 = floor   t0+      let tInt1 = ceiling t1+      let tInt0Neg = Additive.negate tInt0+      ds <- SigI.scalarSamples (toTimeScalar delays) delays+      returnModified [SigP.sampleRate delays]+         (FiltNR.delay tInt0 .+             Delay.modulated ip (tInt1-tInt0+1)+               (FiltNR.delay tInt0Neg+                  (Syn.raise (fromIntegral tInt0Neg)+                     (map (limit (t0,t1)) ds)))) x+++{- | symmetric phaser -}+phaser :: (Additive.C v, Field.C q, Eq q, RealField.C a,+           Module.C a v, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ maxDelay, must be positive -}+   -> SigI.T a q a+          {- ^ delay control -}+   -> SigI.T a q v+   -> SigI.Process a q v+phaser ip maxDelay delays x =+   amplify (asTypeOf 0.5 maxDelay) =<<+      uncurry SynI.mix =<< phaserCore ip maxDelay delays x++phaserStereo :: (Additive.C v, Field.C q, Eq q, Real.C q, RealField.C a,+                 Module.C a v, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ maxDelay, must be positive -}+   -> SigI.T a q a+          {- ^ delay control -}+   -> SigI.T a q v+   -> SigI.Process a q (v,v)+phaserStereo ip maxDelay delays x =+   uncurry CutI.zip =<< phaserCore ip maxDelay delays x++phaserCore :: (Additive.C v, Field.C q, Eq q, RealField.C a,+               Module.C a v, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ maxDelay, must be positive -}+   -> SigI.T a q a+          {- ^ delay control -}+   -> SigI.T a q v+   -> Process.T q (SigI.T a q v, SigI.T a q v)+phaserCore ip maxDelay delays x =+   do let minDelay = Additive.negate maxDelay+      negDelays <- negate delays  -- FiltI.negate delays+      liftM2 (,)+         (phaseModulation ip minDelay maxDelay delays x)+         (phaseModulation ip minDelay maxDelay negDelays x)++++firstOrderLowpass, firstOrderHighpass ::+   (Trans.C a, Trans.C q, Eq q, Module.C a v, OccScalar.C a q) =>+      SigI.T a q a {- ^ Control signal for the cut-off frequency. -}+   -> SigI.T a q v {- ^ Input signal -}+   -> SigI.Process a q v+firstOrderLowpass  = firstOrderGen Filt1.lowpass+firstOrderHighpass = firstOrderGen Filt1.highpass++firstOrderGen :: (Trans.C a, Trans.C q, Eq q, Module.C a v, OccScalar.C a q) =>+      (Sig.T (Filt1.Parameter a) -> Sig.T v -> Sig.T v)+   -> SigI.T a q a+   -> SigI.T a q v+   -> SigI.Process a q v+firstOrderGen filt freq x =+   do freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      returnModified [SigP.sampleRate freq]+         (filt (map Filt1.parameter freqs)) x+++butterworthLowpass, butterworthHighpass,+   chebyshevALowpass, chebyshevAHighpass,+   chebyshevBLowpass, chebyshevBHighpass ::+      (Field.C q, Eq q, Trans.C a, VectorSpace.C a v, OccScalar.C a q) =>+      Int          {- ^ Order of the filter, must be even,+                        the higher the order, the sharper is the separation of frequencies. -}+   -> SigI.T a q a {- ^ The attenuation at the cut-off frequency.+                        Should be between 0 and 1. -}+   -> SigI.T a q a {- ^ Control signal for the cut-off frequency. -}+   -> SigI.T a q v {- ^ Input signal -}+   -> SigI.Process a q v++butterworthLowpass  = higherOrderNoResoGen Butter.lowpassPole+butterworthHighpass = higherOrderNoResoGen Butter.highpassPole+chebyshevALowpass   = higherOrderNoResoGen Cheby.lowpassAPole+chebyshevAHighpass  = higherOrderNoResoGen Cheby.highpassAPole+chebyshevBLowpass   = higherOrderNoResoGen Cheby.lowpassBPole+chebyshevBHighpass  = higherOrderNoResoGen Cheby.highpassBPole++higherOrderNoResoGen ::+   (Field.C q, Eq q, Ring.C a, OccScalar.C a q) =>+      (Int -> Sig.T a -> Sig.T a -> Sig.T v -> Sig.T v)+   -> Int+   -> SigI.T a q a+   -> SigI.T a q a+   -> SigI.T a q v+   -> SigI.Process a q v+higherOrderNoResoGen filt order ratio freq x =+   do ratios <- SigI.scalarSamples (Process.exprToScalar) ratio+      freqs  <- SigI.scalarSamples (toFrequencyScalar x) freq+      returnModified [SigP.sampleRate freq]+         (filt order ratios freqs) x++++universal :: (Trans.C a, Module.C a v, Field.C q, Eq q, OccScalar.C a q) =>+      SigI.T a q a {- ^ signal for resonance,+                        i.e. factor of amplification at the resonance frequency+                        relatively to the transition band. -}+   -> SigI.T a q a {- ^ signal for cut off and band center frequency -}+   -> SigI.T a q v {- ^ input signal -}+   -> SigI.Process a q (UniFilter.Result v)+                   {- ^ highpass, bandpass, lowpass filter -}+universal reso freq x =+   do resos <- SigI.scalarSamples (Process.exprToScalar) reso+      freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      let params =+             map UniFilter.parameter+                 (zipWith FiltR.Pole resos freqs)+      returnModified [SigP.sampleRate reso, SigP.sampleRate freq]+         (UniFilter.run params) x++moogLowpass :: (Trans.C a, Module.C a v, Field.C q, Eq q, OccScalar.C a q) =>+      Int+   -> SigI.T a q a {- ^ signal for resonance,+                        i.e. factor of amplification at the resonance frequency+                        relatively to the transition band. -}+   -> SigI.T a q a {- ^ signal for cut off and band center frequency -}+   -> SigI.T a q v+   -> SigI.Process a q v+moogLowpass order reso freq x =+   do resos <- SigI.scalarSamples (Process.exprToScalar) reso+      freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      let params =+             map (Moog.parameter order)+                 (zipWith FiltR.Pole resos freqs)+      returnModified [SigP.sampleRate reso, SigP.sampleRate freq]+         (Moog.lowpass order params) x++allpassCascade :: (Trans.C a, Module.C a v, Field.C q, Eq q, OccScalar.C a q) =>+      Int          {- ^ order, number of filters in the cascade -}+   -> a            {- ^ the phase shift to be achieved for the given frequency -}+   -> SigI.T a q a {- ^ lowest comb frequency -}+   -> SigI.T a q v+   -> SigI.Process a q v+allpassCascade order phase freq x =+   do freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      let params = map (Allpass.parameter order phase) freqs+      returnModified [SigP.sampleRate freq]+         (Allpass.cascade order params) x++++{- | Infinitely many equi-delayed exponentially decaying echos. -}+comb :: (RealField.C a, Field.C q, Eq q, OccScalar.C a q, Module.C a v) =>+   q -> a -> SigI.T a q v -> SigI.Process a q v+comb time gain x =+   do t <- toTimeScalar x (Expr.constant time)+      returnModified [] (Comb.run (round t) gain) x+++integrate :: (Additive.C v, Field.C q, Eq q) =>+      SigI.T a q v -> SigI.Process a q v+integrate x =+   do amp <- Process.fromExpr (amplitudeExpr x / sampleRateExpr x)+      SigI.returnCons+         (SigP.sampleRate x) amp+         (Integrate.run (SigP.samples x))+++returnModified :: (Eq q) =>+   [Process.Atom q] -> (Sig.T v -> Sig.T w) -> SigI.T a q v -> SigI.Process a q w+returnModified sampleRates proc x =+   do let sampleRate = SigP.sampleRate x+      mapM_ (Process.equalValue sampleRate) sampleRates+      SigI.returnCons+         sampleRate (SigP.amplitude x)+         (proc (SigP.samples x))
+ src/Synthesizer/Inference/Monad/Signal/Noise.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++-}+module Synthesizer.Inference.Monad.Signal.Noise+  (white,+   whiteGen,+   randomPeeks) where+++import qualified UniqueLogicNP.Explicit.Process    as Process+import qualified UniqueLogicNP.Explicit.Expression as Expr+import qualified Synthesizer.Inference.Monad.Signal     as SigI+import qualified UniqueLogicNP.Explicit.System     as IS++import qualified Synthesizer.Physical.Signal as SigP+import qualified Synthesizer.Plain.Noise as Noise++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.Algebraic          as Algebraic+import qualified Algebra.Field              as Field+import qualified Algebra.Ring               as Ring++import System.Random (Random, RandomGen, randomRs, mkStdGen)++import NumericPrelude+import PreludeBase as P++++white :: (Ring.C v, Random v, Algebraic.C q) =>+      q  {-^ width of the frequency band -}+   -> q  {-^ volume caused by the given frequency band -}+   -> SigI.Process a q v+         {-^ noise -}+white = whiteGen (mkStdGen 6746)++whiteGen :: (Ring.C v, Random v, RandomGen g, Algebraic.C q) =>+      g  {-^ random generator, can be used to choose a seed -}+   -> q  {-^ width of the frequency band -}+   -> q  {-^ volume caused by the given frequency band -}+   -> SigI.Process a q v+         {-^ noise -}+whiteGen gen bandWidth volume =+   do sampleRate <- Process.newVariable+      amplitude  <- Process.fromExpr+         (sqrt (3 * Expr.fromAtom sampleRate / Expr.constant bandWidth)+            * Expr.constant volume)+      SigI.returnCons sampleRate amplitude (Noise.whiteGen gen)+++randomPeeks :: (Field.C a, Random a, Ord a,+                Field.C q, OccScalar.C a q) =>+      SigI.T a q a  {- ^ momentary densities (frequency),+                         @p@ means that there is about one peak+                         in the time range of @1\/p@. -}+   -> SigI.Process a q Bool+                    {- ^ Every occurence of 'True' represents a peak. -}+randomPeeks dens =+   do amp <- SigI.toFrequencyScalar dens (SigI.amplitudeExpr dens)+      SigI.returnCons (SigP.sampleRate dens) (IS.constant 1)+          (zipWith (<)+              (randomRs (0, recip amp) (mkStdGen 876))+              (SigP.samples dens))
+ src/Synthesizer/Inference/Monad/Signal/Oscillator.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++-}+module Synthesizer.Inference.Monad.Signal.Oscillator (+   {- * Oscillators with constant waveforms -}+   static,+   freqMod,+   phaseMod,+   phaseFreqMod,+) where+++import qualified UniqueLogicNP.Explicit.Process    as Process+import qualified UniqueLogicNP.Explicit.Expression as Expr+import qualified UniqueLogicNP.Explicit.System     as IS+import qualified Synthesizer.Inference.Monad.Signal     as SigI++import Synthesizer.Inference.Monad.Signal (toFrequencyScalar)++import qualified Synthesizer.Physical.Signal as SigP+import qualified Synthesizer.Plain.Oscillator as Osci+import qualified Synthesizer.Basic.Wave       as Wave++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.RealField          as RealField+import qualified Algebra.Field              as Field++import Control.Monad.Fix (mfix)++-- import NumericPrelude+import PreludeBase as P+++{- * Oscillators with constant waveforms -}++{- | oscillator with a functional waveform with constant frequency -}+static :: (RealField.C a, Field.C q, OccScalar.C a q) =>+      Wave.T a v  {- ^ waveform -}+   -> q           {- ^ amplitude -}+   -> a           {- ^ start phase from the range [0,1] -}+   -> q           {- ^ frequency -}+   -> SigI.Process a q v+static wave amplitude phase freq =+   mfix (\z ->+      do sampleRate <- Process.newVariable+         f <- toFrequencyScalar z (Expr.constant freq)+         SigI.returnCons sampleRate (IS.constant amplitude)+            (Osci.static wave phase f))++{- | oscillator with a functional waveform with modulated frequency -}+freqMod :: (RealField.C a, Field.C q, OccScalar.C a q) =>+      Wave.T a v   {- ^ waveform -}+   -> q            {- ^ amplitude -}+   -> a            {- ^ start phase from the range [0,1] -}+   -> SigI.T a q a {- ^ frequency control -}+   -> SigI.Process a q v+freqMod wave amplitude phase xs =+   do freqs <- SigI.scalarSamples (toFrequencyScalar xs) xs+      SigI.returnCons+         (SigP.sampleRate xs) (IS.constant amplitude)+         (Osci.freqMod wave phase freqs)++{- | oscillator with modulated phase -}+phaseMod :: (RealField.C a, Field.C q, OccScalar.C a q) =>+      Wave.T a v   {- ^ waveform -}+   -> q            {- ^ amplitude -}+   -> q            {- ^ frequency control -}+   -> SigI.T a q a {- ^ phase modulation, phases must have no unit and+                        are from range [0,1] -}+   -> SigI.Process a q v+phaseMod wave amplitude freq xs =+   do freqFac <- toFrequencyScalar xs (Expr.constant freq)+      phases  <- SigI.scalarSamples (Process.exprToScalar) xs+      SigI.returnCons+         (SigP.sampleRate xs) (IS.constant amplitude)+         (Osci.phaseMod wave freqFac phases)++{- | oscillator with a functional waveform with modulated phase and frequency -}+phaseFreqMod :: (RealField.C a, Field.C q, Eq q, OccScalar.C a q) =>+      Wave.T a v   {- ^ waveform -}+   -> q            {- ^ amplitude -}+   -> SigI.T a q a {- ^ phase control -}+   -> SigI.T a q a {- ^ frequency control -}+   -> SigI.Process a q v+phaseFreqMod wave amplitude xs ys =+   do phases <- SigI.scalarSamples (Process.exprToScalar) xs+      freqs  <- SigI.scalarSamples (toFrequencyScalar ys) ys+      sampleRate <- Process.equalValues+                       [SigP.sampleRate xs, SigP.sampleRate ys]+      SigI.returnCons+         sampleRate (IS.constant amplitude)+         (Osci.phaseFreqMod wave phases freqs)
+ src/Synthesizer/Inference/Monad/SignalSeq.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |++Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++++Similar to "Synthesizer.Inference.Monad.Signal"+but the functions have monadic input and sequentialize it.+This allows for a more functional looking style of programming+because the type signature of signal modifiers is essentially+   @SigI.Process a q v -> SigI.Process a q v@+and thus they are perfectly composable with (.)+and normal function application.++The processor sequentializes its inputs+and the order is quite arbitrary,+but actually the order within monad sequences+influences only the order of inference of signal parameters.+The core signal processing does not depend on the monad order.++The interfaces used here allow for function calls like+   @superProc (proc1 x) (proc2 y)@ .+However, we have to be careful with sharing of the results of signal processors.+E.g.+   @superProc x x@+does not mean, that the signal generated by @x@ is used twice.+Instead it means that @x@ is computed twice.+This can be avoided by explicitly sharing+the result signal with 'Inference.Process.share'.+This is absolutely the same situation as in "UniqueLogicNP.Explicit.Expression".++@+   do+      y <- Process.share x+      superProc y y+@++A rule of thumb:+Whenever you use the @let@ syntax,+you are probably planing to use the variable more than once.+Thus you should better use @do@ notation together with 'Inference.Process.share'.++-}+module Synthesizer.Inference.Monad.SignalSeq +(+   T,+   Process,++   run,++   returnCons,++   sampleRateExpr,+   amplitudeExpr,++   toTimeScalar,+   toFrequencyScalar,+   toAmplitudeScalar,++   fixSampleRate,+   loop+)+where++import qualified Synthesizer.Inference.Monad.Signal  as SigI++import Synthesizer.Inference.Monad.Signal (T, Process, run, returnCons,+   sampleRateExpr, amplitudeExpr,+   toTimeScalar, toFrequencyScalar, toAmplitudeScalar)++import UniqueLogicNP.Monad(liftP)+-- import NumericPrelude+import PreludeBase as P++++fixSampleRate :: (Eq q) =>+      q             {-^ sample rate -}+   -> Process a q v {-^ passed through signal -}+   -> Process a q v+fixSampleRate sampleRate =+   liftP (SigI.fixSampleRate sampleRate)++{- | Create a loop from one node to another one.+     That is, compute the fix point of a process iteration. -}+loop :: (Eq q) =>+      (Process a q v -> Process a q v)+                    {-^ process chain that shall be looped -}+   -> Process a q v+loop f = SigI.loop (f . return)
+ src/Synthesizer/Inference/Monad/SignalSeq/Control.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2006+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.Inference.Monad.SignalSeq.Control+   ({- * Primitives -}+    constant, linear, exponential, exponential2,+    {- * Piecewise -}+    piecewise, Control(..), ControlPiece(..),+    (-|#), ( #|-), (=|#), ( #|=), (|#), ( #|),  -- spaces before # for Haddock+    {- * Preparation -}+    mapLinear, mapExponential)+   where+++import qualified Synthesizer.Inference.Monad.Signal         as SigI+import qualified Synthesizer.Inference.Monad.Signal.Control as CtrlI++import Synthesizer.Inference.Monad.Signal.Control+   (constant, linear, exponential, exponential2, piecewise,+    Control(..), ControlPiece(..), (-|#), ( #|-), (=|#), ( #|=), (|#), ( #|))++import qualified Algebra.OccasionallyScalar as OccScalar+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 UniqueLogicNP.Monad(liftP)++-- import NumericPrelude+++mapLinear :: (Ring.C a, Field.C q, Real.C q, OccScalar.C a q) =>+      q+   -> q+   -> SigI.Process a q a+   -> SigI.Process a q a+mapLinear range center =+   liftP (CtrlI.mapLinear range center)++mapExponential :: (Field.C q, Trans.C a, OccScalar.C a q) =>+      a+   -> q+   -> SigI.Process a q a+   -> SigI.Process a q a+mapExponential range center =+   liftP (CtrlI.mapExponential range center)
+ src/Synthesizer/Inference/Monad/SignalSeq/Cut.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+++Similar to "Synthesizer.Inference.Monad.Signal.Cut"+but the functions have monadic input and sequentialize it.+See "Synthesizer.Inference.Monad.SignalSeq".+-}+module Synthesizer.Inference.Monad.SignalSeq.Cut (+   {- * dissection -}+   splitAt,+   take,+   drop,+   takeUntilPause,+   unzip,+   unzip3,++   {- * glueing -}+   concat,+   append,+   zip,+   zip3) where++import qualified UniqueLogicNP.Explicit.Process    as Process+import qualified Synthesizer.Inference.Monad.Signal     as SigI+import qualified Synthesizer.Inference.Monad.Signal.Cut as CutI++import qualified Algebra.NormedSpace.Maximum as NormedMax+import qualified Algebra.OccasionallyScalar  as OccScalar+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 UniqueLogicNP.Monad(liftP, liftP2, liftP3)+import PreludeBase (Ord, (.), sequence)+-- import NumericPrelude++{- * dissection -}++splitAt :: (RealField.C a, Field.C q, OccScalar.C a q) =>+   q -> SigI.Process a q v -> Process.T q (SigI.T a q v, SigI.T a q v)+splitAt t = liftP (CutI.splitAt t)++take :: (RealField.C a, Field.C q, OccScalar.C a q) =>+   q -> SigI.Process a q v -> SigI.Process a q v+take t = liftP (CutI.take t)++drop :: (RealField.C a, Field.C q, OccScalar.C a q) =>+   q -> SigI.Process a q v -> SigI.Process a q v+drop t = liftP (CutI.drop t)++takeUntilPause :: (RealField.C a, Field.C q,+                   NormedMax.C a v, OccScalar.C a q) =>+   q -> q -> SigI.Process a q v -> SigI.Process a q v+takeUntilPause y t = liftP (CutI.takeUntilPause y t)+++unzip ::+   SigI.Process a q (v0, v1) -> Process.T q (SigI.T a q v0, SigI.T a q v1)+unzip = liftP CutI.unzip++unzip3 ::+      SigI.Process a q (v0, v1, v2)+   -> Process.T q (SigI.T a q v0, SigI.T a q v1, SigI.T a q v2)+unzip3 = liftP CutI.unzip3++++{- * glueing -}++{- More efficient than 'foldr1 append'+   because it reduces the number of amplifications. -}+concat :: (RealField.C q, Ord q, Ring.C q, OccScalar.C a q,+           Module.C a v) =>+   [SigI.Process a q v] -> SigI.Process a q v+concat = liftP CutI.concat . sequence++append :: (Real.C q, Field.C q, Ord q, OccScalar.C a q,+         Module.C a v) =>+   SigI.Process a q v -> SigI.Process a q v -> SigI.Process a q v+append = liftP2 CutI.append+++zip :: (Real.C q, Field.C q, Ord q, OccScalar.C a q,+        Module.C a v0, Module.C a v1)+   => SigI.Process a q v0+   -> SigI.Process a q v1+   -> SigI.Process a q (v0, v1)+zip = liftP2 CutI.zip++zip3 :: (Real.C q, Field.C q, Ord q, OccScalar.C a q,+         Module.C a v0, Module.C a v1, Module.C a v2)+   => SigI.Process a q v0+   -> SigI.Process a q v1+   -> SigI.Process a q v2+   -> SigI.Process a q (v0, v1, v2)+zip3 = liftP3 CutI.zip3
+ src/Synthesizer/Inference/Monad/SignalSeq/Displacement.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |++Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++-}+module Synthesizer.Inference.Monad.SignalSeq.Displacement(+   {- * Non-linearities -}+   mapScalar,+   mapVector,++   {- * Mixing -}+   mix,+   mixMulti,+) where++import qualified Synthesizer.Inference.Monad.Signal             as SigI+import qualified Synthesizer.Inference.Monad.Signal.Displacement as SynI++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.Module             as Module+import qualified Algebra.Field              as Field+import qualified Algebra.Ring               as Ring++import UniqueLogicNP.Monad(liftP, liftP2)+-- import NumericPrelude+import PreludeBase+++mapVector :: (Module.C a v0, Field.C q, OccScalar.C a q) =>+      q+   -> q+   -> (v0 -> v1)+   -> SigI.Process a q v0+   -> SigI.Process a q v1+mapVector rateX ampY f = liftP (SynI.mapVector rateX ampY f)++mapScalar :: (Ring.C a, Field.C q, OccScalar.C a q) =>+      q+   -> q+   -> (a -> a)+   -> SigI.Process a q a+   -> SigI.Process a q a+mapScalar rateX ampY f = liftP (SynI.mapScalar rateX ampY f)+++{- | Mix two signals.+     In opposition to 'zipWith' the result has the length of the longer signal. -}+mix :: (Field.C q, Eq q, Module.C a v, OccScalar.C a q) =>+      SigI.Process a q v+   -> SigI.Process a q v+   -> SigI.Process a q v+mix = liftP2 SynI.mix++{- | Mix one or more signals. -}+mixMulti :: (Field.C q, Eq q, Module.C a v, OccScalar.C a q) =>+      [SigI.Process a q v]+   ->  SigI.Process a q v+mixMulti = liftP SynI.mixMulti . sequence
+ src/Synthesizer/Inference/Monad/SignalSeq/Filter.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |++Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Inference.Monad.SignalSeq.Filter(+   {- * Non-recursive -}++   {- ** Amplification -}+   amplify,+   negate,+   envelope,+   {- ** Filter operators from calculus -}+   differentiate,++   {- ** Smooth -}+   mean,++   {- ** Delay -}+   delay,+   phaseModulation,+   phaser,+   phaserStereo,++   {- * Recursive -}++   {- ** Without resonance -}+   firstOrderLowpass,+   firstOrderHighpass,+   butterworthLowpass,+   butterworthHighpass,+   chebyshevALowpass,+   chebyshevAHighpass,+   chebyshevBLowpass,+   chebyshevBHighpass,+   {- ** With resonance -}+   universal,+   moogLowpass,+   {- ** Allpass -}+   allpassCascade,+   {- ** Reverb -}+   comb,+   {- ** Filter operators from calculus -}+   integrate+) where++import qualified Synthesizer.Inference.Monad.Signal        as SigI+import qualified Synthesizer.Inference.Monad.Signal.Filter as FiltI++import qualified Synthesizer.Plain.Interpolation as Interpolation+import qualified Synthesizer.Plain.Filter.Recursive.Universal   as UniFilter++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.VectorSpace    as VectorSpace+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.Additive       as Additive++import UniqueLogicNP.Monad(liftP, liftP2, liftP3)+import NumericPrelude+import PreludeBase as P+++{- | The amplification factor must be positive. -}+amplify :: (Field.C q, Eq q) =>+      q+   -> SigI.Process a q v+   -> SigI.Process a q v+amplify volume = liftP (FiltI.amplify volume)++envelope :: (Module.C y v, Field.C q, Eq q) =>+      SigI.Process a q y  {- ^ the envelope -}+   -> SigI.Process a q v  {- ^ the signal to be enveloped -}+   -> SigI.Process a q v+envelope = liftP2 FiltI.envelope+++++integrate :: (Additive.C v, Field.C q, Eq q) =>+      SigI.Process a q v -> SigI.Process a q v+integrate = liftP FiltI.integrate++differentiate :: (Additive.C v, Field.C q, Eq q) =>+      SigI.Process a q v -> SigI.Process a q v+differentiate = liftP FiltI.differentiate++++++mean :: (Additive.C v, Field.C q, Eq q, RealField.C a,+         Module.C a v, OccScalar.C a q) =>+      q            {- ^ time length of the window -}+   -> SigI.Process a q v+   -> SigI.Process a q v+mean time = liftP (FiltI.mean time)+++delay :: (Additive.C v, Field.C q, Eq q, RealField.C a, OccScalar.C a q) =>+      q+   -> SigI.Process a q v+   -> SigI.Process a q v+delay time = liftP (FiltI.delay time)+++phaseModulation ::+         (Additive.C v, Field.C q, Eq q, RealField.C a, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ minDelay, minimal delay, may be negative -}+   -> q   {- ^ maxDelay, maximal delay, it must be @minDelay <= maxDelay@+               and the modulation must always be+               in the range [minDelay,maxDelay]. -}+   -> SigI.Process a q a+          {- ^ delay control, positive numbers mean delay,+               negative numbers mean prefetch -}+   -> SigI.Process a q v+   -> SigI.Process a q v+phaseModulation ip minDelay maxDelay =+   liftP2 (FiltI.phaseModulation ip minDelay maxDelay)+++{- | symmetric phaser -}+phaser :: (Additive.C v, Field.C q, Eq q, RealField.C a,+           Module.C a v, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ maxDelay, must be positive -}+   -> SigI.Process a q a+          {- ^ delay control -}+   -> SigI.Process a q v+   -> SigI.Process a q v+phaser ip maxDelay = liftP2 (FiltI.phaser ip maxDelay)++phaserStereo :: (Additive.C v, Field.C q, Eq q, Real.C q, RealField.C a,+                 Module.C a v, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ maxDelay, must be positive -}+   -> SigI.Process a q a+          {- ^ delay control -}+   -> SigI.Process a q v+   -> SigI.Process a q (v,v)+phaserStereo ip maxDelay = liftP2 (FiltI.phaserStereo ip maxDelay)++++firstOrderLowpass, firstOrderHighpass ::+   (Trans.C a, Trans.C q, Eq q,Module.C a v, OccScalar.C a q) =>+      SigI.Process a q a+   -> SigI.Process a q v+   -> SigI.Process a q v+firstOrderLowpass  = liftP2 FiltI.firstOrderLowpass+firstOrderHighpass = liftP2 FiltI.firstOrderHighpass+++butterworthLowpass, butterworthHighpass,+   chebyshevALowpass, chebyshevAHighpass,+   chebyshevBLowpass, chebyshevBHighpass ::+      (Field.C q, Eq q, Trans.C a, VectorSpace.C a v, OccScalar.C a q) =>+      Int+   -> SigI.Process a q a+   -> SigI.Process a q a+   -> SigI.Process a q v+   -> SigI.Process a q v++butterworthLowpass  order = liftP3 (FiltI.butterworthLowpass  order)+butterworthHighpass order = liftP3 (FiltI.butterworthHighpass order)+chebyshevALowpass   order = liftP3 (FiltI.chebyshevALowpass   order)+chebyshevAHighpass  order = liftP3 (FiltI.chebyshevAHighpass  order)+chebyshevBLowpass   order = liftP3 (FiltI.chebyshevBLowpass   order)+chebyshevBHighpass  order = liftP3 (FiltI.chebyshevBHighpass  order)+++universal :: (Trans.C a, Module.C a v, Field.C q, Eq q, OccScalar.C a q) =>+      SigI.Process a q a+   -> SigI.Process a q a+   -> SigI.Process a q v+   -> SigI.Process a q (UniFilter.Result v)+universal = liftP3 FiltI.universal+++moogLowpass :: (Trans.C a, Module.C a v, Field.C q, Eq q, OccScalar.C a q) =>+      Int+   -> SigI.Process a q a+   -> SigI.Process a q a+   -> SigI.Process a q v+   -> SigI.Process a q v+moogLowpass order = liftP3 (FiltI.moogLowpass order)++allpassCascade :: (Trans.C a, Module.C a v, Field.C q, Eq q, OccScalar.C a q) =>+      Int+   -> a+   -> SigI.Process a q a+   -> SigI.Process a q v+   -> SigI.Process a q v+allpassCascade order phase =+   liftP2 (FiltI.allpassCascade order phase)+++{- | Infinitely many equi-delayed exponentially decaying echos. -}+comb :: (RealField.C a, Field.C q, Eq q, OccScalar.C a q, Module.C a v) =>+   q -> a -> SigI.Process a q v -> SigI.Process a q v+comb time gain = liftP (FiltI.comb time gain)
+ src/Synthesizer/Inference/Monad/SignalSeq/Noise.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++-}+module Synthesizer.Inference.Monad.SignalSeq.Noise+  (white,+   whiteGen,+   randomPeeks) where+++import qualified Synthesizer.Inference.Monad.Signal     as SigI++import qualified Synthesizer.Inference.Monad.Signal.Noise as NoiseI+import Synthesizer.Inference.Monad.Signal.Noise (white, whiteGen)++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.Field              as Field++import System.Random (Random)++import UniqueLogicNP.Monad(liftP)+-- import NumericPrelude+import PreludeBase as P++++randomPeeks :: (Field.C a, Random a, Ord a,+                Field.C q, OccScalar.C a q) =>+      SigI.Process a q a+           {- ^ momentary densities (frequency),+                @p@ means that there is about one peak+                in the time range of @1\/p@. -}+   -> SigI.Process a q Bool+           {- ^ Every occurence of 'True' represents a peak. -}+randomPeeks = liftP NoiseI.randomPeeks
+ src/Synthesizer/Inference/Monad/SignalSeq/Oscillator.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |++Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Inference.Monad.SignalSeq.Oscillator(+   {- * Oscillators with constant waveforms -}+   static,+   freqMod,+   phaseMod,+   phaseFreqMod,+) where++import qualified Synthesizer.Inference.Monad.Signal     as SigI++import qualified Synthesizer.Inference.Monad.Signal.Oscillator as OsciI++import Synthesizer.Inference.Monad.Signal.Oscillator (static)++import qualified Synthesizer.Basic.Wave       as Wave++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.RealField          as RealField+import qualified Algebra.Field              as Field++import UniqueLogicNP.Monad (liftP, liftP2)+-- import NumericPrelude+import PreludeBase+++{- * Oscillators with constant waveforms -}++{- | oscillator with a functional waveform with modulated frequency -}+freqMod :: (RealField.C a, Field.C q, OccScalar.C a q) =>+      Wave.T a v+   -> q+   -> a+   -> SigI.Process a q a+   -> SigI.Process a q v+freqMod wave amplitude phase =+   liftP (OsciI.freqMod wave amplitude phase)++{- | oscillator with modulated phase -}+phaseMod :: (RealField.C a, Field.C q, OccScalar.C a q) =>+      Wave.T a v+   -> q+   -> q+   -> SigI.Process a q a+   -> SigI.Process a q v+phaseMod wave amplitude freq =+   liftP (OsciI.phaseMod wave amplitude freq)++{- | oscillator with modulated phase and frequency -}+phaseFreqMod :: (RealField.C a, Field.C q, Eq q, OccScalar.C a q) =>+      Wave.T a v+   -> q+   -> SigI.Process a q a+   -> SigI.Process a q a+   -> SigI.Process a q v+phaseFreqMod wave amplitude =+   liftP2 (OsciI.phaseFreqMod wave amplitude)
+ src/Synthesizer/Inference/Reader/Control.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2007+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.Inference.Reader.Control+   ({- * Primitives -}+    constant, constantVector, linear, line, exponential, exponential2,+    {- * Piecewise -}+    piecewise, piecewiseVolume, Control(..), ControlPiece(..),+    (-|#), ( #|-), (=|#), ( #|=), (|#), ( #|),  -- spaces before # for Haddock+    {- * Preparation -}+    mapLinear, mapExponential, )+   where+++import Synthesizer.Plain.Control+   (Control(..), ControlPiece(..), (-|#), ( #|-), (=|#), ( #|=), (|#), ( #|))++import qualified Synthesizer.SampleRateContext.Control as CtrlC++{-+if we import that, then GHC-6.4.1 will no longer complain,+that Synthesizer.Plain.Control is unnecessarily imported+import qualified Synthesizer.Plain.Control as Ctrl+-}++import qualified Synthesizer.Inference.Reader.Signal as SigR+import qualified Synthesizer.Inference.Reader.Process as Proc++import qualified Algebra.OccasionallyScalar as OccScalar+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 NumericPrelude+-- import PreludeBase as P+++constant :: (Field.C y', Real.C y', OccScalar.C y y') =>+      y' {-^ value -}+   -> Proc.T t t' (SigR.T y y' y)+constant y =+   SigR.lift (CtrlC.constant y)++{- |+The amplitude must be positive!+This is not checked.+-}+constantVector :: -- (Field.C y', Real.C y', OccScalar.C y y') =>+      y' {-^ amplitude -}+   -> yv {-^ value -}+   -> Proc.T t t' (SigR.T y y' yv)+constantVector y yv =+   SigR.lift (CtrlC.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', OccScalar.C y y') =>+-}++{- |+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'.+-}+linear ::+   (Field.C q, Field.C q',+    Real.C q', OccScalar.C q q') =>+      q' {-^ slope of the curve -}+   -> q' {-^ initial value -}+   -> Proc.T q q' (SigR.T q q' q)+linear slope y0 =+   SigR.lift (CtrlC.linear slope y0)++{- |+Generates a finite ramp.+-}+line ::+   (RealField.C q, Field.C q',+    Real.C q', OccScalar.C q q') =>+      q'      {-^ duration of the ramp -}+   -> (q',q') {-^ initial and final value -}+   -> Proc.T q q' (SigR.T q q' q)+line dur (y0,y1) =+   SigR.lift (CtrlC.line dur (y0,y1))++exponential :: (Trans.C q, Field.C q', Real.C q', OccScalar.C q q') =>+      q' {-^ time where the function reaches 1\/e of the initial value -}+   -> q' {-^ initial value -}+   -> Proc.T q q' (SigR.T q q' q)+exponential time y0 =+   SigR.lift (CtrlC.exponential time y0)++{-+  take 1000 $ show (run (fixSampleRate 100 (exponential 0.1 1)) :: SigDouble)+-}++exponential2 :: (Trans.C q, Field.C q', Real.C q', OccScalar.C q q') =>+      q' {-^ half life, time where the function reaches 1\/2 of the initial value -}+   -> q' {-^ initial value -}+   -> Proc.T q q' (SigR.T q q' q)+exponential2 time y0 =+   SigR.lift (CtrlC.exponential2 time y0)++++{- |+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.+-}+piecewise :: (Trans.C q, RealField.C q,+              Real.C q', Field.C q', OccScalar.C q q') =>+      [ControlPiece q']+   -> Proc.T q q' (SigR.T q q' q)+piecewise cs =+   SigR.lift (CtrlC.piecewise cs)++piecewiseVolume ::+   (Trans.C q, RealField.C q,+    Real.C q', Field.C q', OccScalar.C q q') =>+      [ControlPiece q']+   -> q'+   -> Proc.T q q' (SigR.T q q' q)+piecewiseVolume cs amplitude =+   SigR.lift (CtrlC.piecewiseVolume cs amplitude)+++{- |+Map a control curve without amplitude unit+by a linear (affine) function with a unit.+-}+mapLinear :: (Ring.C y, Field.C y', Real.C y', OccScalar.C y y') =>+      y'  {- ^ range: one is mapped to @center+range@ -}+   -> y'  {- ^ center: zero is mapped to @center@ -}+   -> Proc.T t t'+       (SigR.T y y' y+     -> SigR.T y y' y)+mapLinear range center =+   SigR.lift (CtrlC.mapLinear range center)++{- |+Map a control curve without amplitude unit+exponentially to one with a unit.+-}+mapExponential :: (Field.C y', Trans.C y, Module.C y y') =>+      y   {- ^ range: one is mapped to @center*range@, must be positive -}+   -> y'  {- ^ center: zero is mapped to @center@ -}+   -> Proc.T t t'+       (SigR.T y y  y+     -> SigR.T y y' y)+mapExponential range center =+   SigR.lift (CtrlC.mapExponential range center)
+ src/Synthesizer/Inference/Reader/Cut.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Inference.Reader.Cut (+   {- * dissection -}+   splitAt,+   take,+   drop,+   takeUntilPause,+   unzip,+   unzip3,++   {- * glueing -}+   concat,   concatVolume,+   append,   appendVolume,+   zip,      zipVolume,+   zip3,     zip3Volume,+   arrange,  arrangeVolume,+  ) where++import qualified Synthesizer.SampleRateContext.Cut as CutC++import qualified Synthesizer.Inference.Reader.Signal as SigR+import qualified Synthesizer.Inference.Reader.Process as Proc++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.OccasionallyScalar  as OccScalar+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 PreludeBase ((.), Ord)+-- import NumericPrelude+import Prelude (RealFrac)+++{- * dissection -}++splitAt :: (RealField.C t, Field.C t', OccScalar.C t t') =>+   t' -> Proc.T t t' (SigR.T y y' yv -> (SigR.T y y' yv, SigR.T y y' yv))+splitAt t = SigR.lift (CutC.splitAt t)++take :: (RealField.C t, Field.C t', OccScalar.C t t') =>+   t' -> Proc.T t t' (SigR.T y y' yv -> SigR.T y y' yv)+take t = SigR.lift (CutC.take t)++drop :: (RealField.C t, Field.C t', OccScalar.C t t') =>+   t' -> Proc.T t t' (SigR.T y y' yv -> SigR.T y y' yv)+drop t = SigR.lift (CutC.drop t)++takeUntilPause ::+  (RealField.C t, Ring.C t', OccScalar.C t t',+   Field.C y', NormedMax.C y yv, OccScalar.C y y') =>+   y' -> t' -> Proc.T t t' (SigR.T y y' yv -> SigR.T y y' yv)+takeUntilPause y' t' = SigR.lift (CutC.takeUntilPause y' t')+++unzip ::+   Proc.T t t'+      (SigR.T y y' (yv0, yv1) ->+         (SigR.T y y' yv0, SigR.T y y' yv1))+unzip = SigR.lift CutC.unzip++unzip3 ::+   Proc.T t t'+      (SigR.T y y' (yv0, yv1, yv2) ->+         (SigR.T y y' yv0, SigR.T y y' yv1, SigR.T y y' yv2))+unzip3 = SigR.lift CutC.unzip3+++{- * 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.+-}+concat ::+   (Real.C y, Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv) =>+   Proc.T t t' ([SigR.T y y' yv] -> SigR.T y y' yv)+concat = SigR.lift CutC.concat++{- |+Give the output volume explicitly.+Does also work for infinite lists.+-}+concatVolume ::+   (Field.C y', OccScalar.C y y',+    Module.C y yv) =>+   y' -> Proc.T t t' ([SigR.T y y' yv] -> SigR.T y y' yv)+concatVolume = SigR.lift . CutC.concatVolume+++append ::+   (Real.C y, Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv) =>+   Proc.T t t' (SigR.T y y' yv -> SigR.T y y' yv -> SigR.T y y' yv)+append = SigR.lift CutC.append++appendVolume ::+   (Field.C y', OccScalar.C y y',+    Module.C y yv) =>+   y' ->+   Proc.T t t' (SigR.T y y' yv -> SigR.T y y' yv -> SigR.T y y' yv)+appendVolume = SigR.lift . CutC.appendVolume+++zip ::+   (Real.C y, Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv0, Module.C y yv1) =>+   Proc.T t t' (SigR.T y y' yv0 -> SigR.T y y' yv1 -> SigR.T y y' (yv0,yv1))+zip = SigR.lift CutC.zip++zipVolume ::+   (Field.C y', OccScalar.C y y',+    Module.C y yv0, Module.C y yv1) =>+   y' ->+   Proc.T t t' (SigR.T y y' yv0 -> SigR.T y y' yv1 -> SigR.T y y' (yv0,yv1))+zipVolume = SigR.lift . CutC.zipVolume+++zip3 ::+   (Real.C y, Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv0, Module.C y yv1, Module.C y yv2) =>+   Proc.T t t' (SigR.T y y' yv0 -> SigR.T y y' yv1 -> SigR.T y y' yv2 ->+                 SigR.T y y' (yv0,yv1,yv2))+zip3 = SigR.lift CutC.zip3++zip3Volume ::+   (Field.C y', OccScalar.C y y',+    Module.C y yv0, Module.C y yv1, Module.C y yv2) =>+   y' ->+   Proc.T t t' (SigR.T y y' yv0 -> SigR.T y y' yv1 -> SigR.T y y' yv2 ->+                 SigR.T y y' (yv0,yv1,yv2))+zip3Volume = SigR.lift . CutC.zip3Volume+++{- |+Uses maximum input volume as output volume.+-}+arrange ::+   (Ring.C t', OccScalar.C t t',+    RealFrac t, NonNeg.C t,+    Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv) =>+      t'  {-^ Unit of the time values in the time ordered list. -}+   -> Proc.T t t'+        (EventList.T t (SigR.T y y' yv)+             {-  A list of pairs: (relative start time, signal part),+                 The start time is relative+                 to the start time of the previous event. -}+         -> SigR.T y y' yv+             {-  The mixed signal. -} )+arrange = SigR.lift . CutC.arrange+++{- |+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.+-}+arrangeVolume ::+   (Ring.C t', OccScalar.C t t',+    RealFrac t, NonNeg.C t,+    Field.C y', OccScalar.C y y',+    Module.C y yv) =>+      y'  {-^ Output volume. -}+   -> t'  {-^ Unit of the time values in the time ordered list. -}+   -> Proc.T t t'+        (EventList.T t (SigR.T y y' yv)+             {-  A list of pairs: (relative start time, signal part),+                 The start time is relative+                 to the start time of the previous event. -}+         -> SigR.T y y' yv+             {-  The mixed signal. -} )+arrangeVolume amp = SigR.lift . CutC.arrangeVolume amp
+ src/Synthesizer/Inference/Reader/Filter.hs view
@@ -0,0 +1,342 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2007+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Inference.Reader.Filter (+   {- * Non-recursive -}++   {- ** Amplification -}+   amplify,+   negate,+   envelope,+   {- ** Filter operators from calculus -}+   differentiate,++{-+   {- ** Smooth -}+   mean,++   {- ** Delay -}+   delay,+   phaseModulation,+   phaser,+   phaserStereo,+++   {- * Recursive -}++   {- ** Without resonance -}+   firstOrderLowpass,+   firstOrderHighpass,+   butterworthLowpass,+   butterworthHighpass,+   chebyshevALowpass,+   chebyshevAHighpass,+   chebyshevBLowpass,+   chebyshevBHighpass,+   {- ** With resonance -}+   universal,+   moogLowpass,+   {- ** Allpass -}+   allpassCascade,+-}+   {- ** Reverb -}+   comb,++   {- ** Filter operators from calculus -}+   integrate,+) where+++import qualified Synthesizer.SampleRateContext.Filter as FiltC++import qualified Synthesizer.Inference.Reader.Signal as SigR+import qualified Synthesizer.Inference.Reader.Process as Proc++{-+import Synthesizer.Inference.Reader.Signal+   (toTimeScalar, toFrequencyScalar)++import qualified Synthesizer.Physical.Signal as SigP+import qualified Synthesizer.Plain.Displacement as Syn+import qualified Synthesizer.Plain.Interpolation as Interpolation+import qualified Synthesizer.Plain.Filter.Delay.Block as Delay+import qualified Synthesizer.Plain.Filter.NonRecursive as Filt+import qualified Synthesizer.Inference.Monad.Signal.Displacement as SynI+import qualified Synthesizer.Inference.Monad.Signal.Cut         as CutI+-}++import qualified Algebra.OccasionallyScalar as OccScalar+-- 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.Module         as Module+-- import qualified Algebra.VectorSpace    as VectorSpace++{-+import Data.Ord.HT (limit)++import Control.Monad(liftM2)++import NumericPrelude hiding (negate)+import PreludeBase as P+-}+++{- | The amplification factor must be positive. -}+amplify :: (Field.C y') =>+      y'+   -> Proc.T t t'+        (SigR.T y y' yv+      -> SigR.T y y' yv)+amplify volume = SigR.lift (FiltC.amplify volume)++negate :: (Additive.C yv) =>+   Proc.T t t'+       (SigR.T y y' yv+     -> SigR.T y y' yv)+negate = SigR.lift FiltC.negate+++envelope :: (Module.C y yv, Field.C y') =>+   Proc.T t t' (+      SigR.T y y' y   {-  the envelope -}+   -> SigR.T y y' yv  {-  the signal to be enveloped -}+   -> SigR.T y y' yv)+envelope = SigR.lift FiltC.envelope+++differentiate :: (Additive.C v, Field.C q') =>+   Proc.T q q' (+        SigR.T q q' v+     -> SigR.T q q' v)+differentiate = SigR.lift FiltC.differentiate+++{-+{- | needs a good handling of boundaries, yet -}+mean :: (Additive.C yv, Field.C y', RealField.C a,+         Module.C a v, OccScalar.C a q) =>+      q            {- ^ time length of the window -}+   -> SigR.T y y' yv+   -> Proc.T t t' (SigR.T y y' yv)+mean time x =+   do t <- toTimeScalar x (Expr.constant time)+      let tInt  = round ((t-1)/2)+      let width = tInt*2+1+      returnModified []+         ((SigP.asTypeOfAmplitude (recip (fromIntegral width)) x *> ) .+          Filt.sums width . FiltNR.delay tInt) x+++delay :: (Additive.C yv, Field.C y', RealField.C a, OccScalar.C a q) =>+      q+   -> SigR.T y y' yv+   -> Proc.T t t' (SigR.T y y' yv)+delay time x =+   do t <- toTimeScalar x (Expr.constant time)+      returnModified [] (FiltNR.delay (round t)) x+++phaseModulation ::+         (Additive.C yv, Field.C y', RealField.C a, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ minDelay, minimal delay, may be negative -}+   -> q   {- ^ maxDelay, maximal delay, it must be @minDelay <= maxDelay@+               and the modulation must always be+               in the range [minDelay,maxDelay]. -}+   -> SigI.T a q a+          {- ^ delay control, positive numbers mean delay,+               negative numbers mean prefetch -}+   -> SigR.T y y' yv+   -> Proc.T t t' (SigR.T y y' yv)+phaseModulation ip minDelay maxDelay delays x =+   do t0 <- toTimeScalar x (Expr.constant minDelay)+      t1 <- toTimeScalar x (Expr.constant maxDelay)+      let tInt0 = floor   t0+      let tInt1 = ceiling t1+      let tInt0Neg = Additive.negate tInt0+      ds <- SigI.scalarSamples (toTimeScalar delays) delays+      returnModified [SigP.sampleRate delays]+         (FiltNR.delay tInt0 .+             Delay.modulated ip (tInt1-tInt0+1)+               (FiltNR.delay tInt0Neg+                  (Syn.raise (fromIntegral tInt0Neg)+                     (map (limit (t0,t1)) ds)))) x+++{- | symmetric phaser -}+phaser :: (Additive.C yv, Field.C y', RealField.C a,+           Module.C a v, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ maxDelay, must be positive -}+   -> SigI.T a q a+          {- ^ delay control -}+   -> SigR.T y y' yv+   -> Proc.T t t' (SigR.T y y' yv)+phaser ip maxDelay delays x =+   amplify (asTypeOf 0.5 maxDelay) =<<+      uncurry SynI.mix =<< phaserCore ip maxDelay delays x++phaserStereo :: (Additive.C yv, Field.C y', Real.C q, RealField.C a,+                 Module.C a v, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ maxDelay, must be positive -}+   -> SigI.T a q a+          {- ^ delay control -}+   -> SigR.T y y' yv+   -> SigI.Process a q (v,v)+phaserStereo ip maxDelay delays x =+   uncurry CutI.zip =<< phaserCore ip maxDelay delays x++phaserCore :: (Additive.C yv, Field.C y', RealField.C a,+               Module.C a v, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ maxDelay, must be positive -}+   -> SigI.T a q a+          {- ^ delay control -}+   -> SigR.T y y' yv+   -> Process.T q (SigR.T y y' yv, SigR.T y y' yv)+phaserCore ip maxDelay delays x =+   do let minDelay = Additive.negate maxDelay+      negDelays <- Inference.Signal.Filter.negate delays+      liftM2 (,)+         (phaseModulation ip minDelay maxDelay delays x)+         (phaseModulation ip minDelay maxDelay negDelays x)++++firstOrderLowpass, firstOrderHighpass ::+   (Trans.C a, Trans.C q, Module.C a v, OccScalar.C a q) =>+      SigI.T a q a {- ^ Control signal for the cut-off frequency. -}+   -> SigR.T y y' yv {- ^ Input signal -}+   -> Proc.T t t' (SigR.T y y' yv)+firstOrderLowpass  = firstOrderGen Syn.lowpass1stOrder+firstOrderHighpass = firstOrderGen Syn.highpass1stOrder++firstOrderGen :: (Trans.C a, Trans.C q, Module.C a v, OccScalar.C a q) =>+      ([a] -> [v] -> [v])+   -> SigI.T a q a+   -> SigR.T y y' yv+   -> Proc.T t t' (SigR.T y y' yv)+firstOrderGen filt freq x =+   do freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      returnModified [SigP.sampleRate freq]+         (filt (map Syn.lowpass1stOrderParam freqs)) x+++butterworthLowpass, butterworthHighpass,+   chebyshevALowpass, chebyshevAHighpass,+   chebyshevBLowpass, chebyshevBHighpass ::+      (Field.C y', Trans.C a, VectorSpace.C a v, OccScalar.C a q) =>+      Int          {- ^ Order of the filter, must be even,+                        the higher the order, the sharper is the separation of frequencies. -}+   -> a            {- ^ The attenuation at the cut-off frequency.+                        Should be between 0 and 1. -}+   -> SigI.T a q a {- ^ Control signal for the cut-off frequency. -}+   -> SigR.T y y' yv {- ^ Input signal -}+   -> Proc.T t t' (SigR.T y y' yv)++butterworthLowpass  = higherOrderNoResoGen Syn.butterworthLowpass+butterworthHighpass = higherOrderNoResoGen Syn.butterworthHighpass+chebyshevALowpass   = higherOrderNoResoGen Syn.chebyshevALowpass+chebyshevAHighpass  = higherOrderNoResoGen Syn.chebyshevAHighpass+chebyshevBLowpass   = higherOrderNoResoGen Syn.chebyshevBLowpass+chebyshevBHighpass  = higherOrderNoResoGen Syn.chebyshevBHighpass++higherOrderNoResoGen ::+   (Field.C y', Ring.C a, OccScalar.C a q) =>+      (Int -> a -> [a] -> [v] -> [v])+   -> Int+   -> a+   -> SigI.T a q a+   -> SigR.T y y' yv+   -> Proc.T t t' (SigR.T y y' yv)+higherOrderNoResoGen filt order ratio freq x =+   do freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      returnModified [SigP.sampleRate freq]+         (filt order ratio freqs) x++++universal :: (Trans.C a, Module.C a v, Field.C y', OccScalar.C a q) =>+      SigI.T a q a {- ^ signal for resonance,+                        i.e. factor of amplification at the resonance frequency+                        relatively to the transition band. -}+   -> SigI.T a q a {- ^ signal for cut off and band center frequency -}+   -> SigR.T y y' yv {- ^ input signal -}+   -> SigI.Process a q (v,v,v) {- ^ highpass, bandpass, lowpass filter -}+universal reso freq x =+   do resos <- SigI.scalarSamples (Process.exprToScalar) reso+      freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      let params =+             map UniFilter.parameter+                 (zipWith Syn.Pole resos freqs)+      returnModified [SigP.sampleRate reso, SigP.sampleRate freq]+         (UniFilter.run params) x++moogLowpass :: (Trans.C a, Module.C a v, Field.C y', OccScalar.C a q) =>+      Int+   -> SigI.T a q a {- ^ signal for resonance,+                        i.e. factor of amplification at the resonance frequency+                        relatively to the transition band. -}+   -> SigI.T a q a {- ^ signal for cut off and band center frequency -}+   -> SigR.T y y' yv+   -> Proc.T t t' (SigR.T y y' yv)+moogLowpass order reso freq x =+   do resos <- SigI.scalarSamples (Process.exprToScalar) reso+      freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      let params =+             map (Moog.parameter order)+                 (zipWith Syn.Pole resos freqs)+      returnModified [SigP.sampleRate reso, SigP.sampleRate freq]+         (Moog.lowpass order params) x++allpassCascade :: (Trans.C a, Module.C a v, Field.C y', OccScalar.C a q) =>+      Int          {- ^ order, number of filters in the cascade -}+   -> a            {- ^ the phase shift to be achieved for the given frequency -}+   -> SigI.T a q a {- ^ lowest comb frequency -}+   -> SigR.T y y' yv+   -> Proc.T t t' (SigR.T y y' yv)+allpassCascade order phase freq x =+   do freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      let params = map (Syn.allpassCascadeParam order phase) freqs+      returnModified [SigP.sampleRate freq]+         (Syn.allpassCascade order params) x+-}++++{- | Infinitely many equi-delayed exponentially decaying echos. -}+comb :: (RealField.C t, Ring.C t', OccScalar.C t t', Module.C y yv) =>+   t' -> y -> Proc.T t t' (SigR.T y y' yv -> SigR.T y y' yv)+comb time gain = SigR.lift (FiltC.comb time gain)+++integrate :: (Additive.C v, Field.C q') =>+   Proc.T q q'+       (SigR.T q q' v+     -> SigR.T q q' v)+integrate = SigR.lift FiltC.integrate+++{-+returnModified :: (Eq q) =>+   [Process.Value q] -> ([v] -> [w]) -> SigR.T y y' yv -> SigI.Process a q w+returnModified sampleRates proc x =+   do let sampleRate = SigP.sampleRate x+      mapM_ (Process.equalValue sampleRate) sampleRates+      SigI.returnCons+         sampleRate (SigP.amplitude x)+         (proc (SigP.samples x))+-}
+ src/Synthesizer/Inference/Reader/Noise.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++-}+module Synthesizer.Inference.Reader.Noise+  (white,+   whiteGen,+   randomPeeks) where+++import qualified Synthesizer.SampleRateContext.Noise as NoiseC++import qualified Synthesizer.Inference.Reader.Signal as SigR+import qualified Synthesizer.Inference.Reader.Process as Proc++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.Algebraic          as Algebraic+import qualified Algebra.Field              as Field+import qualified Algebra.Ring               as Ring++import System.Random (Random, RandomGen)++-- import NumericPrelude+import PreludeBase as P++++white :: (Ring.C yv, Random yv, Algebraic.C q') =>+      q'  {-^ width of the frequency band -}+   -> q'  {-^ volume caused by the given frequency band -}+   -> Proc.T t q' (SigR.T y q' yv)+          {-^ noise -}+white bandWidth volume = SigR.lift $ NoiseC.white bandWidth volume++whiteGen :: (Ring.C yv, Random yv, RandomGen g, Algebraic.C q') =>+      g   {-^ random generator, can be used to choose a seed -}+   -> q'  {-^ width of the frequency band -}+   -> q'  {-^ volume caused by the given frequency band -}+   -> Proc.T t q' (SigR.T y q' yv)+          {-^ noise -}+whiteGen gen bandWidth volume = SigR.lift (NoiseC.whiteGen gen bandWidth volume)++{-+The Field.C q constraint could be lifted to Ring.C+if we would use direct division instead of toFrequencyScalar.+-}+randomPeeks ::+   (Field.C q, Random q, Ord q,+    Field.C q', OccScalar.C q q') =>+   Proc.T q q'+      (   SigR.T q q' q  {-   momentary densities (frequency),+                              @p@ means that there is about one peak+                              in the time range of @1\/p@. -}+       -> [Bool])+                         {-   Every occurence of 'True' represents a peak. -}+randomPeeks = SigR.lift NoiseC.randomPeeks
+ src/Synthesizer/Inference/Reader/Oscillator.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2006, 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++-}+module Synthesizer.Inference.Reader.Oscillator (+   {- * Oscillators with constant waveforms -}+   static,+   freqMod,+   phaseMod,+   phaseFreqMod,+) where++import qualified Synthesizer.SampleRateContext.Oscillator as OsciC++-- import qualified Synthesizer.Plain.Oscillator as Osci+import qualified Synthesizer.Basic.Wave       as Wave++import qualified Synthesizer.Inference.Reader.Signal as SigR+import qualified Synthesizer.Inference.Reader.Process as Proc++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.RealField          as RealField+import qualified Algebra.Field              as Field++-- import NumericPrelude+-- import PreludeBase as P+++{- * Oscillators with constant waveforms -}++{- | oscillator with a functional waveform with constant frequency -}+static :: (RealField.C t, Field.C t', OccScalar.C t t') =>+      Wave.T t yv  {- ^ waveform -}+   -> y'           {- ^ amplitude -}+   -> t            {- ^ start phase from the range [0,1] -}+   -> t'           {- ^ frequency -}+   -> Proc.T t t' (SigR.T y y' yv)+static wave amplitude phase freq =+   SigR.lift (OsciC.static wave amplitude phase freq)++{- | oscillator with a functional waveform with modulated frequency -}+freqMod :: (RealField.C t, Field.C t', OccScalar.C t t') =>+      Wave.T t yv  {- ^ waveform -}+   -> y'           {- ^ amplitude -}+   -> t            {- ^ start phase from the range [0,1] -}+   -> Proc.T t t' (+          SigR.T t t' t  {-   frequency control -}+       -> SigR.T y y' yv)+freqMod wave amplitude phase =+   SigR.lift (OsciC.freqMod wave amplitude phase)++{- | oscillator with modulated phase -}+phaseMod :: (RealField.C t, Field.C t', OccScalar.C t t') =>+      Wave.T t yv  {- ^ waveform -}+   -> y'           {- ^ amplitude -}+   -> t'           {- ^ frequency control -}+   -> Proc.T t t' (+          SigR.T t t  t  {-   phase modulation, phases must have no unit and+                              are from range [0,1] -}+       -> SigR.T y y' yv)+phaseMod wave amplitude freq =+   SigR.lift (OsciC.phaseMod wave amplitude freq)++{- | oscillator with a functional waveform with modulated phase and frequency -}+phaseFreqMod :: (RealField.C t, Field.C t', OccScalar.C t t') =>+      Wave.T t yv  {- ^ waveform -}+   -> y'           {- ^ amplitude -}+   -> Proc.T t t' (+          SigR.T t t  t  {-   phase control -}+       -> SigR.T t t' t  {-   frequency control -}+       -> SigR.T y y' yv)+phaseFreqMod wave amplitude =+   SigR.lift (OsciC.phaseFreqMod wave amplitude)
+ src/Synthesizer/Inference/Reader/Play.hs view
@@ -0,0 +1,24 @@+module Synthesizer.Inference.Reader.Play where++import qualified Synthesizer.Basic.Binary as BinSmp++import qualified Synthesizer.Inference.Reader.Signal  as SigR+import qualified Synthesizer.Inference.Reader.Process as ProcR+import qualified Synthesizer.Physical.Play           as PlayP++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.VectorSpace        as VectorSpace+import qualified Algebra.RealField          as RealField+import qualified Algebra.Field              as Field++import System.Exit(ExitCode)+++toInt16 ::+   (RealField.C t, BinSmp.C yv,+    Field.C t', OccScalar.C t t',+    Field.C y', OccScalar.C y y',+    VectorSpace.C y yv) =>+   t' -> y' -> t' -> ProcR.T t t' (SigR.T y y' yv) -> IO ExitCode+toInt16 freqUnit amp sampleRate proc =+   PlayP.toInt16 freqUnit amp (SigR.run sampleRate proc)
+ src/Synthesizer/Inference/Reader/Process.hs view
@@ -0,0 +1,110 @@+{- |++Copyright   :  (c) Henning Thielemann 2007+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes (OccasionallyScalar)++++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 in a Reader monad.+We almost do not need monad functionality+but only "Control.Applicative" functionality.++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.+-}+module Synthesizer.Inference.Reader.Process (+      T(..),+      run, share,+      injectParam, extractParam, convertTimeParam,+      loop, pure,+      ($:), ($::), ($^), ($#),+      (.:), (.^),+      liftP, liftP2, liftP3, liftP4,+   ) where++import Control.Monad.Fix (MonadFix(mfix), )+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.+-}+newtype T t t' a = Cons {process :: t' -> a}+++instance Functor (T t t') where+   fmap f x = Cons (f . process x)++instance Applicative (T t t') where+   pure  = pure+   (<*>) = apply++instance Monad (T t t') where+   return = pure+   (>>=)  = share++instance MonadFix (T t t') where+   mfix = loop . injectParam++++run ::+   t' -> T t t' a -> (t', a)+run sr (Cons p) = (sr, p sr)+++{- |+Re-use a result several times without recomputing.+With a simple @let@ you can re-use a result+but it must be recomputed due to the dependency on the sample rate.+-}+share ::+      T t t' a        {-^ process that provides a result -}+   -> (a -> T t t' b) {-^ function that can re-use that result as much as it wants -}+   -> T t t' b+share p f = Cons $ \sr ->+   process (f (process p sr)) sr++++{- |+This corresponds to 'Control.Applicative.pure'+-}+pure :: a -> T t t' a+pure x = Cons $ const x++apply :: T t t' (a -> b) -> T t t' a -> T t t' b+apply f proc = Cons $ \sr ->+   process f sr (process proc sr)++extractParam :: T t t' (a -> b) -> (a -> T t t' b)+extractParam = ($#)++injectParam :: (a -> T t t' b) -> T t t' (a -> b)+injectParam f = Cons $ \sr x ->+   process (f x) sr++{- |+The first argument will be a function like 'InferenceReader.Signal.toTimeScalar'.+If you use this function instead of 'InferenceReader.Signal.toTimeScalar' directly,+the type @t@ can be automatically infered.+-}+convertTimeParam :: (t' -> t' -> t) -> t' -> (t -> a) -> T t t' a+convertTimeParam convert t' f = Cons $ \sr ->+   f (convert sr t')
+ src/Synthesizer/Inference/Reader/Signal.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |++Copyright   :  (c) Henning Thielemann 2007+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes (OccasionallyScalar)+-}+module Synthesizer.Inference.Reader.Signal (+    T(..),+    run,+    addSampleRate,+    apply,+    lift,+    returnCons,++    toTimeScalar,+    toFrequencyScalar,+    toAmplitudeScalar,+    toGradientScalar,++    scalarSamples,+    vectorSamples,++    ($-),+    constant,+   ) where++import Synthesizer.Inference.Reader.Process (($:))+import qualified Synthesizer.Inference.Reader.Process as Proc++import qualified Synthesizer.SampleRateContext.Rate   as Rate+import qualified Synthesizer.SampleRateContext.Signal as SigC+import qualified Synthesizer.Physical.Signal as SigP++import Synthesizer.SampleRateContext.Signal (T(Cons, samples, amplitude))++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.Module         as Module+import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring++import Algebra.OccasionallyScalar (toScalar)++import NumericPrelude+import PreludeBase as P++++run ::+   t' -> Proc.T t t' (T y y' yv) -> SigP.T t t' y y' yv+run sr proc =+   uncurry addSampleRate (Proc.run sr proc)++{-+run ::+   Rate.T t t' -> Proc.T t t' (T y y' yv) -> SigP.T t t' y y' yv+run sr proc =+   uncurry addSampleRate (Proc.run (Rate.toNumber sr) proc)+-}++addSampleRate ::+   t' -> T y y' yv -> SigP.T t t' y y' yv+addSampleRate = SigP.addPlainSampleRate++apply ::+   (Proc.T t t' (T y0 y0' y0v -> T y1 y1' y1v))+    -> SigP.T t t' y0 y0' y0v+    -> SigP.T t t' y1 y1' y1v+apply proc (SigP.Cons sr sig) =+   let (sr', f) = Proc.run (Rate.toNumber sr) proc+   in  addSampleRate sr' (f sig)+++lift :: (Rate.T t t' -> a) -> Proc.T t t' a+lift f = Proc.Cons $ f . Rate.fromNumber+++returnCons ::+   y' -> [yv] -> Proc.T t t' (T y y' yv)+returnCons amp sig = Proc.pure (Cons amp sig)++{-+sampleRateExpr :: SigP.T t (Value t') y (Value y') yv -> Expr t'+sampleRateExpr x = Expr.fromAtom (SigP.sampleRate x)++amplitudeExpr :: SigP.T t (Value t') y (Value y') yv -> Expr y'+amplitudeExpr x = Expr.fromAtom (SigP.amplitude x)+-}++toTimeScalar :: (Ring.C t', OccScalar.C t t') =>+   t' -> t' -> t+toTimeScalar sampleRate t = toScalar (t * sampleRate)++toFrequencyScalar :: (Field.C t', OccScalar.C t t') =>+   t' -> t' -> t+toFrequencyScalar sampleRate f = toScalar (f / sampleRate)++toAmplitudeScalar :: (Field.C y', OccScalar.C y y') =>+   T y y' yv -> y' -> y+toAmplitudeScalar sig y =+   toScalar (y / amplitude sig)++toGradientScalar :: (Field.C q', OccScalar.C q q') =>+   q' -> q' -> q' -> q+toGradientScalar amp sampleRate steepness =+   toFrequencyScalar sampleRate (steepness / amp)+++scalarSamples :: (Ring.C y) =>+   (y' -> y) -> T y y' y -> [y]+scalarSamples toAmpScalar sig =+   let y = toAmpScalar (amplitude sig)+   in  map (y*) (samples sig)++vectorSamples :: (Module.C y yv) =>+   (y' -> y) -> T y y' yv -> [yv]+vectorSamples toAmpScalar sig =+   let y = toAmpScalar (amplitude sig)+   in  y *> samples sig+++{- |+Take a scalar argument where a process expects a signal.+-}+($-) :: Ring.C yv =>+    Proc.T t t' (T y y' yv -> a) -> y' -> Proc.T t t' a+($-) f x = f $: Proc.pure (constant x)++{-+Should be in Control module.+-}+constant :: Ring.C yv => y' -> T y y' yv+constant x = Cons x (repeat 1)
+ src/Synthesizer/Physical.hs view
@@ -0,0 +1,25 @@+{- |++Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++++This module is for documentation purposes.+But the modules below are exported+in order to let you easily navigate to them.+-}+++module Synthesizer.Physical+   (module Synthesizer.Physical.Signal,+    module Synthesizer.Physical.Cut,+    module Synthesizer.Physical.Displacement) where++import Synthesizer.Physical.Signal+import Synthesizer.Physical.Cut+import Synthesizer.Physical.Displacement
+ src/Synthesizer/Physical/Control.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-|+Control curve generation+-}++module Synthesizer.Physical.Control where++import qualified Synthesizer.SampleRateContext.Control as CtrlC+import qualified Synthesizer.Plain.Control as Ctrl+import qualified Synthesizer.Physical.Signal as SigP+import Synthesizer.Physical.Signal(toTimeScalar)++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.Module         as Module+import qualified Algebra.Transcendental as Trans+import qualified Algebra.Real           as Real+import qualified Algebra.Ring           as Ring++-- import PreludeBase+-- import NumericPrelude+++exponential :: (Trans.C a, Ring.C a', Real.C a', OccScalar.C a a') =>+      a' {-^ sample rate -}+   -> a' {-^ time where the function reaches 1\/e of the initial value -}+   -> a' {-^ initial value -}+   -> SigP.T a a' a a' a+         {-^ exponential decay -}+exponential sampleRate time y0 =+   SigP.lift0 (CtrlC.exponential time y0) sampleRate+++exponential2 :: (Trans.C a, Ring.C a', Real.C a', OccScalar.C a a') =>+      a' {-^ sample rate -}+   -> a' {-^ half life -}+   -> a' {-^ initial value -}+   -> SigP.T a a' a a' a+         {-^ exponential decay -}+exponential2 sampleRate halfLife y0 =+   SigP.lift0 (CtrlC.exponential2 halfLife y0) sampleRate+++vectorExponential ::+   (Trans.C t, Ring.C t',+    OccScalar.C t t', Module.C t yv) =>+      t' {-^ sample rate -}+   -> t' {-^ time where the function reaches 1\/e of the initial value -}+   -> y' {-^ amplitude unit -}+   -> yv {-^ initial value -}+   -> SigP.T t t' y y' yv+         {-^ exponential decay -}+vectorExponential sampleRate time amplitude y0 =+   let z = SigP.cons sampleRate amplitude+              (Ctrl.vectorExponential+                 (toTimeScalar z time) y0)+   in  z+++vectorExponential2 ::+   (Trans.C t, Ring.C t',+    OccScalar.C t t', Module.C t yv) =>+      t' {-^ sample rate -}+   -> t' {-^ half life -}+   -> y' {-^ amplitude unit -}+   -> yv {-^ initial value -}+   -> SigP.T t t' y y' yv+         {-^ exponential decay -}+vectorExponential2 sampleRate halfLife amplitude y0 =+   let z = SigP.cons sampleRate amplitude+              (Ctrl.vectorExponential2+                 (toTimeScalar z halfLife) y0)+   in  z
+ src/Synthesizer/Physical/Cut.hs view
@@ -0,0 +1,222 @@+{- |+Copyright   :  (c) Henning Thielemann 2006, 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Cut signals++-}+module Synthesizer.Physical.Cut where++import qualified Synthesizer.SampleRateContext.Cut as CutC+import qualified Synthesizer.SampleRateContext.Signal as SigC+import qualified Synthesizer.SampleRateContext.Rate   as Rate++import qualified Synthesizer.Physical.Signal as SigP++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.OccasionallyScalar as OccScalar+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 Data.Tuple.HT (mapSnd, )++import PreludeBase (Eq, Ord, Bool, uncurry, (.), (==), flip, fst, error)+-- import NumericPrelude++import Prelude (RealFrac)+++{- * Dissection -}++splitAt :: (RealField.C t, Ring.C t', OccScalar.C t t') =>+   t' -> SigP.T t t' y y' yv -> (SigP.T t t' y y' yv, SigP.T t t' y y' yv)+splitAt t = SigP.liftR2 (CutC.splitAt t)++take :: (RealField.C t, Ring.C t', OccScalar.C t t') =>+   t' -> SigP.T t t' y y' yv -> SigP.T t t' y y' yv+take t = SigP.lift1 (CutC.take t)++drop :: (RealField.C t, Ring.C t', OccScalar.C t t') =>+   t' -> SigP.T t t' y y' yv -> SigP.T t t' y y' yv+drop t = SigP.lift1 (CutC.drop t)+++propSplit :: (Eq t', Eq y', Eq yv,+              OccScalar.C t t', Ring.C t', RealField.C t) =>+   t' -> SigP.T t t' y y' yv -> Bool+propSplit t x =  splitAt t x == (take t x, drop t x)+++takeUntilPause :: (RealField.C t, Ring.C t', OccScalar.C t t',+                   Field.C y', NormedMax.C y yv, OccScalar.C y y') =>+   y' -> t' -> SigP.T t t' y y' yv -> SigP.T t t' y y' yv+takeUntilPause y' t' =+   SigP.lift1 (CutC.takeUntilPause y' t')+++unzip ::+   SigP.T t t' y y' (yv0, yv1) -> (SigP.T t t' y y' yv0, SigP.T t t' y y' yv1)+unzip = SigP.liftR2 CutC.unzip++unzip3 ::+      SigP.T t t' y y' (yv0, yv1, yv2)+   -> (SigP.T t t' y y' yv0, SigP.T t t' y y' yv1, SigP.T t t' y y' yv2)+unzip3 = SigP.liftR3 CutC.unzip3+++{- * Glueing -}+++{- |+  Similar to @foldr1 append@ but more efficient and accurate,+  because it reduces the number of amplifications.+  Does not work for infinite lists,+  because in this case a maximum amplitude cannot be computed.+-}+concat :: (Real.C y', Field.C y', Eq t', OccScalar.C y y',+           Module.C y yv) =>+      [SigP.T t t' y y' yv]+   ->  SigP.T t t' y y' yv+concat = SigP.liftList CutC.concat++{- |+  Like 'concat', but you have to specify the amplitude of the resulting signal.+  This way we can process infinite lists, too.+  The list must contain at least one element for getting a sample rate.+-}+concatVolume :: (Field.C y', Eq t', OccScalar.C y y',+              Module.C y yv) =>+       y'+   -> [SigP.T t t' y y' yv]+   ->  SigP.T t t' y y' yv+concatVolume amp = SigP.liftList (CutC.concatVolume amp)++append :: (Eq t', Real.C y', Field.C y', OccScalar.C y y',+         Module.C y yv) =>+   SigP.T t t' y y' yv -> SigP.T t t' y y' yv -> SigP.T t t' y y' yv+append = SigP.lift2 CutC.append+++propConcatAppend :: (Eq t', Eq y', Eq yv,+                   Module.C y yv, OccScalar.C y y',+                   Ring.C t', RealField.C y') =>+      SigP.T t t' y y' yv+   -> SigP.T t t' y y' yv+   -> Bool+propConcatAppend x y =  append x y == concat [x,y]+++propAppendSplit :: (Eq t', Eq y', Eq yv,+                    Module.C y yv, OccScalar.C y y',+                    RealField.C y', OccScalar.C t t',+                    Ring.C t', RealField.C t) =>+   t' -> SigP.T t t' y y' yv -> Bool+propAppendSplit t x =  uncurry append (splitAt t x) == x+++++zip :: (Eq t', Real.C y', Field.C y', OccScalar.C y y',+        Module.C y yv0, Module.C y yv1)+   => SigP.T t t' y y' yv0+   -> SigP.T t t' y y' yv1+   -> SigP.T t t' y y' (yv0, yv1)+zip = SigP.lift2 CutC.zip+++zip3 :: (Eq t', Real.C y', Field.C y', OccScalar.C y y',+         Module.C y yv0, Module.C y yv1, Module.C y yv2)+   => SigP.T t t' y y' yv0+   -> SigP.T t t' y y' yv1+   -> SigP.T t t' y y' yv2+   -> SigP.T t t' y y' (yv0, yv1, yv2)+zip3 = SigP.lift3 CutC.zip3+++propZip :: (Eq t', Eq y', Field.C y', Real.C y',+            Eq yv0, Eq yv1,+            Module.C y yv1, Module.C y yv0,+            OccScalar.C y y') =>+   SigP.T t t' y y' (yv0, yv1) -> Bool+propZip x =  uncurry zip (unzip x) == x++propZip3 :: (Eq t', Eq y', Field.C y', Real.C y',+             Eq yv0, Eq yv1, Eq yv2,+             Module.C y yv2, Module.C y yv1, Module.C y yv0,+             OccScalar.C y y') =>+   SigP.T t t' y y' (yv0, yv1, yv2) -> Bool+propZip3 x =  (\(a,b,c) -> zip3 a b c) (unzip3 x) == x+++splitSampleRateEventList :: (Eq t') =>+      EventList.T time (SigP.T t t' y y' yv)+   -> (Rate.T t t', EventList.T time (SigC.T y y' yv))+splitSampleRateEventList xs =+   case EventList.getBodies xs of+      [] -> error "splitSampleRateEventList: empty list"+      (x:_) ->+         let sr = fst (SigP.splitSampleRate x)+         in  (sr, EventList.mapBody (SigP.checkSampleRate "splitSampleRateEventList" sr) xs)+++{- |+  Given a list of signals with time stamps,+  mix them into one signal as they occur in time.+  Ideally for composing music.+  The amplitude of the output is designed for the worst case+  (all signals coincide).+  This is usually too pessimistic.+  Maybe you prefer 'arrangeVolume'.++  Infinite schedules are not supported,+  because no maximum amplitude can be computed.+  If you want infinite schedules,+  then 'arrangeVolume' is your friend, again.+-}+arrange ::+   (RealFrac t, NonNeg.C t, Eq t', Ring.C t, Ring.C t', OccScalar.C t t',+    Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv) =>+      t'  {-^ Unit of the time values in the time ordered list. -}+   -> EventList.T t (SigP.T t t' y y' yv)+          {-^ A list of pairs: (relative start time, signal part),+              The start time is relative+              to the start time of the previous event. -}+   -> SigP.T t t' y y' yv+          {-^ The mixed signal. -}+arrange unit =+   uncurry SigP.run .+   mapSnd (flip (CutC.arrange unit)) .+   splitSampleRateEventList+++{- |+  Similar to 'arrange' but allows for infinite schedules.+  To this end it needs the amplitude of the resulting signal.+-}+arrangeVolume ::+   (RealFrac t, NonNeg.C t, Eq t', Ring.C t, Ring.C t', OccScalar.C t t',+    Field.C y', OccScalar.C y y',+    Module.C y yv) =>+      y'  {-^ Amplitude of output. -}+   -> t'  {-^ Unit of the time values in the time ordered list. -}+   -> EventList.T t (SigP.T t t' y y' yv)+          {-^ A list of pairs: (relative start time, signal part),+              The start time is relative+              to the start time of the previous event. -}+   -> SigP.T t t' y y' yv+          {-^ The mixed signal. -}+arrangeVolume amp unit =+   uncurry SigP.run .+   mapSnd (flip (CutC.arrangeVolume amp unit)) .+   splitSampleRateEventList
+ src/Synthesizer/Physical/Displacement.hs view
@@ -0,0 +1,45 @@+module Synthesizer.Physical.Displacement where++import qualified Synthesizer.SampleRateContext.Displacement as MiscC++import qualified Synthesizer.Physical.Signal as SigP++import qualified Algebra.OccasionallyScalar as OccScalar+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 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. -}+mix :: (Eq t', Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>+      SigP.T t t' y y' yv+   -> SigP.T t t' y y' yv+   -> SigP.T t t' y y' yv+mix = SigP.lift2 MiscC.mix++{-| Mix one or more signals. -}+mixMulti :: (Eq t', Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>+      [SigP.T t t' y y' yv]+   ->  SigP.T t t' y y' yv+mixMulti = SigP.liftList MiscC.mixMulti++{-| Add a number to all of the signal values.+    This is useful for adjusting the center of a modulation. -}+raise :: (Eq t', Field.C y', Module.C y yv, OccScalar.C y y') =>+      y'+   -> yv+   -> SigP.T t t' y y' yv+   -> SigP.T t t' y y' yv+raise y' yv = SigP.lift1 (MiscC.raise y' yv)
+ src/Synthesizer/Physical/File.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Synthesizer.Physical.File where++import qualified Synthesizer.Plain.File as File+import qualified Synthesizer.Basic.Binary as BinSmp++import qualified Synthesizer.Physical.Signal as SigP++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.VectorSpace        as VectorSpace+import qualified Algebra.RealField          as RealField+import qualified Algebra.Field              as Field++import System.Exit(ExitCode)++-- import NumericPrelude+import PreludeBase++++writeToInt16 ::+   (RealField.C t, BinSmp.C yv,+    Field.C t', OccScalar.C t t',+    Field.C y', OccScalar.C y y',+    VectorSpace.C y yv) =>+   t' -> y' -> FilePath -> SigP.T t t' y y' yv -> IO ExitCode+writeToInt16 freqUnit amp name sig =+   uncurry (File.writeToInt16 name) (SigP.pureData freqUnit amp sig)
+ src/Synthesizer/Physical/Filter.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Synthesizer.Physical.Filter where++import qualified Synthesizer.SampleRateContext.Filter as FiltC+import qualified Synthesizer.Physical.Signal as SigP++import qualified Algebra.OccasionallyScalar as OccScalar+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.Ring           as Ring+import qualified Algebra.Additive       as Additive++import PreludeBase+-- import NumericPrelude+++{- * Amplification -}++amplify :: (Ring.C y') =>+      y'+   -> SigP.T t t' y y' yv+   -> SigP.T t t' y y' yv+amplify volume = SigP.lift1 (FiltC.amplify volume)++envelope :: (Eq t', Module.C y0 yv, Ring.C y') =>+      SigP.T t t' y y' y0  {-^ the envelope -}+   -> SigP.T t t' y y' yv  {-^ the signal to be enveloped -}+   -> SigP.T t t' y y' yv+envelope = SigP.lift2 FiltC.envelope++++{- * Filter operators from calculus -}++differentiate :: (Additive.C yv, Ring.C a')+   => SigP.T t a' y a' yv -> SigP.T t a' y a' yv+differentiate = SigP.lift1 FiltC.differentiate++integrate :: (Additive.C yv, Field.C a')+   => SigP.T t a' y a' yv -> SigP.T t a' y a' yv+integrate = SigP.lift1 FiltC.integrate+++{- * Echo -}++{- | Infinitely many equi-delayed exponentially decaying echos. -}+comb :: (RealField.C t, Ring.C t', OccScalar.C t t', Module.C y yv) =>+   t' -> y -> SigP.T t t' y y' yv -> SigP.T t t' y y' yv+comb time gain = SigP.lift1 (FiltC.comb time gain)
+ src/Synthesizer/Physical/Noise.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Synthesizer.Physical.Noise where++import qualified Synthesizer.SampleRateContext.Noise as NoiseC+-- import qualified Synthesizer.SampleRateContext.Signal as SigC++import qualified Synthesizer.Physical.Signal as SigP++import System.Random (Random)++import qualified Algebra.Algebraic      as Algebraic+import qualified Algebra.Ring           as Ring++-- import PreludeBase+-- import NumericPrelude+++{- * Noise -}++white :: (Ring.C yv, Random yv, Algebraic.C q') =>+      q' {-^ sample rate -}+   -> q'  {-^ width of the frequency band -}+   -> q'  {-^ volume caused by the given frequency band -}+   -> SigP.T t q' y q' yv+         {-^ noise -}+white sampleRate bandWidth volume =+   SigP.lift0 (NoiseC.white bandWidth volume) sampleRate
+ src/Synthesizer/Physical/Oscillator.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2006, 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Tone generators++-}+module Synthesizer.Physical.Oscillator where++import qualified Synthesizer.SampleRateContext.Oscillator as OsciC+-- import qualified Synthesizer.Plain.Oscillator as Osci+import qualified Synthesizer.Basic.Wave       as Wave+import qualified Synthesizer.Physical.Signal as SigP++import qualified Algebra.OccasionallyScalar as OccScalar+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.Ring               as Ring++-- import PreludeBase+-- import NumericPrelude++++{- * Oscillators with constant waveforms -}++{- | oscillator with a functional waveform with constant frequency -}+static :: (RealField.C t, Field.C t', OccScalar.C t t')+   => Wave.T t yv+   -> (t' -> y' -> t -> t' -> SigP.T t t' y y' yv)+static wave sampleRate amplitude phase freq =+   SigP.lift0 (OsciC.static wave amplitude phase freq) sampleRate++{- | oscillator with a functional waveform with modulated frequency -}+freqMod :: (RealField.C t, Field.C t', OccScalar.C t t')+   => Wave.T t yv+   -> (y' -> t -> SigP.T t t' t t' t -> SigP.T t t' y y' yv)+freqMod wave amplitude phase =+   SigP.lift1 (OsciC.freqMod wave amplitude phase)++{- | sine oscillator with static frequency -}+staticSine :: (RealField.C a, Trans.C a, Field.C t', OccScalar.C a t')+   => t' -> y' -> a -> t' -> SigP.T a t' a y' a+staticSine = static Wave.sine++{- | sine oscillator with modulated frequency -}+freqModSine :: (RealField.C a, Trans.C a, Module.C a a, Field.C t', OccScalar.C a t')+   => y' -> a -> SigP.T a t' a t' a -> SigP.T a t' a y' a+freqModSine = freqMod Wave.sine++{- | saw tooth oscillator with modulated frequency -}+staticSaw :: (RealField.C a, Field.C t', OccScalar.C a t')+   => t' -> y' -> a -> t' -> SigP.T a t' a y' a+staticSaw = static Wave.saw++{- | saw tooth oscillator with modulated frequency -}+freqModSaw :: (RealField.C a, Field.C t', Module.C a a, OccScalar.C a t')+   => y' -> a -> SigP.T a t' a t' a -> SigP.T a t' a y' a+freqModSaw = freqMod Wave.saw
+ src/Synthesizer/Physical/Play.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Synthesizer.Physical.Play where++import qualified Synthesizer.Plain.Play as Play+import qualified Synthesizer.Basic.Binary as BinSmp++import qualified Synthesizer.Physical.Signal as SigP++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.VectorSpace        as VectorSpace+import qualified Algebra.RealField          as RealField+import qualified Algebra.Field              as Field++import System.Exit(ExitCode)++-- import NumericPrelude+import PreludeBase++++toInt16 ::+   (RealField.C t, BinSmp.C yv,+    Field.C t', OccScalar.C t t',+    Field.C y', OccScalar.C y y',+    VectorSpace.C y yv) =>+   t' -> y' -> SigP.T t t' y y' yv -> IO ExitCode+toInt16 freqUnit amp sig =+   uncurry Play.toInt16 (SigP.pureData freqUnit amp sig)
+ src/Synthesizer/Physical/Signal.hs view
@@ -0,0 +1,337 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-|+Copyright   :  (c) Henning Thielemann 2006, 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++  This module equips a list of values+  with a sampling rate and an amplitude.+  Since sampling rate and amplitude need not to be of the same type+  and need not to be of the type of the values+  one can choose physical quantities for sampling rate and amplitude+  but low level types like Double and Float for the values.+  The only thing we need is the conversion to scalar types+  provided by the 'Algebra.OccasionallyScalar.C' type class.+  This conversion may fail in which case we encountered a unit error.+  We can also use this module with plain number types.+  Then toScalar cannot fail.++  The conversion to scalars is very general+  and might support applications I can currently not imagine.+-}++module Synthesizer.Physical.Signal where++import qualified Synthesizer.SampleRateContext.Signal as SigC+import qualified Synthesizer.SampleRateContext.Rate   as Rate++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.VectorSpace as VectorSpace+import qualified Algebra.Module      as Module+import qualified Algebra.Field       as Field+import qualified Algebra.Ring        as Ring++import Algebra.OccasionallyScalar(toScalar)+import Algebra.Module((*>))++import Data.Tuple.HT (mapSnd, )+import Synthesizer.Utility (common, )++import PreludeBase+import NumericPrelude++{-| t and y are plain number types,+    t' and y' may be physical quantities.+    yv may be a vector type.+    It should hold:+      @(OccScalar.C t t',+        OccScalar.C y y',+        Module.C y yv)@+    There are no values of type t and type y in T+    but they are essential to computation of intermediate results.+-}+data T t t' y y' yv =+   Cons {+        fullSampleRate :: Rate.T t t'+           {-^ how many values per unit are stored -}+      , content :: SigC.T y y' yv+           {-^ the signal with a unit-equipped volume -}+     }+   deriving (Eq, Show)++{- | Construct a signal. -}+cons ::+      t'    {- ^ sampling rate, must be positive (unchecked) -}+   -> y'    {- ^ amplitude, must be positive (unchecked) -}+   -> [yv]  {- ^ samples, values should be between -1 and 1 (unchecked) -}+   -> T t t' y y' yv+cons sr amp ss =+   Cons (Rate.fromNumber sr) (SigC.Cons amp ss)++sampleRate :: T t t' y y' yv -> t'+sampleRate = Rate.toNumber . fullSampleRate++amplitude :: T t t' y y' yv -> y'+amplitude = SigC.amplitude . content++samples :: T t t' y y' yv -> [yv]+samples = SigC.samples . content++{- |+Replace sample rate and amplitude+with different representations of their values.+This is needed for internal purposes,+especially for preserving the phantom types.+Do not use it for arbitrary changes of sample rate or amplitude!+-}+replaceParameters :: t1' -> y1' -> T t t0' y y0' yv -> T t t1' y y1' yv+replaceParameters sr amp (Cons _ (SigC.Cons _ ss))  =  cons sr amp ss++replaceSampleRate :: t1' -> T t t0' y y' yv -> T t t1' y y' yv+replaceSampleRate sr (Cons _ sig)  =  Cons (Rate.fromNumber sr) sig++replaceAmplitude :: y1' -> T t t' y y0' yv -> T t t' y y1' yv+replaceAmplitude amp (Cons sr sig)  =+   Cons sr (SigC.replaceAmplitude amp sig)++replaceSamples :: [yv1] -> T t t' y y' yv0 -> T t t' y y' yv1+replaceSamples ss (Cons sr sig)  =+   Cons sr (SigC.replaceSamples ss sig)+++{- |+Assert a condition before shipping the first sample.+-}+assert :: String -> Bool -> T t t' y y' yv -> T t t' y y' yv+assert msg cond x =+   replaceSamples (if cond then samples x else error msg) x++{- |+Assert that the amplitude of the signal matches the given one.+Otherwise give an error when the first sample is fetched.+-}+assertAmplitude :: Eq y' => y' -> T t t' y y' yv -> T t t' y y' yv+assertAmplitude amp x =+   replaceSamples+      (if amp == amplitude x+         then samples x+         else error "assertAmplitude: amplitudes differ") x++{- |+Assert that the sample rate of the signal matches the given one.+-}+assertSampleRate :: Eq t' => t' -> T t t' y y' yv -> T t t' y y' yv+assertSampleRate sr0 (Cons sr sig) =+   Cons sr $+   if sr0 == Rate.toNumber sr+     then sig+     else error "assertSampleRate: sample rates differ"++{- | Fix the type of a value to the scalar time type of a signal. -}+asTypeOfTime ::+      t     {- ^ time value, of with a type to be fixed -}+   -> T t t' y y' yv+            {- ^ signal, whose time type shall be matched -}+   -> t     {- ^ the time value, again -}+asTypeOfTime = const++{- | Fix the type of a value to the scalar amplitude type of a signal. -}+asTypeOfAmplitude :: y -> T t t' y y' yv -> y+asTypeOfAmplitude = const++{- | Express a time value as a multiple of the sampling period.+     The multiplicity is returned.+     It is a checked error,+     if the units of time value and sampling period mismatch. -}+toTimeScalar :: (Ring.C t', OccScalar.C t t') =>+   T t t' y y' yv -> t' -> t+toTimeScalar x t =+   toScalar (t * sampleRate x) `asTypeOfTime` x++{- | Express a frequency value as a multiple of the sampling frequency.+     The multiplicity is returned.+     In many applications the multiplicity is below 1.+     It is a checked error,+     if the units of frequency value and sampling frequency mismatch. -}+toFrequencyScalar :: (Field.C t', OccScalar.C t t') =>+   T t t' y y' yv -> t' -> t+toFrequencyScalar x f =+   toScalar (f / sampleRate x) `asTypeOfTime` x++{- | Express an amplitude value as a multiple of the signal amplitude.+     The multiplicity is returned.+     It is a checked error,+     if the units of amplitude value and signal amplitude mismatch. -}+toAmplitudeScalar :: (Field.C y', OccScalar.C y y') =>+   T t t' y y' yv -> y' -> y+toAmplitudeScalar x y =+   toScalar (y / amplitude x) `asTypeOfAmplitude` x++{-| If all signals share the same sampleRate, then return it,+    otherwise raise an error. -}+commonSampleRate :: (Eq t') =>+   T t t' y0 y'0 yv0 -> T t t' y1 y'1 yv1 -> t'+commonSampleRate x y =+   commonSampleRate' (sampleRate x) (sampleRate y)+   -- "The sample rates "++show sr0++" and "++show sr1++" differ."++commonSampleRate' :: (Eq a) => a -> a -> a+commonSampleRate' x y =+   common "The sample rates differ." x y++{- | Extract data for further processing that is not aware of physical units,+     such as playing and creating files. -}+pureData :: (Field.C t', OccScalar.C t t',+             Field.C y', OccScalar.C y y',+             VectorSpace.C y yv) =>+      t'  {- ^ The unit of the sampling frequency, say 'Number.SI.hertz' -}+   -> y'  {- ^ The maximum expected value.+               The data is normalized to this value,+               in order to preserve that all output samples+               are at most 1 in magnitude. -}+   -> T t t' y y' yv+          {- ^ The input signal. -}+   -> (t, [yv])+          {- ^ The sampling frequency without unit and+               the list of normalized samples.+               This information should suffice for playback+               or writing the signal to a file. -}+pureData freqUnit amp sig =+   (toTimeScalar sig (recip freqUnit),+    recip (toAmplitudeScalar sig amp) *> samples sig)+++instance Functor (T t t' y y') where+   fmap f (Cons sr sig) = Cons sr (fmap f sig)++++{- * Conversion from and to signals with sample rate context -}+++runPlain ::+   t' -> (Rate.T t t' -> SigC.T y y' yv) -> T t t' y y' yv+runPlain sr f =+   addPlainSampleRate sr (f (Rate.fromNumber sr))++addPlainSampleRate ::+   t' -> SigC.T y y' yv -> T t t' y y' yv+addPlainSampleRate sr = Cons (Rate.fromNumber sr)++run ::+   Rate.T t t' -> (Rate.T t t' -> SigC.T y y' yv) -> T t t' y y' yv+run sr f =+   addSampleRate sr (f sr)++addSampleRate ::+   Rate.T t t' -> SigC.T y y' yv -> T t t' y y' yv+addSampleRate = Cons++splitSampleRate ::+   T t t' y y' yv -> (Rate.T t t', SigC.T y y' yv)+splitSampleRate (Cons sr sig) = (sr, sig)++{- |+If the given sample rate matches the one of the signal,+then return the core signal, otherwise 'undefined'.+-}+checkSampleRate :: (Eq t') =>+   String ->+   Rate.T t t' ->+   T t t' y y' yv -> SigC.T y y' yv+checkSampleRate funcName sr0 (Cons sr sig) =+   if sr0 == sr+     then sig+     else error ("checkSampleRate for " ++ funcName ++ ": sample rates differ")++splitSampleRateList :: (Eq t') =>+   [T t t' y y' yv] -> (Rate.T t t', [SigC.T y y' yv])+splitSampleRateList [] = error "splitSampleRateList: empty list"+splitSampleRateList xt@(x:_) =+   let sr = fst (splitSampleRate x)+   in  (sr, map (checkSampleRate "splitSampleRateList" sr) xt)+++apply ::+   (Rate.T t t' -> SigC.T y0 y'0 y0v -> SigC.T y1 y'1 y1v)+    -> T t t' y0 y'0 y0v+    -> T t t' y1 y'1 y1v+apply f (Cons sr sig) =+   run sr (flip f sig)+++{-+commonSampleRate :: (Eq t') =>+   T t t' y0 y'0 yv0 -> T t t' y1 y'1 yv1 -> Rate.T t t'+commonSampleRate x0 x1 = Rate.fromNumber (SigP.commonSampleRate x0 x1)+-}+++lift0 ::+      (Rate.T t t' -> SigC.T y y' yv)+   -> t' -> T t t' y y' yv+lift0 = flip runPlain++lift1 ::+      (Rate.T t t' -> SigC.T y0 y0' yv0 -> SigC.T y1 y1' yv1)+   -> (T t t' y0 y0' yv0 -> T t t' y1 y1' yv1)+lift1 = apply++lift2 :: (Eq t') =>+      (Rate.T t t' -> SigC.T y0 y'0 yv0 -> SigC.T y1 y'1 yv1 -> SigC.T y2 y'2 yv2)+   -> (T t t' y0 y'0 yv0 -> T t t' y1 y'1 yv1 -> T t t' y2 y'2 yv2)+lift2 f x0 x1 =+   let (_, y0) = splitSampleRate x0+       (_, y1) = splitSampleRate x1+   in  runPlain (commonSampleRate x0 x1) (\sr -> f sr y0 y1)+{-+   let (sr0, y0) = splitSampleRate x0+       (sr1, y1) = splitSampleRate x1+       sr = SigP.commonSampleRate' sr0 sr1+   in  addSampleRate sr (f sr y0 y1)+-}++lift3 :: (Eq t') =>+      (Rate.T t t' -> SigC.T y0 y'0 yv0 -> SigC.T y1 y'1 yv1 -> SigC.T y2 y'2 yv2 -> SigC.T y3 y'3 yv3)+   -> (T t t' y0 y'0 yv0 -> T t t' y1 y'1 yv1 -> T t t' y2 y'2 yv2 -> T t t' y3 y'3 yv3)+lift3 f x0 x1 x2 =+   let (sr0, y0) = splitSampleRate x0+       (sr1, y1) = splitSampleRate x1+       (sr2, y2) = splitSampleRate x2+   in  run+          (sr0 `commonSampleRate'` sr1 `commonSampleRate'` sr2)+          (\sr -> f sr y0 y1 y2)+++liftList :: Eq t' =>+      (Rate.T t t' -> [SigC.T y1 y'1 yv1] -> SigC.T y y' yv)+   -> ([T t t' y1 y'1 yv1] -> T t t' y y' yv)+liftList f =+   uncurry run .+   mapSnd (flip f) .+   splitSampleRateList++++liftR2 ::+      (Rate.T t t' -> SigC.T y y' yv -> (SigC.T y0 y'0 yv0, SigC.T y1 y'1 yv1))+   -> T t t' y y' yv+   -> (T t t' y0 y'0 yv0, T t t' y1 y'1 yv1)+liftR2 f x0 =+   let (sr,x1) = splitSampleRate x0+       (y0,y1) = f sr x1+   in  (addSampleRate sr y0, addSampleRate sr y1)++liftR3 ::+      (Rate.T t t' -> SigC.T y y' yv -> (SigC.T y0 y'0 yv0, SigC.T y1 y'1 yv1, SigC.T y2 y'2 yv2))+   -> T t t' y y' yv+   -> (T t t' y0 y'0 yv0, T t t' y1 y'1 yv1, T t t' y2 y'2 yv2)+liftR3 f x0 =+   let (sr,x1) = splitSampleRate x0+       (y0,y1,y2) = f sr x1+   in  (addSampleRate sr y0, addSampleRate sr y1, addSampleRate sr y2)++
+ src/Synthesizer/SampleRateContext/Control.hs view
@@ -0,0 +1,202 @@+{- |+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.SampleRateContext.Control+   ({- * Primitives -}+    constant, constantVector, linear, line, exponential, exponential2,+    {- * Piecewise -}+    piecewise, piecewiseVolume, Control(..), ControlPiece(..),+    (-|#), ( #|-), (=|#), ( #|=), (|#), ( #|),  -- spaces before # for Haddock+    {- * Preparation -}+    mapLinear, mapExponential, )+   where++import Synthesizer.Plain.Control+   (Control(..), ControlPiece(..), (-|#), ( #|-), (=|#), ( #|=), (|#), ( #|))++import qualified Synthesizer.Amplitude.Control as CtrlV+import qualified Synthesizer.Plain.Control as Ctrl++import qualified Synthesizer.SampleRateContext.Signal as SigC+import qualified Synthesizer.SampleRateContext.Rate as Rate+import Synthesizer.SampleRateContext.Signal+          (toTimeScalar, toAmplitudeScalar, toGradientScalar)++import qualified Algebra.OccasionallyScalar as OccScalar+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 NumericPrelude+import PreludeBase as P+import Prelude ()+++constant :: (Field.C y', Real.C y', OccScalar.C y y') =>+      y' {-^ value -}+   -> Rate.T t t' -> SigC.T y y' y+constant y = Rate.pure $ CtrlV.constant y++{- |+The amplitude must be positive!+This is not checked.+-}+constantVector :: -- (Field.C y', Real.C y', OccScalar.C y y') =>+      y' {-^ amplitude -}+   -> yv {-^ value -}+   -> Rate.T t t' -> SigC.T y y' yv+constantVector y yv = Rate.pure $ CtrlV.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', OccScalar.C y y') =>+-}++{- |+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'.+-}+linear ::+   (Additive.C q, Field.C q',+    Real.C q', OccScalar.C q q') =>+      q' {-^ slope of the curve -}+   -> q' {-^ initial value -}+   -> Rate.T q q' -> SigC.T q q' q+linear slope y0 sr =+   let amp = abs y0+       steep = toGradientScalar amp sr slope+   in  SigC.Cons amp+          (Ctrl.linearMultiscale steep (OccScalar.toScalar (signum y0)))++{- |+Generates a finite ramp.+-}+line ::+   (RealField.C q, Field.C q',+    Real.C q', OccScalar.C q q') =>+      q'      {-^ duration of the ramp -}+   -> (q',q') {-^ initial and final value -}+   -> Rate.T q q' -> SigC.T q q' q+line dur' (y0',y1') sr =+   let amp = max (abs y0') (abs y1')+       dur = toTimeScalar sr dur'+       y0  = toAmplitudeScalar z y0'+       y1  = toAmplitudeScalar z y1'+       z = SigC.Cons amp+              (take (floor dur)+                 (Ctrl.linearMultiscale ((y1-y0)/dur) y0))+   in  z++exponential :: (Trans.C q, Ring.C q', Real.C q', OccScalar.C q q') =>+      q' {-^ time where the function reaches 1\/e of the initial value -}+   -> q' {-^ initial value -}+   -> Rate.T q q' -> SigC.T q q' q+exponential time y0 sr =+   SigC.Cons (abs y0)+      (Ctrl.exponentialMultiscale+         (toTimeScalar sr time) (OccScalar.toScalar (signum y0)))++{-+  take 1000 $ show (run (fixSampleRate 100 (exponential 0.1 1)) :: SigDouble)+-}++exponential2 :: (Trans.C q, Ring.C q', Real.C q', OccScalar.C q q') =>+      q' {-^ half life, time where the function reaches 1\/2 of the initial value -}+   -> q' {-^ initial value -}+   -> Rate.T q q' -> SigC.T q q' q+exponential2 time y0 sr =+   SigC.Cons (abs y0)+      (Ctrl.exponential2Multiscale+         (toTimeScalar sr time) (OccScalar.toScalar (signum y0)))++++{- |+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.+-}+piecewise :: (Trans.C q, RealField.C q,+              Real.C q', Field.C q', OccScalar.C q q') =>+      [ControlPiece q']+   -> Rate.T q q' -> SigC.T q q' q+piecewise cs =+   let amplitude = maximum+         (map (\c -> max (abs (Ctrl.pieceY0 c))+                         (abs (Ctrl.pieceY1 c))) cs)+   in  piecewiseVolume cs amplitude+++piecewiseVolume ::+   (Trans.C q, RealField.C q,+    Real.C q', Field.C q', OccScalar.C q q') =>+      [ControlPiece q']+   -> q'+   -> Rate.T q q' -> SigC.T q q' q+piecewiseVolume cs amplitude sr =+   let ps = map (\(Ctrl.ControlPiece typ y0 y1 d) ->+          Ctrl.ControlPiece+             {- We cannot provide an default case like "_ -> typ",+                because the returned constructors+                have different parameter type. -}+             (case typ of+                CtrlStep -> CtrlStep+                CtrlLin  -> CtrlLin+                -- this may exceed value range (-1,1)+                CtrlCubic d0 d1 ->+                   CtrlCubic+                      (toGradientScalar amplitude sr d0)+                      (toGradientScalar amplitude sr d1)+                CtrlExp sat ->+                   CtrlExp+                      (toAmplitudeScalar z sat)+                CtrlCos  -> CtrlCos)+             (toAmplitudeScalar z y0)+             (toAmplitudeScalar z y1)+             (toTimeScalar sr d)) cs+       z = SigC.Cons amplitude (Ctrl.piecewise ps)+   in  z++++{- |+Map a control curve without amplitude unit+by a linear (affine) function with a unit.+-}+mapLinear :: (Ring.C y, Field.C y', Real.C y', OccScalar.C y y') =>+      y'  {- ^ range: one is mapped to @center+range@ -}+   -> y'  {- ^ center: zero is mapped to @center@ -}+   -> Rate.T t t'+   -> SigC.T y y' y+   -> SigC.T y y' y+mapLinear range center =+   Rate.pure $ CtrlV.mapLinear range center++{- |+Map a control curve without amplitude unit+exponentially to one with a unit.+-}+mapExponential :: (Field.C y', Trans.C y, Module.C y y') =>+      y   {- ^ range: one is mapped to @center*range@, must be positive -}+   -> y'  {- ^ center: zero is mapped to @center@ -}+   -> Rate.T t t'+   -> SigC.T y y  y+   -> SigC.T y y' y+mapExponential range center =+   Rate.pure $ CtrlV.mapExponential range center
+ src/Synthesizer/SampleRateContext/Cut.hs view
@@ -0,0 +1,214 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.SampleRateContext.Cut (+   {- * dissection -}+   splitAt,+   take,+   drop,+   takeUntilPause,+   unzip,+   unzip3,++   {- * glueing -}+   concat,   concatVolume,+   append,   appendVolume,+   zip,      zipVolume,+   zip3,     zip3Volume,+   arrange,  arrangeVolume,+  ) where++import qualified Synthesizer.Amplitude.Cut as CutV+import qualified Synthesizer.Plain.Cut as CutS++import qualified Synthesizer.SampleRateContext.Signal as SigC+import qualified Synthesizer.SampleRateContext.Rate as Rate+-- import Synthesizer.SampleRateContext.Rate (($#))+import Synthesizer.SampleRateContext.Signal+   (toTimeScalar, toAmplitudeScalar)++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.OccasionallyScalar  as OccScalar+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, fst, snd)+-- import NumericPrelude+import Prelude (RealFrac)+++{- * dissection -}++splitAt :: (RealField.C t, Ring.C t', OccScalar.C t t') =>+   t' -> Rate.T t t' -> SigC.T y y' yv -> (SigC.T y y' yv, SigC.T y y' yv)+splitAt t' sr x =+   let (ss0,ss1) = List.splitAt (RealField.round (toTimeScalar sr t')) (SigC.samples x)+   in  (SigC.replaceSamples ss0 x,+        SigC.replaceSamples ss1 x)++take :: (RealField.C t, Ring.C t', OccScalar.C t t') =>+   t' -> Rate.T t t' -> SigC.T y y' yv -> SigC.T y y' yv+take t sr = fst . splitAt t sr++drop :: (RealField.C t, Ring.C t', OccScalar.C t t') =>+   t' -> Rate.T t t' -> SigC.T y y' yv -> SigC.T y y' yv+drop t sr = snd . splitAt t sr++takeUntilPause ::+  (RealField.C t, Ring.C t', OccScalar.C t t',+   Field.C y', NormedMax.C y yv, OccScalar.C y y') =>+   y' -> t' -> Rate.T t t' -> SigC.T y y' yv -> SigC.T y y' yv+takeUntilPause y' t' sr x =+   let t = toTimeScalar      sr t'+       y = toAmplitudeScalar x  y'+   in  SigC.replaceSamples+         (CutS.takeUntilInterval ((<=y) . NormedMax.norm)+             (RealField.ceiling t) (SigC.samples x)) x+++unzip ::+   Rate.T t t' ->+   SigC.T y y' (yv0, yv1) ->+   (SigC.T y y' yv0, SigC.T y y' yv1)+unzip = Rate.pure CutV.unzip++unzip3 ::+   Rate.T t t' ->+   SigC.T y y' (yv0, yv1, yv2) ->+   (SigC.T y y' yv0, SigC.T y y' yv1, SigC.T y y' yv2)+unzip3 = Rate.pure CutV.unzip3++++{- * 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.+-}+concat ::+   (Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv) =>+   Rate.T t t' -> [SigC.T y y' yv] -> SigC.T y y' yv+concat = Rate.pure $ CutV.concat++{- |+Give the output volume explicitly.+Does also work for infinite lists.+-}+concatVolume ::+   (Field.C y', OccScalar.C y y',+    Module.C y yv) =>+   y' -> Rate.T t t' -> [SigC.T y y' yv] -> SigC.T y y' yv+concatVolume amp = Rate.pure $ CutV.concatVolume amp+++append ::+   (Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv) =>+   Rate.T t t' -> SigC.T y y' yv -> SigC.T y y' yv -> SigC.T y y' yv+append = Rate.pure $ CutV.append++appendVolume ::+   (Field.C y', OccScalar.C y y',+    Module.C y yv) =>+   y' ->+   Rate.T t t' -> SigC.T y y' yv -> SigC.T y y' yv -> SigC.T y y' yv+appendVolume amp = Rate.pure $ CutV.appendVolume amp+++zip ::+   (Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv0, Module.C y yv1) =>+   Rate.T t t' -> SigC.T y y' yv0 -> SigC.T y y' yv1 -> SigC.T y y' (yv0,yv1)+zip = Rate.pure $ CutV.zip++zipVolume ::+   (Field.C y', OccScalar.C y y',+    Module.C y yv0, Module.C y yv1) =>+   y' ->+   Rate.T t t' -> SigC.T y y' yv0 -> SigC.T y y' yv1 -> SigC.T y y' (yv0,yv1)+zipVolume amp = Rate.pure $ CutV.zipVolume amp++++zip3 ::+   (Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv0, Module.C y yv1, Module.C y yv2) =>+   Rate.T t t' -> SigC.T y y' yv0 -> SigC.T y y' yv1 -> SigC.T y y' yv2 ->+                 SigC.T y y' (yv0,yv1,yv2)+zip3 = Rate.pure $ CutV.zip3++zip3Volume ::+   (Field.C y', OccScalar.C y y',+    Module.C y yv0, Module.C y yv1, Module.C y yv2) =>+   y' ->+   Rate.T t t' -> SigC.T y y' yv0 -> SigC.T y y' yv1 -> SigC.T y y' yv2 ->+                 SigC.T y y' (yv0,yv1,yv2)+zip3Volume amp = Rate.pure $ CutV.zip3Volume amp+++{- |+Uses maximum input volume as output volume.+-}+arrange ::+   (Ring.C t', OccScalar.C t t',+    RealFrac t, NonNeg.C t,+    Ord y', Field.C y', OccScalar.C y y',+    Module.C y yv) =>+      t'  {-^ Unit of the time values in the time ordered list. -}+   -> Rate.T t t'+   -> EventList.T t (SigC.T y y' yv)+            {- ^ A list of pairs: (relative start time, signal part),+                 The start time is relative+                 to the start time of the previous event. -}+   -> SigC.T y y' yv+             {- ^ The mixed signal. -}+arrange unit' sr sched =+   let amp = List.maximum (map SigC.amplitude (EventList.getBodies sched))+   in  arrangeVolume amp unit' sr 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.+-}+arrangeVolume ::+   (Ring.C t', OccScalar.C t t',+    RealFrac t, NonNeg.C t,+    Field.C y', OccScalar.C y y',+    Module.C y yv) =>+      y'  {-^ Output volume. -}+   -> t'  {-^ Unit of the time values in the time ordered list. -}+   -> Rate.T t t'+   -> EventList.T t (SigC.T y y' yv)+            {- ^ A list of pairs: (relative start time, signal part),+                 The start time is relative+                 to the start time of the previous event. -}+   -> SigC.T y y' yv+            {- ^ The mixed signal. -}+arrangeVolume amp unit' sr sched' =+   let unit = toTimeScalar sr unit'+       sched =+          EventList.mapBody (SigC.vectorSamples (toAmplitudeScalar z)) sched'+       z = SigC.Cons amp+              (CutS.arrange (EventList.resample unit sched))+   in  z
+ src/Synthesizer/SampleRateContext/Displacement.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+-}+module Synthesizer.SampleRateContext.Displacement (+   mix, mixVolume,+   mixMulti, mixMultiVolume,+   raise,+   ) where++import qualified Synthesizer.Amplitude.Displacement as MiscV++import qualified Synthesizer.SampleRateContext.Signal as SigC+import qualified Synthesizer.SampleRateContext.Rate as Rate++-- import Synthesizer.SampleRateContext.Signal (toAmplitudeScalar)++-- import qualified Synthesizer++import qualified Algebra.OccasionallyScalar as OccScalar+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 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. -}+mix :: (Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>+      Rate.T t t'+   -> SigC.T y y' yv+   -> SigC.T y y' yv+   -> SigC.T y y' yv+mix = Rate.pure MiscV.mix++mixVolume ::+   (Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>+      y'+   -> Rate.T t t'+   -> SigC.T y y' yv+   -> SigC.T y y' yv+   -> SigC.T y y' yv+mixVolume v = Rate.pure $ MiscV.mixVolume v++{-| Mix one or more signals. -}+mixMulti ::+   (Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>+      Rate.T t t'+   -> [SigC.T y y' yv]+   ->  SigC.T y y' yv+mixMulti = Rate.pure MiscV.mixMulti++mixMultiVolume ::+   (Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>+      y'+   -> Rate.T t t'+   -> [SigC.T y y' yv]+   ->  SigC.T y y' yv+mixMultiVolume v = Rate.pure $ MiscV.mixMultiVolume v++{-| Add a number to all of the signal values.+    This is useful for adjusting the center of a modulation. -}+raise :: (Field.C y', Module.C y yv, OccScalar.C y y') =>+      y'+   -> yv+   -> Rate.T t t'+   -> SigC.T y y' yv+   -> SigC.T y y' yv+raise y' yv = Rate.pure $ MiscV.raise y' yv
+ src/Synthesizer/SampleRateContext/Filter.hs view
@@ -0,0 +1,345 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.SampleRateContext.Filter (+   {- * Non-recursive -}++   {- ** Amplification -}+   amplify,+   negate,+   envelope,+   {- ** Filter operators from calculus -}+   differentiate,++{-+   {- ** Smooth -}+   mean,++   {- ** Delay -}+   delay,+   phaseModulation,+   phaser,+   phaserStereo,+++   {- * Recursive -}++   {- ** Without resonance -}+   firstOrderLowpass,+   firstOrderHighpass,+   butterworthLowpass,+   butterworthHighpass,+   chebyshevALowpass,+   chebyshevAHighpass,+   chebyshevBLowpass,+   chebyshevBHighpass,+   {- ** With resonance -}+   universal,+   moogLowpass,+   {- ** Allpass -}+   allpassCascade,+-}+   {- ** Reverb -}+   comb,++   {- ** Filter operators from calculus -}+   integrate,+) where+++import qualified Synthesizer.Amplitude.Filter as FiltV+import qualified Synthesizer.SampleRateContext.Signal as SigC+import qualified Synthesizer.SampleRateContext.Rate as Rate++import Synthesizer.SampleRateContext.Signal+   (toTimeScalar, {- toFrequencyScalar, -} )++-- import qualified Synthesizer.Plain.Displacement as Syn+-- import qualified Synthesizer.Plain.Filter.Recursive    as FiltR+import qualified Synthesizer.Plain.Filter.Recursive.Comb        as Comb+import qualified Synthesizer.Plain.Filter.Recursive.Integration as Integrate+import qualified Synthesizer.Plain.Filter.NonRecursive as FiltNR+{-+import qualified Synthesizer.Plain.Interpolation as Interpolation+import qualified Synthesizer.Plain.Filter.Delay.Block as Delay++import Data.Ord.HT (limit, )+-}++import qualified Algebra.OccasionallyScalar as OccScalar+-- 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.Module         as Module+-- import qualified Algebra.VectorSpace    as VectorSpace++-- import Control.Monad(liftM2)++import NumericPrelude hiding (negate)+import PreludeBase as P+import Prelude ()+++{- | The amplification factor must be positive. -}+amplify :: (Ring.C y') =>+      y'+   -> Rate.T t t'+   -> SigC.T y y' yv+   -> SigC.T y y' yv+amplify volume = Rate.pure $ FiltV.amplify volume++negate :: (Additive.C yv) =>+      Rate.T t t'+   -> SigC.T y y' yv+   -> SigC.T y y' yv+negate = Rate.pure FiltV.negate++envelope :: (Module.C y0 yv, Ring.C y') =>+      Rate.T t t'+   -> SigC.T y y' y0  {-  the envelope -}+   -> SigC.T y y' yv  {-  the signal to be enveloped -}+   -> SigC.T y y' yv+envelope = Rate.pure FiltV.envelope++++differentiate :: (Additive.C v, Ring.C q') =>+      Rate.T t q'+   -> SigC.T y q' v+   -> SigC.T y q' v+differentiate sr x =+   SigC.Cons+      (SigC.amplitude x * Rate.toNumber sr)+      (FiltNR.differentiate (SigC.samples x))+++{-+{- | needs a good handling of boundaries, yet -}+mean :: (Additive.C yv, Field.C y', RealField.C a,+         Module.C a v, OccScalar.C a q) =>+      q            {- ^ time length of the window -}+   -> SigC.T y y' yv+   -> Rate.T t t' -> (SigC.T y y' yv)+mean time x =+   do t <- toTimeScalar x (Expr.constant time)+      let tInt  = round ((t-1)/2)+      let width = tInt*2+1+      returnModified []+         ((SigP.asTypeOfAmplitude (recip (fromIntegral width)) x *> ) .+          Filt.sums width . FiltNR.delay tInt) x+++delay :: (Additive.C yv, Field.C y', RealField.C a, OccScalar.C a q) =>+      q+   -> SigC.T y y' yv+   -> Rate.T t t' -> (SigC.T y y' yv)+delay time x =+   do t <- toTimeScalar x (Expr.constant time)+      returnModified [] (FiltNR.delay (round t)) x+++phaseModulation ::+         (Additive.C yv, Field.C y', RealField.C a, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ minDelay, minimal delay, may be negative -}+   -> q   {- ^ maxDelay, maximal delay, it must be @minDelay <= maxDelay@+               and the modulation must always be+               in the range [minDelay,maxDelay]. -}+   -> SigI.T a q a+          {- ^ delay control, positive numbers mean delay,+               negative numbers mean prefetch -}+   -> SigC.T y y' yv+   -> Rate.T t t' -> (SigC.T y y' yv)+phaseModulation ip minDelay maxDelay delays x =+   do t0 <- toTimeScalar x (Expr.constant minDelay)+      t1 <- toTimeScalar x (Expr.constant maxDelay)+      let tInt0 = floor   t0+      let tInt1 = ceiling t1+      let tInt0Neg = Additive.negate tInt0+      ds <- SigI.scalarSamples (toTimeScalar delays) delays+      returnModified [SigP.sampleRate delays]+         (FiltNR.delay tInt0 .+             Delay.modulated ip (tInt1-tInt0+1)+               (FiltNR.delay tInt0Neg+                  (Syn.raise (fromIntegral tInt0Neg)+                     (map (clip t0 t1) ds)))) x+++{- | symmetric phaser -}+phaser :: (Additive.C yv, Field.C y', RealField.C a,+           Module.C a v, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ maxDelay, must be positive -}+   -> SigI.T a q a+          {- ^ delay control -}+   -> SigC.T y y' yv+   -> Rate.T t t' -> (SigC.T y y' yv)+phaser ip maxDelay delays x =+   amplify (asTypeOf 0.5 maxDelay) =<<+      uncurry SynI.mix =<< phaserCore ip maxDelay delays x++phaserStereo :: (Additive.C yv, Field.C y', Real.C q, RealField.C a,+                 Module.C a v, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ maxDelay, must be positive -}+   -> SigI.T a q a+          {- ^ delay control -}+   -> SigC.T y y' yv+   -> SigI.Process a q (v,v)+phaserStereo ip maxDelay delays x =+   uncurry CutI.zip =<< phaserCore ip maxDelay delays x++phaserCore :: (Additive.C yv, Field.C y', RealField.C a,+               Module.C a v, OccScalar.C a q) =>+      Interpolation.T a v+   -> q   {- ^ maxDelay, must be positive -}+   -> SigI.T a q a+          {- ^ delay control -}+   -> SigC.T y y' yv+   -> Process.T q (SigC.T y y' yv, SigC.T y y' yv)+phaserCore ip maxDelay delays x =+   do let minDelay = Additive.negate maxDelay+      negDelays <- Inference.Signal.Filter.negate delays+      liftM2 (,)+         (phaseModulation ip minDelay maxDelay delays x)+         (phaseModulation ip minDelay maxDelay negDelays x)++++firstOrderLowpass, firstOrderHighpass ::+   (Trans.C a, Trans.C q, Module.C a v, OccScalar.C a q) =>+      SigI.T a q a {- ^ Control signal for the cut-off frequency. -}+   -> SigC.T y y' yv {- ^ Input signal -}+   -> Rate.T t t' -> (SigC.T y y' yv)+firstOrderLowpass  = firstOrderGen Filt1.lowpass+firstOrderHighpass = firstOrderGen Filt1.highpass++firstOrderGen :: (Trans.C a, Trans.C q, Module.C a v, OccScalar.C a q) =>+      ([a] -> [v] -> [v])+   -> SigI.T a q a+   -> SigC.T y y' yv+   -> Rate.T t t' -> (SigC.T y y' yv)+firstOrderGen filt freq x =+   do freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      returnModified [SigP.sampleRate freq]+         (filt (map Filt1.parameter freqs)) x+++butterworthLowpass, butterworthHighpass,+   chebyshevALowpass, chebyshevAHighpass,+   chebyshevBLowpass, chebyshevBHighpass ::+      (Field.C y', Trans.C a, VectorSpace.C a v, OccScalar.C a q) =>+      Int          {- ^ Order of the filter, must be even,+                        the higher the order, the sharper is the separation of frequencies. -}+   -> a            {- ^ The attenuation at the cut-off frequency.+                        Should be between 0 and 1. -}+   -> SigI.T a q a {- ^ Control signal for the cut-off frequency. -}+   -> SigC.T y y' yv {- ^ Input signal -}+   -> Rate.T t t' -> (SigC.T y y' yv)++butterworthLowpass  = higherOrderNoResoGen Butter.lowpass+butterworthHighpass = higherOrderNoResoGen FiltR.butterworthHighpass+chebyshevALowpass   = higherOrderNoResoGen FiltR.chebyshevALowpass+chebyshevAHighpass  = higherOrderNoResoGen FiltR.chebyshevAHighpass+chebyshevBLowpass   = higherOrderNoResoGen FiltR.chebyshevBLowpass+chebyshevBHighpass  = higherOrderNoResoGen FiltR.chebyshevBHighpass++higherOrderNoResoGen ::+   (Field.C y', Ring.C a, OccScalar.C a q) =>+      (Int -> a -> [a] -> [v] -> [v])+   -> Int+   -> a+   -> SigI.T a q a+   -> SigC.T y y' yv+   -> Rate.T t t' -> (SigC.T y y' yv)+higherOrderNoResoGen filt order ratio freq x =+   do freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      returnModified [SigP.sampleRate freq]+         (filt order ratio freqs) x++++universal :: (Trans.C a, Module.C a v, Field.C y', OccScalar.C a q) =>+      SigI.T a q a {- ^ signal for resonance,+                        i.e. factor of amplification at the resonance frequency+                        relatively to the transition band. -}+   -> SigI.T a q a {- ^ signal for cut off and band center frequency -}+   -> SigC.T y y' yv {- ^ input signal -}+   -> SigI.Process a q (v,v,v) {- ^ highpass, bandpass, lowpass filter -}+universal reso freq x =+   do resos <- SigI.scalarSamples (Process.exprToScalar) reso+      freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      let params =+             map FiltR.uniFilterParam+                 (zipWith FiltR.Pole resos freqs)+      returnModified [SigP.sampleRate reso, SigP.sampleRate freq]+         (FiltR.uniFilter params) x++moogLowpass :: (Trans.C a, Module.C a v, Field.C y', OccScalar.C a q) =>+      Int+   -> SigI.T a q a {- ^ signal for resonance,+                        i.e. factor of amplification at the resonance frequency+                        relatively to the transition band. -}+   -> SigI.T a q a {- ^ signal for cut off and band center frequency -}+   -> SigC.T y y' yv+   -> Rate.T t t' -> (SigC.T y y' yv)+moogLowpass order reso freq x =+   do resos <- SigI.scalarSamples (Process.exprToScalar) reso+      freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      let params =+             map (Moog.parameter order)+                 (zipWith FiltR.Pole resos freqs)+      returnModified [SigP.sampleRate reso, SigP.sampleRate freq]+         (Moog.lowpass order params) x++allpassCascade :: (Trans.C a, Module.C a v, Field.C y', OccScalar.C a q) =>+      Int          {- ^ order, number of filters in the cascade -}+   -> a            {- ^ the phase shift to be achieved for the given frequency -}+   -> SigI.T a q a {- ^ lowest comb frequency -}+   -> SigC.T y y' yv+   -> Rate.T t t' -> (SigC.T y y' yv)+allpassCascade order phase freq x =+   do freqs <- SigI.scalarSamples (toFrequencyScalar x) freq+      let params = map (FiltR.allpassCascadeParam order phase) freqs+      returnModified [SigP.sampleRate freq]+         (FiltR.allpassCascade order params) x+-}++++{- | Infinitely many equi-delayed exponentially decaying echos. -}+comb :: (RealField.C t, Ring.C t', OccScalar.C t t', Module.C y yv) =>+   t' -> y -> Rate.T t t' -> SigC.T y y' yv -> SigC.T y y' yv+comb time gain sr x =+   SigC.Cons (SigC.amplitude x)+      (Comb.run (round (toTimeScalar sr time)) gain (SigC.samples x))+++integrate :: (Additive.C v, Field.C q') =>+      Rate.T t q'+   -> SigC.T y q' v+   -> SigC.T y q' v+integrate sr x =+   SigC.Cons+      (SigC.amplitude x / Rate.toNumber sr)+      (Integrate.run (SigC.samples x))+++{-+returnModified :: (Eq q) =>+   [Process.Value q] -> ([v] -> [w]) -> SigC.T y y' yv -> SigI.Process a q w+returnModified sampleRates proc x =+   do let sampleRate = SigP.sampleRate x+      mapM_ (Process.equalValue sampleRate) sampleRates+      SigI.returnCons+         sampleRate (SigP.amplitude x)+         (proc (SigP.samples x))+-}
+ src/Synthesizer/SampleRateContext/Noise.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++-}+module Synthesizer.SampleRateContext.Noise+  (white,    whiteBandEnergy,    randomPeeks,+   whiteGen, whiteBandEnergyGen, randomPeeksGen,+   ) where+++import qualified Synthesizer.Plain.Noise as Noise++import qualified Synthesizer.SampleRateContext.Signal as SigC+import qualified Synthesizer.SampleRateContext.Rate as Rate++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.Algebraic          as Algebraic+import qualified Algebra.Field              as Field+import qualified Algebra.Ring               as Ring++import System.Random (Random, RandomGen, randomRs, mkStdGen)++import NumericPrelude+import PreludeBase as P++++{- |+Uniformly distributed white noise.+The volume is given by two values:+The width of a frequency band and the volume caused by it.+The width of a frequency band must be given+in order to achieve independence from sample rate.++See 'whiteBandEnergy'.+-}+white :: (Ring.C yv, Random yv, Algebraic.C q') =>+      q'  {-^ width of the frequency band -}+   -> q'  {-^ volume caused by the given frequency band -}+   -> Rate.T t q' -> SigC.T y q' yv+          {-^ noise -}+white = whiteGen (mkStdGen 6746)++whiteGen :: (Ring.C yv, Random yv, RandomGen g, Algebraic.C q') =>+      g   {-^ random generator, can be used to choose a seed -}+   -> q'  {-^ width of the frequency band -}+   -> q'  {-^ volume caused by the given frequency band -}+   -> Rate.T t q' -> SigC.T y q' yv+         {-^ noise -}+whiteGen gen bandWidth volume sr =+   SigC.Cons+      (sqrt (3 * bandWidth / Rate.toNumber sr) * volume)+      (Noise.whiteGen gen)+++{-|+Uniformly distributed white noise.+Instead of an amplitude you must specify a value+that is like an energy per frequency band.+It makes no sense to specify an amplitude+because if you keep the same signal amplitude+while increasing the sample rate by a factor of four+the amplitude of the frequency spectrum halves.+Thus deep frequencies would be damped+when higher frequencies enter.++Example:+If your signal is a function from time to voltage,+the amplitude must have the unit @volt^2*second@,+which can be also viewed as @volt^2\/hertz@.++Note that the energy is proportional to the square of the signal amplitude.+In order to double the noise amplitude,+you must increase the energy by a factor of four.++Using this notion of amplitude+the behaviour amongst several frequency filters+is quite consistent but a problem remains:+When the noise is quantised+then noise at low sample rates and noise at high sample rates+behave considerably different.+This indicates that quantisation should not just pick values,+but it should average over the hold periods.+-}+whiteBandEnergy :: (Ring.C yv, Random yv, Algebraic.C q') =>+      q'  {-^ energy per frequency band -}+   -> Rate.T t q' -> SigC.T y q' yv+          {-^ noise -}+whiteBandEnergy = whiteBandEnergyGen (mkStdGen 6746)++whiteBandEnergyGen :: (Ring.C yv, Random yv, RandomGen g, Algebraic.C q') =>+      g   {-^ random generator, can be used to choose a seed -}+   -> q'  {-^ energy per frequency band -}+   -> Rate.T t q' -> SigC.T y q' yv+         {-^ noise -}+whiteBandEnergyGen gen energy sr =+   SigC.Cons (sqrt (3 * Rate.toNumber sr * energy)) (Noise.whiteGen gen)+++{-+The Field.C q constraint could be lifted to Ring.C+if we would use direct division instead of toFrequencyScalar.+-}+randomPeeks ::+   (Field.C q, Random q, Ord q,+    Field.C q', OccScalar.C q q') =>+       Rate.T q q'+    -> SigC.T q q' q  {- ^ momentary densities (frequency),+                           @p@ means that there is about one peak+                           in the time range of @1\/p@. -}+    -> [Bool]+                      {- ^ Every occurence of 'True' represents a peak. -}+randomPeeks =+   randomPeeksGen (mkStdGen 876)++randomPeeksGen ::+   (Field.C q, Random q, Ord q,+    Field.C q', OccScalar.C q q',+    RandomGen g) =>+       g  {-^ random generator, can be used to choose a seed -}+    -> Rate.T q q'+    -> SigC.T q q' q  {- ^ momentary densities (frequency),+                           @p@ means that there is about one peak+                           in the time range of @1\/p@. -}+    -> [Bool]+                      {- ^ Every occurence of 'True' represents a peak. -}+randomPeeksGen g sr dens =+   let amp = SigC.toFrequencyScalar sr (SigC.amplitude dens)+   in  zipWith (<)+          (randomRs (0, recip amp) g)+          (SigC.samples dens)
+ src/Synthesizer/SampleRateContext/Oscillator.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++-}+module Synthesizer.SampleRateContext.Oscillator (+   {- * Oscillators with constant waveforms -}+   static,+   freqMod,+   phaseMod,+   phaseFreqMod,+) where++import qualified Synthesizer.Plain.Oscillator as Osci+import qualified Synthesizer.Basic.Wave       as Wave+-- import qualified Synthesizer.Basic.Phase      as Phase++import qualified Synthesizer.SampleRateContext.Signal as SigC+import qualified Synthesizer.SampleRateContext.Rate   as Rate+import Synthesizer.SampleRateContext.Signal (toFrequencyScalar)++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.RealField          as RealField+import qualified Algebra.Field              as Field++-- import NumericPrelude+import PreludeBase as P+++{- * Oscillators with constant waveforms -}++{- | oscillator with a functional waveform with constant frequency -}+static :: (RealField.C t, Field.C t', OccScalar.C t t') =>+      Wave.T t yv  {- ^ waveform -}+   -> y'           {- ^ amplitude -}+   -> t            {- ^ start phase from the range [0,1] -}+   -> t'           {- ^ frequency -}+   -> Rate.T t t'+   -> SigC.T y y' yv+static wave amplitude phase freq' sr =+   let freq = toFrequencyScalar sr freq'+   in  SigC.Cons amplitude (Osci.static wave phase freq)++{- | oscillator with a functional waveform with modulated frequency -}+freqMod :: (RealField.C t, Field.C t', OccScalar.C t t') =>+      Wave.T t yv  {- ^ waveform -}+   -> y'           {- ^ amplitude -}+   -> t            {- ^ start phase from the range [0,1] -}+   -> Rate.T t t'+   -> SigC.T t t' t  {- ^ frequency control -}+   -> SigC.T y y' yv+freqMod wave amplitude phase sr xs =+   let freqs = SigC.scalarSamples (toFrequencyScalar sr) xs+   in  SigC.Cons amplitude+          (Osci.freqMod wave phase freqs)++{- | oscillator with modulated phase -}+phaseMod :: (RealField.C t, Field.C t', OccScalar.C t t') =>+      Wave.T t yv  {- ^ waveform -}+   -> y'           {- ^ amplitude -}+   -> t'           {- ^ frequency control -}+   -> Rate.T t t'+   -> SigC.T t t  t  {- ^ phase modulation, phases must have no unit and+                          are from range [0,1] -}+   -> SigC.T y y' yv+phaseMod wave amplitude freq' sr xs =+   let freq = toFrequencyScalar sr freq'+       phases = SigC.scalarSamples id xs+   in  SigC.Cons amplitude+          (Osci.phaseMod wave freq phases)++{- | oscillator with a functional waveform with modulated phase and frequency -}+phaseFreqMod :: (RealField.C t, Field.C t', OccScalar.C t t') =>+      Wave.T t yv  {- ^ waveform -}+   -> y'           {- ^ amplitude -}+   -> Rate.T t t'+   -> SigC.T t t  t  {- ^ phase control -}+   -> SigC.T t t' t  {- ^ frequency control -}+   -> SigC.T y y' yv+phaseFreqMod wave amplitude sr xs ys =+   let phases = SigC.scalarSamples id xs+       freqs  = SigC.scalarSamples (toFrequencyScalar sr) ys+   in  SigC.Cons amplitude+          (Osci.phaseFreqMod wave phases freqs)
+ src/Synthesizer/SampleRateContext/Play.hs view
@@ -0,0 +1,25 @@+module Synthesizer.SampleRateContext.Play where++import qualified Synthesizer.Basic.Binary as BinSmp++import qualified Synthesizer.SampleRateContext.Signal as SigC+import qualified Synthesizer.SampleRateContext.Rate   as Rate+import qualified Synthesizer.Physical.Signal         as SigP+import qualified Synthesizer.Physical.Play           as PlayP++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.VectorSpace        as VectorSpace+import qualified Algebra.RealField          as RealField+import qualified Algebra.Field              as Field++import System.Exit(ExitCode)+++toInt16 ::+   (RealField.C t, BinSmp.C yv,+    Field.C t', OccScalar.C t t',+    Field.C y', OccScalar.C y y',+    VectorSpace.C y yv) =>+   t' -> y' -> t' -> (Rate.T t t' -> SigC.T y y' yv) -> IO ExitCode+toInt16 freqUnit amp sampleRate proc =+   PlayP.toInt16 freqUnit amp (SigP.runPlain sampleRate proc)
+ src/Synthesizer/SampleRateContext/Rate.hs view
@@ -0,0 +1,68 @@+{- |++Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes (OccasionallyScalar)++++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 handled 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.+-}+module Synthesizer.SampleRateContext.Rate (+      T(..),+      fromNumber, toNumber,+      loop, pure,+      ($:), ($::), ($^), ($#),+      (.:), (.^),+      liftP, liftP2, liftP3, liftP4,+   ) where++import Synthesizer.ApplicativeUtility++{-+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 t t' = Cons {decons :: t'}+   deriving (Eq, Ord, Show)+++fromNumber :: t' -> T t t'+fromNumber = Cons++toNumber :: T t t' -> t'+toNumber = decons+++pure :: a -> T t t' -> a+pure = const+++{-+{- |+The first argument will be a function like 'Synthesizer.SampleRateContext.Signal.toTimeScalar'.+If you use this function instead of 'Synthesizer.SampleRateContext.Signal.toTimeScalar' directly,+the type @t@ can be automatically infered.+-}+convertTimeParam :: (t' -> t' -> t) -> t' -> (t -> a) -> T t t' -> a+convertTimeParam convert t' f = Cons $ \sr ->+   f (convert sr t')+-}
+ src/Synthesizer/SampleRateContext/Signal.hs view
@@ -0,0 +1,72 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes (OccasionallyScalar)++For a description see "Synthesizer.SampleRateContext.Rate".+-}+module Synthesizer.SampleRateContext.Signal (+   T(..),+   toTimeScalar,+   toFrequencyScalar,+   toAmplitudeScalar,+   toGradientScalar,+   scalarSamples,+   vectorSamples,+   replaceAmplitude,+   replaceSamples,+   ($-),+   ) where++import Synthesizer.SampleRateContext.Rate (($:))+import qualified Synthesizer.SampleRateContext.Rate as Rate++import Synthesizer.Amplitude.Signal+import qualified Synthesizer.Amplitude.Control as CtrlV++import qualified Algebra.OccasionallyScalar as OccScalar+-- 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 Algebra.OccasionallyScalar (toScalar)++import NumericPrelude+-- import PreludeBase as P+import Prelude ()+++{-+returnCons ::+   y' -> [yv] -> Rate t t' (T y y' yv)+returnCons amp sig = Proc.pure (Cons amp sig)+-}+++toTimeScalar :: (Ring.C t', OccScalar.C t t') =>+   Rate.T t t' -> t' -> t+toTimeScalar sampleRate t =+   toScalar (t * Rate.toNumber sampleRate)++toFrequencyScalar :: (Field.C t', OccScalar.C t t') =>+   Rate.T t t' -> t' -> t+toFrequencyScalar sampleRate f =+   toScalar (f / Rate.toNumber sampleRate)++toGradientScalar :: (Field.C q', OccScalar.C q q') =>+   q' -> Rate.T q q' -> q' -> q+toGradientScalar amp sampleRate steepness =+   toFrequencyScalar sampleRate (steepness / amp)+++{- |+Take a scalar argument where a process expects a signal.+Only possible for non-negative values so far.+-}+($-) :: (Field.C y', Real.C y', OccScalar.C y y') =>+    (Rate.T t t' -> T y y' y -> a) -> y' -> (Rate.T t t' -> a)+($-) f x = f $: Rate.pure (CtrlV.constant x)
+ synthesizer-inference.cabal view
@@ -0,0 +1,141 @@+Name:           synthesizer-inference+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 dynamic physical dimensions+Description:+   High-level functions which use physical units.+   We try to abstract from the sample rate using various approaches.+   The modules are a bit outdated however,+   and I think that the package @synthesizer-dimensional@+   provides the better design.+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 category+  description: Check whether Arrow class is split into Arrow and Category.++Flag optimizeAdvanced+  description: Enable advanced optimizations. They slow down compilation considerably.+  default:     True++Flag buildProfilers+  description: Build executables for investigating efficiency of code+  default:     False++Flag buildTests+  description: Build test suite+  default:     False++Flag buildExamples+  description: Build example executables+  default:     False+++Source-Repository this+  Tag:         0.2+  Type:        darcs+  Location:    http://code.haskell.org/synthesizer/inference/++Source-Repository head+  Type:        darcs+  Location:    http://code.haskell.org/synthesizer/inference/++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,+    -- UniqueLogicNP is needed for InferenceFix+    UniqueLogicNP >= 0.2 && <0.3,+    numeric-prelude >=0.1.1 && <0.2,+    utility-ht >=0.0.5 && <0.1++  If flag(splitBase)+    Build-Depends:+      base >= 3 && <5,+      random >=1.0 && <2.0+  Else+    Build-Depends:+      base >= 1.0 && < 2,+      special-functors >= 1.0 && <1.1++  GHC-Options:    -Wall+  Hs-source-dirs: src+  Exposed-modules:+    Synthesizer.Physical+    Synthesizer.Physical.Cut+    Synthesizer.Physical.Control+    Synthesizer.Physical.File+    Synthesizer.Physical.Filter+    Synthesizer.Physical.Noise+    Synthesizer.Physical.Oscillator+    Synthesizer.Physical.Play+    Synthesizer.Physical.Signal+    Synthesizer.Physical.Displacement+    Synthesizer.Amplitude.Signal+    Synthesizer.Amplitude.Cut+    Synthesizer.Amplitude.Control+    Synthesizer.Amplitude.Filter+    Synthesizer.Amplitude.Displacement+    Synthesizer.SampleRateContext.Rate+    Synthesizer.SampleRateContext.Signal+    Synthesizer.SampleRateContext.Oscillator+    Synthesizer.SampleRateContext.Cut+    Synthesizer.SampleRateContext.Control+    Synthesizer.SampleRateContext.Filter+    Synthesizer.SampleRateContext.Displacement+    Synthesizer.SampleRateContext.Noise+    Synthesizer.SampleRateContext.Play+    Synthesizer.Inference.Fix+    Synthesizer.Inference.Fix.Cut+    Synthesizer.Inference.Fix.Filter+    Synthesizer.Inference.Func.Cut+    Synthesizer.Inference.Func.Signal+    Synthesizer.Inference.Monad.File+    Synthesizer.Inference.Monad.Play+    Synthesizer.Inference.Monad.Signal+    Synthesizer.Inference.Monad.Signal.Control+    Synthesizer.Inference.Monad.Signal.Cut+    Synthesizer.Inference.Monad.Signal.Filter+    Synthesizer.Inference.Monad.Signal.Noise+    Synthesizer.Inference.Monad.Signal.Oscillator+    Synthesizer.Inference.Monad.Signal.Displacement+    Synthesizer.Inference.Monad.SignalSeq+    Synthesizer.Inference.Monad.SignalSeq.Control+    Synthesizer.Inference.Monad.SignalSeq.Cut+    Synthesizer.Inference.Monad.SignalSeq.Filter+    Synthesizer.Inference.Monad.SignalSeq.Noise+    Synthesizer.Inference.Monad.SignalSeq.Oscillator+    Synthesizer.Inference.Monad.SignalSeq.Displacement+    Synthesizer.Inference.Reader.Play+    Synthesizer.Inference.Reader.Process+    Synthesizer.Inference.Reader.Signal+    Synthesizer.Inference.Reader.Control+    Synthesizer.Inference.Reader.Cut+    Synthesizer.Inference.Reader.Filter+    Synthesizer.Inference.Reader.Noise+    Synthesizer.Inference.Reader.Oscillator++--  Other-Modules:+++Executable alinea+  If !flag(buildExamples)+    Buildable: False+  GHC-Options: -Wall+  Hs-Source-Dirs: alinea, src+  Main-Is: Alinea.hs