pax_global_header00006660000000000000000000000064147466203360014525gustar00rootroot0000000000000052 comment=315343ee82c185e0dd647f7262e82e7558faae0c ocaml-xiph-1.0.0/000077500000000000000000000000001474662033600135645ustar00rootroot00000000000000ocaml-xiph-1.0.0/.github/000077500000000000000000000000001474662033600151245ustar00rootroot00000000000000ocaml-xiph-1.0.0/.github/workflows/000077500000000000000000000000001474662033600171615ustar00rootroot00000000000000ocaml-xiph-1.0.0/.github/workflows/ci.yml000066400000000000000000000006711474662033600203030ustar00rootroot00000000000000name: CI on: [push] concurrency: group: ${{ github.workflow }}-${{ github.ref }} cancel-in-progress: true jobs: build: runs-on: ${{ matrix.os }} strategy: fail-fast: false matrix: os: [macos-latest, ubuntu-24.04] compiler: [4.14.2, 5.2.0] steps: - name: Build and test module uses: savonet/build-and-test-ocaml-module@main with: ocaml-compiler: ${{ matrix.compiler }} ocaml-xiph-1.0.0/.github/workflows/doc.yml000066400000000000000000000011541474662033600204520ustar00rootroot00000000000000name: Doc build on: push: branches: - main jobs: build_doc: runs-on: ubuntu-24.04 steps: - name: Checkout code uses: actions/checkout@v1 - name: Setup OCaml uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: 4.14.x - name: Pin locally run: opam pin -y add --no-action . - name: Install locally run: opam install -y --with-doc . - name: Build doc run: opam exec dune build @doc - name: Deploy doc uses: JamesIves/github-pages-deploy-action@4.1.4 with: branch: gh-pages folder: _build/default/_doc/_html ocaml-xiph-1.0.0/.gitignore000066400000000000000000000000721474662033600155530ustar00rootroot00000000000000*~ _build *.byte *.native _tests .merlin *.install .*.sw* ocaml-xiph-1.0.0/.ocamlformat000066400000000000000000000003371474662033600160740ustar00rootroot00000000000000version=0.25.1 profile = conventional break-separators = after space-around-lists = false doc-comments = before match-indent = 2 match-indent-nested = always parens-ite exp-grouping = preserve module-item-spacing = compact ocaml-xiph-1.0.0/CHANGES.md000066400000000000000000000005101474662033600151520ustar00rootroot000000000000001.0.0 (2025-01-30) ===== * Initial release of the combined modules * `ogg`: Add optional `fill` argument to decoders, used to pull more data when needed. * `flac`: cleanup implementation and global roots, add `fill` argument to decoder to prevent use of exception to refill data. * Others: adapted to new `fill` API from `ogg`. ocaml-xiph-1.0.0/COPYING000066400000000000000000000634761474662033600146370ustar00rootroot00000000000000 GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! ocaml-xiph-1.0.0/README.md000066400000000000000000000016701474662033600150470ustar00rootroot00000000000000ocaml-xiph ============ ![GitHub](https://img.shields.io/github/license/savonet/ocaml-xiph) ![CI](https://github.com/savonet/ocaml-xiph/workflows/CI/badge.svg) ![GitHub release (latest by date)](https://img.shields.io/github/v/release/savonet/ocaml-xiph) This repository provides various OCaml bindings to the [xiph](https://xiph.org/) libraries. Documentation: ============= The [API documentation is available here](http://www.liquidsoap.info/ocaml-xiph/). Prerequisites: ============== - ocaml - dune - findlib - libogg - libvorbis - libspeex - libflac - libtheora - libopus See [dune-project](dune-project) file for versions. Installation: ============= The preferred installation method is via [opam](http://opam.ocaml.org/): ``` opam install ogg vorbis ... ``` If you wish to install the latest code from this repository, you can do: ``` opam install . ``` From within this repository. Compilation: ============ ``` dune build ``` ocaml-xiph-1.0.0/dune-project000066400000000000000000000025071474662033600161120ustar00rootroot00000000000000(lang dune 2.8) (version 1.0.0) (name ogg) (source (github savonet/ocaml-xiph)) (license LGPL-2.1-only) (authors "The Savonet Team ") (maintainers "The Savonet Team ") (generate_opam_files true) (use_standard_c_and_cxx_flags false) (package (name ogg) (synopsis "Bindings to libogg") (depends conf-libogg conf-pkg-config (ocaml (>= 4.08.0)) dune dune-configurator) ) (package (name vorbis) (synopsis "Bindings to libvorbis") (depends conf-libvorbis conf-pkg-config (ocaml (>= 4.03.0)) dune dune-configurator (ogg (= :version))) ) (package (name speex) (synopsis "Bindings to libspeex") (depends conf-libogg conf-libspeex conf-pkg-config dune dune-configurator (ocaml (>= 4.07)) (ogg (= :version))) ) (package (name theora) (synopsis "Bindings to libtheora") (depends conf-libtheora conf-pkg-config dune dune-configurator (ogg (= :version))) ) (package (name opus) (synopsis "Bindings to libopus") (depends conf-libogg conf-libopus conf-pkg-config (ocaml (>= 4.08.0)) dune dune-configurator (ogg (= :version))) ) (package (name flac) (synopsis "Bindings to libflac") (depends conf-libflac conf-pkg-config (ocaml (>= 4.03.0)) dune dune-configurator) (depopts (ogg (= :version))) ) ocaml-xiph-1.0.0/flac.opam000066400000000000000000000015001474662033600153430ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "1.0.0" synopsis: "Bindings to libflac" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] license: "LGPL-2.1-only" homepage: "https://github.com/savonet/ocaml-xiph" bug-reports: "https://github.com/savonet/ocaml-xiph/issues" depends: [ "conf-libflac" "conf-pkg-config" "ocaml" {>= "4.03.0"} "dune" {>= "2.8"} "dune-configurator" "odoc" {with-doc} ] depopts: [ "ogg" {= version} ] build: [ ["dune" "subst"] {dev} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] dev-repo: "git+https://github.com/savonet/ocaml-xiph.git" x-maintenance-intent: ["(latest)"] ocaml-xiph-1.0.0/flac.opam.template000066400000000000000000000000431474662033600171560ustar00rootroot00000000000000x-maintenance-intent: ["(latest)"] ocaml-xiph-1.0.0/flac/000077500000000000000000000000001474662033600144715ustar00rootroot00000000000000ocaml-xiph-1.0.0/flac/config/000077500000000000000000000000001474662033600157365ustar00rootroot00000000000000ocaml-xiph-1.0.0/flac/config/discover_flac.ml000066400000000000000000000013321474662033600210720ustar00rootroot00000000000000module C = Configurator.V1 external is_big_endian : unit -> bool = "ocaml_mm_is_big_endian" let () = C.main ~name:"flac-pkg-config" (fun c -> C.C_define.gen_header_file c ~fname:"flac_config.h" [("BIGENDIAN", Switch (is_big_endian ()))]; let default : C.Pkg_config.package_conf = { libs = ["-lflac"]; cflags = [] } in let conf = match C.Pkg_config.get c with | None -> default | Some pc -> ( match C.Pkg_config.query pc ~package:"flac" with | None -> default | Some deps -> deps) in C.Flags.write_sexp "flac_c_flags.sexp" conf.cflags; C.Flags.write_sexp "flac_c_library_flags.sexp" conf.libs) ocaml-xiph-1.0.0/flac/config/discover_flac_ogg.ml000066400000000000000000000011021474662033600217210ustar00rootroot00000000000000module C = Configurator.V1 let () = C.main ~name:"flac-ogg-pkg-config" (fun c -> let default : C.Pkg_config.package_conf = { libs = ["-logg"; "-lflac"]; cflags = [] } in let conf = match C.Pkg_config.get c with | None -> default | Some pc -> ( match C.Pkg_config.query pc ~package:"ogg flac" with | None -> default | Some deps -> deps) in C.Flags.write_sexp "flac_ogg_c_flags.sexp" conf.cflags; C.Flags.write_sexp "flac_ogg_c_library_flags.sexp" conf.libs) ocaml-xiph-1.0.0/flac/config/dune000066400000000000000000000003631474662033600166160ustar00rootroot00000000000000(executable (name discover_flac) (modules discover_flac) (foreign_stubs (language c) (names endianess)) (libraries dune.configurator)) (executable (name discover_flac_ogg) (modules discover_flac_ogg) (libraries dune.configurator)) ocaml-xiph-1.0.0/flac/config/endianess.c000066400000000000000000000006161474662033600200560ustar00rootroot00000000000000#include #include enum { OCAML_MM_LITTLE_ENDIAN = 0x0100, OCAML_MM_BIG_ENDIAN = 0x0001, }; static const union { unsigned char bytes[2]; uint16_t value; } host_order = { { 0, 1 } }; CAMLprim value ocaml_mm_is_big_endian(value unit) { CAMLparam0(); if (host_order.value == OCAML_MM_BIG_ENDIAN) CAMLreturn(Val_bool(1)); CAMLreturn(Val_bool(0)); } ocaml-xiph-1.0.0/flac/dune000066400000000000000000000020371474662033600153510ustar00rootroot00000000000000(library (name flac) (public_name flac) (synopsis "OCaml bindings for libflac") (modules flac) (libraries unix) (foreign_stubs (language c) (names flac_stubs) (extra_deps "flac_config.h") (flags (:include flac_c_flags.sexp))) (c_library_flags (:include flac_c_library_flags.sexp))) (library (name flac_ogg) (public_name flac.ogg) (synopsis "API to decode flac data in ogg container") (libraries flac ogg) (optional) (modules flac_ogg) (foreign_stubs (language c) (names flac_ogg_stubs) (flags (:include flac_ogg_c_flags.sexp))) (c_library_flags (:include flac_ogg_c_library_flags.sexp))) (library (name flac_decoder) (public_name flac.decoder) (synopsis "Flac decoder for the ogg-decoder library") (libraries ogg.decoder flac.ogg) (optional) (modules flac_decoder)) (rule (targets flac_config.h flac_c_flags.sexp flac_c_library_flags.sexp) (action (run ./config/discover_flac.exe))) (rule (targets flac_ogg_c_flags.sexp flac_ogg_c_library_flags.sexp) (action (run ./config/discover_flac_ogg.exe))) ocaml-xiph-1.0.0/flac/examples/000077500000000000000000000000001474662033600163075ustar00rootroot00000000000000ocaml-xiph-1.0.0/flac/examples/decode.ml000066400000000000000000000136771474662033600201020ustar00rootroot00000000000000let () = Printexc.record_backtrace true let output_int chan n = output_char chan (char_of_int ((n lsr 0) land 0xff)); output_char chan (char_of_int ((n lsr 8) land 0xff)); output_char chan (char_of_int ((n lsr 16) land 0xff)); output_char chan (char_of_int ((n lsr 24) land 0xff)) let output_short chan n = output_char chan (char_of_int ((n lsr 0) land 0xff)); output_char chan (char_of_int ((n lsr 8) land 0xff)) let progress_bar = let spin = ref 0 in fun title pos tot -> let nbeq = 40 in let n = min (100. *. float_of_int pos /. float_of_int tot) 100. in Printf.printf "\r%s " title; if tot > 0 then begin Printf.printf "%6.2f%% [" n; let e = int_of_float (n /. 100. *. float_of_int nbeq) in for _ = 1 to e do Printf.printf "=" done; if e != nbeq then Printf.printf ">"; for _ = e + 2 to nbeq do Printf.printf " " done; Printf.printf "] " end; incr spin; if !spin > 4 then spin := 1; Printf.printf "%c%!" (if tot > 0 && n = 100. then ' ' else ( match !spin with | 1 -> '|' | 2 -> '/' | 3 -> '-' | 4 -> '\\' | _ -> failwith "this did not happen")) let infile = ref "input.flac" let outfile = ref "output.raw" let ogg = ref false let () = Arg.parse [ ("-o", Arg.Set_string outfile, "Output file"); ("-i", Arg.Set_string infile, "Input file"); ("-ogg", Arg.Bool (fun x -> ogg := x), "Ogg/flac file"); ] ignore "decode [options]" let process () = let fd = Printf.printf "Opening input file %S\n%!" !infile; Unix.openfile !infile [Unix.O_RDONLY] 0o640 in let oc = Printf.printf "Opening output file %S\n%!" !outfile; open_out !outfile in let ret = Buffer.create 1024 in let write x = Buffer.add_string ret (Flac.Decoder.to_s16le x) in let get () = let ans = Buffer.contents ret in Buffer.reset ret; ans in let process, info, comments = if not !ogg then ( let h = Flac.Decoder.File.create_from_fd ~write fd in let process () = Flac.Decoder.process h.Flac.Decoder.File.dec; Flac.Decoder.state h.Flac.Decoder.File.dec in (process, h.Flac.Decoder.File.info, h.Flac.Decoder.File.comments)) else ( let sync = Ogg.Sync.create (Unix.read fd) in let test_flac () = (* Get First page *) let page = Ogg.Sync.read sync in (* Check wether this is a b_o_s *) if not (Ogg.Page.bos page) then raise Flac.Decoder.Not_flac; (* Create a stream with this ID *) let serial = Ogg.Page.serialno page in Printf.printf "Testing stream %nx\n" serial; let os = Ogg.Stream.create ~serial () in Ogg.Stream.put_page os page; let packet = Ogg.Stream.peek_packet os in (* Test header. Do not catch anything, first page should be sufficient *) if not (Flac_ogg.Decoder.check_packet packet) then raise Not_found; Printf.printf "Got a flac stream !\n"; let fill () = let page = Ogg.Sync.read sync in if Ogg.Page.serialno page = serial then Ogg.Stream.put_page os page in let dec, info, meta = Flac_ogg.Decoder.create ~fill ~write os in let rec process () = try Flac.Decoder.process dec; Flac.Decoder.state dec with | Ogg.End_of_stream -> `End_of_stream | Ogg.Not_enough_data -> ( try fill (); process () with Ogg.End_of_stream | Ogg.Not_enough_data -> `End_of_stream) in (process, info, meta) in (* Now find a flac stream *) let rec init () = try test_flac () with | Not_found -> Printf.printf "This stream was not flac..\n"; init () | Flac.Decoder.Not_flac -> Printf.printf "No flac stream was found..\n%!"; raise Flac.Decoder.Not_flac in init ()) in Printf.printf "Stream info:\n"; Printf.printf "sample rate: %i\n" info.Flac.Decoder.sample_rate; Printf.printf "bits per sample: %i\n" info.Flac.Decoder.bits_per_sample; Printf.printf "channels: %i\n" info.Flac.Decoder.channels; Printf.printf "total samples: %s\n" (Int64.to_string info.Flac.Decoder.total_samples); Printf.printf "md5sum: "; String.iter (fun c -> Printf.printf "%x" (int_of_char c)) info.Flac.Decoder.md5sum; Printf.printf "\n"; if info.Flac.Decoder.bits_per_sample <> 16 then failwith "Unsupported bits per sample."; let srate = info.Flac.Decoder.sample_rate in let chans = info.Flac.Decoder.channels in let datalen = Int64.to_int info.Flac.Decoder.total_samples * chans * 2 in let () = match comments with | None -> Printf.printf "No comment found..\n" | Some (vendor, comments) -> Printf.printf "Metadata:\n"; List.iter (fun (x, y) -> Printf.printf "%s: %s\n" x y) comments; Printf.printf "VENDOR: %s\n" vendor in output_string oc "RIFF"; output_int oc (4 + 24 + 8 + datalen); output_string oc "WAVE"; output_string oc "fmt "; output_int oc 16; output_short oc 1; (* WAVE_FORMAT_PCM *) output_short oc chans; (* channels *) output_int oc srate; (* freq *) output_int oc (srate * chans * 2); (* bytes / s *) output_short oc (chans * 2); (* block alignment *) output_short oc 16; (* bits per sample *) output_string oc "data"; output_int oc datalen; let pos = ref 0 in let rec decode () = let state = process () in let ret = get () in pos := !pos + String.length ret; progress_bar "Decoding FLAC file:" !pos datalen; output_string oc ret; flush oc; match state with `End_of_stream -> Printf.printf "\n" | _ -> decode () in decode (); Printf.printf "\n"; close_out oc; Unix.close fd let () = process (); (* We have global root values * so we need to do two full major.. *) Gc.full_major (); Gc.full_major () ocaml-xiph-1.0.0/flac/examples/dune000066400000000000000000000011531474662033600171650ustar00rootroot00000000000000(executable (name decode) (modules decode) (optional) (libraries flac.ogg)) (executable (name encode) (modules encode) (optional) (libraries flac.ogg)) (rule (alias citest) (target src.wav) (action (run ffmpeg -hide_banner -loglevel error -f lavfi -i "sine=frequency=220:duration=5" -ac 2 %{target}))) (rule (alias citest) (deps ./src.wav) (action (progn (run ./encode.exe ./src.wav ./src.flac) (run ./decode.exe -i ./src.flac -o ./dst.wav) (run ./encode.exe --ogg true ./src.wav ./dst.ogg) (run ./decode.exe -ogg true -i ./dst.ogg -o ./ogg-dst.wav)))) ocaml-xiph-1.0.0/flac/examples/encode.ml000066400000000000000000000073231474662033600201030ustar00rootroot00000000000000let src = ref "" let dst = ref "" let buflen = ref 1024 let flush_outchan = flush let input_string chan len = let ans = Bytes.create len in really_input chan ans 0 len; Bytes.to_string ans let input_int chan = let buf = input_string chan 4 in int_of_char buf.[0] + (int_of_char buf.[1] lsl 8) + (int_of_char buf.[2] lsl 16) + (int_of_char buf.[3] lsl 24) let input_short chan = let buf = input_string chan 2 in int_of_char buf.[0] + (int_of_char buf.[1] lsl 8) let compression = ref 5 let ogg = ref false let usage = "usage: encode [options] source destination" let _ = Arg.parse [ ( "--compression", Arg.Int (fun b -> compression := b), "Compression level." ); ("--ogg", Arg.Bool (fun b -> ogg := b), "Encoder in ogg format."); ] (let pnum = ref (-1) in fun s -> incr pnum; match !pnum with | 0 -> src := s | 1 -> dst := s | _ -> Printf.eprintf "Error: too many arguments\n"; exit 1) usage; if !src = "" || !dst = "" then ( Printf.printf "%s\n" usage; exit 1); let ic = open_in_bin !src in (* TODO: improve! *) if input_string ic 4 <> "RIFF" then invalid_arg "No RIFF tag"; ignore (input_string ic 4); if input_string ic 4 <> "WAVE" then invalid_arg "No WAVE tag"; if input_string ic 4 <> "fmt " then invalid_arg "No fmt tag"; let _ = input_int ic in let _ = input_short ic in (* TODO: should be 1 *) let channels = input_short ic in let infreq = input_int ic in let _ = input_int ic in (* bytes / s *) let _ = input_short ic in (* block align *) let bits = input_short ic in if bits <> 16 then failwith "only s16le is supported for now.."; let params = { Flac.Encoder.channels; sample_rate = infreq; bits_per_sample = bits; compression_level = Some !compression; total_samples = None; } in let comments = [("TITLE", "Encoding example")] in let encode, finish = if not !ogg then ( let enc = Flac.Encoder.File.create ~comments params !dst in let encode buf = Flac.Encoder.process enc.Flac.Encoder.File.enc buf in let finish () = Flac.Encoder.finish enc.Flac.Encoder.File.enc; Unix.close enc.Flac.Encoder.File.fd in (encode, finish)) else ( let oc = open_out !dst in let write_page (header, body) = output_string oc header; output_string oc body in let serialno = Random.nativeint Nativeint.max_int in let { Flac_ogg.Encoder.encoder; first_pages } = Flac_ogg.Encoder.create ~comments ~serialno ~write:write_page params in List.iter write_page first_pages; let encode = Flac.Encoder.process encoder in let finish () = Flac.Encoder.finish encoder in (encode, finish)) in let start = Unix.time () in Printf.printf "Input detected: PCM WAVE %d channels, %d Hz, %d bits\n%!" channels infreq bits; Printf.printf "Encoding to: %s %d channels, %d Hz, compression level: %d\n\ Please wait...\n\ %!" (if !ogg then "OGG/FLAC" else "FLAC") channels infreq !compression; while input_string ic 4 <> "data" do let len = input_int ic in really_input ic (Bytes.create len) 0 len done; (* This ensures the actual audio data will start on a new page, as per * spec. *) let buflen = channels * bits / 8 * !buflen in let buf = Bytes.create buflen in begin try while true do really_input ic buf 0 (Bytes.length buf); encode (Flac.Encoder.from_s16le (Bytes.to_string buf) channels) done with End_of_file -> () end; finish (); close_in ic; Printf.printf "Finished in %.0f seconds.\n" (Unix.time () -. start); Gc.full_major (); Gc.full_major () ocaml-xiph-1.0.0/flac/flac.ml000066400000000000000000000160711474662033600157350ustar00rootroot00000000000000(* * Copyright 2003-2011 Savonet team * * This file is part of Ocaml-flac. * * Ocaml-flac 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 2 of the License, or * (at your option) any later version. * * Ocaml-flac 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 Ocaml-flac; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (* Author; Romain Beauxis *) exception Internal let () = Callback.register_exception "flac_exn_internal" Internal module Decoder = struct type t (** Possible states of a decoder. *) type state = [ `Search_for_metadata | `Read_metadata | `Search_for_frame_sync | `Read_frame | `End_of_stream | `Ogg_error | `Seek_error | `Aborted | `Memory_allocation_error | `Uninitialized ] exception Lost_sync exception Bad_header exception Frame_crc_mismatch exception Unparseable_stream exception Not_flac let () = Callback.register_exception "flac_dec_exn_lost_sync" Lost_sync; Callback.register_exception "flac_dec_exn_bad_header" Bad_header; Callback.register_exception "flac_dec_exn_crc_mismatch" Frame_crc_mismatch; Callback.register_exception "flac_dec_exn_unparseable_stream" Unparseable_stream type info = { sample_rate : int; channels : int; bits_per_sample : int; total_samples : int64; md5sum : string; } type comments = string * (string * string) list type comments_array = string * string array external info : t -> info * comments_array option = "ocaml_flac_decoder_info" let split_comment comment = try let equal_pos = String.index_from comment 0 '=' in let c1 = String.uppercase_ascii (String.sub comment 0 equal_pos) in let c2 = String.sub comment (equal_pos + 1) (String.length comment - equal_pos - 1) in (c1, c2) with Not_found -> (comment, "") let _comments cmts = match cmts with | None -> None | Some (vd, cmts) -> Some (vd, Array.to_list (Array.map split_comment cmts)) let info x = try let info, comments = info x in (info, _comments comments) with Internal -> raise Not_flac external alloc : seek:(int64 -> unit) option -> tell:(unit -> int64) option -> length:(unit -> int64) option -> eof:(unit -> bool) option -> read:(bytes -> int -> int -> int) -> write:(float array array -> unit) -> unit -> t = "ocaml_flac_decoder_alloc_bytecode" "ocaml_flac_decoder_alloc_native" external cleanup : t -> unit = "ocaml_flac_cleanup_decoder" external init : t -> unit = "ocaml_flac_decoder_init" let create ?seek ?tell ?length ?eof ~read ~write () = let write pcm = write (Array.copy pcm) in let dec = alloc ~seek ~tell ~length ~eof ~read ~write () in Gc.finalise cleanup dec; init dec; let info, comments = info dec in (dec, info, comments) external state : t -> state = "ocaml_flac_decoder_state" external process : t -> unit = "ocaml_flac_decoder_process" external seek : t -> Int64.t -> bool = "ocaml_flac_decoder_seek" external flush : t -> bool = "ocaml_flac_decoder_flush" external reset : t -> bool = "ocaml_flac_decoder_reset" external to_s16le : float array array -> string = "caml_flac_float_to_s16le" module File = struct type handle = { fd : Unix.file_descr; dec : t; info : info; comments : (string * (string * string) list) option; } let create_from_fd ~write fd = let read = Unix.read fd in let seek n = let n = Int64.to_int n in ignore (Unix.lseek fd n Unix.SEEK_SET) in let tell () = Int64.of_int (Unix.lseek fd 0 Unix.SEEK_CUR) in let length () = let stats = Unix.fstat fd in Int64.of_int stats.Unix.st_size in let eof () = let stats = Unix.fstat fd in Unix.lseek fd 0 Unix.SEEK_CUR = stats.Unix.st_size in let dec, info, comments = create ~seek ~tell ~length ~eof ~write ~read () in { fd; comments; dec; info } let create ~write filename = let fd = Unix.openfile filename [Unix.O_RDONLY] 0o640 in try create_from_fd ~write fd with e -> Unix.close fd; raise e end end module Encoder = struct type priv type params = { channels : int; bits_per_sample : int; sample_rate : int; compression_level : int option; total_samples : int64 option; } type comments = (string * string) list type t = priv * params exception Invalid_data exception Invalid_metadata let () = Callback.register_exception "flac_enc_exn_invalid_metadata" Invalid_metadata external vorbiscomment_entry_name_is_legal : string -> bool = "ocaml_flac_encoder_vorbiscomment_entry_name_is_legal" external vorbiscomment_entry_value_is_legal : string -> bool = "ocaml_flac_encoder_vorbiscomment_entry_value_is_legal" external alloc : (string * string) array -> seek:(int64 -> unit) option -> tell:(unit -> int64) option -> write:(bytes -> int -> unit) -> params -> priv = "ocaml_flac_encoder_alloc" external cleanup : priv -> unit = "ocaml_flac_cleanup_encoder" external init : priv -> unit = "ocaml_flac_encoder_init" let create ?(comments = []) ?seek ?tell ~write p = if p.channels <= 0 then raise Invalid_data; let comments = Array.of_list comments in let write b len = write (Bytes.sub b 0 len) in let enc = alloc comments ~seek ~tell ~write p in Gc.finalise cleanup enc; init enc; (enc, p) external process : priv -> float array array -> int -> unit = "ocaml_flac_encoder_process" let process (enc, p) data = if Array.length data <> p.channels then raise Invalid_data; process enc data p.bits_per_sample external finish : priv -> unit = "ocaml_flac_encoder_finish" let finish (enc, _) = finish enc external from_s16le : string -> int -> float array array = "caml_flac_s16le_to_float" module File = struct type handle = { fd : Unix.file_descr; enc : t } let create_from_fd ?comments params fd = let write s = let len = Bytes.length s in let rec f pos = if pos < len then ( let ret = Unix.write fd s pos (len - pos) in f (pos + ret)) in f 0 in let seek n = let n = Int64.to_int n in ignore (Unix.lseek fd n Unix.SEEK_SET) in let tell () = Int64.of_int (Unix.lseek fd 0 Unix.SEEK_CUR) in let enc = create ?comments ~seek ~tell ~write params in { fd; enc } let create ?comments params filename = let fd = Unix.openfile filename [Unix.O_CREAT; Unix.O_RDWR] 0o640 in create_from_fd ?comments params fd end end ocaml-xiph-1.0.0/flac/flac.mli000066400000000000000000000260441474662033600161070ustar00rootroot00000000000000(* * Copyright 2003-2010 Savonet team * * This file is part of Ocaml-flac. * * Ocaml-flac 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 2 of the License, or * (at your option) any later version. * * Ocaml-flac 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 Ocaml-flac; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (* Author; Romain Beauxis *) (** {1 Native FLAC decoder/encoder modules for OCaml} *) (** Decode native FLAC data *) module Decoder : sig (** {3 Usage} *) (** A typical use of the FLAC decoder is the following: * * {v (* Raise this when streams has ended. *) * exception End_of_stream * (* Define a read function *) * let input = (..a function of type read..) in * (* Define a write function *) * let output = (..a function of type write..) in * (* Create callbacks *) * let callbacks = Flac.Decoder.get_callbacks input write in * (* Create an unitialized decoder *) * let decoder = Flac.Decoder.create callbacks in * (* Initialize decoder *) * let decoder,info,comments = Flac.Decoder.init decoder callbacks in * (..do something with info and comments..) * (* Decode data *) * match Flac.Decoder.state decoder c with * | `Search_for_metadata * | `Read_metadata * | `Search_for_frame_sync * | `Read_frame -> * Flac.Decoder.process decoder callbacks * | _ -> raise End_of_stream v} * * Some remarks: * - Exceptions raised by callbacks should be treated * as fatal errors. The dehaviour of the flac library * after being interrupted by an exception is unknown. * The only notable exception is Ogg/flac decoding, where * the read callback raises [Ogg.Not_enough_data]. * - The state of the decoder should be checked prior to calling * [process]. Termination may not be detected nor raise an * exception so it is the caller's responsibility to check * on this. * - See FLAC documentation for the information on the * callbacks. * - The variant type for decoder and callbacks is used * to make sure that different type of decoders * (generic, file, ogg) are only used with the same * type of callbacks. *) (** {3 Types } *) type t type info = { sample_rate : int; channels : int; bits_per_sample : int; total_samples : int64; md5sum : string; } (** (Vorbis) comments of decoded FLAC data. *) type comments = string * (string * string) list (** Possible states of a decoder. *) type state = [ (* The decoder is ready to search for metadata. *) `Search_for_metadata (* The decoder is ready to or is in the process of reading metadata. *) | `Read_metadata (* The decoder is ready to or is in the process of searching for the frame sync code. *) | `Search_for_frame_sync (* The decoder is ready to or is in the process of reading a frame. *) | `Read_frame (* The decoder has reached the end of the stream. *) | `End_of_stream (* An error occurred in the underlying Ogg layer. *) | `Ogg_error (* An error occurred while seeking. The decoder must be flushed or reset before decoding can continue. *) | `Seek_error (* The decoder was aborted by the read callback. *) | `Aborted (* An error occurred allocating memory. The decoder is in an invalid state and can no longer be used. *) | `Memory_allocation_error (* This state is seen in the case of an uninitialized ogg decoder. *) | `Uninitialized ] (** {3 Exceptions } *) (** An error in the stream caused the decoder to lose synchronization. *) exception Lost_sync (** The decoder encountered a corrupted frame header. *) exception Bad_header (** The frame's data did not match the CRC in the footer. *) exception Frame_crc_mismatch (** The decoder encountered reserved fields in use in the stream. *) exception Unparseable_stream (** Raised if trying to decode a stream that * is not flac. *) exception Not_flac (** {3 Functions} *) (** Create a decoder. The decoder will be used to decode * all metadata. Initial audio data shall be immediatly available * after this call. *) val create : ?seek:(int64 -> unit) -> ?tell:(unit -> int64) -> ?length:(unit -> int64) -> ?eof:(unit -> bool) -> read:(bytes -> int -> int -> int) -> write:(float array array -> unit) -> unit -> t * info * comments option (** Decode one frame of audio data. *) val process : t -> unit (** Flush the input and seek to an absolute sample. * Decoding will resume at the given sample. Note * that because of this, the next write callback may * contain a partial block. The client must support seeking * the input or this function will fail and return [false]. * Furthermore, if the decoder state is [`Seek_error] * then the decoder must be flushed or reset * before decoding can continue. *) val seek : t -> Int64.t -> bool (** Flush the stream input. * The decoder's input buffer will be cleared and the state set to * [`Search_for_frame_sync]. This will also turn * off MD5 checking. *) val flush : t -> bool (** Reset the decoding process. * The decoder's input buffer will be cleared and the state set to * [`Search_for_metadata]. MD5 checking will be restored to its original * setting. * * If the decoder is seekable, the decoder will also attempt to seek to * the beginning of the stream. If this rewind fails, this function will * return [false]. It follows that [reset] cannot be used when decoding * from [stdin]. * * If the decoder is not seekable (i.e. no seek callback was provided) * it is the duty of the client to start feeding data from the beginning * of the stream on the next [process]. *) val reset : t -> bool (** Get the state of a decoder. *) val state : t -> state (** {3 Convenience} *) (** Convert an audio array to a S16LE string for * decoding FLAC to WAV and raw PCM *) val to_s16le : float array array -> string (** Local file decoding. *) module File : sig (** Convenience module to * decode local files *) (** {3 Types} *) (* Handler for file decoder *) type handle = { fd : Unix.file_descr; dec : t; info : info; comments : (string * (string * string) list) option; } (** {3 Functions} *) (** Create a file decoder from a Unix file * descriptor * * Note: this decoder requires seeking thus will only work on seekable * file descriptor. *) val create_from_fd : write:(float array array -> unit) -> Unix.file_descr -> handle (** Create a file decoder from a file URI *) val create : write:(float array array -> unit) -> string -> handle end end (** Encode native FLAC data *) module Encoder : sig (** {3 Usage} *) (** A typical use of the FLAC encoder is the following: * {v (* A function to write encoded data *) * let write = (..a function of type write..) in * (* Create the encoding callbacks *) * let callbacks = Flac.Encoder.get_callbacks write in * (* Define the parameters and comments *) * let params = (..a value of type params ..) in * let comments = [("title","FLAC encoding example")] in * (* Create an encoder *) * let enc = Flac.Encoder.create ~comments params callbacks in * (* Encode data *) * let data = (..a value of type float array array.. in * Flac.Encoder.process enc callbacks data ; * (..repeat encoding process..) * (* Close encoder *) * Flac.Encoder.finish enc callbacks v} * * Remarks: * - Exceptions raised by the callbacks should be treated * as fatal. The behaviour of the FLAC encoding library is * unknown after interrupted by an exception. * - Encoded data should have the same number of channels as * specified in encoder's parameters and the same number of * samples in each channels. * - See FLAC documentation for informations about the callbacks. * Note in particular that some information about encoded data * such as md5 sum and total samples are only written when a * [seek] callback is given. * - Variant types for callbacks and encoder are used to make sure * that different type of callbacks (generic, file, ogg) are always * used with the corresponding decoder type. *) (** {3 Types} *) (** Type of an encoder. *) type t (** Type of encoding parameters *) type params = { channels : int; bits_per_sample : int; sample_rate : int; compression_level : int option; total_samples : int64 option; } (** (Vorbis) comments for encoding *) type comments = (string * string) list (** {3 Exceptions} *) (** Raised when submiting invalid data to * encode *) exception Invalid_data (** Raised when initiating an encoder with * invalid metadata. You can use `vorbiscomment_entry_name_is_legal` * and `vorbiscomment_entry_value_is_legal` to check submitted metadata. *) exception Invalid_metadata (** {3 Functions} *) (** Check if a comment label is valid *) val vorbiscomment_entry_name_is_legal : string -> bool (** Check if a comment value is valid *) val vorbiscomment_entry_value_is_legal : string -> bool (** Create an encoder *) val create : ?comments:comments -> ?seek:(int64 -> unit) -> ?tell:(unit -> int64) -> write:(bytes -> unit) -> params -> t (** Encode some data *) val process : t -> float array array -> unit (** Terminate an encoder. Causes the encoder to * flush remaining encoded data. The encoder should * not be used anymore afterwards. *) val finish : t -> unit (** {3 Convenience} *) (** Convert S16LE pcm data to an audio array for * encoding WAV and raw PCM to flac. *) val from_s16le : string -> int -> float array array (** Encode to a local file *) module File : sig (** Convenience module to encode to a local native FLAC file. *) (** {3 Types} *) (** Handle for file encoder *) type handle = { fd : Unix.file_descr; enc : t } (** {3 Functions} *) (** Create a file encoder writing data to a given Unix file descriptor. * * Note: this encoder requires seeking thus will only work on seekable * file descriptor. *) val create_from_fd : ?comments:comments -> params -> Unix.file_descr -> handle (** Create a file encoder writing data to the given file URI *) val create : ?comments:comments -> params -> string -> handle end end (** Raised when an internal error occured. Should be * reported if seen. *) exception Internal ocaml-xiph-1.0.0/flac/flac_decoder.ml000066400000000000000000000046251474662033600174240ustar00rootroot00000000000000(* * Copyright 2003-2011 Savonet team * * This file is part of Ocaml-flac. * * Ocaml-flac 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 2 of the License, or * (at your option) any later version. * * Ocaml-flac 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 Ocaml-flac; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) let check = Flac_ogg.Decoder.check_packet let mk_decoder ~fill ~write os = let dec, info, m = Flac_ogg.Decoder.create ~fill ~write os in let meta = match m with None -> ("Unknown vendor", []) | Some x -> x in (dec, info, meta) let decoder ~fill os = let decoder = ref None in let write_ref = ref (fun _ -> ()) in let write ret = let fn = !write_ref in fn ret in let get_decoder () = match !decoder with | None -> let dec, info, meta = mk_decoder ~fill ~write os in decoder := Some (dec, info, meta); (dec, info, meta) | Some d -> d in let info () = let _, info, m = get_decoder () in ( { Ogg_decoder.channels = info.Flac.Decoder.channels; sample_rate = info.Flac.Decoder.sample_rate; }, m ) in let decode write = write_ref := write; let decoder, _, _ = get_decoder () in match Flac.Decoder.state decoder with | `Search_for_metadata | `Read_metadata | `Search_for_frame_sync | `Read_frame -> Flac.Decoder.process decoder (* Ogg decoder is responsible for detecting end of stream vs. end of track. *) | _ -> raise Ogg.Not_enough_data in let restart ~fill new_os = (write_ref := fun _ -> ()); let d, _, _ = get_decoder () in (* Flush error are very unlikely. *) assert (Flac.Decoder.flush d); decoder := Some (mk_decoder ~fill ~write new_os) in Ogg_decoder.Audio { Ogg_decoder.name = "flac"; info; decode; restart; samples_of_granulepos = (fun x -> x); } let register () = Hashtbl.add Ogg_decoder.ogg_decoders "flac" (check, decoder) ocaml-xiph-1.0.0/flac/flac_decoder.mli000066400000000000000000000016351474662033600175730ustar00rootroot00000000000000(* * Copyright 2003-2011 Savonet team * * This file is part of Ocaml-flac. * * Ocaml-flac 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 2 of the License, or * (at your option) any later version. * * Ocaml-flac 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 Ocaml-flac; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Ogg flac decoder implementation for * the [Ogg_demuxer] module. *) (** Register the decoder. *) val register : unit -> unit ocaml-xiph-1.0.0/flac/flac_ogg.ml000066400000000000000000000077401474662033600165740ustar00rootroot00000000000000(* * Copyright 2003-2010 Savonet team * * This file is part of Ocaml-flac. * * Ocaml-flac 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 2 of the License, or * (at your option) any later version. * * Ocaml-flac 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 Ocaml-flac; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (* Author; Romain Beauxis *) module Decoder = struct external get_packet_data : Ogg.Stream.packet -> string = "ocaml_flac_decoder_packet_data" let ogg_header_len = 9 let create ~fill ~write os = let read_data = Buffer.create 1024 in let is_first_packet = ref true in let rec read bytes ofs len = try if Buffer.length read_data = 0 then ( let p = Ogg.Stream.get_packet os in let data = get_packet_data p in let data = if !is_first_packet then ( let len = String.length data in assert (len > ogg_header_len); String.sub data ogg_header_len (len - ogg_header_len)) else data in is_first_packet := false; Buffer.add_string read_data data); let c = Buffer.contents read_data in let c_len = String.length c in let len = min len c_len in let rem = String.sub c len (c_len - len) in Buffer.reset read_data; Buffer.add_string read_data rem; Bytes.blit_string c 0 bytes ofs len; len with | Ogg.Not_enough_data -> fill (); read bytes ofs len | Ogg.End_of_stream -> 0 in Flac.Decoder.create ~read ~write () external check_packet : Ogg.Stream.packet -> bool = "ocaml_flac_decoder_check_ogg" end module Encoder = struct type priv type t = { encoder : Flac.Encoder.t; first_pages : Ogg.Page.t list } external alloc : (string * string) array -> seek:(int64 -> unit) option -> tell:(unit -> int64) option -> write:(bytes -> int -> unit) -> Flac.Encoder.params -> priv = "ocaml_flac_encoder_alloc" external cleanup : priv -> unit = "ocaml_flac_cleanup_encoder" external init : priv -> nativeint -> unit = "ocaml_flac_encoder_ogg_init" let create ?(comments = []) ~serialno ~write params = if params.Flac.Encoder.channels <= 0 then raise Flac.Encoder.Invalid_data; let comments = Array.of_list comments in let first_pages_parsed = ref false in let first_pages = ref [] in let header = ref None in let write_wrap write p = match !header with | Some h -> header := None; write (h, p) | None -> header := Some p in let write_first_page p = first_pages := p :: !first_pages in let write = write_wrap (fun p -> if !first_pages_parsed then write p else write_first_page p) in let write b len = write (Bytes.sub_string b 0 len) in let enc = alloc comments ~seek:None ~tell:None ~write params in Gc.finalise cleanup enc; init enc serialno; first_pages_parsed := true; assert (!header = None); { encoder = Obj.magic (enc, params); first_pages = List.rev !first_pages } end module Skeleton = struct external fisbone : Nativeint.t -> Int64.t -> Int64.t -> string -> Ogg.Stream.packet = "ocaml_flac_skeleton_fisbone" let fisbone ?(start_granule = Int64.zero) ?(headers = [("Content-type", "audio/x-flac")]) ~serialno ~samplerate () = let concat s (h, v) = Printf.sprintf "%s%s: %s\r\n" s h v in let s = List.fold_left concat "" headers in fisbone serialno samplerate start_granule s end ocaml-xiph-1.0.0/flac/flac_ogg.mli000066400000000000000000000037071474662033600167440ustar00rootroot00000000000000(* * Copyright 2003-2010 Savonet team * * This file is part of Ocaml-flac. * * Ocaml-flac 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 2 of the License, or * (at your option) any later version. * * Ocaml-flac 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 Ocaml-flac; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (* Author; Romain Beauxis *) (** {1 Ogg/flac encoder/decoder modules for OCaml} *) module Decoder : sig (** Check if an ogg packet is the first * packet of an ogg/flac stream. *) val check_packet : Ogg.Stream.packet -> bool val create : fill:(unit -> unit) -> write:(float array array -> unit) -> Ogg.Stream.stream -> Flac.Decoder.t * Flac.Decoder.info * Flac.Decoder.comments option end module Encoder : sig type t = { encoder : Flac.Encoder.t; first_pages : Ogg.Page.t list } val create : ?comments:(string * string) list -> serialno:Nativeint.t -> write:(Ogg.Page.t -> unit) -> Flac.Encoder.params -> t end (** Ogg/flac skeleton module *) module Skeleton : sig (** Generate a flac fisbone packet with * these parameters, to use in an ogg skeleton. * Default value for [start_granule] is [Int64.zero], * Default value for [headers] is ["Content-type","audio/x-flac"] * * See: http://xiph.org/ogg/doc/skeleton.html. *) val fisbone : ?start_granule:Int64.t -> ?headers:(string * string) list -> serialno:Nativeint.t -> samplerate:Int64.t -> unit -> Ogg.Stream.packet end ocaml-xiph-1.0.0/flac/flac_ogg_stubs.c000066400000000000000000000107501474662033600176210ustar00rootroot00000000000000/* 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 2 * 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, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * * Chunks of this code have been borrowed and influenced * by flac/decode.c and the flac XMMS plugin. * */ #include #include #include #include #include #include #include #include #include #include #include #include "flac_stubs.h" /* C.f. http://flac.sourceforge.net/ogg_mapping.html */ CAMLprim value ocaml_flac_decoder_check_ogg(value v) { CAMLparam1(v); ogg_packet *p = Packet_val(v); unsigned char *h = p->packet; if (p->bytes < 9 || /* FLAC */ h[0] != 0x7f || h[1] != 'F' || h[2] != 'L' || h[3] != 'A' || h[4] != 'C') CAMLreturn(Val_false); CAMLreturn(Val_true); } CAMLprim value ocaml_flac_decoder_packet_data(value v) { CAMLparam1(v); CAMLlocal1(ans); ogg_packet *p = Packet_val(v); ans = caml_alloc_string(p->bytes); memcpy((char *)String_val(ans), p->packet, p->bytes); CAMLreturn(ans); } /* Encoder */ CAMLprim value ocaml_flac_encoder_ogg_init(value _enc, value _serialno) { CAMLparam2(_enc, _serialno); intnat serialno = Nativeint_val(_serialno); ocaml_flac_encoder *enc = Encoder_val(_enc); caml_release_runtime_system(); FLAC__stream_encoder_set_ogg_serial_number(enc->encoder, serialno); FLAC__stream_encoder_init_ogg_stream(enc->encoder, NULL, enc_write_callback, NULL, NULL, NULL, (void *)&enc->callbacks); caml_acquire_runtime_system(); CAMLreturn(Val_unit); } /* Ogg skeleton interface */ /* Wrappers */ static void write32le(unsigned char *ptr, ogg_uint32_t v) { ptr[0] = v & 0xff; ptr[1] = (v >> 8) & 0xff; ptr[2] = (v >> 16) & 0xff; ptr[3] = (v >> 24) & 0xff; } static void write64le(unsigned char *ptr, ogg_int64_t v) { ogg_uint32_t hi = v >> 32; ptr[0] = v & 0xff; ptr[1] = (v >> 8) & 0xff; ptr[2] = (v >> 16) & 0xff; ptr[3] = (v >> 24) & 0xff; ptr[4] = hi & 0xff; ptr[5] = (hi >> 8) & 0xff; ptr[6] = (hi >> 16) & 0xff; ptr[7] = (hi >> 24) & 0xff; } /* Values from http://xiph.org/ogg/doc/skeleton.html */ #define FISBONE_IDENTIFIER "fisbone\0" #define FISBONE_MESSAGE_HEADER_OFFSET 44 #define FISBONE_SIZE 52 /* Code from theorautils.c in ffmpeg2theora */ CAMLprim value ocaml_flac_skeleton_fisbone(value serial, value samplerate, value start, value content) { CAMLparam4(serial, samplerate, start, content); CAMLlocal1(packet); ogg_packet op; int len = FISBONE_SIZE + caml_string_length(content); memset(&op, 0, sizeof(op)); op.packet = malloc(len); if (op.packet == NULL) caml_raise_out_of_memory(); memset(op.packet, 0, len); /* it will be the fisbone packet for the vorbis audio */ memcpy(op.packet, FISBONE_IDENTIFIER, 8); /* identifier */ write32le( op.packet + 8, FISBONE_MESSAGE_HEADER_OFFSET); /* offset of the message header fields */ write32le(op.packet + 12, Nativeint_val(serial)); /* serialno of the vorbis stream */ write32le(op.packet + 16, 2); /* number of header packet, 2 for now. */ /* granulerate, temporal resolution of the bitstream in Hz */ write64le(op.packet + 20, (ogg_int64_t)Int64_val(samplerate)); /* granulerate numerator */ write64le(op.packet + 28, (ogg_int64_t)1); /* granulerate denominator */ write64le(op.packet + 36, (ogg_int64_t)Int64_val(start)); /* start granule */ write32le(op.packet + 44, 2); /* preroll, for flac its 2 ??? */ *(op.packet + 48) = 0; /* granule shift, always 0 for flac */ memcpy(op.packet + FISBONE_SIZE, String_val(content), caml_string_length(content)); op.b_o_s = 0; op.e_o_s = 0; op.bytes = len; packet = value_of_packet(&op); free(op.packet); CAMLreturn(packet); } ocaml-xiph-1.0.0/flac/flac_stubs.c000066400000000000000000000634561474662033600170000ustar00rootroot00000000000000/* 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 2 * 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, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * * Chunks of this code have been borrowed and influenced * by flac/decode.c and the flac XMMS plugin. * */ #include #include #include #include #include #include #include #include #include #include "flac_config.h" #include "flac_stubs.h" #ifndef Bytes_val #define Bytes_val String_val #endif #ifndef INT24_MAX #define INT24_MAX 0x007fffffL #endif /* Thank you * http://www.linux-nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.php#ref_option */ value flac_Val_some(value v) { CAMLparam1(v); CAMLlocal1(some); some = caml_alloc(1, 0); Store_field(some, 0, v); CAMLreturn(some); } /* Threads management. */ static pthread_key_t ocaml_c_thread_key; static pthread_once_t ocaml_c_thread_key_once = PTHREAD_ONCE_INIT; static void ocaml_flac_on_thread_exit(void *key) { caml_c_thread_unregister(); } static void ocaml_flac_make_key() { pthread_key_create(&ocaml_c_thread_key, ocaml_flac_on_thread_exit); } void ocaml_flac_register_thread() { static int initialized = 1; pthread_once(&ocaml_c_thread_key_once, ocaml_flac_make_key); if (caml_c_thread_register() && !pthread_getspecific(ocaml_c_thread_key)) pthread_setspecific(ocaml_c_thread_key, (void *)&initialized); } /* Convenience functions */ #ifdef BIGENDIAN static inline int16_t bswap_16(int16_t x) { return ((((x) >> 8) & 0xff) | (((x) & 0xff) << 8)); } #endif static inline int16_t clip(double s) { if (s < -1) return INT16_MIN; if (s > 1) return INT16_MAX; return (s * INT16_MAX); } CAMLprim value caml_flac_float_to_s16le(value a) { CAMLparam1(a); CAMLlocal1(ans); int c, i; int nc = Wosize_val(a); if (nc == 0) CAMLreturn(caml_copy_string("")); int len = Wosize_val(Field(a, 0)) / Double_wosize; ans = caml_alloc_string(2 * len * nc); int16_t *dst = (int16_t *)String_val(ans); for (c = 0; c < nc; c++) { for (i = 0; i < len; i++) { dst[i * nc + c] = clip(Double_field(Field(a, c), i)); #ifdef BIGENDIAN dst[i * nc + c] = bswap_16(dst[i * nc + c]); #endif } } CAMLreturn(ans); } #define s16tof(x) (((double)x) / INT16_MAX) #ifdef BIGENDIAN #define get_s16le(src, nc, c, i) s16tof(bswap_16(((int16_t *)src)[i * nc + c])) #else #define get_s16le(src, nc, c, i) s16tof(((int16_t *)src)[i * nc + c]) #endif CAMLprim value caml_flac_s16le_to_float(value _src, value _chans) { CAMLparam1(_src); CAMLlocal1(ans); char *src = (char *)Bytes_val(_src); int chans = Int_val(_chans); int samples = caml_string_length(_src) / (2 * chans); int i, c; ans = caml_alloc_tuple(chans); for (c = 0; c < chans; c++) Store_field(ans, c, caml_alloc(samples * Double_wosize, Double_array_tag)); for (c = 0; c < chans; c++) for (i = 0; i < samples; i++) Store_double_field(Field(ans, c), i, get_s16le(src, chans, c, i)); CAMLreturn(ans); } /* Decoder */ /* polymorphic variant utility macros */ #define get_var(x) caml_hash_variant(#x) static value val_of_state(int s) { switch (s) { case FLAC__STREAM_DECODER_SEARCH_FOR_METADATA: return get_var(Search_for_metadata); case FLAC__STREAM_DECODER_READ_METADATA: return get_var(Read_metadata); case FLAC__STREAM_DECODER_SEARCH_FOR_FRAME_SYNC: return get_var(Search_for_frame_sync); case FLAC__STREAM_DECODER_READ_FRAME: return get_var(Read_frame); case FLAC__STREAM_DECODER_END_OF_STREAM: return get_var(End_of_stream); case FLAC__STREAM_DECODER_OGG_ERROR: return get_var(Ogg_error); case FLAC__STREAM_DECODER_SEEK_ERROR: return get_var(Seek_error); case FLAC__STREAM_DECODER_ABORTED: return get_var(Aborted); case FLAC__STREAM_DECODER_MEMORY_ALLOCATION_ERROR: return get_var(Memory_allocation_error); case FLAC__STREAM_DECODER_UNINITIALIZED: return get_var(Uninitialized); default: return get_var(Unknown); } } static value raise_exn_of_error(FLAC__StreamDecoderErrorStatus e) { switch (e) { case FLAC__STREAM_DECODER_ERROR_STATUS_LOST_SYNC: caml_raise_constant(*caml_named_value("flac_dec_exn_lost_sync")); case FLAC__STREAM_DECODER_ERROR_STATUS_BAD_HEADER: caml_raise_constant(*caml_named_value("flac_dec_exn_bad_header")); case FLAC__STREAM_DECODER_ERROR_STATUS_FRAME_CRC_MISMATCH: caml_raise_constant(*caml_named_value("flac_dec_exn_crc_mismatch")); case FLAC__STREAM_DECODER_ERROR_STATUS_UNPARSEABLE_STREAM: caml_raise_constant(*caml_named_value("flac_dec_exn_unparseable_stream")); default: caml_raise_constant(*caml_named_value("flac_exn_internal")); } } /* Caml abstract value containing the decoder. */ #define Decoder_val(v) (*((ocaml_flac_decoder **)Data_custom_val(v))) CAMLprim value ocaml_flac_cleanup_decoder(value e) { ocaml_flac_decoder *dec = Decoder_val(e); caml_remove_generational_global_root(&dec->callbacks.read_cb); caml_remove_generational_global_root(&dec->callbacks.seek_cb); caml_remove_generational_global_root(&dec->callbacks.tell_cb); caml_remove_generational_global_root(&dec->callbacks.eof_cb); caml_remove_generational_global_root(&dec->callbacks.length_cb); caml_remove_generational_global_root(&dec->callbacks.write_cb); caml_remove_generational_global_root(&dec->callbacks.buffer); caml_remove_generational_global_root(&dec->callbacks.output); return Val_unit; } static void finalize_decoder(value e) { ocaml_flac_decoder *dec = Decoder_val(e); FLAC__stream_decoder_delete(dec->decoder); if (dec->callbacks.info != NULL) free(dec->callbacks.info); if (dec->callbacks.meta != NULL) FLAC__metadata_object_delete(dec->callbacks.meta); free(dec); } static struct custom_operations decoder_ops = { "ocaml_flac_decoder", finalize_decoder, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default}; /* start all the callbacks here. */ void dec_metadata_callback(const FLAC__StreamDecoder *decoder, const FLAC__StreamMetadata *metadata, void *client_data) { ocaml_flac_decoder_callbacks *callbacks = (ocaml_flac_decoder_callbacks *)client_data; switch (metadata->type) { case FLAC__METADATA_TYPE_STREAMINFO: if (callbacks->info != NULL) { caml_acquire_runtime_system(); caml_raise_constant(*caml_named_value("flac_exn_internal")); } callbacks->info = malloc(sizeof(FLAC__StreamMetadata_StreamInfo)); if (callbacks->info == NULL) { // This callback is run in non-blocking mode caml_acquire_runtime_system(); caml_raise_out_of_memory(); } memcpy(callbacks->info, &metadata->data.stream_info, sizeof(FLAC__StreamMetadata_StreamInfo)); break; case FLAC__METADATA_TYPE_VORBIS_COMMENT: if (callbacks->meta != NULL) { caml_acquire_runtime_system(); caml_raise_constant(*caml_named_value("flac_exn_internal")); } callbacks->meta = FLAC__metadata_object_clone(metadata); if (callbacks->meta == NULL) { caml_acquire_runtime_system(); caml_raise_out_of_memory(); } break; default: break; } return; } void dec_error_callback(const FLAC__StreamDecoder *decoder, FLAC__StreamDecoderErrorStatus status, void *client_data) { ocaml_flac_register_thread(); caml_acquire_runtime_system(); raise_exn_of_error(status); return; } static FLAC__StreamDecoderSeekStatus dec_seek_callback(const FLAC__StreamDecoder *decoder, FLAC__uint64 absolute_byte_offset, void *client_data) { ocaml_flac_decoder_callbacks *callbacks = (ocaml_flac_decoder_callbacks *)client_data; if (callbacks->seek_cb == Val_none) return FLAC__STREAM_DECODER_SEEK_STATUS_UNSUPPORTED; ocaml_flac_register_thread(); caml_acquire_runtime_system(); caml_callback(callbacks->seek_cb, caml_copy_int64(absolute_byte_offset)); caml_release_runtime_system(); return FLAC__STREAM_DECODER_SEEK_STATUS_OK; } static FLAC__StreamDecoderTellStatus dec_tell_callback(const FLAC__StreamDecoder *decoder, FLAC__uint64 *absolute_byte_offset, void *client_data) { ocaml_flac_decoder_callbacks *callbacks = (ocaml_flac_decoder_callbacks *)client_data; if (callbacks->tell_cb == Val_none) return FLAC__STREAM_DECODER_TELL_STATUS_UNSUPPORTED; ocaml_flac_register_thread(); caml_acquire_runtime_system(); value ret = caml_callback(callbacks->tell_cb, Val_unit); *absolute_byte_offset = (FLAC__uint64)Int64_val(ret); caml_release_runtime_system(); return FLAC__STREAM_DECODER_TELL_STATUS_OK; } static FLAC__StreamDecoderLengthStatus dec_length_callback(const FLAC__StreamDecoder *decoder, FLAC__uint64 *stream_length, void *client_data) { ocaml_flac_decoder_callbacks *callbacks = (ocaml_flac_decoder_callbacks *)client_data; if (callbacks->length_cb == Val_none) return FLAC__STREAM_DECODER_LENGTH_STATUS_UNSUPPORTED; ocaml_flac_register_thread(); caml_acquire_runtime_system(); value ret = caml_callback(callbacks->length_cb, Val_unit); *stream_length = (FLAC__uint64)Int64_val(ret); caml_release_runtime_system(); return FLAC__STREAM_DECODER_LENGTH_STATUS_OK; } static FLAC__bool dec_eof_callback(const FLAC__StreamDecoder *decoder, void *client_data) { ocaml_flac_decoder_callbacks *callbacks = (ocaml_flac_decoder_callbacks *)client_data; if (callbacks->eof_cb == Val_none) return false; ocaml_flac_register_thread(); caml_acquire_runtime_system(); value ret = caml_callback(callbacks->eof_cb, Val_unit); caml_release_runtime_system(); if (ret == Val_true) return true; return false; } FLAC__StreamDecoderReadStatus static dec_read_callback( const FLAC__StreamDecoder *decoder, FLAC__byte buffer[], size_t *bytes, void *client_data) { ocaml_flac_decoder_callbacks *callbacks = (ocaml_flac_decoder_callbacks *)client_data; ocaml_flac_register_thread(); caml_acquire_runtime_system(); int readlen = *bytes; if (callbacks->buflen < readlen) readlen = callbacks->buflen; value ret = caml_callback3(callbacks->read_cb, callbacks->buffer, Val_int(0), Val_int(readlen)); memcpy(buffer, String_val(callbacks->buffer), Int_val(ret)); *bytes = Int_val(ret); caml_release_runtime_system(); if (*bytes == 0) return FLAC__STREAM_DECODER_READ_STATUS_END_OF_STREAM; else return FLAC__STREAM_DECODER_READ_STATUS_CONTINUE; } static inline double sample_to_double(FLAC__int32 x, unsigned bps) { switch (bps) { case 8: return (((double)x) / INT8_MAX); case 16: return (((double)x) / INT16_MAX); case 24: return (((double)x) / INT24_MAX); default: return (((double)x) / INT32_MAX); } } FLAC__StreamDecoderWriteStatus dec_write_callback(const FLAC__StreamDecoder *decoder, const FLAC__Frame *frame, const FLAC__int32 *const buffer[], void *client_data) { ocaml_flac_decoder_callbacks *callbacks = (ocaml_flac_decoder_callbacks *)client_data; int samples = frame->header.blocksize; int channels = frame->header.channels; int bps = frame->header.bits_per_sample; ocaml_flac_register_thread(); caml_acquire_runtime_system(); int c, i; for (c = 0; c < channels; c++) { Store_field(callbacks->output, c, caml_alloc(samples * Double_wosize, Double_array_tag)); for (i = 0; i < samples; i++) Store_double_field(Field(callbacks->output, c), i, sample_to_double(buffer[c][i], bps)); } caml_callback(callbacks->write_cb, callbacks->output); caml_release_runtime_system(); return FLAC__STREAM_DECODER_WRITE_STATUS_CONTINUE; } #define Some_or_none(v) (v == Val_none ? Val_none : Some_val(v)) CAMLprim value ocaml_flac_decoder_alloc_native(value seek, value tell, value length, value eof, value read, value write, value u) { CAMLparam5(seek, tell, length, eof, read); CAMLxparam1(write); CAMLlocal1(ans); // Initialize things ocaml_flac_decoder *dec = malloc(sizeof(ocaml_flac_decoder)); if (dec == NULL) caml_raise_out_of_memory(); dec->decoder = FLAC__stream_decoder_new(); dec->callbacks.seek_cb = Some_or_none(seek); caml_register_generational_global_root(&dec->callbacks.seek_cb); dec->callbacks.tell_cb = Some_or_none(tell); caml_register_generational_global_root(&dec->callbacks.tell_cb); dec->callbacks.length_cb = Some_or_none(length); caml_register_generational_global_root(&dec->callbacks.length_cb); dec->callbacks.eof_cb = Some_or_none(eof); caml_register_generational_global_root(&dec->callbacks.eof_cb); dec->callbacks.write_cb = write; caml_register_generational_global_root(&dec->callbacks.write_cb); dec->callbacks.read_cb = read; caml_register_generational_global_root(&dec->callbacks.read_cb); dec->callbacks.buflen = 1024; dec->callbacks.buffer = caml_alloc_string(dec->callbacks.buflen); caml_register_generational_global_root(&dec->callbacks.buffer); dec->callbacks.output = Val_none; caml_register_generational_global_root(&dec->callbacks.output); dec->callbacks.info = NULL; dec->callbacks.meta = NULL; // Accept vorbis comments FLAC__stream_decoder_set_metadata_respond(dec->decoder, FLAC__METADATA_TYPE_VORBIS_COMMENT); // Fill custom value ans = caml_alloc_custom(&decoder_ops, sizeof(ocaml_flac_decoder *), 1, 0); Decoder_val(ans) = dec; CAMLreturn(ans); } CAMLprim value ocaml_flac_decoder_alloc_bytecode(value *argv, int argn) { return ocaml_flac_decoder_alloc_native(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ocaml_flac_decoder_init(value _dec) { CAMLparam1(_dec); ocaml_flac_decoder *dec = Decoder_val(_dec); // Intialize decoder caml_release_runtime_system(); FLAC__stream_decoder_init_stream( dec->decoder, dec_read_callback, dec_seek_callback, dec_tell_callback, dec_length_callback, dec_eof_callback, dec_write_callback, dec_metadata_callback, dec_error_callback, (void *)&dec->callbacks); FLAC__stream_decoder_process_until_end_of_metadata(dec->decoder); caml_acquire_runtime_system(); caml_modify_generational_global_root( &dec->callbacks.output, caml_alloc_tuple(dec->callbacks.info->channels)); CAMLreturn(Val_unit); } CAMLprim value ocaml_flac_decoder_state(value d) { CAMLparam1(d); ocaml_flac_decoder *dec = Decoder_val(d); int ret = FLAC__stream_decoder_get_state(dec->decoder); CAMLreturn(val_of_state(ret)); } CAMLprim value ocaml_flac_decoder_info(value d) { CAMLparam1(d); CAMLlocal4(ret, m, i, tmp); ocaml_flac_decoder *dec = Decoder_val(d); FLAC__StreamMetadata_StreamInfo *info = dec->callbacks.info; if (info == NULL) caml_raise_constant(*caml_named_value("flac_exn_internal")); // Info block i = caml_alloc_tuple(5); Store_field(i, 0, Val_int(info->sample_rate)); Store_field(i, 1, Val_int(info->channels)); Store_field(i, 2, Val_int(info->bits_per_sample)); Store_field(i, 3, caml_copy_int64(info->total_samples)); tmp = caml_alloc_string(16); memcpy(Bytes_val(tmp), info->md5sum, 16); Store_field(i, 4, tmp); // Comments block if (dec->callbacks.meta != NULL) { m = caml_alloc_tuple(2); FLAC__StreamMetadata_VorbisComment coms = dec->callbacks.meta->data.vorbis_comment; // First comment is vendor string if (coms.vendor_string.entry != NULL) Store_field(m, 0, caml_copy_string((char *)coms.vendor_string.entry)); else Store_field(m, 0, caml_copy_string("")); // Now the other metadata tmp = caml_alloc_tuple(coms.num_comments); int i; for (i = 0; i < coms.num_comments; i++) Store_field(tmp, i, caml_copy_string((char *)coms.comments[i].entry)); Store_field(m, 1, tmp); m = flac_Val_some(m); } else m = Val_none; ret = caml_alloc_tuple(2); Store_field(ret, 0, i); Store_field(ret, 1, m); CAMLreturn(ret); } CAMLprim value ocaml_flac_decoder_process(value d) { CAMLparam1(d); ocaml_flac_decoder *dec = Decoder_val(d); // Process one frame caml_release_runtime_system(); FLAC__stream_decoder_process_single(dec->decoder); caml_acquire_runtime_system(); CAMLreturn(Val_unit); } CAMLprim value ocaml_flac_decoder_seek(value d, value pos) { CAMLparam2(d, pos); FLAC__uint64 offset = Int64_val(pos); FLAC_API FLAC__bool ret; ocaml_flac_decoder *dec = Decoder_val(d); caml_release_runtime_system(); ret = FLAC__stream_decoder_seek_absolute(dec->decoder, offset); caml_acquire_runtime_system(); if (ret == true) CAMLreturn(Val_true); else CAMLreturn(Val_false); } CAMLprim value ocaml_flac_decoder_reset(value d) { CAMLparam1(d); FLAC_API FLAC__bool ret; ocaml_flac_decoder *dec = Decoder_val(d); caml_release_runtime_system(); ret = FLAC__stream_decoder_reset(dec->decoder); caml_acquire_runtime_system(); if (ret == true) CAMLreturn(Val_true); else CAMLreturn(Val_false); } CAMLprim value ocaml_flac_decoder_flush(value d) { CAMLparam1(d); FLAC_API FLAC__bool ret; ocaml_flac_decoder *dec = Decoder_val(d); caml_release_runtime_system(); ret = FLAC__stream_decoder_flush(dec->decoder); caml_acquire_runtime_system(); if (ret == true) CAMLreturn(Val_true); else CAMLreturn(Val_false); } /* Encoder */ CAMLprim value ocaml_flac_cleanup_encoder(value e) { ocaml_flac_encoder *enc = Encoder_val(e); caml_remove_generational_global_root(&enc->callbacks.write_cb); caml_remove_generational_global_root(&enc->callbacks.seek_cb); caml_remove_generational_global_root(&enc->callbacks.tell_cb); caml_remove_generational_global_root(&enc->callbacks.buffer); return Val_unit; } static void finalize_encoder(value e) { ocaml_flac_encoder *enc = Encoder_val(e); if (enc->encoder != NULL) FLAC__stream_encoder_delete(enc->encoder); if (enc->meta != NULL) FLAC__metadata_object_delete(enc->meta); if (enc->buf != NULL) free(enc->buf); if (enc->lines != NULL) free(enc->lines); free(enc); } static struct custom_operations encoder_ops = { "ocaml_flac_encoder", finalize_encoder, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default}; FLAC__StreamEncoderWriteStatus enc_write_callback(const FLAC__StreamEncoder *encoder, const FLAC__byte buffer[], size_t bytes, unsigned samples, unsigned current_frame, void *client_data) { int pos, len; ocaml_flac_encoder_callbacks *callbacks = (ocaml_flac_encoder_callbacks *)client_data; ocaml_flac_register_thread(); caml_acquire_runtime_system(); pos = 0; while (pos < bytes) { len = bytes - pos; if (callbacks->buflen < len) len = callbacks->buflen; memcpy(Bytes_val(callbacks->buffer), buffer + pos, len); caml_callback2(callbacks->write_cb, callbacks->buffer, Val_int(len)); pos += len; } caml_release_runtime_system(); return FLAC__STREAM_ENCODER_WRITE_STATUS_OK; } FLAC__StreamEncoderSeekStatus enc_seek_callback(const FLAC__StreamEncoder *encoder, FLAC__uint64 absolute_byte_offset, void *client_data) { ocaml_flac_encoder_callbacks *callbacks = (ocaml_flac_encoder_callbacks *)client_data; if (callbacks->seek_cb == Val_none) return FLAC__STREAM_ENCODER_SEEK_STATUS_UNSUPPORTED; ocaml_flac_register_thread(); caml_acquire_runtime_system(); caml_callback(callbacks->seek_cb, caml_copy_int64(absolute_byte_offset)); caml_release_runtime_system(); return FLAC__STREAM_ENCODER_SEEK_STATUS_OK; } static FLAC__StreamEncoderTellStatus enc_tell_callback(const FLAC__StreamEncoder *decoder, FLAC__uint64 *absolute_byte_offset, void *client_data) { ocaml_flac_encoder_callbacks *callbacks = (ocaml_flac_encoder_callbacks *)client_data; if (callbacks->tell_cb == Val_none) return FLAC__STREAM_ENCODER_TELL_STATUS_UNSUPPORTED; ocaml_flac_register_thread(); caml_acquire_runtime_system(); *absolute_byte_offset = (FLAC__uint64)Int64_val(caml_callback(callbacks->tell_cb, Val_unit)); caml_release_runtime_system(); return FLAC__STREAM_ENCODER_TELL_STATUS_OK; } CAMLprim value ocaml_flac_encoder_vorbiscomment_entry_name_is_legal(value name) { CAMLparam1(name); CAMLreturn(Val_bool( FLAC__format_vorbiscomment_entry_name_is_legal(String_val(name)))); } CAMLprim value ocaml_flac_encoder_vorbiscomment_entry_value_is_legal(value _value) { CAMLparam1(_value); CAMLreturn(Val_bool(FLAC__format_vorbiscomment_entry_value_is_legal( (const FLAC__byte *)String_val(_value), caml_string_length(_value)))); } CAMLprim value ocaml_flac_encoder_alloc(value comments, value seek, value tell, value write, value params) { CAMLparam5(comments, seek, tell, write, params); CAMLlocal1(ret); FLAC__StreamEncoder *enc = FLAC__stream_encoder_new(); if (enc == NULL) caml_raise_out_of_memory(); FLAC__stream_encoder_set_channels(enc, Int_val(Field(params, 0))); FLAC__stream_encoder_set_bits_per_sample(enc, Int_val(Field(params, 1))); FLAC__stream_encoder_set_sample_rate(enc, Int_val(Field(params, 2))); if (Field(params, 3) != Val_none) FLAC__stream_encoder_set_compression_level( enc, Int_val(Some_val(Field(params, 3)))); if (Field(params, 4) != Val_none) FLAC__stream_encoder_set_total_samples_estimate( enc, Int64_val(Some_val(Field(params, 4)))); ocaml_flac_encoder *caml_enc = malloc(sizeof(ocaml_flac_encoder)); if (caml_enc == NULL) { FLAC__stream_encoder_delete(enc); caml_raise_out_of_memory(); } caml_enc->encoder = enc; caml_enc->callbacks.seek_cb = Some_or_none(seek); caml_register_generational_global_root(&caml_enc->callbacks.seek_cb); caml_enc->callbacks.tell_cb = Some_or_none(tell); caml_register_generational_global_root(&caml_enc->callbacks.tell_cb); caml_enc->callbacks.write_cb = write; caml_register_generational_global_root(&caml_enc->callbacks.write_cb); caml_enc->callbacks.buflen = 1024; caml_enc->callbacks.buffer = caml_alloc_string(caml_enc->callbacks.buflen); caml_register_generational_global_root(&caml_enc->callbacks.buffer); caml_enc->buf = NULL; caml_enc->lines = NULL; // Fill custom value ret = caml_alloc_custom(&encoder_ops, sizeof(ocaml_flac_encoder *), 1, 0); Encoder_val(ret) = caml_enc; /* Metadata */ caml_enc->meta = FLAC__metadata_object_new(FLAC__METADATA_TYPE_VORBIS_COMMENT); if (caml_enc->meta == NULL) { FLAC__stream_encoder_delete(enc); caml_raise_out_of_memory(); } FLAC__StreamMetadata_VorbisComment_Entry entry; /* Vendor string is ignored by libFLAC.. */ int i; for (i = 0; i < Wosize_val(comments); i++) { if (!FLAC__metadata_object_vorbiscomment_entry_from_name_value_pair( &entry, String_val(Field(Field(comments, i), 0)), String_val(Field(Field(comments, i), 1)))) caml_raise_constant(*caml_named_value("flac_enc_exn_invalid_metadata")); FLAC__metadata_object_vorbiscomment_append_comment(caml_enc->meta, entry, true); } FLAC__stream_encoder_set_metadata(enc, &caml_enc->meta, 1); CAMLreturn(ret); } CAMLprim value ocaml_flac_encoder_init(value _enc) { CAMLparam1(_enc); ocaml_flac_encoder *enc = Encoder_val(_enc); caml_release_runtime_system(); FLAC__stream_encoder_init_stream(enc->encoder, enc_write_callback, enc_seek_callback, enc_tell_callback, NULL, (void *)&enc->callbacks); caml_acquire_runtime_system(); CAMLreturn(Val_unit); } static inline FLAC__int32 sample_from_double(double x, unsigned bps) { if (x < -1) { x = -1; } else if (x > 1) { x = 1; } switch (bps) { case 8: return x * INT8_MAX; case 16: return x * INT16_MAX; case 24: return x * INT24_MAX; default: return x * INT32_MAX; } } CAMLprim value ocaml_flac_encoder_process(value _enc, value data, value bps) { CAMLparam2(_enc, data); ocaml_flac_encoder *enc = Encoder_val(_enc); int chans = Wosize_val(data); int samples = Wosize_val(Field(data, 0)) / Double_wosize; int i; int c; if (enc->buf != NULL) free(enc->buf); if (enc->lines != NULL) free(enc->lines); enc->buf = malloc(chans * sizeof(FLAC__int32 *)); if (enc->buf == NULL) caml_raise_out_of_memory(); enc->lines = malloc(chans * samples * sizeof(FLAC__int32)); enc->buf[0] = enc->lines; if (enc->lines == NULL) caml_raise_out_of_memory(); for (c = 0; c < chans; c++) { if (c > 0) enc->buf[c] = enc->buf[c - 1] + samples; for (i = 0; i < samples; i++) enc->buf[c][i] = sample_from_double(Double_field(Field(data, c), i), Int_val(bps)); } caml_release_runtime_system(); FLAC__stream_encoder_process(enc->encoder, (const FLAC__int32 *const *)enc->buf, samples); caml_acquire_runtime_system(); CAMLreturn(Val_unit); } CAMLprim value ocaml_flac_encoder_finish(value _enc) { CAMLparam1(_enc); ocaml_flac_encoder *enc = Encoder_val(_enc); caml_release_runtime_system(); FLAC__stream_encoder_finish(enc->encoder); caml_acquire_runtime_system(); CAMLreturn(Val_unit); } ocaml-xiph-1.0.0/flac/flac_stubs.h000066400000000000000000000061241474662033600167720ustar00rootroot00000000000000/* 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 2 * 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, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * * Chunks of this code have been borrowed and influenced * by flac/decode.c and the flac XMMS plugin. * */ #include #include #include #include #include #include #define Val_none Val_int(0) #define Some_val(v) Field(v, 0) value flac_Val_some(value v); /* Decoder */ typedef struct ocaml_flac_decoder_callbacks { /* This is used for callback from caml. */ value read_cb; value seek_cb; value tell_cb; value length_cb; value eof_cb; value write_cb; value output; value buffer; int buflen; FLAC__StreamMetadata_StreamInfo *info; FLAC__StreamMetadata *meta; } ocaml_flac_decoder_callbacks; typedef struct ocaml_flac_decoder { FLAC__StreamDecoder *decoder; ocaml_flac_decoder_callbacks callbacks; } ocaml_flac_decoder; /* Caml abstract value containing the decoder. */ #define Decoder_val(v) (*((ocaml_flac_decoder **)Data_custom_val(v))) void dec_metadata_callback(const FLAC__StreamDecoder *decoder, const FLAC__StreamMetadata *metadata, void *client_data); FLAC__StreamDecoderWriteStatus dec_write_callback(const FLAC__StreamDecoder *decoder, const FLAC__Frame *frame, const FLAC__int32 *const buffer[], void *client_data); void dec_error_callback(const FLAC__StreamDecoder *decoder, FLAC__StreamDecoderErrorStatus status, void *client_data); /* Encoder */ typedef struct ocaml_flac_encoder_callbacks { value write_cb; value seek_cb; value tell_cb; value buffer; int buflen; } ocaml_flac_encoder_callbacks; typedef struct ocaml_flac_encoder { FLAC__StreamEncoder *encoder; FLAC__StreamMetadata *meta; FLAC__int32 **buf; FLAC__int32 *lines; ocaml_flac_encoder_callbacks callbacks; } ocaml_flac_encoder; /* Caml abstract value containing the decoder. */ #define Encoder_val(v) (*((ocaml_flac_encoder **)Data_custom_val(v))) value ocaml_flac_encoder_alloc(value comments, value seek, value tell, value write, value params); FLAC__StreamEncoderWriteStatus enc_write_callback(const FLAC__StreamEncoder *encoder, const FLAC__byte buffer[], size_t bytes, unsigned samples, unsigned current_frame, void *client_data); /* Threads management */ void ocaml_flac_register_thread(); ocaml-xiph-1.0.0/ogg.opam000066400000000000000000000014351474662033600152210ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "1.0.0" synopsis: "Bindings to libogg" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] license: "LGPL-2.1-only" homepage: "https://github.com/savonet/ocaml-xiph" bug-reports: "https://github.com/savonet/ocaml-xiph/issues" depends: [ "conf-libogg" "conf-pkg-config" "ocaml" {>= "4.08.0"} "dune" {>= "2.8"} "dune-configurator" "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] dev-repo: "git+https://github.com/savonet/ocaml-xiph.git" x-maintenance-intent: ["(latest)"] ocaml-xiph-1.0.0/ogg.opam.template000066400000000000000000000000431474662033600170250ustar00rootroot00000000000000x-maintenance-intent: ["(latest)"] ocaml-xiph-1.0.0/ogg/000077500000000000000000000000001474662033600143405ustar00rootroot00000000000000ocaml-xiph-1.0.0/ogg/config/000077500000000000000000000000001474662033600156055ustar00rootroot00000000000000ocaml-xiph-1.0.0/ogg/config/discover.ml000066400000000000000000000011271474662033600177560ustar00rootroot00000000000000module C = Configurator.V1 let () = C.main ~name:"ogg-pkg-config" (fun c -> let default : C.Pkg_config.package_conf = { libs = ["-logg"]; cflags = [] } in let conf = match C.Pkg_config.get c with | None -> default | Some pc -> ( match C.Pkg_config.query_expr_err pc ~package:"ogg" ~expr:"ogg" with | Error msg -> failwith msg | Ok deps -> deps) in C.Flags.write_sexp "c_flags.sexp" conf.cflags; C.Flags.write_sexp "c_library_flags.sexp" conf.libs) ocaml-xiph-1.0.0/ogg/config/dune000066400000000000000000000000751474662033600164650ustar00rootroot00000000000000(executable (name discover) (libraries dune.configurator)) ocaml-xiph-1.0.0/ogg/dune000066400000000000000000000010341474662033600152140ustar00rootroot00000000000000(library (name ogg) (public_name ogg) (synopsis "OCaml bindings for libogg") (libraries threads) (modules ogg) (install_c_headers ocaml-ogg) (foreign_stubs (language c) (names ogg_stubs) (flags (:include c_flags.sexp))) (c_library_flags (:include c_library_flags.sexp))) (library (name ogg_decoder) (public_name ogg.decoder) (synopsis "Ogg decoding library with pluggable decoders") (libraries ogg) (modules ogg_decoder)) (rule (targets c_flags.sexp c_library_flags.sexp) (action (run ./config/discover.exe))) ocaml-xiph-1.0.0/ogg/ocaml-ogg.h000066400000000000000000000037511474662033600163640ustar00rootroot00000000000000/* * Copyright 2007 Samuel Mimram * * This file is part of ocaml-ogg. * * ocaml-ogg is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * ocaml-ogg 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 Lesser General Public License * along with ocaml-ogg; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * As a special exception to the GNU Library General Public License, you may * link, statically or dynamically, a "work that uses the Library" with a * publicly distributed version of the Library to produce an executable file * containing portions of the Library, and distribute that executable file under * terms of your choice, without any of the additional requirements listed in * clause 6 of the GNU Library General Public License. By "a publicly * distributed version of the Library", we mean either the unmodified Library as * distributed by The Savonet Team, or a modified version of the Library that is * distributed under the conditions defined in clause 3 of the GNU Library * General Public License. This exception does not however invalidate any other * reasons why the executable file might be covered by the GNU Library General * Public License. * */ #include #define Sync_state_val(v) (*((ogg_sync_state **)Data_custom_val(v))) #define Stream_state_val(v) (*((ogg_stream_state **)Data_custom_val(v))) #define Packet_val(v) (*((ogg_packet **)Data_custom_val(v))) value value_of_page(ogg_page *op); value value_of_packet(ogg_packet *op); ogg_page *page_of_value(value v, ogg_page *op); ocaml-xiph-1.0.0/ogg/ogg.ml000066400000000000000000000132141474662033600154470ustar00rootroot00000000000000(* * Copyright 2007-2011 Savonet team * * This file is part of ocaml-ogg. * * ocaml-ogg is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * ocaml-ogg 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 Lesser General Public License * along with ocaml-ogg; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * As a special exception to the GNU Library General Public License, you may * link, statically or dynamically, a "work that uses the Library" with a publicly * distributed version of the Library to produce an executable file containing * portions of the Library, and distribute that executable file under terms of * your choice, without any of the additional requirements listed in clause 6 * of the GNU Library General Public License. * By "a publicly distributed version of the Library", we mean either the unmodified * Library as distributed by The Savonet Team, or a modified version of the Library that is * distributed under the conditions defined in clause 3 of the GNU Library General * Public License. This exception does not however invalidate any other reasons why * the executable file might be covered by the GNU Library General Public License. * *) (* * Functions for manipulating ogg streams files using libogg. * * @author Samuel Mimram *) exception Not_enough_data exception Bad_data exception Out_of_sync exception End_of_stream exception Internal_error let () = Callback.register_exception "ogg_exn_not_enough_data" Not_enough_data; Callback.register_exception "ogg_exn_bad_data" Bad_data; Callback.register_exception "ogg_exn_out_of_sync" Out_of_sync; Callback.register_exception "ogg_exn_eos" End_of_stream; Callback.register_exception "ogg_exn_internal_error" Internal_error module Page = struct type t = string * string external serialno : t -> nativeint = "ocaml_ogg_page_serialno" external eos : t -> bool = "ocaml_ogg_page_eos" external bos : t -> bool = "ocaml_ogg_page_bos" external packets : t -> int = "ocaml_ogg_page_packets" external continued : t -> bool = "ocaml_ogg_page_continued" external version : t -> int = "ocaml_ogg_page_version" external granulepos : t -> Int64.t = "ocaml_ogg_page_granulepos" external pageno : t -> nativeint = "ocaml_ogg_page_pageno" external set_checksum : t -> unit = "ocaml_ogg_page_checksum_set" end module Stream = struct type stream type packet external packet_granulepos : packet -> Int64.t = "ocaml_ogg_stream_packet_granulepos" external create : nativeint -> stream = "ocaml_ogg_stream_init" let create ?(serial = Random.nativeint (Nativeint.of_int 0x3FFFFFFF)) () = create serial external serialno : stream -> nativeint = "ocaml_ogg_stream_serialno" external eos : stream -> bool = "ocaml_ogg_stream_eos" external terminate : stream -> Page.t = "ocaml_ogg_stream_terminate" external get_page : stream -> unit -> Page.t = "ocaml_ogg_stream_pageout" external get_page_fill : stream -> int -> Page.t = "ocaml_ogg_stream_pageout" let get_page ?fill os = match fill with | Some bytes -> get_page_fill os bytes | None -> get_page os () external get_packet : stream -> packet = "ocaml_ogg_stream_packetout" external peek_packet : stream -> packet = "ocaml_ogg_stream_packetpeek" external peek_granulepos : stream -> Int64.t = "ocaml_ogg_stream_granulepospeek" external skip_packet : stream -> unit = "ocaml_ogg_stream_packet_advance" external put_packet : stream -> packet -> unit = "ocaml_ogg_stream_packetin" external put_page : stream -> Page.t -> unit = "ocaml_ogg_stream_pagein" external flush_page : stream -> Page.t = "ocaml_ogg_flush_stream" let terminate os = let rec f pages = try f (flush_page os :: pages) with Not_enough_data -> pages in let pages = f [] in List.rev (terminate os :: pages) end module Sync = struct (** Internal type for sync state *) type sync type read = bytes -> int -> int -> int (** External type for sync state. References the C sync structure, and the read function *) type t = (read * sync) ref external create : unit -> sync = "ocaml_ogg_sync_init" let create f = ref (f, create ()) let create_from_file f = let fd = Unix.openfile f [Unix.O_RDONLY] 0o400 in (create (Unix.read fd), fd) external read : read -> sync -> Page.t = "ocaml_ogg_sync_read" let read s = let f, s = !s in read f s external reset : sync -> unit = "ocaml_ogg_sync_reset" let reset ?read_func x = let f, s = !x in reset s; match read_func with None -> x := (f, s) | Some v -> x := (v, s) external seek : read -> sync -> Page.t = "ocaml_ogg_sync_pageseek" let seek x = let f, s = !x in seek f s end module Skeleton = struct external fishead : Int64.t -> Int64.t -> Int64.t -> Int64.t -> Int32.t -> Stream.packet = "ocaml_ogg_skeleton_fishead" let fishead ?(presentation_numerator = Int64.zero) ?(presentation_denominator = Int64.of_int 1000) ?(basetime_numerator = Int64.zero) ?(basetime_denominator = Int64.of_int 1000) ?(utc = Int32.zero) () = fishead presentation_numerator presentation_denominator basetime_numerator basetime_denominator utc external eos : unit -> Stream.packet = "ocaml_ogg_skeleton_eos" end ocaml-xiph-1.0.0/ogg/ogg.mli000066400000000000000000000263561474662033600156330ustar00rootroot00000000000000(* * Copyright 2007-2011 Savonet team * * This file is part of ocaml-ogg. * * ocaml-ogg is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * ocaml-ogg 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 Lesser General Public License * along with ocaml-ogg; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * As a special exception to the GNU Library General Public License, you may * link, statically or dynamically, a "work that uses the Library" with a publicly * distributed version of the Library to produce an executable file containing * portions of the Library, and distribute that executable file under terms of * your choice, without any of the additional requirements listed in clause 6 * of the GNU Library General Public License. * By "a publicly distributed version of the Library", we mean either the unmodified * Library as distributed by The Savonet Team, or a modified version of the Library that is * distributed under the conditions defined in clause 3 of the GNU Library General * Public License. This exception does not however invalidate any other reasons why * the executable file might be covered by the GNU Library General Public License. * *) (** * Functions for manipulating ogg streams files using libogg. * * @author Samuel Mimram, Romain Beauxis *) exception Not_enough_data exception Bad_data exception Out_of_sync exception End_of_stream exception Internal_error (** * The [page] struct encapsulates the data for an Ogg page. * * Ogg pages are the fundamental unit of framing and interleave in an ogg * bitstream. They are made up of packet segments of 255 bytes each. There can * be as many as 255 packet segments per page, for a maximum page size of a * little under 64 kB. This is not a practical limitation as the segments can be * joined across page boundaries allowing packets of arbitrary size. In practice * pages are usually around 4 kB. *) module Page : sig (** A page is a header and a body *) type t = string * string (** * Returns the unique serial number for the logical bitstream of this page. * Each page contains the serial number for the logical bitstream that it belongs to.*) val serialno : t -> nativeint (** * Indicates whether this page is at the end of the logical bitstream. *) val eos : t -> bool (** * Indicates whether this page is at the begining of the logical bitstream. *) val bos : t -> bool (** * Indicates whether this page contains packet data which has been * continued from the previous page. *) val continued : t -> bool (** * Returns the number of packets that are completed on this page. * If the leading packet is begun on a previous page, but ends on this page, it's counted. * * If a page consists of a packet begun on a previous page, and a new packet begun * (but not completed) on this page, the return will be: * * [packets page] will return [1], * [continued paged] will return [true] * * If a page happens to be a single packet that was begun on a previous page, * and spans to the next page (in the case of a three or more page packet), the return will be: * * [packets page] will return 0, * [continued page] will return [true].*) val packets : t -> int (** * This function returns the version of ogg_page used in this page. * In current versions of libogg, all ogg_page structs have the same version, * so [0] should always be returned. *) val version : t -> int (** * Returns the exact granular position of the packet data contained at the end of this page. * * This is useful for tracking location when seeking or decoding. * * For example, in audio codecs this position is the pcm sample number and * in video this is the frame number.*) val granulepos : t -> Int64.t (** * Returns the sequential page number. * * This is useful for ordering pages or determining when pages have been lost. *) val pageno : t -> nativeint (** * Checksums an ogg_page. *) val set_checksum : t -> unit end module Sync : sig type t (** Type for read functions. *) type read = bytes -> int -> int -> int (** * This function is used to initialize a [Sync.t] to a known initial value * in preparation for manipulation of an Ogg bitstream. * * The function passed is used to fill the stream with new data. *) val create : read -> t (** * Wrapper around [create] to open a file as the ogg stream. *) val create_from_file : string -> t * Unix.file_descr (** * Read a page from [Sync.t] * * Raises [End_of_stream] if the reading function returned an empty string. * Raises [Out_of_sync] if data is not synced and some byte where skiped. *) val read : t -> Page.t (** * This function is used to reset the internal counters of the * [Sync.t] to initial values. * * [read_func] is optional and is a new function to read new data. *) val reset : ?read_func:read -> t -> unit (** * This function synchronizes the ogg_sync_state struct to the next ogg_page. * * This is useful when seeking within a bitstream. page_seek will synchronize * to the next page in the bitstream and return information about how many bytes * we advanced or skipped in order to do so. *) val seek : t -> Page.t end module Stream : sig (** * The [stream] values track the current encode/decode state of the * current logical bitstream. *) type stream (** * A data packet to pass to the decoder *) type packet (** * Create a [stream]. *) val create : ?serial:nativeint -> unit -> stream (** * Get a stream's serial number. *) val serialno : stream -> nativeint (** Returns true if the end of stream has been reached. *) val eos : stream -> bool (** Terminate the stream and return its final pages. *) val terminate : stream -> Page.t list (** * This function forms packets into pages. Internally, * it assembles the accumulated packet bodies into an Ogg page * suitable for writing to a stream. * * If no [fill] argument is passed, this function will only return * a page when a "reasonable" amount of packet data is available. * Normally this is appropriate since it limits the overhead of the * Ogg page headers in the bitstream. * * If a [fill] argument is passed, this function will return a page when at * least four packets have been accumulated and accumulated packet data meets * or exceeds the specified number of bytes, and/or when the accumulated * packet data meets/exceeds the maximum page size regardless of accumulated * packet count. * * The exception [Not_enough_data] is raised if not enough data is available * to generate the page. * * Call [flush_page] if immediate page generation is desired. This * may be occasionally necessary, for example, to limit the temporal * latency of a variable bitrate stream. *) val get_page : ?fill:int -> stream -> Page.t (** * This function adds a complete page to the bitstream. * * In a typical decoding situation, this function would be called after * using [Sync.read] to create a valid [Page.t] * * Raises [Bad_data] if the serial number of the page did not match the * serial number of the bitstream, or the page version was incorrect. *) val put_page : stream -> Page.t -> unit (** * This function assembles a data packet for output * to the codec decoding engine. * * Each successive call returns the next complete packet built from those segments. * In a typical decoding situation, this should be used after calling * [put_page] to submit a page of data to the bitstream. * * This function should *not* be used. Because of ocaml's paradigm, it is necessary * to copy each packet since they are only valid until this function is called again. * When dealing with many packets, this will lead to multiple unecessary memory allocation * and desallocation. * * Raises [Not_enough_data] if more data is needed and another page should be submitted. * * Raises [Out_of_sync] if we are out of sync and there is a gap in the data. *) val get_packet : stream -> packet (** * This function assembles a data packet for output * to the codec decoding engine without advancing the stream. * * Raises [Not_enough_data] if more data is needed and another page should be submitted. * * Raises [Out_of_sync] if we are out of sync and there is a gap in the data *) val peek_packet : stream -> packet (** This function picks up the granule position * of the next packet in the stream without advancing it. * * Raises [Not_enough_data] if more data is needed and another page should be submitted. * * Raises [Out_of_sync] if we are out of sync and there is a gap in the data *) val peek_granulepos : stream -> Int64.t (** This function discards the next packet in the stream. * * Raises [Not_enough_data] if more data is needed and another page should be submitted. * * Raises [Out_of_sync] if we are out of sync and there is a gap in the data *) val skip_packet : stream -> unit (** * This function submits a packet to the bitstream for page encapsulation. * After this is called, more packets can be submitted, or pages can be written out. * * This function is provided to ease ogg strea multiplexing, where packet submission * order is important. It should not be used to encoder further data. *) val put_packet : stream -> packet -> unit (** * This function checks for remaining packets inside the stream and forces * remaining packets into a page, regardless of the size of the page. * * This should only be used when you want to flush an undersized page from the * middle of the stream. Otherwise, [get_page] should always be used. * * This function can be used to verify that all packets have been flushed. * * Raises [Not_enough_data] if all packet data has already been flushed into pages, * and there are no packets to put into the page. *) val flush_page : stream -> Page.t (** Returns a packet's granule position. *) val packet_granulepos : packet -> Int64.t end module Skeleton : sig (** * Create an initial ogg skeleton packet ('fishead'), * to complete with data packet from the various codecs * in the stream ('fishbone'). * See: http://xiph.org/ogg/doc/skeleton.html. *) val fishead : ?presentation_numerator:Int64.t -> ?presentation_denominator:Int64.t -> ?basetime_numerator:Int64.t -> ?basetime_denominator:Int64.t -> ?utc:Int32.t -> unit -> Stream.packet (** Create an end-of-stream packet for * an ogg skeleton logical stream *) val eos : unit -> Stream.packet end ocaml-xiph-1.0.0/ogg/ogg_decoder.ml000066400000000000000000000554551474662033600171510ustar00rootroot00000000000000(* * Copyright 2007-2011 Savonet team * * This file is part of ocaml-ogg. * * ocaml-ogg is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * ocaml-ogg 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 Lesser General Public License * along with ocaml-ogg; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * As a special exception to the GNU Library General Public License, you may * link, statically or dynamically, a "work that uses the Library" with * a publicly distributed version of the Library to produce an executable file * containing portions of the Library, and distribute that executable file * under terms of your choice, without any of the additional requirements * listed in clause 6 of the GNU Library General Public License. * By "a publicly distributed version of the Library", we mean either * the unmodified Library as distributed by INRIA, or a modified version of * the Library that is distributed under the conditions defined in clause 3 * of the GNU Library General Public License. This exception does not however * invalidate any other reasons why the executable file might be covered by * the GNU Library General Public License. * *) (** Ogg stream demuxer *) type metadata = string * (string * string) list type ('a, 'b) decoder = { name : string; info : unit -> 'a * metadata; decode : ('b -> unit) -> unit; restart : fill:(unit -> unit) -> Ogg.Stream.stream -> unit; samples_of_granulepos : Int64.t -> Int64.t; } type audio_info = { channels : int; sample_rate : int } type audio_data = float array array type audio_ba_data = (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t array type video_plane = (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t (** Only supported for now: plannar YUV formats. *) type video_format = | Yuvj_420 (* Planar YCbCr 4:2:0. Each component is an uint8_t, * luma and chroma values are full range (0x00 .. 0xff) *) | Yuvj_422 (* Planar YCbCr 4:2:2. Each component is an uint8_t, * luma and chroma values are full range (0x00 .. 0xff) *) | Yuvj_444 (* Planar YCbCr 4:4:4. Each component is an uint8_t, * luma and chroma values are full range (0x00 .. 0xff) *) type video_info = { fps_numerator : int; fps_denominator : int; width : int; (** Width of the Y' luminance plane *) height : int; (** Height of the luminance plane *) } type video_data = { format : video_format; frame_width : int; frame_height : int; y_stride : int; (** Length, in bytes, per line *) uv_stride : int; (** Length, in bytes, per line *) y : video_plane; (** luminance data *) u : video_plane; (** Cb data *) v : video_plane; (** Cr data *) } type decoders = | Video of (video_info, video_data) decoder | Audio of (audio_info, audio_data) decoder | Audio_ba of (audio_info, audio_ba_data) decoder | Audio_both of (audio_info, audio_data) decoder * (audio_info, audio_ba_data) decoder | Unknown type callbacks = { read : bytes -> int -> int -> int; seek : (int -> int) option; tell : (unit -> int) option; } type index_element = { index_bytes : int; samples : Int64.t; total_samples : Int64.t; } type stream = { mutable os : Ogg.Stream.stream; mutable position : float; index : (Int64.t, index_element) Hashtbl.t; mutable read_samples : Int64.t; dec : decoders; } type t = { sync : Ogg.Sync.t; callbacks : callbacks; mutable started : bool; mutable last_p : int option; log : string -> unit; streams : (nativeint, stream) Hashtbl.t; finished_streams : (nativeint, stream) Hashtbl.t; } type track = | Audio_track of (string * nativeint) | Video_track of (string * nativeint) exception Internal of (Ogg.Page.t * int option) exception Exit of nativeint * Ogg.Stream.stream * decoders exception Track of (bool * nativeint * stream) exception Invalid_stream exception Not_available (* This exception has a different semantics than [Ogg.End_of_stream]. * [Ogg.End_of_stream] is raised when end of data has been reached, * while this exception is raised when end of a logical stream has * been reached.. *) exception End_of_stream type register_decoder = (Ogg.Stream.packet -> bool) * (fill:(unit -> unit) -> Ogg.Stream.stream -> decoders) let get_some x = match x with Some x -> x | None -> assert false let ogg_decoders = Hashtbl.create 1 let log dec = Printf.ksprintf dec.log (* End of stream is declared only when * all logical stream have ended (dec.streams = 0) * _and_ all their data has been consumed (dec.finished_streams = 0) *) let eos dec = dec.started && Hashtbl.length dec.streams = 0 && Hashtbl.length dec.finished_streams = 0 let granuleconv dec granulepos cur = try let ret = match dec with | Audio_ba d -> d.samples_of_granulepos granulepos | Audio_both (d, _) -> d.samples_of_granulepos granulepos | Audio d -> d.samples_of_granulepos granulepos | Video d -> d.samples_of_granulepos granulepos | Unknown -> assert false in if ret > Int64.zero then ret else cur with _ -> cur let feed_page ~position decoder page = let serial = Ogg.Page.serialno page in try let stream = Hashtbl.find decoder.streams serial in if stream.dec <> Unknown then begin Ogg.Stream.put_page stream.os page; let granulepos = Ogg.Page.granulepos page in let total_samples = granuleconv stream.dec granulepos stream.read_samples in if total_samples > stream.read_samples then begin begin match position with | Some p -> if not (Hashtbl.mem stream.index granulepos) then Hashtbl.add stream.index granulepos { index_bytes = p; samples = Int64.sub total_samples stream.read_samples; total_samples = stream.read_samples; } | None -> () end; stream.read_samples <- total_samples end end; if Ogg.Page.eos page then begin log decoder "Reached last page of logical stream %nx" serial; Hashtbl.remove decoder.streams serial; if stream.dec <> Unknown then (* Moving finished stream to decoder.finished_streams *) Hashtbl.add decoder.finished_streams serial stream end with Not_found -> log decoder "Couldn't find a decoder for page in stream %nx" serial; raise Invalid_stream let get_page decoder = if eos decoder then raise End_of_stream; let position = match decoder.callbacks.tell with None -> None | Some f -> Some (f ()) in let page = Ogg.Sync.read decoder.sync in match decoder.callbacks.tell with | Some f -> if Some (f ()) = position then (decoder.last_p, page) else begin let pos = decoder.last_p in decoder.last_p <- position; (pos, page) end | _ -> (None, page) let feed decoder = let position, page = get_page decoder in feed_page ~position decoder page let test dec page = let serial = Ogg.Page.serialno page in log dec "Found a ogg logical stream, serial: %nx" serial; let os = Ogg.Stream.create ~serial () in Ogg.Stream.put_page os page; (* Get first packet *) let packet = Ogg.Stream.peek_packet os in try Hashtbl.iter (fun format (check, decode) -> log dec "Trying ogg/%s format" format; if check packet then ( log dec "ogg/%s format detected for stream %nx" format serial; raise (Exit (serial, os, decode ~fill:(fun () -> feed dec) os))) else ()) ogg_decoders; log dec "Couldn't find a decoder for ogg logical stream with serial %nx" serial; raise (Exit (serial, os, Unknown)) with Exit (s, o, d) -> (s, o, d) (** This should be called only * when we are near the end of * a stream... *) let abort dec = dec.started <- true; begin try while Hashtbl.length dec.streams > 0 do feed dec done with _ -> Hashtbl.clear dec.streams end; Hashtbl.clear dec.finished_streams let parse dec = assert (not (eos dec)); let rec parse () = try (* Get First page *) let position, page = get_page dec in (* Check wether this is a b_o_s *) if not (Ogg.Page.bos page) then raise (Internal (page, position)); let serial, os, decoder = test dec page in (* Should not happen *) if Hashtbl.mem dec.streams serial then raise Invalid_stream; let stream = { os; position = 0.; read_samples = Int64.zero; index = Hashtbl.create 10; dec = decoder; } in Hashtbl.add dec.streams serial stream; parse () with Internal (p, position) -> feed_page ~position dec p in parse (); dec.started <- true; dec let init ?(log = fun _ -> ()) c = let sync = Ogg.Sync.create c.read in let streams = Hashtbl.create 2 in let finished_streams = Hashtbl.create 2 in let pos = match c.tell with None -> None | Some f -> Some (f ()) in parse { sync; started = false; log; streams; callbacks = c; last_p = pos; finished_streams; } let unix_callbacks fd = { read = Unix.read fd; tell = Some (fun () -> Unix.lseek fd 0 Unix.SEEK_CUR); seek = Some (fun len -> Unix.lseek fd len Unix.SEEK_SET); } let init_from_fd ?log fd = init ?log (unix_callbacks fd) let init_from_file ?log filename = let fd = Unix.openfile filename [Unix.O_RDONLY] 0o640 in (init_from_fd ?log fd, fd) let get_ogg_sync dec = dec.sync let reset dec = if Hashtbl.length dec.streams > 0 || Hashtbl.length dec.finished_streams > 0 then log dec "Reseting a stream that has not ended!"; Hashtbl.clear dec.streams; Hashtbl.clear dec.finished_streams; dec.started <- false; ignore (parse dec) let fold_tracks dec f x = let x = Hashtbl.fold f dec.streams x in Hashtbl.fold f dec.finished_streams x let get_track dec dtype = let test ended id stream = match (stream.dec, dtype) with | Audio_ba _, Audio_track (_, x) when x = id -> raise (Track (ended, id, stream)) | Audio_both _, Audio_track (_, x) when x = id -> raise (Track (ended, id, stream)) | Audio _, Audio_track (_, x) when x = id -> raise (Track (ended, id, stream)) | Video _, Video_track (_, x) when x = id -> raise (Track (ended, id, stream)) | _ -> () in try (* First check active streams *) Hashtbl.iter (test false) dec.streams; (* Now check finished streams *) Hashtbl.iter (test true) dec.finished_streams; raise Not_found with Track t -> t let get_tracks dec = let f id stream l = match stream.dec with | Audio_ba d -> Audio_track (d.name, id) :: l | Audio_both (d, _) -> Audio_track (d.name, id) :: l | Audio d -> Audio_track (d.name, id) :: l | Video d -> Video_track (d.name, id) :: l | Unknown -> l in fold_tracks dec f [] type standard_tracks = { mutable audio_track : track option; mutable video_track : track option; } let drop_track dec dtype = (* Remove all track of this type *) let get_tracks id s l = match (s.dec, dtype) with | Audio_ba _, Audio_track (_, x) when x = id -> (id, s) :: l | Audio_both _, Audio_track (_, x) when x = id -> (id, s) :: l | Audio _, Audio_track (_, x) when x = id -> (id, s) :: l | Video _, Video_track (_, x) when x = id -> (id, s) :: l | _ -> l in let tracks = fold_tracks dec get_tracks [] in let stype = match dtype with Audio_track _ -> "audio" | Video_track _ -> "video" in let f (a, x) = log dec "Dropping %s track with serial %nx." stype a; Hashtbl.replace dec.streams a { os = x.os; index = x.index; read_samples = x.read_samples; position = x.position; dec = Unknown; } in List.iter f tracks let get_standard_tracks ?tracks dec = let f id stream (a_t, v_t, l) = match stream.dec with | Audio_ba d when a_t = None -> (Some (Audio_track (d.name, id)), v_t, l) | Audio_ba d -> (a_t, v_t, Audio_track (d.name, id) :: l) | Audio_both (d, _) when a_t = None -> (Some (Audio_track (d.name, id)), v_t, l) | Audio_both (d, _) -> (a_t, v_t, Audio_track (d.name, id) :: l) | Audio d when a_t = None -> (Some (Audio_track (d.name, id)), v_t, l) | Audio d -> (a_t, v_t, Audio_track (d.name, id) :: l) | Video d when v_t = None -> (a_t, Some (Video_track (d.name, id)), l) | Video d -> (a_t, v_t, Video_track (d.name, id) :: l) | _ -> (a_t, v_t, l) in let a_t, v_t, drop = fold_tracks dec f (None, None, []) in List.iter (drop_track dec) drop; match tracks with | None -> { audio_track = a_t; video_track = v_t } | Some x -> x.audio_track <- a_t; x.video_track <- v_t; x let update_standard_tracks dec tracks = ignore (get_standard_tracks ~tracks dec) let get_standard_tracks dec = get_standard_tracks dec let rec sample_rate_priv d dec = try match d with | Audio_ba d -> ((fst (d.info ())).sample_rate, 1) | Audio_both (d, _) -> ((fst (d.info ())).sample_rate, 1) | Audio d -> ((fst (d.info ())).sample_rate, 1) | Video d -> ((fst (d.info ())).fps_numerator, (fst (d.info ())).fps_denominator) | _ -> assert false with Ogg.Not_enough_data -> feed dec; sample_rate_priv d dec let sample_rate dec dtype = let _, _, stream = get_track dec dtype in sample_rate_priv stream.dec dec let get_track_position dec dtype = let _, _, stream = get_track dec dtype in stream.position let get_position dec = if Hashtbl.length dec.streams = 0 && Hashtbl.length dec.finished_streams = 0 then raise Not_available; let f _ stream pos = match stream.dec with | Audio_ba _ | Audio_both _ | Audio _ | Video _ -> min stream.position pos | _ -> pos in fold_tracks dec f max_float let can_seek dec = dec.callbacks.seek <> None && dec.callbacks.tell <> None type sync_point = { sync_stream : stream; sync_id : nativeint; sync_rate : float; mutable sync_seen : bool; mutable sync_granulepos : Int64.t; mutable sync_skip_samples : int; mutable sync_bytes : int; } (* Function to seek at a given point. *) let sync_seek dec pos = Ogg.Sync.reset dec.sync; let seek = get_some dec.callbacks.seek in ignore (seek pos); Ogg.Sync.seek dec.sync exception Position of (Int64.t * index_element) let find_seek_pos dec time sync_point = let samples = Int64.of_float (time *. sync_point.sync_rate) in while sync_point.sync_stream.read_samples <= samples do feed dec done; let f granulepos index_element = if index_element.total_samples <= samples && Int64.add index_element.total_samples index_element.samples >= samples then raise (Position (granulepos, index_element)) in let granulepos, index_element = try Hashtbl.iter f sync_point.sync_stream.index; raise Not_found with Position x -> x in let skip_samples = Int64.sub samples index_element.total_samples in sync_point.sync_stream.read_samples <- index_element.total_samples; sync_point.sync_granulepos <- granulepos; sync_point.sync_skip_samples <- Int64.to_int skip_samples; sync_point.sync_bytes <- index_element.index_bytes; sync_point.sync_stream.position <- Int64.to_float (Int64.add sync_point.sync_stream.read_samples (Int64.of_int sync_point.sync_skip_samples)) /. sync_point.sync_rate let feed_sync_page sync_point page = if Ogg.Page.granulepos page = sync_point.sync_granulepos then sync_point.sync_seen <- true; if sync_point.sync_seen then Ogg.Stream.put_page sync_point.sync_stream.os page exception Found_sync let feed_sync dec sync_points = let page = Ogg.Sync.read dec.sync in try List.iter (fun sync_point -> if Ogg.Page.serialno page = sync_point.sync_id then begin feed_sync_page sync_point page; raise Found_sync end) sync_points; assert false with Found_sync -> () let sync_forward dec sync_points sync_point = let rec skip (cur, skipped) = try let pos = Ogg.Stream.peek_granulepos sync_point.sync_stream.os in let total_samples = granuleconv sync_point.sync_stream.dec pos cur in let diff = Int64.to_int (Int64.sub total_samples cur) in if skipped + diff < sync_point.sync_skip_samples then begin Ogg.Stream.skip_packet sync_point.sync_stream.os; skip (total_samples, skipped + diff) end else sync_point.sync_stream.position <- (Int64.to_float sync_point.sync_stream.read_samples +. float skipped) /. sync_point.sync_rate with | Ogg.Out_of_sync -> skip (cur, skipped) | Ogg.Not_enough_data -> feed_sync dec sync_points; skip (cur, skipped) in skip (sync_point.sync_stream.read_samples, 0) let seek ?(relative = false) dec time = if (not (can_seek dec)) || get_tracks dec = [] then raise Not_available; if eos dec then raise End_of_stream; let orig_time = get_position dec in if relative then log dec "Seeking to %.02f sec from current position at %.02f sec" time orig_time; let time = if relative then time +. orig_time else time in let time = if time < 0. then 0. else time in log dec "Seeking to absolute position at %.2f sec" time; let f id stream l = let sample_rate () = let x, y = sample_rate_priv stream.dec dec in float x /. float y in match stream.dec with | Audio_ba _ | Audio_both _ | Audio _ -> { sync_id = id; sync_stream = stream; sync_rate = sample_rate (); sync_seen = false; sync_granulepos = Int64.zero; sync_skip_samples = 0; sync_bytes = 0; } :: l | Video _ -> { sync_id = id; sync_stream = stream; sync_rate = sample_rate (); sync_seen = false; sync_granulepos = Int64.zero; sync_skip_samples = 0; sync_bytes = 0; } :: l | _ -> l in let sync_points = Hashtbl.fold f dec.streams [] in (* Resolve each sync_point. *) List.iter (find_seek_pos dec time) sync_points; (* Move all finished streams back to * streams. *) let f x y = Hashtbl.add dec.streams x y in Hashtbl.iter f dec.finished_streams; Hashtbl.clear dec.finished_streams; (* Now finally resync. *) let sync_bytes = let f cur sync_point = if sync_point.sync_bytes < cur then sync_point.sync_bytes else cur in List.fold_left f max_int sync_points in let page = sync_seek dec sync_bytes in (* First, reinitiate all ogg streams. *) let reiniate x = x.sync_stream.os <- Ogg.Stream.create ~serial:x.sync_id (); if Ogg.Page.serialno page = x.sync_id then feed_sync_page x page in List.iter reiniate sync_points; (* Get to the next sync point for * each streams. *) let resync x = sync_forward dec sync_points x; let fill () = feed dec in match x.sync_stream.dec with | Audio_ba d -> d.restart ~fill x.sync_stream.os | Audio_both (d, _) -> d.restart ~fill x.sync_stream.os | Audio d -> d.restart ~fill x.sync_stream.os | Video d -> d.restart ~fill x.sync_stream.os | _ -> () in List.iter resync sync_points; let sync_time = get_position dec in log dec "Found nearest seek point at %.02f sec" sync_time; if relative then sync_time -. orig_time else sync_time let seek ?relative dec time = try seek ?relative dec time with End_of_stream -> abort dec; raise End_of_stream let incr_pos dec stream len = let x, y = sample_rate_priv stream.dec dec in let rate = float x /. float y in stream.position <- stream.position +. (float len /. rate) let rec audio_info dec dtype = let _, _, stream = get_track dec dtype in try match stream.dec with | Audio_ba d -> d.info () | Audio_both (d, _) -> d.info () | Audio d -> d.info () | _ -> raise Not_found with Ogg.Not_enough_data -> feed dec; audio_info dec dtype let can_decode_ba dec dtype = let _, _, stream = get_track dec dtype in match stream.dec with Audio_ba _ | Audio_both _ -> true | _ -> false let rec video_info dec dtype = let _, _, stream = get_track dec dtype in try match stream.dec with Video d -> d.info () | _ -> raise Not_found with Ogg.Not_enough_data -> feed dec; video_info dec dtype let decode_audio_gen ~get_decoder ~length dec dtype f = let ended, id, stream = get_track dec dtype in try let f x = begin try incr_pos dec stream (length x.(0)) with _ -> () end; f x in (get_decoder stream.dec).decode f with | ( End_of_stream (* In very rare cases (e.g. with a track that * does not have any data to decode), [Ogg.Not_enough_data] * may be raised at the end of the track instead of * [End_of_stream]. Thus, we also catch it here * but re-raise it if the track has not ended yet. *) | Ogg.Not_enough_data ) as e -> if ended then begin log dec "All data from stream %nx has been decoded" id; Hashtbl.remove dec.finished_streams id (* Reraise [Ogg.Not_enough_data] to feed the * decoder. *) end else if e = Ogg.Not_enough_data then raise e; if eos dec then raise End_of_stream let decode_audio = let get_decoder = function | Audio d -> d | Audio_both (d, _) -> d | _ -> raise Not_available in let length = Array.length in decode_audio_gen ~get_decoder ~length let decode_audio_ba = let get_decoder = function | Audio_ba d -> d | Audio_both (_, d) -> d | _ -> raise Not_available in let length = Bigarray.Array1.dim in decode_audio_gen ~get_decoder ~length let decode_video dec dtype f = let ended, id, stream = get_track dec dtype in try let f x = incr_pos dec stream 1; f x in match stream.dec with Video d -> d.decode f | _ -> assert false with (End_of_stream | Ogg.Not_enough_data) as e -> if ended then begin log dec "All data from stream %nx has been decoded: droping stream." id; Hashtbl.remove dec.finished_streams id (* Reraise [Ogg.Not_enough_data] to feed the * decoder. *) end else if e = Ogg.Not_enough_data then raise e; if eos dec then raise End_of_stream let decode_rec g dec dtype f = let rec exec () = try g dec dtype f with Ogg.Not_enough_data -> feed dec; exec () in exec () let decode_audio = decode_rec decode_audio let decode_audio_ba = decode_rec decode_audio_ba let decode_video = decode_rec decode_video ocaml-xiph-1.0.0/ogg/ogg_decoder.mli000066400000000000000000000223401474662033600173050ustar00rootroot00000000000000(***************************************************************************** Liquidsoap, a programmable audio stream generator. Copyright 2003-2011 Savonet team 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 2 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, fully stated in the COPYING file at the root of the liquidsoap distribution. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *****************************************************************************) (** Ogg stream demuxer *) (** This module provides a functional abstract API to * decode and seek in Ogg streams. * * Decoders are also provided in ocaml-vorbis, * ocaml-speex, ocaml-schroedinger, ocaml-flac and * ocaml-theora. * * Functions in this module are not thread safe! *) (** {2 Decoding} *) (** {3 Types} *) (** Type of an ogg stream decoder. *) type t (** Type for callbacks used to acess encoded data. *) type callbacks = { read : bytes -> int -> int -> int; seek : (int -> int) option; tell : (unit -> int) option; } (** Type for a decodable track. * First element is a string describing * the decoder used to decode the track. * Second element is the serial number * associated to the [Ogg.Stream.stream] logical * stream used to pull data packets for that * track. *) type track = | Audio_track of (string * nativeint) | Video_track of (string * nativeint) (** Type for standard tracks (see [get_standard_tracks] below). *) type standard_tracks = { mutable audio_track : track option; mutable video_track : track option; } (** Type for metadata. First element * is a string describing the vendor, second * element is a list of metadata of the form: * [(label,value)]. *) type metadata = string * (string * string) list (** Type for audio information. *) type audio_info = { channels : int; sample_rate : int } (** Type for audio data. *) type audio_data = float array array type audio_ba_data = (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t array (** Type of a video plane. *) type video_plane = (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t (** Supported video formats. *) type video_format = (* Planar YCbCr 4:2:0. Each component is an uint8_t, * luma and chroma values are full range (0x00 .. 0xff) *) | Yuvj_420 (* Planar YCbCr 4:2:2. Each component is an uint8_t, * luma and chroma values are full range (0x00 .. 0xff) *) | Yuvj_422 (* Planar YCbCr 4:4:4. Each component is an uint8_t, * luma and chroma values are full range (0x00 .. 0xff) *) | Yuvj_444 (* Type for video information. *) type video_info = { fps_numerator : int; fps_denominator : int; (* Width of the Y' luminance plane *) width : int; (* Height of the luminance plane *) height : int; } (** Type for video data. *) type video_data = { format : video_format; frame_width : int; frame_height : int; y_stride : int; (** Length, in bytes, per line *) uv_stride : int; (** Length, in bytes, per line *) y : video_plane; (** luminance data *) u : video_plane; (** Cb data *) v : video_plane; (** Cr data *) } (** {3 Exceptions } *) exception Invalid_stream exception Not_available (* This exception has a different semantics than [Ogg.End_of_stream]. * [Ogg.End_of_stream] is raised when end of data has been reached, * while this exception is raised when end of a logical stream has * been reached.. *) exception End_of_stream (** {3 Initialization functions } *) (** Initiate a decoder with the given callbacks. * [log] is an optional functioned used to * return logged messages during the deocding * process. *) val init : ?log:(string -> unit) -> callbacks -> t (** Initiate a decoder from a given file name. *) val init_from_file : ?log:(string -> unit) -> string -> t * Unix.file_descr (** Initate a decoder from a given [Unix.file_descriptor] *) val init_from_fd : ?log:(string -> unit) -> Unix.file_descr -> t (** Get the Ogg.Sync handler associated to * the decoder. Use only if know what you are doing. *) val get_ogg_sync : t -> Ogg.Sync.t (** Reset encoder, try to parse a new sequentialized stream. * To use when end_of_stream has been reached. *) val reset : t -> unit (** Consume all remaining pages of the current * stream. This function may be called to skip * a sequentialized stream but it may be quite * CPU intensive if there are many pages remaining.. * * [eos dec] is [true] after this call. *) val abort : t -> unit (** [true] if the decoder has reached the end of each * logical streams and all data has been decoded. * * If you do not plan on decoding some data, * you should use [drop_track] to indicate it * to the decoder. Otherwise, [eos] will return * [false] until you have decoded all data. *) val eos : t -> bool (** Get all decodable tracks available. *) val get_tracks : t -> track list (** Get the first available audio and * video tracks and drop the other one. *) val get_standard_tracks : t -> standard_tracks (** Update a given record of standard tracks. You should * use this after a [reset] to update the standard tracks * with the newly created tracks. *) val update_standard_tracks : t -> standard_tracks -> unit (** Remove all tracks of the given type. *) val drop_track : t -> track -> unit (** {3 Information functions} *) (** Get informations about the * audio track. *) val audio_info : t -> track -> audio_info * metadata (** [true] if the decoder can decoder to bigarray data. *) val can_decode_ba : t -> track -> bool (** Get informations about the * video track. *) val video_info : t -> track -> video_info * metadata (** Get the sample_rate of the track * of that type. Returns a pair [(numerator,denominator)]. *) val sample_rate : t -> track -> int * int (** Get track absolute position. *) val get_track_position : t -> track -> float (** Get absolute position in the stream. *) val get_position : t -> float (** {3 Seeking functions} *) (** Returns [true] if the decoder * can be used with the [seek] function. *) val can_seek : t -> bool (** Seek to an absolute or relative position in seconds. * * Raises [Not_available] if seeking is * not possible. * * Raises [End_of_stream] if the end of * current stream has been reached while * seeking. You may call [reset] in this * situation to see if there is a new seqentialized * stream available. * * Returns the time actually reached, either in * relative time or absolute time. *) val seek : ?relative:bool -> t -> float -> float (** {3 Decoding functions} *) (** Decode audio data, if possible. * Decoded data is passed to the second argument. * * Raises [End_of_stream] if all stream have ended. * In this case, you can try [reset] to see if there is a * new sequentialized stream. *) val decode_audio : t -> track -> (audio_data -> unit) -> unit (** Decode audio data, if possible. * Decoded data is passed to the second argument. * * Raises [End_of_stream] if all stream have ended. * In this case, you can try [reset] to see if there is a * new sequentialized stream. *) val decode_audio_ba : t -> track -> (audio_ba_data -> unit) -> unit (** Decode video data, if possible. * Decoded data is passed to the second argument. * * Raises [End_of_stream] if all streams have ended. * In this case, you can try [reset] to see if there is a * new sequentialized stream. *) val decode_video : t -> track -> (video_data -> unit) -> unit (** {2 Implementing decoders} *) (** {3 Types } *) (** Generic type for a decoder. *) type ('a, 'b) decoder = { name : string; info : unit -> 'a * metadata; decode : ('b -> unit) -> unit; restart : fill:(unit -> unit) -> Ogg.Stream.stream -> unit; (* This function is called after seeking * to notify the decoder of the new [Ogg.Stream.stream] * that is should use to pull data packets. *) samples_of_granulepos : Int64.t -> Int64.t; } (** Type for a generic logical stream decoder. *) type decoders = | Video of (video_info, video_data) decoder | Audio of (audio_info, audio_data) decoder | Audio_ba of (audio_info, audio_ba_data) decoder | Audio_both of (audio_info, audio_data) decoder * (audio_info, audio_ba_data) decoder | Unknown (** Type used to register a new decoder. First * element is a function used to check if the initial [Ogg.Stream.packet] * of an [Ogg.Stream.stream] matches the format decodable by this decoder. * Second element is a function that instanciates the actual decoder * using the initial [Ogg.Stream.stream] used to pull data packets for the * decoder. *) type register_decoder = (Ogg.Stream.packet -> bool) * (fill:(unit -> unit) -> Ogg.Stream.stream -> decoders) (** {3 Functions} *) (** Register a new decoder. *) val ogg_decoders : (string, register_decoder) Hashtbl.t ocaml-xiph-1.0.0/ogg/ogg_stubs.c000066400000000000000000000356211474662033600165070ustar00rootroot00000000000000/* * Copyright 2007 Samuel Mimram * * This file is part of ocaml-ogg. * * ocaml-ogg is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * ocaml-ogg 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 Lesser General Public License * along with ocaml-ogg; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * As a special exception to the GNU Library General Public License, you may * link, statically or dynamically, a "work that uses the Library" with a * publicly distributed version of the Library to produce an executable file * containing portions of the Library, and distribute that executable file under * terms of your choice, without any of the additional requirements listed in * clause 6 of the GNU Library General Public License. By "a publicly * distributed version of the Library", we mean either the unmodified Library as * distributed by The Savonet Team, or a modified version of the Library that is * distributed under the conditions defined in clause 3 of the GNU Library * General Public License. This exception does not however invalidate any other * reasons why the executable file might be covered by the GNU Library General * Public License. * */ #include #include #include #include #include #include #include #include #include #include #include #include "ocaml-ogg.h" #ifndef Bytes_val #define Bytes_val String_val #endif /** Page manipulation **/ value value_of_page(ogg_page *op) { CAMLparam0(); CAMLlocal3(v, header, body); header = caml_alloc_string(op->header_len); memcpy(Bytes_val(header), op->header, op->header_len); body = caml_alloc_string(op->body_len); memcpy(Bytes_val(body), op->body, op->body_len); v = caml_alloc_tuple(2); Store_field(v, 0, header); Store_field(v, 1, body); CAMLreturn(v); } ogg_page *page_of_value(value v, ogg_page *page) { page->header = (unsigned char *)String_val(Field(v, 0)); page->header_len = caml_string_length(Field(v, 0)); page->body = (unsigned char *)String_val(Field(v, 1)); page->body_len = caml_string_length(Field(v, 1)); return page; } CAMLprim value ocaml_ogg_page_serialno(value page) { CAMLparam1(page); ogg_page op; CAMLreturn(caml_copy_nativeint(ogg_page_serialno(page_of_value(page, &op)))); } CAMLprim value ocaml_ogg_page_eos(value page) { CAMLparam1(page); ogg_page op; CAMLreturn(Val_bool(ogg_page_eos(page_of_value(page, &op)))); } CAMLprim value ocaml_ogg_page_bos(value page) { CAMLparam1(page); ogg_page op; CAMLreturn(Val_bool(ogg_page_bos(page_of_value(page, &op)))); } CAMLprim value ocaml_ogg_page_packets(value page) { CAMLparam1(page); ogg_page op; CAMLreturn(Val_int(ogg_page_packets(page_of_value(page, &op)))); } CAMLprim value ocaml_ogg_page_continued(value page) { CAMLparam1(page); ogg_page op; CAMLreturn(Val_bool(ogg_page_continued(page_of_value(page, &op)))); } CAMLprim value ocaml_ogg_page_version(value page) { CAMLparam1(page); ogg_page op; CAMLreturn(Val_int(ogg_page_version(page_of_value(page, &op)))); } CAMLprim value ocaml_ogg_page_granulepos(value page) { CAMLparam1(page); ogg_page op; CAMLreturn(caml_copy_int64(ogg_page_granulepos(page_of_value(page, &op)))); } CAMLprim value ocaml_ogg_page_pageno(value page) { CAMLparam1(page); ogg_page op; CAMLreturn(caml_copy_nativeint(ogg_page_pageno(page_of_value(page, &op)))); } CAMLprim value ocaml_ogg_page_checksum_set(value page) { CAMLparam1(page); ogg_page op; ogg_page_checksum_set(page_of_value(page, &op)); CAMLreturn(Val_unit); } /***** Sync state *****/ static void finalize_sync_state(value s) { ogg_sync_destroy(Sync_state_val(s)); } static struct custom_operations sync_state_ops = { "ocaml_ogg_sync_state", finalize_sync_state, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default}; CAMLprim value ocaml_ogg_sync_init() { CAMLparam0(); CAMLlocal1(sync); ogg_sync_state *oy = malloc(sizeof(ogg_sync_state)); ogg_sync_init(oy); sync = caml_alloc_custom(&sync_state_ops, sizeof(ogg_sync_state *), 1, 0); Sync_state_val(sync) = oy; CAMLreturn(sync); } CAMLprim value ocaml_ogg_sync_reset(value oy) { CAMLparam1(oy); ogg_sync_reset(Sync_state_val(oy)); CAMLreturn(Val_unit); } CAMLprim value ocaml_ogg_sync_pageseek(value cb, value oy) { CAMLparam2(cb, oy); CAMLlocal1(bytes); ogg_sync_state *sync = Sync_state_val(oy); int read; int len = 4096; ogg_page page; int err = ogg_sync_pageseek(sync, &page); bytes = caml_alloc_string(len); while (err <= 0) { read = Int_val(caml_callback3(cb, bytes, Val_int(0), Val_int(len))); if (read == 0) caml_raise_constant(*caml_named_value("ogg_exn_eos")); char *buffer = ogg_sync_buffer(sync, read); memcpy(buffer, String_val(bytes), read); ogg_sync_wrote(sync, read); err = ogg_sync_pageseek(sync, &page); } CAMLreturn(value_of_page(&page)); } CAMLprim value ocaml_ogg_sync_read(value cb, value oy) { CAMLparam2(cb, oy); CAMLlocal2(ret, bytes); ogg_sync_state *sync = Sync_state_val(oy); int read; int len = 4096; ogg_page page; int ans = ogg_sync_pageout(sync, &page); bytes = caml_alloc_string(len); while (ans != 1) { if (ans == -1) caml_raise_constant(*caml_named_value("ogg_exn_out_of_sync")); read = Int_val(caml_callback3(cb, bytes, Val_int(0), Val_int(len))); if (read == 0) caml_raise_constant(*caml_named_value("ogg_exn_eos")); char *buffer = ogg_sync_buffer(sync, read); memcpy(buffer, String_val(bytes), read); ogg_sync_wrote(sync, read); ans = ogg_sync_pageout(sync, &page); } CAMLreturn(value_of_page(&page)); } /***** Stream state ******/ static void finalize_stream_state(value s) { // This also free the argument ogg_stream_destroy(Stream_state_val(s)); } static struct custom_operations stream_state_ops = { "ocaml_ogg_stream_state", finalize_stream_state, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default}; static void finalize_packet(value s) { ogg_packet *op = Packet_val(s); free(op->packet); free(op); } static inline ogg_packet *copy_packet(ogg_packet *op) { ogg_packet *nop = malloc(sizeof(ogg_packet)); if (nop == NULL) caml_raise_out_of_memory(); nop->packet = malloc(op->bytes); memcpy(nop->packet, op->packet, op->bytes); nop->bytes = op->bytes; nop->b_o_s = op->b_o_s; nop->e_o_s = op->e_o_s; nop->granulepos = op->granulepos; nop->packetno = op->packetno; return nop; } static struct custom_operations packet_ops = { "ocaml_ogg_packet", finalize_packet, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default}; value value_of_packet(ogg_packet *op) { CAMLparam0(); CAMLlocal1(packet); packet = caml_alloc_custom_mem(&packet_ops, sizeof(ogg_packet *), op->bytes); Packet_val(packet) = copy_packet(op); CAMLreturn(packet); } CAMLprim value ocaml_ogg_stream_init(value serial) { CAMLparam0(); CAMLlocal1(ans); ogg_stream_state *os = malloc(sizeof(ogg_stream_state)); ogg_stream_init(os, Nativeint_val(serial)); ans = caml_alloc_custom(&stream_state_ops, sizeof(ogg_stream_state *), 1, 0); Stream_state_val(ans) = os; CAMLreturn(ans); } CAMLprim value ocaml_ogg_stream_eos(value o_stream_state) { CAMLparam1(o_stream_state); ogg_stream_state *os = Stream_state_val(o_stream_state); CAMLreturn(Val_bool(ogg_stream_eos(os))); } // libogg does not offer any API to generate a final, empty page. // However, some (most!) codecs need a synchronous way to end their // logical bitstream without having to submit an empty packet so we // hack it away.. CAMLprim value ocaml_ogg_stream_terminate(value o_stream_state) { CAMLparam1(o_stream_state); ogg_stream_state *os = Stream_state_val(o_stream_state); ogg_page page; ogg_packet op; op.packet = (unsigned char *)NULL; op.bytes = 0; op.b_o_s = 0; op.e_o_s = 1; op.granulepos = os->granulepos + 1; op.packetno = os->packetno + 1; ogg_stream_packetin(os, &op); if (!ogg_stream_pageout(os, &page)) caml_raise_constant(*caml_named_value("ogg_exn_bad_data")); page.header[26] = 0; page.header_len = 27; page.body = NULL; page.body_len = 0; ogg_page_checksum_set(&page); CAMLreturn(value_of_page(&page)); } CAMLprim value ocaml_ogg_stream_pageout(value o_stream_state, value fill) { CAMLparam1(o_stream_state); ogg_stream_state *os = Stream_state_val(o_stream_state); ogg_page og; int ret; #ifdef HAVE_PAGEOUT_FILL if (fill != Val_unit) ret = ogg_stream_pageout_fill(os, &og, Int_val(fill)); else #endif ret = ogg_stream_pageout(os, &og); if (!ret) caml_raise_constant(*caml_named_value("ogg_exn_not_enough_data")); CAMLreturn(value_of_page(&og)); } CAMLprim value ocaml_ogg_stream_pagein(value o_stream_state, value page) { CAMLparam2(o_stream_state, page); ogg_stream_state *os = Stream_state_val(o_stream_state); ogg_page op; if (ogg_stream_pagein(os, page_of_value(page, &op)) != 0) caml_raise_constant(*caml_named_value("ogg_exn_bad_data")); CAMLreturn(Val_unit); } CAMLprim value ocaml_ogg_stream_packetin(value o_stream_state, value packet) { CAMLparam2(o_stream_state, packet); ogg_stream_state *os = Stream_state_val(o_stream_state); if (ogg_stream_packetin(os, Packet_val(packet)) != 0) caml_raise_constant(*caml_named_value("ogg_exn_bad_data")); CAMLreturn(Val_unit); } CAMLprim value ocaml_ogg_stream_packetout(value o_stream_state) { CAMLparam1(o_stream_state); ogg_stream_state *os = Stream_state_val(o_stream_state); ogg_packet op; int ret = ogg_stream_packetout(os, &op); if (ret == 0) caml_raise_constant(*caml_named_value("ogg_exn_not_enough_data")); if (ret == -1) caml_raise_constant(*caml_named_value("ogg_exn_out_of_sync")); CAMLreturn(value_of_packet(&op)); } CAMLprim value ocaml_ogg_stream_packet_advance(value o_stream_state) { CAMLparam1(o_stream_state); ogg_stream_state *os = Stream_state_val(o_stream_state); ogg_packet op; int ret = ogg_stream_packetout(os, &op); if (ret == 0) caml_raise_constant(*caml_named_value("ogg_exn_not_enough_data")); if (ret == -1) caml_raise_constant(*caml_named_value("ogg_exn_out_of_sync")); CAMLreturn(Val_unit); } CAMLprim value ocaml_ogg_stream_packetpeek(value o_stream_state) { CAMLparam1(o_stream_state); ogg_stream_state *os = Stream_state_val(o_stream_state); ogg_packet op; int ret = ogg_stream_packetpeek(os, &op); if (ret == 0) caml_raise_constant(*caml_named_value("ogg_exn_not_enough_data")); if (ret == -1) caml_raise_constant(*caml_named_value("ogg_exn_out_of_sync")); CAMLreturn(value_of_packet(&op)); } CAMLprim value ocaml_ogg_stream_granulepospeek(value o_stream_state) { CAMLparam1(o_stream_state); ogg_stream_state *os = Stream_state_val(o_stream_state); ogg_packet op; int ret = ogg_stream_packetpeek(os, &op); if (ret == 0) caml_raise_constant(*caml_named_value("ogg_exn_not_enough_data")); if (ret == -1) caml_raise_constant(*caml_named_value("ogg_exn_out_of_sync")); CAMLreturn(caml_copy_int64(op.granulepos)); } CAMLprim value ocaml_ogg_stream_packet_granulepos(value _op) { CAMLparam1(_op); ogg_packet *op = Packet_val(_op); CAMLreturn(caml_copy_int64(op->granulepos)); } CAMLprim value ocaml_ogg_flush_stream(value o_stream_state) { CAMLparam1(o_stream_state); ogg_stream_state *os = Stream_state_val(o_stream_state); ogg_page og; if (!ogg_stream_flush(os, &og)) caml_raise_constant(*caml_named_value("ogg_exn_not_enough_data")); CAMLreturn(value_of_page(&og)); } CAMLprim value ocaml_ogg_stream_serialno(value o_stream_state) { CAMLparam1(o_stream_state); ogg_stream_state *os = Stream_state_val(o_stream_state); CAMLreturn(caml_copy_nativeint((intnat)os->serialno)); } /* Ogg skeleton helpers */ /* Values from http://xiph.org/ogg/doc/skeleton.html */ #define SKELETON_VERSION_MAJOR 3 #define SKELETON_VERSION_MINOR 0 #define FISHEAD_IDENTIFIER "fishead\0" /* Wrappers */ static void write16le(unsigned char *ptr, ogg_uint16_t v) { ptr[0] = v & 0xff; ptr[1] = (v >> 8) & 0xff; } static void write32le(unsigned char *ptr, ogg_uint32_t v) { ptr[0] = v & 0xff; ptr[1] = (v >> 8) & 0xff; ptr[2] = (v >> 16) & 0xff; ptr[3] = (v >> 24) & 0xff; } static void write64le(unsigned char *ptr, ogg_int64_t v) { ogg_uint32_t hi = v >> 32; ptr[0] = v & 0xff; ptr[1] = (v >> 8) & 0xff; ptr[2] = (v >> 16) & 0xff; ptr[3] = (v >> 24) & 0xff; ptr[4] = hi & 0xff; ptr[5] = (hi >> 8) & 0xff; ptr[6] = (hi >> 16) & 0xff; ptr[7] = (hi >> 24) & 0xff; } /* Code from theorautils.c in ffmpeg2theora */ CAMLprim value ocaml_ogg_skeleton_fishead(value pres_num, value pres_den, value base_num, value base_den, value time) { CAMLparam0(); CAMLlocal1(packet); ogg_packet op; memset(&op, 0, sizeof(op)); op.packet = malloc(64); if (op.packet == NULL) caml_raise_out_of_memory(); memset(op.packet, 0, 64); memcpy(op.packet, FISHEAD_IDENTIFIER, 8); /* identifier */ write16le(op.packet + 8, SKELETON_VERSION_MAJOR); /* version major */ write16le(op.packet + 10, SKELETON_VERSION_MINOR); /* version minor */ write64le(op.packet + 12, (ogg_int64_t)Int64_val(pres_num)); /* presentationtime numerator */ write64le(op.packet + 20, (ogg_int64_t)Int64_val( pres_den)); /* presentationtime denominator */ write64le(op.packet + 28, (ogg_int64_t)Int64_val(base_num)); /* basetime numerator */ write64le(op.packet + 36, (ogg_int64_t)Int64_val(base_den)); /* basetime denominator */ /* both the numerator are zero hence handled by the memset */ write32le(op.packet + 44, Int32_val(time)); /* UTC time, set to zero for now */ op.b_o_s = 1; /* its the first packet of the stream */ op.e_o_s = 0; /* its not the last packet of the stream */ op.bytes = 64; /* length of the packet in bytes */ packet = value_of_packet(&op); free(op.packet); CAMLreturn(packet); } /* Code from theorautils.c from ffmpeg2theora */ CAMLprim value ocaml_ogg_skeleton_eos(value v) { CAMLparam0(); ogg_packet op; /* build the e_o_s packet */ memset(&op, 0, sizeof(op)); op.b_o_s = 0; op.e_o_s = 1; /* its the e_o_s packet */ op.granulepos = 0; op.bytes = 0; /* e_o_s packet is an empty packet */ CAMLreturn(value_of_packet(&op)); } ocaml-xiph-1.0.0/opus.opam000066400000000000000000000015031474662033600154270ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "1.0.0" synopsis: "Bindings to libopus" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] license: "LGPL-2.1-only" homepage: "https://github.com/savonet/ocaml-xiph" bug-reports: "https://github.com/savonet/ocaml-xiph/issues" depends: [ "conf-libogg" "conf-libopus" "conf-pkg-config" "ocaml" {>= "4.08.0"} "dune" {>= "2.8"} "dune-configurator" "ogg" {= version} "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] dev-repo: "git+https://github.com/savonet/ocaml-xiph.git" x-maintenance-intent: ["(latest)"] ocaml-xiph-1.0.0/opus.opam.template000066400000000000000000000000431474662033600172370ustar00rootroot00000000000000x-maintenance-intent: ["(latest)"] ocaml-xiph-1.0.0/opus/000077500000000000000000000000001474662033600145525ustar00rootroot00000000000000ocaml-xiph-1.0.0/opus/config/000077500000000000000000000000001474662033600160175ustar00rootroot00000000000000ocaml-xiph-1.0.0/opus/config/discover.ml000066400000000000000000000013301474662033600201640ustar00rootroot00000000000000module C = Configurator.V1 external is_big_endian : unit -> bool = "ocaml_mm_is_big_endian" let () = C.main ~name:"opus-pkg-config" (fun c -> C.C_define.gen_header_file c ~fname:"config.h" [("BIGENDIAN", Switch (is_big_endian ()))]; let default : C.Pkg_config.package_conf = { libs = ["-lopus"; "-logg"]; cflags = [] } in let conf = match C.Pkg_config.get c with | None -> default | Some pc -> ( match C.Pkg_config.query pc ~package:"opus ogg" with | None -> default | Some deps -> deps) in C.Flags.write_sexp "c_flags.sexp" conf.cflags; C.Flags.write_sexp "c_library_flags.sexp" conf.libs) ocaml-xiph-1.0.0/opus/config/dune000066400000000000000000000001611474662033600166730ustar00rootroot00000000000000(executable (name discover) (foreign_stubs (language c) (names endianess)) (libraries dune.configurator)) ocaml-xiph-1.0.0/opus/config/endianess.c000066400000000000000000000006161474662033600201370ustar00rootroot00000000000000#include #include enum { OCAML_MM_LITTLE_ENDIAN = 0x0100, OCAML_MM_BIG_ENDIAN = 0x0001, }; static const union { unsigned char bytes[2]; uint16_t value; } host_order = { { 0, 1 } }; CAMLprim value ocaml_mm_is_big_endian(value unit) { CAMLparam0(); if (host_order.value == OCAML_MM_BIG_ENDIAN) CAMLreturn(Val_bool(1)); CAMLreturn(Val_bool(0)); } ocaml-xiph-1.0.0/opus/dune000066400000000000000000000010661474662033600154330ustar00rootroot00000000000000(library (name opus) (public_name opus) (synopsis "OCaml bindings for libopus") (libraries bigarray ogg) (modules opus) (foreign_stubs (language c) (names opus_stubs) (extra_deps "config.h") (flags (:include c_flags.sexp))) (c_library_flags (:include c_library_flags.sexp))) (library (name opus_decoder) (public_name opus.decoder) (synopsis "Opus decoder for the ogg-decoder library") (libraries ogg.decoder opus) (modules opus_decoder)) (rule (targets config.h c_flags.sexp c_library_flags.sexp) (action (run ./config/discover.exe))) ocaml-xiph-1.0.0/opus/examples/000077500000000000000000000000001474662033600163705ustar00rootroot00000000000000ocaml-xiph-1.0.0/opus/examples/dune000066400000000000000000000002111474662033600172400ustar00rootroot00000000000000(executable (name opus2wav) (modules opus2wav) (libraries opus)) (executable (name wav2opus) (modules wav2opus) (libraries opus)) ocaml-xiph-1.0.0/opus/examples/opus2wav.ml000066400000000000000000000112201474662033600205040ustar00rootroot00000000000000(* * Copyright 2003 Savonet team * * This file is part of OCaml-Opus. * * OCaml-Opus 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 2 of the License, or * (at your option) any later version. * * OCaml-Opus 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 OCaml-Opus; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** * An opus to wav converter using OCaml-Opus. * * @author Samuel Mimram *) let src = ref "" let dst = ref "" let output_int chan n = output_char chan (char_of_int ((n lsr 0) land 0xff)); output_char chan (char_of_int ((n lsr 8) land 0xff)); output_char chan (char_of_int ((n lsr 16) land 0xff)); output_char chan (char_of_int ((n lsr 24) land 0xff)) let output_short chan n = output_char chan (char_of_int ((n lsr 0) land 0xff)); output_char chan (char_of_int ((n lsr 8) land 0xff)) let usage = "usage: opus2wav [options] source destination" let use_ba = ref false let () = Arg.parse [("-ba", Arg.Set use_ba, "Use big arrays")] (let pnum = ref (-1) in fun s -> incr pnum; match !pnum with | 0 -> src := s | 1 -> dst := s | _ -> Printf.eprintf "Error: too many arguments\n"; exit 1) usage; if !src = "" || !dst = "" then ( Printf.printf "%s\n" usage; exit 1); let sync, fd = Ogg.Sync.create_from_file !src in Printf.printf "Checking file.\n%!"; let os, p1 = let page = Ogg.Sync.read sync in assert (Ogg.Page.bos page); let serial = Ogg.Page.serialno page in Printf.printf "Testing stream %nx.%!\n" serial; let os = Ogg.Stream.create ~serial () in Ogg.Stream.put_page os page; let packet = Ogg.Stream.get_packet os in assert (Opus.Decoder.check_packet packet); Printf.printf "Found an opus stream!\n%!"; (os, packet) in let page = Ogg.Sync.read sync in Ogg.Stream.put_page os page; let p2 = Ogg.Stream.get_packet os in let samplerate = 48000 in Printf.printf "Creating decoder...\n%!"; let dec = Opus.Decoder.create ~samplerate p1 p2 in let chans = Opus.Decoder.channels dec in Printf.printf "Channels: %d\n%!" chans; let vendor, comments = Opus.Decoder.comments dec in Printf.printf "Vendor: %s\nComments:\n%!" vendor; List.iter (fun (l, v) -> Printf.printf "- %s = %s\n%!" l v) comments; Printf.printf "done.\n%!"; Printf.printf "Decoding...%!"; let max_frame_size = 960 * 6 in let buflen = max_frame_size in let outbuf = Array.make chans ([||] : float array) in let decode () = if !use_ba then ( let buf = Array.init chans (fun _ -> Bigarray.Array1.create Bigarray.float32 Bigarray.c_layout buflen) in let len = Opus.Decoder.decode_float_ba dec os buf 0 buflen in for c = 0 to chans - 1 do let pcm = Array.make len 0. in for i = 0 to len - 1 do pcm.(i) <- buf.(c).{i} done; outbuf.(c) <- pcm done) else ( let buf = Array.init chans (fun _ -> Array.make buflen 0.) in let len = Opus.Decoder.decode_float dec os buf 0 buflen in for c = 0 to chans - 1 do outbuf.(c) <- Array.append outbuf.(c) (Array.sub buf.(c) 0 len) done) in (try while true do try decode () with Ogg.Not_enough_data -> let page = Ogg.Sync.read sync in if Ogg.Page.serialno page = Ogg.Stream.serialno os then Ogg.Stream.put_page os page done with Ogg.End_of_stream -> ()); Printf.printf "done.\n%!"; Unix.close fd; let len = Array.length outbuf.(0) in let datalen = 2 * len in let oc = open_out_bin !dst in output_string oc "RIFF"; output_int oc (4 + 24 + 8 + datalen); output_string oc "WAVE"; output_string oc "fmt "; output_int oc 16; output_short oc 1; (* WAVE_FORMAT_PCM *) output_short oc 2; (* channels *) output_int oc samplerate; (* freq *) output_int oc (samplerate * 2 * 2); (* bytes / s *) output_short oc (2 * 2); (* block alignment *) output_short oc 16; (* bits per sample *) output_string oc "data"; output_int oc datalen; for i = 0 to len - 1 do for c = 0 to chans - 1 do let x = outbuf.(c).(i) in let x = int_of_float (x *. 32767.) in output_short oc x done done; close_out oc; Gc.full_major () ocaml-xiph-1.0.0/opus/examples/wav2opus.ml000066400000000000000000000126111474662033600205110ustar00rootroot00000000000000(* * Copyright 2003 Savonet team * * This file is part of OCaml-opus. * * OCaml-opus 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 2 of the License, or * (at your option) any later version. * * OCaml-opus 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 OCaml-opus; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** * An wav to ogg converter using OCaml-opus. * * @author Samuel Mimram, and many others... *) open Opus let src = ref "" let dst = ref "" let buflen = ref 4096 let input_string chan len = let ans = Bytes.create len in (* TODO: check length *) ignore (input chan ans 0 len); Bytes.unsafe_to_string ans let input_int chan = let buf = input_string chan 4 in int_of_char buf.[0] + (int_of_char buf.[1] lsl 8) + (int_of_char buf.[2] lsl 16) + (int_of_char buf.[3] lsl 24) let input_short chan = let buf = input_string chan 2 in int_of_char buf.[0] + (int_of_char buf.[1] lsl 8) let usage = "usage: wav2ogg [options] source destination" let use_ba = ref false let _ = Arg.parse [ ( "--buflen", Arg.Int (fun i -> buflen := i), "Size of chunks successively encoded" ); ("-ba", Arg.Set use_ba, "Use big arrays"); ] (let pnum = ref (-1) in fun s -> incr pnum; match !pnum with | 0 -> src := s | 1 -> dst := s | _ -> Printf.eprintf "Error: too many arguments\n"; exit 1) usage; if !src = "" || !dst = "" then ( Printf.printf "%s\n" usage; exit 1); let ic = open_in_bin !src in let oc = open_out_bin !dst in (* TODO: improve! *) if input_string ic 4 <> "RIFF" then invalid_arg "No RIFF tag"; ignore (input_string ic 4); if input_string ic 4 <> "WAVE" then invalid_arg "No WAVE tag"; if input_string ic 4 <> "fmt " then invalid_arg "No fmt tag"; let _ = input_int ic in let _ = input_short ic in (* TODO: should be 1 *) let channels = input_short ic in let infreq = input_int ic in let _ = input_int ic in (* bytes / s *) let _ = input_short ic in (* block align *) let bits = input_short ic in let fos buf = let len = String.length buf / (2 * channels) in let ans = Array.init channels (fun _ -> Array.make len 0.) in for i = 0 to len - 1 do for c = 0 to channels - 1 do let n = int_of_char buf.[(2 * channels * i) + (2 * c)] + (int_of_char buf.[(2 * channels * i) + (2 * c) + 1] lsl 8) in let n = if n land (1 lsl 15) = 0 then n else (n land 0b111111111111111) - 32768 in ans.(c).(i) <- float n /. 32768.; ans.(c).(i) <- max (-1.) (min 1. ans.(c).(i)) done done; ans in let os = Ogg.Stream.create () in let enc = Encoder.create ~samplerate:infreq ~channels ~application:`Audio os in Ogg.Stream.put_packet os (Opus.Encoder.header enc); let ph, pb = Ogg.Stream.flush_page os in output_string oc (ph ^ pb); Ogg.Stream.put_packet os (Opus.Encoder.comments enc); let ph, pb = Ogg.Stream.flush_page os in output_string oc (ph ^ pb); let rem = ref (Array.make channels [||]) in let encode buf = let encoded, buf = if !use_ba then ( let buf = fos buf in let buf = Array.mapi (fun c d -> Array.append d buf.(c)) !rem in let bbuf = Array.map (fun d -> Bigarray.Array1.of_array Bigarray.float32 Bigarray.c_layout d) buf in let encoded = Encoder.encode_float_ba enc bbuf 0 (Bigarray.Array1.dim bbuf.(0)) in (encoded, buf)) else ( let buf = fos buf in let buf = Array.mapi (fun c d -> Array.append d buf.(c)) !rem in let encoded = Encoder.encode_float enc buf 0 (Array.length buf.(0)) in (encoded, buf)) in rem := Array.map (fun d -> Array.sub d encoded (Array.length d - encoded)) buf in let start = Unix.time () in Printf.printf "Input detected: PCM WAVE %d channels, %d Hz, %d bits\n%!" channels infreq bits; Printf.printf "Encoding to: ogg/opus %d channels, %d Hz\nPlease wait...\n%!" channels infreq; (* skip headers *) let rec aux () = let tag = input_string ic 4 in match tag with | "LIST" -> let n = input_int ic in let _ = input_string ic n in aux () | "data" -> () | _ -> invalid_arg "No data tag" in aux (); let buflen = !buflen in let buf = Bytes.create buflen in begin try while true do try really_input ic buf 0 buflen; encode (Bytes.unsafe_to_string buf); while true do let ph, pb = Ogg.Stream.get_page os in output_string oc (ph ^ pb) done with Ogg.Not_enough_data -> () done with End_of_file -> () end; List.iter (fun (ph, pb) -> output_string oc (ph ^ pb)) (Ogg.Stream.terminate os); close_in ic; close_out oc; Printf.printf "Finished in %.0f seconds.\n" (Unix.time () -. start); Gc.full_major () ocaml-xiph-1.0.0/opus/opus.ml000066400000000000000000000140711474662033600160750ustar00rootroot00000000000000exception Buffer_too_small exception Internal_error exception Invalid_packet exception Unimplemented exception Invalid_state exception Alloc_fail let () = Callback.register_exception "opus_exn_buffer_too_small" Buffer_too_small; Callback.register_exception "opus_exn_internal_error" Internal_error; Callback.register_exception "opus_exn_invalid_packet" Invalid_packet; Callback.register_exception "opus_exn_unimplemented" Unimplemented; Callback.register_exception "opus_exn_invalid_state" Invalid_state; Callback.register_exception "opus_exn_alloc_fail" Alloc_fail let recommended_frame_size = 960 * 6 external version_string : unit -> string = "ocaml_opus_version_string" let version_string = version_string () type max_bandwidth = [ `Narrow_band | `Medium_band | `Wide_band | `Super_wide_band | `Full_band ] type bandwidth = [ `Auto | max_bandwidth ] type generic_control = [ `Reset_state | `Get_final_range of int ref | `Get_pitch of int ref | `Get_bandwidth of bandwidth ref | `Set_lsb_depth of int | `Get_lsb_depth of int ref | `Set_phase_inversion_disabled of bool ] module Decoder = struct type control = [ generic_control | `Set_gain of int | `Get_gain of int ref ] external check_packet : Ogg.Stream.packet -> bool = "ocaml_opus_packet_check_header" external channels : Ogg.Stream.packet -> int = "ocaml_opus_decoder_channels" external comments : Ogg.Stream.packet -> string * string array = "ocaml_opus_comments" let comments p = let vendor, comments = comments p in let comments = Array.map (fun s -> let n = String.index s '=' in (String.sub s 0 n, String.sub s (n + 1) (String.length s - n - 1))) comments in let comments = Array.to_list comments in (vendor, comments) type decoder type t = { header : Ogg.Stream.packet; comments : Ogg.Stream.packet; decoder : decoder; } external create : samplerate:int -> channels:int -> decoder = "ocaml_opus_decoder_create" let create ?(samplerate = 48000) p1 p2 = if not (check_packet p1) then raise Invalid_packet; let decoder = create ~samplerate ~channels:(channels p1) in { header = p1; comments = p2; decoder } external apply_control : control -> decoder -> unit = "ocaml_opus_decoder_ctl" let apply_control control t = apply_control control t.decoder external decode_float : decoder -> Ogg.Stream.stream -> float array array -> int -> int -> bool -> int = "ocaml_opus_decoder_decode_float_byte" "ocaml_opus_decoder_decode_float" let decode_float ?(decode_fec = false) t os buf ofs len = decode_float t.decoder os buf ofs len decode_fec external decode_float_ba : decoder -> Ogg.Stream.stream -> (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t array -> int -> int -> bool -> int = "ocaml_opus_decoder_decode_float_ba_byte" "ocaml_opus_decoder_decode_float_ba" let decode_float_ba ?(decode_fec = false) t os buf ofs len = decode_float_ba t.decoder os buf ofs len decode_fec let comments t = comments t.comments let channels t = channels t.header end module Encoder = struct type application = [ `Voip | `Audio | `Restricted_lowdelay ] type signal = [ `Auto | `Voice | `Music ] type bitrate = [ `Auto | `Bitrate_max | `Bitrate of int ] type control = [ generic_control | `Set_complexity of int | `Get_complexity of int ref | `Set_bitrate of bitrate | `Get_bitrate of bitrate ref | `Set_vbr of bool | `Get_vbr of bool ref | `Set_vbr_constraint of bool | `Get_vbr_constraint of bool ref | `Set_force_channels of bool | `Get_force_channels of bool ref | `Set_max_bandwidth of max_bandwidth | `Get_max_bandwidth of max_bandwidth | `Set_bandwidth of bandwidth | `Set_signal of signal | `Get_signal of signal ref | `Set_application of application | `Get_application of application | `Get_samplerate of int | `Get_lookhead of int | `Set_inband_fec of bool | `Get_inband_fec of bool ref | `Set_packet_loss_perc of int | `Get_packet_loss_perc of int ref | `Set_dtx of bool | `Get_dtx of bool ref ] type encoder type t = { header : Ogg.Stream.packet; comments : Ogg.Stream.packet; os : Ogg.Stream.stream; samplerate : int; enc : encoder; } external create : pre_skip:int -> comments:string array -> gain:int -> samplerate:int -> channels:int -> application:application -> encoder * Ogg.Stream.packet * Ogg.Stream.packet = "ocaml_opus_encoder_create_byte" "ocaml_opus_encoder_create" let create ?(pre_skip = 3840) ?(comments = []) ?(gain = 0) ~samplerate ~channels ~application os = let comments = List.map (fun (label, value) -> Printf.sprintf "%s=%s" label value) comments in let comments = Array.of_list comments in let enc, p1, p2 = create ~pre_skip ~comments ~gain ~samplerate ~channels ~application in { os; header = p1; comments = p2; samplerate; enc } let header enc = enc.header let comments enc = enc.comments external apply_control : control -> encoder -> unit = "ocaml_opus_encoder_ctl" let apply_control control enc = apply_control control enc.enc external encode_float : frame_size:int -> encoder -> Ogg.Stream.stream -> float array array -> int -> int -> int = "ocaml_opus_encode_float_byte" "ocaml_opus_encode_float" external encode_float_ba : frame_size:int -> encoder -> Ogg.Stream.stream -> (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t array -> int -> int -> int = "ocaml_opus_encode_float_ba_byte" "ocaml_opus_encode_float_ba" let mk_encode_float fn ?(frame_size = 20.) t = let frame_size = frame_size *. float t.samplerate /. 1000. in fn ~frame_size:(int_of_float frame_size) t.enc t.os let encode_float = mk_encode_float encode_float let encode_float_ba = mk_encode_float encode_float_ba external eos : Ogg.Stream.stream -> encoder -> unit = "ocaml_opus_encode_eos" let eos t = eos t.os t.enc end ocaml-xiph-1.0.0/opus/opus.mli000066400000000000000000000062661474662033600162550ustar00rootroot00000000000000exception Buffer_too_small exception Internal_error exception Invalid_packet exception Unimplemented exception Invalid_state exception Alloc_fail (** Recommended size of a frame in sample. Buffers for decoding are typically of this size. *) val recommended_frame_size : int val version_string : string type max_bandwidth = [ `Narrow_band | `Medium_band | `Wide_band | `Super_wide_band | `Full_band ] type bandwidth = [ `Auto | max_bandwidth ] type generic_control = [ `Reset_state | `Get_final_range of int ref | `Get_pitch of int ref | `Get_bandwidth of bandwidth ref | `Set_lsb_depth of int | `Get_lsb_depth of int ref | `Set_phase_inversion_disabled of bool ] module Decoder : sig type control = [ generic_control | `Set_gain of int | `Get_gain of int ref ] type t val check_packet : Ogg.Stream.packet -> bool (** Create a decoder with given samplerate an number of channels. *) val create : ?samplerate:int -> Ogg.Stream.packet -> Ogg.Stream.packet -> t val comments : t -> string * (string * string) list val channels : t -> int val apply_control : control -> t -> unit val decode_float : ?decode_fec:bool -> t -> Ogg.Stream.stream -> float array array -> int -> int -> int val decode_float_ba : ?decode_fec:bool -> t -> Ogg.Stream.stream -> (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t array -> int -> int -> int end module Encoder : sig type application = [ `Voip | `Audio | `Restricted_lowdelay ] type signal = [ `Auto | `Voice | `Music ] type bitrate = [ `Auto | `Bitrate_max | `Bitrate of int ] type control = [ generic_control | `Set_complexity of int | `Get_complexity of int ref | `Set_bitrate of bitrate | `Get_bitrate of bitrate ref | `Set_vbr of bool | `Get_vbr of bool ref | `Set_vbr_constraint of bool | `Get_vbr_constraint of bool ref | `Set_force_channels of bool | `Get_force_channels of bool ref | `Set_max_bandwidth of max_bandwidth | `Get_max_bandwidth of max_bandwidth | `Set_bandwidth of bandwidth | `Set_signal of signal | `Get_signal of signal ref | `Set_application of application | `Get_application of application | `Get_samplerate of int | `Get_lookhead of int | `Set_inband_fec of bool | `Get_inband_fec of bool ref | `Set_packet_loss_perc of int | `Get_packet_loss_perc of int ref | `Set_dtx of bool | `Get_dtx of bool ref ] type t val create : ?pre_skip:int -> ?comments:(string * string) list -> ?gain:int -> samplerate:int -> channels:int -> application:application -> Ogg.Stream.stream -> t val header : t -> Ogg.Stream.packet val comments : t -> Ogg.Stream.packet val apply_control : control -> t -> unit val encode_float : ?frame_size:float -> t -> float array array -> int -> int -> int val encode_float_ba : ?frame_size:float -> t -> (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t array -> int -> int -> int val eos : t -> unit [@@alert deprecated "This function generates invalid bitstream. Please use \ Ogg.Stream.terminate instead!"] end ocaml-xiph-1.0.0/opus/opus_decoder.ml000066400000000000000000000057451474662033600175720ustar00rootroot00000000000000(* * Copyright 2003-2011 Savonet team * * This file is part of ocaml-opus. * * ocaml-opus 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 2 of the License, or * (at your option) any later version. * * ocaml-opus 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 ocaml-opus; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * *) let check = Opus.Decoder.check_packet let buflen = Opus.recommended_frame_size let decoder_samplerate = ref 48000 let decoder ~fill:_ os = let decoder = ref None in let packet1 = ref None in let packet2 = ref None in let os = ref os in let init () = match !decoder with | None -> let packet1 = match !packet1 with | None -> let p = Ogg.Stream.get_packet !os in packet1 := Some p; p | Some p -> p in let packet2 = match !packet2 with | None -> let p = Ogg.Stream.get_packet !os in packet2 := Some p; p | Some p -> p in let dec = Opus.Decoder.create ~samplerate:!decoder_samplerate packet1 packet2 in let chans = Opus.Decoder.channels dec in let meta = Opus.Decoder.comments dec in decoder := Some (dec, chans, meta); (dec, chans, meta) | Some dec -> dec in let info () = let _, chans, meta = init () in ({ Ogg_decoder.channels = chans; sample_rate = !decoder_samplerate }, meta) in let restart ~fill:_ new_os = os := new_os; decoder := None; ignore (init ()) in let decode ~decode_float ~make_float ~sub_float feed = let dec, chans, _ = init () in let chan _ = make_float buflen in let buf = Array.init chans chan in let ret = decode_float dec !os buf 0 buflen in feed (Array.map (fun x -> sub_float x 0 ret) buf) in let decoder ~decode_float ~make_float ~sub_float = { Ogg_decoder.name = "opus"; info; decode = decode ~decode_float ~make_float ~sub_float; restart; samples_of_granulepos = (fun x -> x); } in Ogg_decoder.Audio_both ( decoder ~decode_float:Opus.Decoder.decode_float ~make_float:(fun len -> Array.make len 0.) ~sub_float:Array.sub, decoder ~decode_float:Opus.Decoder.decode_float_ba ~make_float:(Bigarray.Array1.create Bigarray.float32 Bigarray.c_layout) ~sub_float:Bigarray.Array1.sub ) let register () = Hashtbl.add Ogg_decoder.ogg_decoders "opus" (check, decoder) ocaml-xiph-1.0.0/opus/opus_decoder.mli000066400000000000000000000017061474662033600177340ustar00rootroot00000000000000(* * Copyright 2003-2011 Savonet team * * This file is part of Ocaml-opus. * * Ocaml-opus 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 2 of the License, or * (at your option) any later version. * * Ocaml-opus 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 Ocaml-opus; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** This module provides a opus decoder for * the [Ogg_demuxer] module. *) val decoder_samplerate : int ref (** Register the opus decoder *) val register : unit -> unit ocaml-xiph-1.0.0/opus/opus_stubs.c000066400000000000000000000674761474662033600171500ustar00rootroot00000000000000#include #include #include #include #include #include #include #include #define caml_acquire_runtime_system caml_leave_blocking_section #define caml_release_runtime_system caml_enter_blocking_section #include #include #include #include #include #include #include #include "config.h" #ifndef Bytes_val #define Bytes_val String_val #endif #ifdef BIGENDIAN // code from bits/byteswap.h (C) 1997, 1998 Free Software Foundation, Inc. #define int32le_to_native(x) \ ((((x)&0xff000000) >> 24) | (((x)&0x00ff0000) >> 8) | \ (((x)&0x0000ff00) << 8) | (((x)&0x000000ff) << 24)) #define int16le_to_native(x) ((((x) >> 8) & 0xff) | (((x)&0xff) << 8)) #else #define int32le_to_native(x) x #define int16le_to_native(x) x #endif static inline double clip(double s) { // NaN if (s != s) return 0; if (s < -1) { return -1; } else if (s > 1) { return 1; } else return s; } /* polymorphic variant utility macro */ #define get_var(x) caml_hash_variant(#x) /* Macros to convert variants to controls. */ #define set_ctl(tag, variant, handle, fn, name, v) \ if (tag == get_var(variant)) { \ check(fn(handle, name(Int_val(v)))); \ CAMLreturn(Val_unit); \ } #define set_value_ctl(tag, variant, handle, fn, name, v, convert) \ if (tag == get_var(variant)) { \ check(fn(handle, name(convert(v)))); \ CAMLreturn(Val_unit); \ } #define get_ctl(tag, variant, handle, fn, name, v, type) \ if (tag == get_var(variant)) { \ type name = (type)Int_val(Field(v, 0)); \ check(fn(handle, name(&name))); \ Store_field(v, 0, Val_int(name)); \ CAMLreturn(Val_unit); \ } #define get_value_ctl(tag, variant, handle, fn, name, v, type, convert) \ if (tag == get_var(variant)) { \ type name = (type)Int_val(Field(v, 0)); \ check(fn(handle, name(&name))); \ Store_field(v, 0, convert(name)); \ CAMLreturn(Val_unit); \ } static void check(int ret) { if (ret < 0) switch (ret) { case OPUS_BAD_ARG: caml_invalid_argument("opus"); case OPUS_BUFFER_TOO_SMALL: caml_raise_constant(*caml_named_value("opus_exn_buffer_too_small")); case OPUS_INTERNAL_ERROR: caml_raise_constant(*caml_named_value("opus_exn_internal_error")); case OPUS_INVALID_PACKET: caml_raise_constant(*caml_named_value("opus_exn_invalid_packet")); case OPUS_UNIMPLEMENTED: caml_raise_constant(*caml_named_value("opus_exn_unimplemented")); case OPUS_INVALID_STATE: caml_raise_constant(*caml_named_value("opus_exn_invalid_state")); case OPUS_ALLOC_FAIL: caml_raise_constant(*caml_named_value("opus_exn_alloc_fail")); default: caml_failwith("Unknown opus error"); } } CAMLprim value ocaml_opus_version_string(value unit) { CAMLparam0(); CAMLreturn(caml_copy_string(opus_get_version_string())); } /***** Decoder ******/ #define Dec_val(v) (*(OpusDecoder **)Data_custom_val(v)) static void finalize_dec(value v) { OpusDecoder *dec = Dec_val(v); opus_decoder_destroy(dec); } static struct custom_operations dec_ops = { "ocaml_opus_dec", finalize_dec, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default}; CAMLprim value ocaml_opus_decoder_create(value _sr, value _chans) { CAMLparam0(); CAMLlocal1(ans); opus_int32 sr = Int_val(_sr); int chans = Int_val(_chans); int ret = 0; OpusDecoder *dec; dec = opus_decoder_create(sr, chans, &ret); check(ret); ans = caml_alloc_custom(&dec_ops, sizeof(OpusDecoder *), 0, 1); Dec_val(ans) = dec; CAMLreturn(ans); } CAMLprim value ocaml_opus_packet_check_header(value packet) { CAMLparam1(packet); ogg_packet *op = Packet_val(packet); int ans = 0; if (op->bytes >= 8 && !memcmp(op->packet, "OpusHead", 8)) ans = 1; CAMLreturn(Val_bool(ans)); } CAMLprim value ocaml_opus_decoder_channels(value packet) { CAMLparam1(packet); ogg_packet *op = Packet_val(packet); uint8_t *data = op->packet; uint8_t version = *(data + 8); if (op->bytes <= 10 || memcmp(op->packet, "OpusHead", 8)) caml_invalid_argument("Wrong header data."); if (version != 1) caml_invalid_argument("Wrong header version."); uint8_t ret = *(data + 9); CAMLreturn(Val_int(ret)); } CAMLprim value ocaml_opus_comments(value packet) { CAMLparam1(packet); CAMLlocal2(ans, comments); ogg_packet *op = Packet_val(packet); if (!(op->bytes >= 8 && !memcmp(op->packet, "OpusTags", 8))) check(OPUS_INVALID_PACKET); ans = caml_alloc_tuple(2); int off = 8; /* Vendor */ if (off + 4 > op->bytes) check(OPUS_INVALID_PACKET); opus_int32 vendor_length = int32le_to_native(*((opus_int32 *)(op->packet + off))); off += 4; if (off + vendor_length > op->bytes) check(OPUS_INVALID_PACKET); Store_field(ans, 0, caml_alloc_string(vendor_length)); memcpy(Bytes_val(Field(ans, 0)), op->packet + off, vendor_length); off += vendor_length; /* Comments */ if (off + 4 > op->bytes) check(OPUS_INVALID_PACKET); opus_int32 comments_length = int32le_to_native(*((opus_int32 *)(op->packet + off))); off += 4; comments = caml_alloc_tuple(comments_length); Store_field(ans, 1, comments); opus_int32 i, len; for (i = 0; i < comments_length; i++) { if (off + 4 > op->bytes) check(OPUS_INVALID_PACKET); len = int32le_to_native(*((opus_int32 *)(op->packet + off))); off += 4; if (off + len > op->bytes) check(OPUS_INVALID_PACKET); Store_field(comments, i, caml_alloc_string(len)); memcpy(Bytes_val(Field(comments, i)), op->packet + off, len); off += len; } CAMLreturn(ans); } static opus_int32 bandwidth_of_value(value v) { if (v == get_var(Auto)) return OPUS_AUTO; if (v == get_var(Narrow_band)) return OPUS_BANDWIDTH_NARROWBAND; if (v == get_var(Medium_band)) return OPUS_BANDWIDTH_MEDIUMBAND; if (v == get_var(Wide_band)) return OPUS_BANDWIDTH_WIDEBAND; if (v == get_var(Super_wide_band)) return OPUS_BANDWIDTH_SUPERWIDEBAND; if (v == get_var(Full_band)) return OPUS_BANDWIDTH_FULLBAND; caml_failwith("Unknown opus error"); } static value value_of_bandwidth(opus_int32 a) { switch (a) { case OPUS_AUTO: return get_var(Auto); case OPUS_BANDWIDTH_NARROWBAND: return get_var(Narrow_band); case OPUS_BANDWIDTH_MEDIUMBAND: return get_var(Medium_band); case OPUS_BANDWIDTH_WIDEBAND: return get_var(Wide_band); case OPUS_BANDWIDTH_SUPERWIDEBAND: return get_var(Super_wide_band); case OPUS_BANDWIDTH_FULLBAND: return get_var(Full_band); default: caml_failwith("Unknown opus error"); } } CAMLprim value ocaml_opus_decoder_ctl(value ctl, value _dec) { CAMLparam2(_dec, ctl); CAMLlocal2(tag, v); OpusDecoder *dec = Dec_val(_dec); if (Is_long(ctl)) { // Only ctl without argument here is reset state.. opus_decoder_ctl(dec, OPUS_RESET_STATE); CAMLreturn(Val_unit); } else { v = Field(ctl, 1); tag = Field(ctl, 0); /* Generic controls. */ get_ctl(tag, Get_final_range, dec, opus_decoder_ctl, OPUS_GET_FINAL_RANGE, v, opus_uint32); get_ctl(tag, Get_pitch, dec, opus_decoder_ctl, OPUS_GET_PITCH, v, opus_int32); get_value_ctl(tag, Get_bandwidth, dec, opus_decoder_ctl, OPUS_GET_BANDWIDTH, v, opus_int32, value_of_bandwidth); set_ctl(tag, Set_lsb_depth, dec, opus_decoder_ctl, OPUS_SET_LSB_DEPTH, v); get_ctl(tag, Get_lsb_depth, dec, opus_decoder_ctl, OPUS_GET_LSB_DEPTH, v, opus_int32); #ifdef OPUS_SET_PHASE_INVERSION_DISABLED set_ctl(tag, Set_phase_inversion_disabled, dec, opus_decoder_ctl, OPUS_SET_PHASE_INVERSION_DISABLED, v); #endif /* Decoder controls. */ get_ctl(tag, Get_gain, dec, opus_decoder_ctl, OPUS_GET_GAIN, v, opus_int32); set_ctl(tag, Set_gain, dec, opus_decoder_ctl, OPUS_SET_GAIN, v); } caml_failwith("Unknown opus error"); } CAMLprim value ocaml_opus_decoder_decode_float(value _dec, value _os, value buf, value _ofs, value _len, value _fec) { CAMLparam3(_dec, _os, buf); CAMLlocal1(chan); ogg_stream_state *os = Stream_state_val(_os); ogg_packet op; OpusDecoder *dec = Dec_val(_dec); int decode_fec = Int_val(_fec); int ofs = Int_val(_ofs); int len = Int_val(_len); int total_samples = 0; int ret; int chans = Wosize_val(buf); float *pcm = malloc(chans * len * sizeof(float)); if (pcm == NULL) caml_raise_out_of_memory(); int i, c; while (total_samples < len) { ret = ogg_stream_packetout(os, &op); /* returned values are: * 1: ok * 0: not enough data. in this case * we return the number of samples * decoded if > 0 and raise * Ogg_not_enough_data otherwise * -1: out of sync */ if (ret == -1) caml_raise_constant(*caml_named_value("ogg_exn_out_of_sync")); if (ret == 0) { free(pcm); if (total_samples > 0) { CAMLreturn(Val_int(total_samples)); } else { caml_raise_constant(*caml_named_value("ogg_exn_not_enough_data")); } } if (chans != opus_packet_get_nb_channels(op.packet)) caml_invalid_argument("Wrong number of channels."); caml_release_runtime_system(); ret = opus_decode_float(dec, op.packet, op.bytes, pcm, len, decode_fec); caml_acquire_runtime_system(); if (ret < 0) { free(pcm); check(ret); } for (c = 0; c < chans; c++) { chan = Field(buf, c); for (i = 0; i < ret; i++) Store_double_field(chan, ofs + total_samples + i, clip(pcm[i * chans + c])); } total_samples += ret; len -= ret; } free(pcm); CAMLreturn(Val_int(total_samples)); } CAMLprim value ocaml_opus_decoder_decode_float_byte(value *argv, int argn) { return ocaml_opus_decoder_decode_float(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ocaml_opus_decoder_decode_float_ba(value _dec, value _os, value buf, value _ofs, value _len, value _fec) { CAMLparam3(_dec, _os, buf); CAMLlocal1(chan); ogg_stream_state *os = Stream_state_val(_os); ogg_packet op; OpusDecoder *dec = Dec_val(_dec); int decode_fec = Int_val(_fec); int ofs = Int_val(_ofs); int len = Int_val(_len); int total_samples = 0; int ret; int chans = Wosize_val(buf); float *pcm = malloc(chans * len * sizeof(float)); if (pcm == NULL) caml_raise_out_of_memory(); int i, c; while (total_samples < len) { ret = ogg_stream_packetout(os, &op); /* returned values are: * 1: ok * 0: not enough data. in this case * we return the number of samples * decoded if > 0 and raise * Ogg_not_enough_data otherwise * -1: out of sync */ if (ret == -1) caml_raise_constant(*caml_named_value("ogg_exn_out_of_sync")); if (ret == 0) { free(pcm); if (total_samples > 0) { CAMLreturn(Val_int(total_samples)); } else { caml_raise_constant(*caml_named_value("ogg_exn_not_enough_data")); } } if (chans != opus_packet_get_nb_channels(op.packet)) caml_invalid_argument("Wrong number of channels."); caml_release_runtime_system(); ret = opus_decode_float(dec, op.packet, op.bytes, pcm, len, decode_fec); caml_acquire_runtime_system(); if (ret < 0) { free(pcm); check(ret); } for (c = 0; c < chans; c++) { chan = Field(buf, c); for (i = 0; i < ret; i++) ((float *)Caml_ba_data_val(chan))[ofs + total_samples + i] = pcm[i * chans + c]; } total_samples += ret; len -= ret; } free(pcm); CAMLreturn(Val_int(total_samples)); } CAMLprim value ocaml_opus_decoder_decode_float_ba_byte(value *argv, int argn) { return ocaml_opus_decoder_decode_float_ba(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } /***** Encoder *****/ typedef struct encoder_t { OpusEncoder *encoder; int samplerate_ratio; ogg_int64_t granulepos; ogg_int64_t packetno; } encoder_t; #define Enc_val(v) (*(encoder_t **)Data_custom_val(v)) static void finalize_enc(value v) { encoder_t *enc = Enc_val(v); opus_encoder_destroy(enc->encoder); free(enc); } static struct custom_operations enc_ops = { "ocaml_opus_enc", finalize_enc, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default}; static opus_int32 application_of_value(value v) { if (v == get_var(Voip)) return OPUS_APPLICATION_VOIP; if (v == get_var(Audio)) return OPUS_APPLICATION_AUDIO; if (v == get_var(Restricted_lowdelay)) return OPUS_APPLICATION_RESTRICTED_LOWDELAY; caml_failwith("Unknown opus error"); } static value value_of_application(opus_int32 a) { switch (a) { case OPUS_APPLICATION_VOIP: return get_var(Voip); case OPUS_APPLICATION_AUDIO: return get_var(Audio); case OPUS_APPLICATION_RESTRICTED_LOWDELAY: return get_var(Restricted_lowdelay); default: caml_failwith("Unknown opus error"); } } static unsigned char header_packet[19] = { /* Identifier. */ 'O', 'p', 'u', 's', 'H', 'e', 'a', 'd', /* version, channels count, pre-skip (16 bits, unsigned, * little endian) */ 1, 2, 0, 0, /* Samperate (32 bits, unsigned, little endian) */ 0, 0, 0, 0, /* output gain (16 bits, signed, little endian), channels mapping familly, * stream count (always 0 in this implementation) */ 0, 0, 0}; static void pack_header(ogg_packet *op, opus_int32 sr, int channels, opus_int16 pre_skip, opus_int16 gain) { op->bytes = sizeof(header_packet); op->packet = header_packet; /* Now fill data. */ op->packet[9] = channels; opus_int16 pre_skip_native = int16le_to_native(pre_skip); memcpy(op->packet + 10, &pre_skip_native, sizeof(opus_int16)); opus_int32 sr_native = int32le_to_native(sr); memcpy(op->packet + 12, &sr_native, sizeof(opus_int32)); opus_int16 gain_native = int16le_to_native(gain); memcpy(op->packet + 16, &gain_native, sizeof(opus_int16)); op->b_o_s = 1; op->e_o_s = op->granulepos = op->packetno = 0; } static void pack_comments(ogg_packet *op, char *vendor, value comments) { int i; long pos = 0; opus_int32 vendor_length = strlen(vendor); char *comment; opus_int32 comments_len = Wosize_val(comments); opus_int32 comment_length; op->bytes = 8 + 4 + vendor_length + 4; for (i = 0; i < Wosize_val(comments); i++) op->bytes += 4 + caml_string_length(Field(comments, i)); op->packet = malloc(op->bytes); if (op->packet == NULL) caml_raise_out_of_memory(); /* Identifier. */ memcpy(op->packet, "OpusTags", 8); pos += 8; /* Vendor. */ opus_int32 vendor_length_native = int32le_to_native(vendor_length); memcpy(op->packet + 8, &vendor_length_native, sizeof(opus_int32)); memcpy(op->packet + 12, vendor, vendor_length); pos += 4 + vendor_length; /* Comments length. */ memcpy(op->packet + pos, &comments_len, sizeof(opus_int32)); pos += 4; /* Comments. */ for (i = 0; i < comments_len; i++) { comment = (char *)Bytes_val(Field(comments, i)); comment_length = caml_string_length(Field(comments, i)); opus_int32 comment_length_native = int32le_to_native(comment_length); memcpy(op->packet + pos, &comment_length_native, sizeof(opus_int32)); memcpy(op->packet + pos + 4, comment, comment_length); pos += 4 + comment_length; } op->e_o_s = op->b_o_s = op->granulepos = 0; op->packetno = 1; } CAMLprim value ocaml_opus_encoder_create(value _skip, value _comments, value _gain, value _sr, value _chans, value _application) { CAMLparam0(); CAMLlocal2(_enc, ans); opus_int32 sr = Int_val(_sr); int chans = Int_val(_chans); int ret = 0; int app = application_of_value(_application); encoder_t *enc = malloc(sizeof(encoder_t)); if (enc == NULL) caml_raise_out_of_memory(); /* First encoded packet is the third one. */ enc->packetno = 1; enc->granulepos = 0; /* Value samplerates are: 48000, 24000, 16000, 12000, 8000 * so this value is always an integer. */ enc->samplerate_ratio = 48000 / sr; ogg_packet header; pack_header(&header, sr, chans, Int_val(_skip), Int_val(_gain)); ogg_packet comments; pack_comments(&comments, "ocaml-opus by the Savonet Team.", _comments); enc->encoder = opus_encoder_create(sr, chans, app, &ret); check(ret); _enc = caml_alloc_custom(&enc_ops, sizeof(encoder_t *), 0, 1); Enc_val(_enc) = enc; ans = caml_alloc_tuple(3); Store_field(ans, 0, _enc); Store_field(ans, 1, value_of_packet(&header)); Store_field(ans, 2, value_of_packet(&comments)); free(comments.packet); CAMLreturn(ans); } CAMLprim value ocaml_opus_encoder_create_byte(value *argv, int argn) { return ocaml_opus_encoder_create(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } static opus_int32 bitrate_of_value(value v) { if (Is_long(v)) { if (v == get_var(Auto)) return OPUS_AUTO; if (v == get_var(Bitrate_max)) return OPUS_BITRATE_MAX; } else { if (Field(v, 0) == get_var(Bitrate)) return Int_val(Field(v, 1)); } caml_failwith("Unknown opus error"); } CAMLprim value value_of_bitrate(opus_int32 a) { CAMLparam0(); CAMLlocal1(ret); switch (a) { case OPUS_AUTO: CAMLreturn(get_var(Auto)); case OPUS_BITRATE_MAX: CAMLreturn(get_var(Voice)); default: ret = caml_alloc_tuple(2); Store_field(ret, 0, get_var(Bitrate)); Store_field(ret, 1, Val_int(a)); CAMLreturn(ret); } } static opus_int32 signal_of_value(value v) { if (v == get_var(Auto)) return OPUS_AUTO; if (v == get_var(Voice)) return OPUS_SIGNAL_VOICE; if (v == get_var(Music)) return OPUS_SIGNAL_MUSIC; caml_failwith("Unknown opus error"); } static value value_of_signal(opus_int32 a) { switch (a) { case OPUS_AUTO: return get_var(Auto); case OPUS_SIGNAL_VOICE: return get_var(Voice); case OPUS_SIGNAL_MUSIC: return get_var(Music); default: caml_failwith("Unknown opus error"); } } CAMLprim value ocaml_opus_encoder_ctl(value ctl, value _enc) { CAMLparam2(_enc, ctl); CAMLlocal2(tag, v); encoder_t *handler = Enc_val(_enc); OpusEncoder *enc = handler->encoder; if (Is_long(ctl)) { // Only ctl without argument here is reset state.. opus_encoder_ctl(enc, OPUS_RESET_STATE); CAMLreturn(Val_unit); } else { v = Field(ctl, 1); tag = Field(ctl, 0); /* Generic controls. */ get_ctl(tag, Get_final_range, enc, opus_encoder_ctl, OPUS_GET_FINAL_RANGE, v, opus_uint32); get_ctl(tag, Get_pitch, enc, opus_encoder_ctl, OPUS_GET_PITCH, v, opus_int32); get_value_ctl(tag, Get_bandwidth, enc, opus_encoder_ctl, OPUS_GET_BANDWIDTH, v, opus_int32, value_of_bandwidth); set_ctl(tag, Set_lsb_depth, enc, opus_encoder_ctl, OPUS_SET_LSB_DEPTH, v); get_ctl(tag, Get_lsb_depth, enc, opus_encoder_ctl, OPUS_GET_LSB_DEPTH, v, opus_int32); #ifdef OPUS_SET_PHASE_INVERSION_DISABLED set_ctl(tag, Set_phase_inversion_disabled, enc, opus_encoder_ctl, OPUS_SET_PHASE_INVERSION_DISABLED, v); #endif /* Encoder controls. */ set_ctl(tag, Set_complexity, enc, opus_encoder_ctl, OPUS_SET_COMPLEXITY, v); get_ctl(tag, Get_complexity, enc, opus_encoder_ctl, OPUS_GET_COMPLEXITY, v, opus_int32); set_ctl(tag, Set_vbr, enc, opus_encoder_ctl, OPUS_SET_VBR, v); get_ctl(tag, Get_vbr, enc, opus_encoder_ctl, OPUS_GET_VBR, v, opus_int32); set_ctl(tag, Set_vbr_constraint, enc, opus_encoder_ctl, OPUS_SET_VBR_CONSTRAINT, v); get_ctl(tag, Get_vbr_constraint, enc, opus_encoder_ctl, OPUS_GET_VBR_CONSTRAINT, v, opus_int32); set_ctl(tag, Set_force_channels, enc, opus_encoder_ctl, OPUS_SET_FORCE_CHANNELS, v); get_ctl(tag, Get_force_channels, enc, opus_encoder_ctl, OPUS_GET_FORCE_CHANNELS, v, opus_int32); get_ctl(tag, Get_samplerate, enc, opus_encoder_ctl, OPUS_GET_SAMPLE_RATE, v, opus_int32); get_ctl(tag, Get_lookhead, enc, opus_encoder_ctl, OPUS_GET_LOOKAHEAD, v, opus_int32); set_ctl(tag, Set_inband_fec, enc, opus_encoder_ctl, OPUS_SET_INBAND_FEC, v); get_ctl(tag, Get_inband_fec, enc, opus_encoder_ctl, OPUS_GET_INBAND_FEC, v, opus_int32); set_ctl(tag, Set_packet_loss_perc, enc, opus_encoder_ctl, OPUS_SET_PACKET_LOSS_PERC, v); get_ctl(tag, Get_packet_loss_perc, enc, opus_encoder_ctl, OPUS_GET_PACKET_LOSS_PERC, v, opus_int32); set_ctl(tag, Set_dtx, enc, opus_encoder_ctl, OPUS_SET_DTX, v); get_ctl(tag, Get_dtx, enc, opus_encoder_ctl, OPUS_GET_DTX, v, opus_int32); /* These guys have polynmorphic variant as argument.. */ set_value_ctl(tag, Set_bitrate, enc, opus_encoder_ctl, OPUS_SET_BITRATE, v, bitrate_of_value); get_value_ctl(tag, Get_bitrate, enc, opus_encoder_ctl, OPUS_GET_BITRATE, v, opus_int32, value_of_bitrate); set_value_ctl(tag, Set_max_bandwidth, enc, opus_encoder_ctl, OPUS_SET_MAX_BANDWIDTH, v, bandwidth_of_value); get_value_ctl(tag, Get_max_bandwidth, enc, opus_encoder_ctl, OPUS_GET_MAX_BANDWIDTH, v, opus_int32, value_of_bandwidth); set_value_ctl(tag, Set_bandwidth, enc, opus_encoder_ctl, OPUS_SET_BANDWIDTH, v, bandwidth_of_value); set_value_ctl(tag, Set_signal, enc, opus_encoder_ctl, OPUS_SET_SIGNAL, v, signal_of_value); get_value_ctl(tag, Get_signal, enc, opus_encoder_ctl, OPUS_GET_SIGNAL, v, opus_int32, value_of_signal); set_value_ctl(tag, Set_application, enc, opus_encoder_ctl, OPUS_SET_APPLICATION, v, application_of_value); get_value_ctl(tag, Get_application, enc, opus_encoder_ctl, OPUS_GET_APPLICATION, v, opus_int32, value_of_application); } caml_failwith("Unknown opus error"); } CAMLprim value ocaml_opus_encode_float(value _frame_size, value _enc, value _os, value buf, value _off, value _len) { CAMLparam3(_enc, buf, _os); encoder_t *handler = Enc_val(_enc); OpusEncoder *enc = handler->encoder; ogg_stream_state *os = Stream_state_val(_os); ogg_packet op; int off = Int_val(_off); int len = Int_val(_len); int frame_size = Int_val(_frame_size); if (len < frame_size) caml_raise_constant(*caml_named_value("opus_exn_buffer_too_small")); int chans = Wosize_val(buf); /* This is the recommended value */ int max_data_bytes = 4000; unsigned char *data = malloc(max_data_bytes); if (data == NULL) caml_raise_out_of_memory(); float *pcm = malloc(chans * frame_size * sizeof(float)); if (pcm == NULL) caml_raise_out_of_memory(); int i, j, c; int ret; int loops = len / frame_size; for (i = 0; i < loops; i++) { for (j = 0; j < frame_size; j++) for (c = 0; c < chans; c++) pcm[chans * j + c] = clip(Double_field(Field(buf, c), off + j + i * frame_size)); caml_release_runtime_system(); ret = opus_encode_float(enc, pcm, frame_size, data, max_data_bytes); caml_acquire_runtime_system(); if (ret < 0) { free(pcm); free(data); check(ret); } /* From the documentation: If the return value is 1 byte, * then the packet does not need to be transmitted (DTX). */ if (ret < 2) continue; handler->granulepos += frame_size * handler->samplerate_ratio; handler->packetno++; op.bytes = ret; op.packet = data; op.b_o_s = op.e_o_s = 0; op.packetno = handler->packetno; op.granulepos = handler->granulepos; if (ogg_stream_packetin(os, &op) != 0) { free(pcm); free(data); caml_raise_constant(*caml_named_value("ogg_exn_internal_error")); } } free(pcm); free(data); CAMLreturn(Val_int(loops * frame_size)); } CAMLprim value ocaml_opus_encode_float_byte(value *argv, int argn) { return ocaml_opus_encode_float(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ocaml_opus_encode_float_ba(value _frame_size, value _enc, value _os, value buf, value _ofs, value _len) { CAMLparam3(_enc, buf, _os); encoder_t *handler = Enc_val(_enc); OpusEncoder *enc = handler->encoder; ogg_stream_state *os = Stream_state_val(_os); ogg_packet op; int len = Int_val(_len); int ofs = Int_val(_ofs); int chans = Wosize_val(buf); int frame_size = Int_val(_frame_size); if (chans == 0) CAMLreturn(Val_int(0)); if (Caml_ba_array_val(Field(buf, 0))->dim[0] < ofs + len) caml_failwith("Invalid length or offset!"); if (len < frame_size) caml_raise_constant(*caml_named_value("opus_exn_buffer_too_small")); /* This is the recommended value */ int max_data_bytes = 4000; unsigned char *data = malloc(max_data_bytes); if (data == NULL) caml_raise_out_of_memory(); float *pcm = malloc(chans * frame_size * sizeof(float)); if (pcm == NULL) caml_raise_out_of_memory(); int i, j, c; int ret; int loops = len / frame_size; for (i = 0; i < loops; i++) { for (j = 0; j < frame_size; j++) for (c = 0; c < chans; c++) pcm[chans * j + c] = ((float *)Caml_ba_data_val( Field(buf, c)))[j + i * frame_size + ofs]; caml_release_runtime_system(); ret = opus_encode_float(enc, pcm, frame_size, data, max_data_bytes); caml_acquire_runtime_system(); if (ret < 0) { free(pcm); free(data); check(ret); } /* From the documentation: If the return value is 1 byte, * then the packet does not need to be transmitted (DTX). */ if (ret < 2) continue; handler->granulepos += frame_size * handler->samplerate_ratio; handler->packetno++; op.bytes = ret; op.packet = data; op.b_o_s = op.e_o_s = 0; op.packetno = handler->packetno; op.granulepos = handler->granulepos; if (ogg_stream_packetin(os, &op) != 0) { free(pcm); free(data); caml_raise_constant(*caml_named_value("ogg_exn_internal_error")); } } free(pcm); free(data); CAMLreturn(Val_int(loops * frame_size)); } CAMLprim value ocaml_opus_encode_float_ba_byte(value *argv, int argn) { return ocaml_opus_encode_float_ba(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ocaml_opus_encode_eos(value _os, value _enc) { CAMLparam2(_os, _enc); ogg_stream_state *os = Stream_state_val(_os); ogg_packet op; encoder_t *handler = Enc_val(_enc); handler->packetno++; op.bytes = 0; op.packet = NULL; op.b_o_s = 0; op.e_o_s = 1; op.packetno = handler->packetno; op.granulepos = handler->granulepos; if (ogg_stream_packetin(os, &op) != 0) caml_raise_constant(*caml_named_value("ogg_exn_internal_error")); ; CAMLreturn(Val_unit); } ocaml-xiph-1.0.0/speex.opam000066400000000000000000000015031474662033600155650ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "1.0.0" synopsis: "Bindings to libspeex" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] license: "LGPL-2.1-only" homepage: "https://github.com/savonet/ocaml-xiph" bug-reports: "https://github.com/savonet/ocaml-xiph/issues" depends: [ "conf-libogg" "conf-libspeex" "conf-pkg-config" "dune" {>= "2.8"} "dune-configurator" "ocaml" {>= "4.07"} "ogg" {= version} "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] dev-repo: "git+https://github.com/savonet/ocaml-xiph.git" x-maintenance-intent: ["(latest)"] ocaml-xiph-1.0.0/speex.opam.template000066400000000000000000000000431474662033600173750ustar00rootroot00000000000000x-maintenance-intent: ["(latest)"] ocaml-xiph-1.0.0/speex/000077500000000000000000000000001474662033600147105ustar00rootroot00000000000000ocaml-xiph-1.0.0/speex/config/000077500000000000000000000000001474662033600161555ustar00rootroot00000000000000ocaml-xiph-1.0.0/speex/config/discover.ml000066400000000000000000000010571474662033600203300ustar00rootroot00000000000000module C = Configurator.V1 let () = C.main ~name:"speex-pkg-config" (fun c -> let default : C.Pkg_config.package_conf = { libs = ["-lspeex"; "-logg"]; cflags = [] } in let conf = match C.Pkg_config.get c with | None -> default | Some pc -> ( match C.Pkg_config.query pc ~package:"speex ogg" with | None -> default | Some deps -> deps) in C.Flags.write_sexp "c_flags.sexp" conf.cflags; C.Flags.write_sexp "c_library_flags.sexp" conf.libs) ocaml-xiph-1.0.0/speex/config/dune000066400000000000000000000001611474662033600170310ustar00rootroot00000000000000(executable (name discover) (foreign_stubs (language c) (names endianess)) (libraries dune.configurator)) ocaml-xiph-1.0.0/speex/config/endianess.c000066400000000000000000000006161474662033600202750ustar00rootroot00000000000000#include #include enum { OCAML_MM_LITTLE_ENDIAN = 0x0100, OCAML_MM_BIG_ENDIAN = 0x0001, }; static const union { unsigned char bytes[2]; uint16_t value; } host_order = { { 0, 1 } }; CAMLprim value ocaml_mm_is_big_endian(value unit) { CAMLparam0(); if (host_order.value == OCAML_MM_BIG_ENDIAN) CAMLreturn(Val_bool(1)); CAMLreturn(Val_bool(0)); } ocaml-xiph-1.0.0/speex/dune000066400000000000000000000010241474662033600155630ustar00rootroot00000000000000(library (name speex) (public_name speex) (synopsis "OCaml bindings for libspeex") (libraries ogg) (modules speex) (foreign_stubs (language c) (names speex_stubs) (flags (:include c_flags.sexp))) (c_library_flags (:include c_library_flags.sexp))) (library (name speex_decoder) (public_name speex.decoder) (synopsis "Speex decoder for the ogg-decoder library") (libraries ogg.decoder speex) (modules speex_decoder)) (rule (targets c_flags.sexp c_library_flags.sexp) (action (run ./config/discover.exe))) ocaml-xiph-1.0.0/speex/examples/000077500000000000000000000000001474662033600165265ustar00rootroot00000000000000ocaml-xiph-1.0.0/speex/examples/dune000066400000000000000000000006321474662033600174050ustar00rootroot00000000000000(executable (name speex2wav) (modules speex2wav) (libraries speex speex.decoder ogg.decoder)) (executable (name wav2speex) (modules wav2speex) (libraries speex)) (rule (alias runtest) (package speex) (deps (:speex test.ogg) (:wav2speex ./wav2speex.exe) (:speex2wav ./speex2wav.exe)) (action (progn (run %{speex2wav} %{speex} decoded.wav) (run %{wav2speex} decoded.wav encoded.ogg)))) ocaml-xiph-1.0.0/speex/examples/speex2wav.ml000066400000000000000000000077531474662033600210200ustar00rootroot00000000000000(* * Copyright 2008 Savonet team * * This file is part of OCaml-speex. * * OCaml-speex 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 2 of the License, or * (at your option) any later version. * * OCaml-speex 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 OCaml-speex; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** * A speex to wav converter using OCaml-speex. * * @author Samuel Mimram * @author Romain Beauxis *) let src = ref "" let dst = ref "" let output_int chan n = output_char chan (char_of_int ((n lsr 0) land 0xff)); output_char chan (char_of_int ((n lsr 8) land 0xff)); output_char chan (char_of_int ((n lsr 16) land 0xff)); output_char chan (char_of_int ((n lsr 24) land 0xff)) let output_short chan n = output_char chan (char_of_int ((n lsr 0) land 0xff)); output_char chan (char_of_int ((n lsr 8) land 0xff)) let usage = "usage: speex2wav source destination" let () = Speex_decoder.register () let _ = Arg.parse [] (let pnum = ref (-1) in fun s -> incr pnum; match !pnum with | 0 -> src := s | 1 -> dst := s | _ -> Printf.eprintf "Error: too many arguments\n"; exit 1) usage; if !src = "" || !dst = "" then ( Printf.printf "%s\n" usage; exit 1); let dec, fd = Ogg_decoder.init_from_file !src in let { Ogg_decoder.audio_track; _ } = Ogg_decoder.get_standard_tracks dec in let audio_track = match audio_track with | None -> Printf.eprintf "Error: no audio track\n"; exit 1 | Some audio_track -> audio_track in let { Ogg_decoder.channels; sample_rate }, (encoder, comments) = Ogg_decoder.audio_info dec audio_track in Printf.printf "Encoder: %s\n" encoder; let print_comment (k, v) = Printf.printf "%s: %s\n" k v in Printf.printf "Comments:\n"; List.iter print_comment comments; Printf.printf "\n"; Printf.printf "Input file characteristics: %d channels, %d Hz\n" channels sample_rate; (* Using speex to decode the ogg. *) Printf.printf "\nDecoding...\n"; flush_all (); let tmpdst, oc = Filename.open_temp_file ~mode:[Open_binary] "speex2wav" ".raw" in (try while true do Ogg_decoder.decode_audio dec audio_track (fun data -> let s1 = data.(0) in Array.iteri (fun n _ -> Array.iter (fun s -> let sample = int_of_float (s.(n) *. 32767.) in output_short oc sample) data) s1) done with Ogg_decoder.End_of_stream -> close_out oc); Printf.printf "Decoding finished, writing WAV..\n"; Unix.close fd; (* Do the wav stuff. *) let datalen = (Unix.stat tmpdst).st_size in let ic = open_in_bin tmpdst in let oc = open_out_bin !dst in output_string oc "RIFF"; output_int oc (4 + 24 + 8 + datalen); output_string oc "WAVE"; output_string oc "fmt "; output_int oc 16; output_short oc 1; (* WAVE_FORMAT_PCM *) output_short oc 2; (* channels *) output_int oc sample_rate; (* freq *) output_int oc (sample_rate * 2 * 2); (* bytes / s *) output_short oc (2 * 2); (* block alignment *) output_short oc 16; (* bits per sample *) output_string oc "data"; output_int oc datalen; (let buflen = 256 * 1024 in let buf = Bytes.create buflen in let r = ref 1 in let pos = ref 0 in while !r <> 0 do r := input ic buf 0 buflen; output oc buf 0 !r; pos := !pos + !r done); close_in ic; close_out oc; Unix.unlink tmpdst; Printf.printf "Done !\n"; Gc.full_major () ocaml-xiph-1.0.0/speex/examples/test.ogg000066400000000000000000000003441474662033600202040ustar00rootroot00000000000000OggSdšžë FPSpeex 1.2.0PD¬ÿÿÿÿ@@OggSdšžN+B¬@8ocaml-speex by the savonet team (http://savonet.sf.net/)OggS@dšž ,xûocaml-xiph-1.0.0/speex/examples/wav2speex.ml000066400000000000000000000147711474662033600210160ustar00rootroot00000000000000(* * Copyright 2008 Savonet team * * This file is part of ocaml-speex. * * ocaml-speex 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 2 of the License, or * (at your option) any later version. * * ocaml-speex 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 ocaml-speex; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** * An wav to ogg converter using ocaml-speex. * * @author Samuel Mimram, Romain Beauxis, and many others... *) open Speex let src = ref "" let dst = ref "" let input_string chan len = let ans = Bytes.create len in really_input chan ans 0 len; Bytes.to_string ans let input_int chan = let buf = input_string chan 4 in int_of_char buf.[0] + (int_of_char buf.[1] lsl 8) + (int_of_char buf.[2] lsl 16) + (int_of_char buf.[3] lsl 24) let input_short chan = let buf = input_string chan 2 in int_of_char buf.[0] + (int_of_char buf.[1] lsl 8) let usage = "usage: wav2speex [options] source destination" let float = ref false let mode = ref Wideband let fpp = ref 5 let vbr = ref false let quality = ref 7 let _ = let f = Printf.sprintf in let string_of_mode m = match m with | Narrowband -> "narrowband" | Wideband -> "wideband" | Ultra_wideband -> "ultra-wideband" in Arg.parse [ ( "--float", Arg.Unit (fun _ -> float := true), f "Use floats for decoding. Default: %b" !float ); ( "--mode", Arg.String (fun b -> match b with | "narrowband" -> mode := Narrowband | "wideband" -> mode := Wideband | "ultra-wideband" -> mode := Ultra_wideband | _ -> failwith "unkown mode"), f "Encoding mode, one of \"narrowband\", \"wideband\" or \ \"ultra-wideband\". Default: %s" (string_of_mode !mode) ); ( "--frame_per_packet", Arg.Int (fun b -> fpp := b), f "Frames per Ogg packet. Default: %i" !fpp ); ( "--vbr", Arg.Unit (fun _ -> vbr := true), f "Encode in vbr mode. Default: %b" !vbr ); ( "--quality", Arg.Int (fun b -> quality := b), f "Encoding bitrate, in Kbps. Default: %i" !quality ); ] (let pnum = ref (-1) in fun s -> incr pnum; match !pnum with | 0 -> src := s | 1 -> dst := s | _ -> Printf.eprintf "Error: too many arguments\n"; exit 1) usage; if !src = "" || !dst = "" then ( Printf.printf "%s\n" usage; exit 1); let ic = open_in_bin !src in let oc = open_out_bin !dst in (* TODO: improve! *) if input_string ic 4 <> "RIFF" then invalid_arg "No RIFF tag"; ignore (input_string ic 4); if input_string ic 4 <> "WAVE" then invalid_arg "No WAVE tag"; if input_string ic 4 <> "fmt " then invalid_arg "No fmt tag"; let _ = input_int ic in let _ = input_short ic in (* TODO: should be 1 *) let channels = input_short ic in let infreq = input_int ic in let _ = input_int ic in (* bytes / s *) let _ = input_short ic in (* block align *) let ibits = input_short ic in if input_string ic 4 <> "data" then invalid_arg "No data tag"; let _ = input_int ic in (* datalen *) let fos buf = let len = String.length buf / (2 * channels) in let ans = Array.init channels (fun _ -> Array.make len 0) in for i = 0 to len - 1 do for c = 0 to channels - 1 do let n = int_of_char buf.[(2 * channels * i) + (2 * c)] + (int_of_char buf.[(2 * channels * i) + (2 * c) + 1] lsl 8) in let n = if n land (1 lsl 15) = 0 then n else (n land 0b111111111111111) - 32768 in ans.(c).(i) <- max (-32768) (min 32767 n) done done; ans in let enc = Encoder.init !mode !fpp in if not !vbr then Encoder.set enc SPEEX_SET_QUALITY !quality else Encoder.set enc SPEEX_SET_VBR_QUALITY !quality; Encoder.set enc SPEEX_SET_SAMPLING_RATE infreq; let ivbr = if !vbr then 1 else 0 in Encoder.set enc SPEEX_SET_VBR ivbr; let fsize = Encoder.get enc SPEEX_GET_FRAME_SIZE in let os = Ogg.Stream.create () in let header = Header.init ~rate:infreq ~nb_channels:channels ~mode:!mode ~vbr:!vbr ~frames_per_packet:!fpp () in Header.encode_header header [] os; let s_o_f (h, b) = h ^ b in let flush s = let rec f v = try let v = v ^ s_o_f (Ogg.Stream.flush_page s) in f v with Ogg.Not_enough_data -> v in f "" in output_string oc (flush os); let start = Unix.time () in let smode = match !mode with | Narrowband -> "narrowband" | Wideband -> "wideband" | Ultra_wideband -> "ultra-wideband" in Printf.printf "Input detected: PCM WAVE %d channels, %d Hz, %d bits\n%!" channels infreq ibits; Printf.printf "Encoding to: SPEEX %d channels, %d Hz, %s, VBR: %s\nPlease wait...\n%!" channels infreq smode (string_of_bool !vbr); begin try while true do let buflen = 2 * fsize * channels in let buf = Bytes.create buflen in let feed () = really_input ic buf 0 buflen; let buf = Bytes.to_string buf in let fbuf = fos buf in assert (Array.length fbuf.(0) = fsize); fbuf in let h, v = if channels = 1 then ( let feed () = let frame = feed () in frame.(0) in if !float then ( let feed () = Array.map float_of_int (feed ()) in Encoder.encode_page enc os feed) else Encoder.encode_page_int enc os feed) else if !float then ( let feed () = Array.map (fun x -> Array.map float_of_int x) (feed ()) in Encoder.encode_page_stereo enc os feed) else Encoder.encode_page_int_stereo enc os feed in output_string oc (h ^ v) done with End_of_file -> () end; List.iter (fun (ph, pb) -> output_string oc (ph ^ pb)) (Ogg.Stream.terminate os); close_in ic; close_out oc; Printf.printf "Finished in %.0f seconds.\n" (Unix.time () -. start); Gc.full_major () ocaml-xiph-1.0.0/speex/speex.ml000066400000000000000000000322401474662033600163670ustar00rootroot00000000000000(* * Copyright 2003-2011 Savonet team * * This file is part of Ocaml-speex. * * Ocaml-speex 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 2 of the License, or * (at your option) any later version. * * Ocaml-speex 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 Ocaml-speex; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** * Functions for decoding speex files using libspeex. * * @author Romain Beauxis *) exception Invalid_frame_size type mode = Narrowband | Wideband | Ultra_wideband (* Internal use only *) type internal_mode external internal_mode_of_int : int -> internal_mode = "caml_speex_get_mode" (* Values from speex.h *) let mode_of_int x = match x with | 0 -> Narrowband | 1 -> Wideband | 2 -> Ultra_wideband | _ -> failwith "unknown mode" let int_of_mode x = match x with Narrowband -> 0 | Wideband -> 1 | Ultra_wideband -> 2 let internal_mode_of_mode x = internal_mode_of_int (int_of_mode x) (* Generated by control_define *) (** TODO: better implementation.. *) type control = | SPEEX_RESET_STATE | SPEEX_SET_ENH | SPEEX_GET_ENH | SPEEX_GET_FRAME_SIZE | SPEEX_SET_QUALITY | SPEEX_SET_MODE | SPEEX_GET_MODE | SPEEX_SET_LOW_MODE | SPEEX_GET_LOW_MODE | SPEEX_SET_HIGH_MODE | SPEEX_GET_HIGH_MODE | SPEEX_SET_VBR | SPEEX_GET_VBR | SPEEX_SET_VBR_QUALITY | SPEEX_GET_VBR_QUALITY | SPEEX_SET_COMPLEXITY | SPEEX_GET_COMPLEXITY | SPEEX_SET_BITRATE | SPEEX_GET_BITRATE | SPEEX_SET_SAMPLING_RATE | SPEEX_GET_SAMPLING_RATE | SPEEX_SET_VAD | SPEEX_GET_VAD | SPEEX_SET_ABR | SPEEX_GET_ABR | SPEEX_SET_DTX | SPEEX_GET_DTX | SPEEX_SET_SUBMODE_ENCODING | SPEEX_GET_SUBMODE_ENCODING | SPEEX_SET_PLC_TUNING | SPEEX_GET_PLC_TUNING | SPEEX_SET_VBR_MAX_BITRATE | SPEEX_GET_VBR_MAX_BITRATE | SPEEX_SET_HIGHPASS | SPEEX_GET_HIGHPASS | SPEEX_GET_ACTIVITY let int_of_control x = match x with | SPEEX_SET_ENH -> 0 | SPEEX_GET_ENH -> 1 | SPEEX_GET_FRAME_SIZE -> 3 | SPEEX_SET_QUALITY -> 4 | SPEEX_SET_MODE -> 6 | SPEEX_GET_MODE -> 7 | SPEEX_SET_LOW_MODE -> 8 | SPEEX_GET_LOW_MODE -> 9 | SPEEX_SET_HIGH_MODE -> 10 | SPEEX_GET_HIGH_MODE -> 11 | SPEEX_SET_VBR -> 12 | SPEEX_GET_VBR -> 13 | SPEEX_SET_VBR_QUALITY -> 14 | SPEEX_GET_VBR_QUALITY -> 15 | SPEEX_SET_COMPLEXITY -> 16 | SPEEX_GET_COMPLEXITY -> 17 | SPEEX_SET_BITRATE -> 18 | SPEEX_GET_BITRATE -> 19 | SPEEX_SET_SAMPLING_RATE -> 24 | SPEEX_GET_SAMPLING_RATE -> 25 | SPEEX_RESET_STATE -> 26 | SPEEX_SET_VAD -> 30 | SPEEX_GET_VAD -> 31 | SPEEX_SET_ABR -> 32 | SPEEX_GET_ABR -> 33 | SPEEX_SET_DTX -> 34 | SPEEX_GET_DTX -> 35 | SPEEX_SET_SUBMODE_ENCODING -> 36 | SPEEX_GET_SUBMODE_ENCODING -> 37 | SPEEX_SET_PLC_TUNING -> 40 | SPEEX_GET_PLC_TUNING -> 41 | SPEEX_SET_VBR_MAX_BITRATE -> 42 | SPEEX_GET_VBR_MAX_BITRATE -> 43 | SPEEX_SET_HIGHPASS -> 44 | SPEEX_GET_HIGHPASS -> 45 | SPEEX_GET_ACTIVITY -> 47 let _ = Callback.register "caml_speex_mode_of_int" mode_of_int; Callback.register "caml_speex_int_of_mode" int_of_mode; Callback.register_exception "ocaml_speex_invfrlen_exn" Invalid_frame_size; Callback.register_exception "ocaml_speex_eos_exn" Ogg.End_of_stream module Header = struct type t = { id : string; version : string; version_id : int; header_size : int; rate : int; mode : mode; mode_bitstream_version : int; nb_channels : int; bitrate : int; frame_size : int; vbr : bool; frames_per_packet : int; extra_headers : int; } (* Defined in speex_header.h *) let header_string_length = 8 let header_version_length = 20 external init : int -> int -> internal_mode -> int -> bool -> t = "caml_speex_init_header" let init ?(frames_per_packet = 1) ?(mode = Wideband) ?(vbr = true) ~nb_channels ~rate () = init rate nb_channels (internal_mode_of_mode mode) frames_per_packet vbr external encode_header_packetout : t -> string array -> Ogg.Stream.packet * Ogg.Stream.packet = "caml_speex_encode_header" let encode_header_packetout e l = let l = List.map (fun (x, y) -> Printf.sprintf "%s=%s" x y) l in encode_header_packetout e (Array.of_list l) let encode_header e l s = let p1, p2 = encode_header_packetout e l in Ogg.Stream.put_packet s p1; Ogg.Stream.put_packet s p2 external header_of_packet : Ogg.Stream.packet -> t = "caml_speex_header_of_packet" external comments_of_packet : Ogg.Stream.packet -> string array = "caml_speex_comments_of_packet" let comments_of_packet p = let x = comments_of_packet p in let vendor = x.(0) in let x = Array.sub x 1 (Array.length x - 1) in let c_k = ref 0 in let c_v = ref 0 in let split s = try let i = String.index s '=' in try (String.sub s 0 i, String.sub s (i + 1) (String.length s - i - 1)) with Invalid_argument _ -> c_v := !c_v + 1; (String.sub s 0 i, Printf.sprintf "unknown_value_%i" !c_k) with Not_found -> c_k := !c_k + 1; (Printf.sprintf "unkown_key_%i" !c_k, s) in (vendor, Array.to_list (Array.map split x)) end module Encoder = struct type t external init : internal_mode -> int -> t = "ocaml_speex_enc_init" let init m x = init (internal_mode_of_mode m) x external get : t -> int -> int = "ocaml_speex_encoder_ctl_get" let get x q = get x (int_of_control q) external set : t -> int -> int -> unit = "ocaml_speex_encoder_ctl_set" let set x q v = set x (int_of_control q) v external encode_page_main : t -> int -> Ogg.Stream.stream -> (unit -> float array) -> Ogg.Page.t = "ocaml_speex_encode_page" let encode_page e s f = encode_page_main e 1 s f let merge frame = let ret = Array.init (2 * Array.length frame.(0)) (fun _ -> frame.(0).(0)) in Array.iteri (fun i _ -> ret.(2 * i) <- frame.(0).(i); ret.((2 * i) + 1) <- frame.(1).(i)) frame.(0); ret let encode_page_stereo e s f = let f () = merge (f ()) in encode_page_main e 2 s f external encode_page_int_main : t -> int -> Ogg.Stream.stream -> (unit -> int array) -> Ogg.Page.t = "ocaml_speex_encode_page_int" let encode_page_int e s f = encode_page_int_main e 1 s f let encode_page_int_stereo e s f = let f () = merge (f ()) in encode_page_int_main e 2 s f external eos : t -> Ogg.Stream.stream -> unit = "ocaml_speex_encoder_eos" end module Decoder = struct type t external init : internal_mode -> t = "ocaml_speex_dec_init" let init m = init (internal_mode_of_mode m) external get : t -> int -> int = "ocaml_speex_decoder_ctl_get" let get x q = get x (int_of_control q) external set : t -> int -> int -> unit = "ocaml_speex_decoder_ctl_set" let set x q v = set x (int_of_control q) v let split frame = let ret = Array.make 2 (Array.make (Array.length frame / 2) frame.(0)) in for i = 0 to (Array.length frame / 2) - 1 do ret.(0).(i) <- frame.(2 * i); ret.(1).(i) <- frame.((2 * i) + 1) done; ret external decode_feed : t -> int -> Ogg.Stream.stream -> (float array -> unit) -> unit = "ocaml_speex_decoder_decode" let decode_gen e s chan func split = let l = ref [] in let feed x = l := split x :: !l in begin try func e chan s feed with Ogg.Not_enough_data -> if List.length !l = 0 then raise Ogg.Not_enough_data end; List.rev !l let decode e s = decode_gen e s 1 decode_feed (fun x -> x) let decode_stereo e s = decode_gen e s 2 decode_feed split let decode_feed_stereo e s feed = let feed x = feed (split x) in decode_feed e 2 s feed let decode_feed e s feed = decode_feed e 1 s feed external decode_int_feed : t -> int -> Ogg.Stream.stream -> (int array -> unit) -> unit = "ocaml_speex_decoder_decode_int" let decode_int e s = decode_gen e s 2 decode_int_feed (fun x -> x) let decode_int_stereo e s = decode_gen e s 2 decode_int_feed split let decode_int_feed_stereo e s feed = let feed x = feed (split x) in decode_int_feed e 2 s feed let decode_int_feed e s feed = decode_int_feed e 1 s feed end module Wrapper = struct module Decoder = struct exception Not_speex exception Internal type t = (Decoder.t * Ogg.Stream.stream * Ogg.Sync.t * nativeint * int * (string * (string * string) list) * Header.t) ref type read = bytes -> int -> int -> int let open_sync sync = (* Test wether the stream contains speex data *) let test_speex () = (* Get First page *) let page = Ogg.Sync.read sync in (* Check wether this is a b_o_s *) if not (Ogg.Page.bos page) then raise Not_found; (* Create a stream with this ID *) let serial = Ogg.Page.serialno page in let os = Ogg.Stream.create ~serial () in Ogg.Stream.put_page os page; (* Test header. Do not catch anything, first page should be sufficient *) let packet = Ogg.Stream.get_packet os in try let header = Header.header_of_packet packet in (* Get comments *) let page = ref (Ogg.Sync.read sync) in while Ogg.Page.serialno !page <> serial do page := Ogg.Sync.read sync done; Ogg.Stream.put_page os !page; let comments = Ogg.Stream.get_packet os in let comments = Header.comments_of_packet comments in (serial, os, header, comments) with _ -> Printf.printf "Not a speex stream..\n"; raise Internal in let rec init () = try test_speex () with (* Not_found is not catched: ogg stream always start with all b_o_s and we don't care about sequenced streams here *) | Internal -> init () | Ogg.Not_enough_data -> raise Not_speex in let serial, os, header, comments = init () in let chans = header.Header.nb_channels in let rate = header.Header.rate in let mode = header.Header.mode in let dec = Decoder.init mode in Decoder.set dec SPEEX_SET_SAMPLING_RATE rate; ref (dec, os, sync, serial, chans, comments, header) let open_file file = let sync, fd = Ogg.Sync.create_from_file file in (open_sync sync, fd) let open_feed feed = let sync = Ogg.Sync.create feed in open_sync sync let serial x = let _, _, _, serial, _, _, _ = !x in serial let comments x = let _, _, _, _, _, (_, l), _ = !x in l let header x = let _, _, _, _, _, _, h = !x in h let decode_gen f x = let dec, os, sync, serial, _, _, _ = !x in let dec = ref dec in let serial = ref serial in let os = ref os in let eos = ref false in let rec put () = try if !eos then ( try (* Try to open a new stream *) let y = open_sync sync in let ndec, nos, _, nserial, _, _, _ = !y in x := !y; dec := ndec; serial := nserial; os := nos; eos := false with Not_found -> raise Internal); let page = Ogg.Sync.read sync in if Ogg.Stream.eos !os then eos := true; if Ogg.Page.serialno page = !serial then Ogg.Stream.put_page !os page with | Internal | Ogg.Not_enough_data -> raise Ogg.End_of_stream | Ogg.End_of_stream -> eos := true; put () in let rec get () = try f !dec !os with | Ogg.End_of_stream -> eos := true; put (); get () | Ogg.Not_enough_data -> put (); get () in get () let decode v = decode_gen Decoder.decode v let decode_stereo v = decode_gen Decoder.decode_stereo v let decode_feed v feed = decode_gen (fun x y -> Decoder.decode_feed x y feed) v let decode_feed_stereo v feed = decode_gen (fun x y -> Decoder.decode_feed_stereo x y feed) v let decode_int v = decode_gen Decoder.decode_int v let decode_int_stereo v = decode_gen Decoder.decode_int_stereo v let decode_int_feed v feed = decode_gen (fun x y -> Decoder.decode_int_feed x y feed) v let decode_int_feed_stereo v feed = decode_gen (fun x y -> Decoder.decode_int_feed_stereo x y feed) v end end module Skeleton = struct external fisbone : nativeint -> Header.t -> Int64.t -> string -> Ogg.Stream.packet = "ocaml_speex_skeleton_fisbone" let fisbone ?(start_granule = Int64.zero) ?(headers = [("Content-type", "audio/speex")]) ~serialno ~header () = let concat s (h, v) = Printf.sprintf "%s%s: %s\r\n" s h v in let s = List.fold_left concat "" headers in fisbone serialno header start_granule s end ocaml-xiph-1.0.0/speex/speex.mli000066400000000000000000000221341474662033600165410ustar00rootroot00000000000000(* * Copyright 2003-2006 Savonet team * * This file is part of Ocaml-speex. * * Ocaml-speex 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 2 of the License, or * (at your option) any later version. * * Ocaml-speex 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 Ocaml-speex; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** * Functions for manipulating speex audio data using libspeex. * * @author Romain Beauxis *) exception Invalid_frame_size type mode = Narrowband | Wideband | Ultra_wideband (* Generated by control_define *) type control = | (* Reset the encoder/decoder memories to zero *) SPEEX_RESET_STATE | (* Set/get enhancement on/off (decoder only) *) SPEEX_SET_ENH | SPEEX_GET_ENH | (* Obtain frame size used by encoder/decoder *) SPEEX_GET_FRAME_SIZE | (* Set/get quality value *) SPEEX_SET_QUALITY | (* Set/get sub-mode to use *) SPEEX_SET_MODE | SPEEX_GET_MODE | (* Set/get low-band sub-mode to use (wideband only)*) SPEEX_SET_LOW_MODE | SPEEX_GET_LOW_MODE | (* Set/get high-band sub-mode to use (wideband only)*) SPEEX_SET_HIGH_MODE | SPEEX_GET_HIGH_MODE | (* Set/get VBR on (1) or off (0) *) SPEEX_SET_VBR | SPEEX_GET_VBR | (* Set/get quality value for VBR encoding (0-10) *) SPEEX_SET_VBR_QUALITY | SPEEX_GET_VBR_QUALITY | (* Set/get complexity of the encoder (0-10) *) SPEEX_SET_COMPLEXITY | SPEEX_GET_COMPLEXITY | (* Set/get bitrate *) SPEEX_SET_BITRATE | SPEEX_GET_BITRATE | (* Set/get sampling rate *) SPEEX_SET_SAMPLING_RATE | SPEEX_GET_SAMPLING_RATE | (* Set/get VAD status (1 for on, 0 for off) *) SPEEX_SET_VAD | SPEEX_GET_VAD | (* Set/get Average Bit-Rate (ABR) to n bits per seconds *) SPEEX_SET_ABR | SPEEX_GET_ABR | (* Set/get DTX status (1 for on, 0 for off) *) SPEEX_SET_DTX | SPEEX_GET_DTX | (* Set/get submode encoding in each frame (1 for yes, 0 for no, setting to no breaks the standard) *) SPEEX_SET_SUBMODE_ENCODING | SPEEX_GET_SUBMODE_ENCODING | (* Set/get tuning for packet-loss concealment (expected loss rate) *) SPEEX_SET_PLC_TUNING | SPEEX_GET_PLC_TUNING | (* Set/get the max bit-rate allowed in VBR mode *) SPEEX_SET_VBR_MAX_BITRATE | SPEEX_GET_VBR_MAX_BITRATE | (* Turn on/off input/output high-pass filtering *) SPEEX_SET_HIGHPASS | SPEEX_GET_HIGHPASS | (* Get "activity level" of the last decoded frame, i.e. how much damage we cause if we remove the frame *) SPEEX_GET_ACTIVITY module Header : sig (** Type for speex header. *) type t = { id : string; version : string; version_id : int; header_size : int; rate : int; mode : mode; mode_bitstream_version : int; nb_channels : int; bitrate : int; frame_size : int; vbr : bool; frames_per_packet : int; extra_headers : int; } (* Defined in speex_header.h *) val header_string_length : int val header_version_length : int (** Initiate a new speex header. *) val init : ?frames_per_packet:int -> ?mode:mode -> ?vbr:bool -> nb_channels:int -> rate:int -> unit -> t (** [encode_header_packetout header metadata]: output ogg packets containing the header. * First packet contains speex audio codec settings, second the metadata. *) val encode_header_packetout : t -> (string * string) list -> Ogg.Stream.packet * Ogg.Stream.packet (** Output ogg packets containing the header and put them into the given stream. *) val encode_header : t -> (string * string) list -> Ogg.Stream.stream -> unit (** Decode the speex header contained in the given packet. * * Raises [Invalid_argument] if the packet does not contain speex audio codec data. *) val header_of_packet : Ogg.Stream.packet -> t (** Decode the metadata contained in the given packet. * * Raises [Invalid_argument] if the packet does not contain speex metadata. *) val comments_of_packet : Ogg.Stream.packet -> string * (string * string) list end module Encoder : sig (** Opaque type for the speex encoder. *) type t (** Initiate a new encoder. *) val init : mode -> int -> t (** Get a parameter. *) val get : t -> control -> int (** Set a parameter. *) val set : t -> control -> int -> unit (** [encode_page encoder stream f]: calls [f] to get audio data and encode it until a page is ready. * * Known issue: float expected values seem not to be in [-1..1] but in * [-32768..32767] which does not seem to be correct. *) val encode_page : t -> Ogg.Stream.stream -> (unit -> float array) -> Ogg.Page.t (** Same as [encode_page] except that it encodes stereo data into mono. *) val encode_page_stereo : t -> Ogg.Stream.stream -> (unit -> float array array) -> Ogg.Page.t (** Same as [encode_page] but using integers. *) val encode_page_int : t -> Ogg.Stream.stream -> (unit -> int array) -> Ogg.Page.t (** Same as [encode_page_stereo] but using integers. *) val encode_page_int_stereo : t -> Ogg.Stream.stream -> (unit -> int array array) -> Ogg.Page.t (** Set the end of stream for this stream. *) val eos : t -> Ogg.Stream.stream -> unit [@@alert deprecated "This function generates invalid bitstream. Please use \ Ogg.Stream.terminate instead!"] end module Decoder : sig (** Opaque type for the speex decoder. *) type t (** Initiate a new decoder. *) val init : mode -> t (** Get a setting. *) val get : t -> control -> int (** Set a setting. *) val set : t -> control -> int -> unit (** Decode data. *) val decode : t -> Ogg.Stream.stream -> float array list (** Decode stereo data. *) val decode_stereo : t -> Ogg.Stream.stream -> float array array list (** Decode data, passing them to the given feed. *) val decode_feed : t -> Ogg.Stream.stream -> (float array -> unit) -> unit (** Decode stereo data, passing them to the given feed. *) val decode_feed_stereo : t -> Ogg.Stream.stream -> (float array array -> unit) -> unit (** Same as [decode] but with integers. *) val decode_int : t -> Ogg.Stream.stream -> int array list (** Same as [decode_stereo] but with integers. *) val decode_int_stereo : t -> Ogg.Stream.stream -> int array array list (** Same as [decode_feed] but with integers. *) val decode_int_feed : t -> Ogg.Stream.stream -> (int array -> unit) -> unit (** Same as [decode_feed_stereo] but with integers. *) val decode_int_feed_stereo : t -> Ogg.Stream.stream -> (int array array -> unit) -> unit end module Wrapper : sig (** High level wrappers for speex. *) module Decoder : sig (** High level wrapper to easily decode speex files. *) exception Not_speex (** Opaque type for the decoder. *) type t (** Type for data read. Same signature as [Unix.read]. *) type read = bytes -> int -> int -> int (** Open the passed [Ogg.Sync] as a new speex stream. *) val open_sync : Ogg.Sync.t -> t (** Open the passed file name as a new speex stream. *) val open_file : string -> t * Unix.file_descr (** Open the passed feed as a new speex stream. *) val open_feed : read -> t (** Get the serial of the stream currently being decoded. * This value may change if the stream contains sequentialized ogg streams. *) val serial : t -> nativeint (** Get current comments. *) val comments : t -> (string * string) list (** Get current header. *) val header : t -> Header.t (** Decode audio data. *) val decode : t -> float array list (** Decode stereo audio data. *) val decode_stereo : t -> float array array list (** Decode audio data, passing it to a feed. *) val decode_feed : t -> (float array -> unit) -> unit (** Same as [decode_feed] but with stereo data. *) val decode_feed_stereo : t -> (float array array -> unit) -> unit (** Same as [decode] but with integers. *) val decode_int : t -> int array list (** Same as [decode_stereo] but with integers. *) val decode_int_stereo : t -> int array array list (** Same as [decode_feed] but with integers. *) val decode_int_feed : t -> (int array -> unit) -> unit (** Same as [decode_int_feed_stereo] but with integers. *) val decode_int_feed_stereo : t -> (int array array -> unit) -> unit end end module Skeleton : sig (** Generate a vorbis fisbone packet with * these parameters, to use in an ogg skeleton. * Default value for [start_granule] is [Int64.zero], * Default value for [headers] is ["Content-type","audio/speex"] * * See: http://xiph.org/ogg/doc/skeleton.html. *) val fisbone : ?start_granule:Int64.t -> ?headers:(string * string) list -> serialno:nativeint -> header:Header.t -> unit -> Ogg.Stream.packet end ocaml-xiph-1.0.0/speex/speex_decoder.ml000066400000000000000000000061321474662033600200550ustar00rootroot00000000000000(* * Copyright 2003-2011 Savonet team * * This file is part of Ocaml-speex. * * Ocaml-speex 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 2 of the License, or * (at your option) any later version. * * Ocaml-speex 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 Ocaml-speex; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) let check p = try let _ = Speex.Header.header_of_packet p in true with _ -> false let decoder ~fill:_ os = let dec_p = ref None in let decoder = ref None in let com_p = ref None in let os = ref os in let init () = match !decoder with | None -> let dec_p = match !dec_p with | None -> let packet = Ogg.Stream.get_packet !os in dec_p := Some packet; packet | Some p -> p in let com_p = match !com_p with | None -> let packet = Ogg.Stream.get_packet !os in com_p := Some packet; packet | Some p -> p in let header = Speex.Header.header_of_packet dec_p in let meta = Speex.Header.comments_of_packet com_p in let mode = header.Speex.Header.mode in let dec = Speex.Decoder.init mode in let sample_freq = header.Speex.Header.rate in let chans = header.Speex.Header.nb_channels in Speex.Decoder.set dec Speex.SPEEX_SET_SAMPLING_RATE sample_freq; decoder := Some (dec, sample_freq, chans, meta); (dec, sample_freq, chans, meta) | Some d -> d in let info () = let _, rate, chans, meta = init () in ({ Ogg_decoder.channels = chans; sample_rate = rate }, meta) in let decode feed = let dec, _, chans, _ = init () in let len = ref 0 in let feed buf = let buf = Array.map (Array.map (fun x -> float x /. 32768.)) buf in len := !len + Array.length buf.(0); feed buf in try let decode dec os feed = if chans = 2 then Speex.Decoder.decode_int_feed_stereo dec os feed else ( let feed x = feed [| x |] in Speex.Decoder.decode_int_feed dec os feed) in decode dec !os feed with Ogg.Not_enough_data -> if !len = 0 then raise Ogg.Not_enough_data in let restart ~fill:_ new_os = os := new_os; let d, _, _, _ = init () in Speex.Decoder.set d Speex.SPEEX_RESET_STATE 0 in Ogg_decoder.Audio { Ogg_decoder.name = "speex"; info; restart; decode; samples_of_granulepos = (fun x -> x); } let register () = Hashtbl.add Ogg_decoder.ogg_decoders "speex" (check, decoder) ocaml-xiph-1.0.0/speex/speex_decoder.mli000066400000000000000000000016121474662033600202240ustar00rootroot00000000000000(* * Copyright 2003-2011 Savonet team * * This file is part of Ocaml-speex. * * Ocaml-speex 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 2 of the License, or * (at your option) any later version. * * Ocaml-speex 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 Ocaml-speex; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Speex decoder for the [Ogg_demuxer] module. *) (** Register the decoder. *) val register : unit -> unit ocaml-xiph-1.0.0/speex/speex_stubs.c000066400000000000000000000565351474662033600174360ustar00rootroot00000000000000/* Copyright 2003-2008 Savonet team This file is part of Ocaml-speex. Ocaml-speex 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 2 of the License, or (at your option) any later version. Ocaml-speex 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 Ocaml-speex; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ #define CAML_NAME_SPACE #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #ifndef Bytes_val #define Bytes_val String_val #endif /* Comment API */ /* This is stolen from speexenc.c * It should definitely be part of the library.. */ /* Comments will be stored in the Vorbis style. It is describled in the "Structure" section of http://www.xiph.org/ogg/vorbis/doc/v-comment.html The comment header is decoded as follows: 1) [vendor_length] = read an unsigned integer of 32 bits 2) [vendor_string] = read a UTF-8 vector as [vendor_length] octets 3) [user_comment_list_length] = read an unsigned integer of 32 bits 4) iterate [user_comment_list_length] times { 5) [length] = read an unsigned integer of 32 bits 6) this iteration's user comment = read a UTF-8 vector as [length] octets } 7) [framing_bit] = read a single bit as boolean 8) if ( [framing_bit] unset or end of packet ) then ERROR 9) done. If you have troubles, please write to ymnk@jcraft.com. */ #define readint(buf, base) \ (((buf[base + 3] << 24) & 0xff000000) | ((buf[base + 2] << 16) & 0xff0000) | \ ((buf[base + 1] << 8) & 0xff00) | (buf[base] & 0xff)) #define writeint(buf, base, val) \ do { \ buf[base + 3] = ((val) >> 24) & 0xff; \ buf[base + 2] = ((val) >> 16) & 0xff; \ buf[base + 1] = ((val) >> 8) & 0xff; \ buf[base] = (val)&0xff; \ } while (0) void comment_init(char **comments, int *length, char *vendor_string) { int vendor_length = strlen(vendor_string); int user_comment_list_length = 0; int len = 4 + vendor_length + 4; char *p = (char *)malloc(len); if (p == NULL) caml_raise_out_of_memory(); writeint(p, 0, vendor_length); memcpy(p + 4, vendor_string, vendor_length); writeint(p, 4 + vendor_length, user_comment_list_length); *length = len; *comments = p; } void comment_add(char **comments, int *length, char *val) { char *p = *comments; int vendor_length = readint(p, 0); int user_comment_list_length = readint(p, 4 + vendor_length); int val_len = strlen(val); int len = (*length) + 4 + val_len; p = (char *)realloc(p, len); if (p == NULL) { caml_failwith("realloc"); } writeint(p, *length, val_len); /* length of comment */ memcpy(p + *length + 4, val, val_len); /* comment */ writeint(p, 4 + vendor_length, user_comment_list_length + 1); *comments = p; *length = len; } CAMLprim value caml_speex_comments_of_packet(value o_packet) { CAMLparam1(o_packet); CAMLlocal2(ret, tmp); ogg_packet *op = Packet_val(o_packet); char *c = (char *)op->packet; int length = op->bytes; int len, i, nb_fields; char *end; if (length < 8) caml_failwith("Invalid comments raw length"); end = c + length; len = readint(c, 0); c += 4; if (len < 0 || c + len > end) caml_failwith("Invalid comments raw data"); tmp = caml_alloc_string(len); memcpy(Bytes_val(tmp), c, len); c += len; if (c + 4 > end) caml_failwith("Invalid comments raw data"); nb_fields = readint(c, 0); ret = caml_alloc_tuple(nb_fields + 1); Store_field(ret, 0, tmp); c += 4; for (i = 0; i < nb_fields; i++) { if (c + 4 > end) caml_failwith("Invalid comments raw data"); len = readint(c, 0); c += 4; if (len < 0 || c + len > end) caml_failwith("Invalid comments raw data"); tmp = caml_alloc_string(len); memcpy(Bytes_val(tmp), c, len); Store_field(ret, i + 1, tmp); c += len; } CAMLreturn(ret); } #undef readint #undef writeint /* Mode API */ #define Mode_val(v) (*((SpeexMode **)Data_abstract_val(v))) static inline value value_of_speex_mode(value v, const SpeexMode *s) { v = caml_alloc(1, Abstract_tag); *((const SpeexMode **)Data_abstract_val(v)) = s; return v; } CAMLprim value caml_speex_get_mode(value i) { CAMLparam0(); CAMLlocal1(ret); CAMLreturn(value_of_speex_mode(ret, speex_lib_get_mode(Int_val(i)))); } /* Header API */ static SpeexHeader *header_of_value(value v, SpeexHeader *header) { int i = 0; value tmp; tmp = Field(v, i++); if (caml_string_length(tmp) > SPEEX_HEADER_STRING_LENGTH) caml_invalid_argument("wrong argument: speex_string too long"); memcpy(header->speex_string, String_val(tmp), caml_string_length(tmp)); tmp = Field(v, i++); if (caml_string_length(tmp) > SPEEX_HEADER_VERSION_LENGTH) caml_invalid_argument("wrong argument: speex_version too long"); memcpy(header->speex_version, String_val(tmp), caml_string_length(tmp)); #define shv(x) header->x = Int_val(Field(v, i++)) shv(speex_version_id); shv(header_size); shv(rate); header->mode = Int_val(caml_callback( *caml_named_value("caml_speex_int_of_mode"), Field(v, i++))); shv(mode_bitstream_version); shv(nb_channels); shv(bitrate); shv(frame_size); Store_field(v, i++, Val_bool(header->vbr)); shv(frames_per_packet); shv(extra_headers); return header; } CAMLprim value value_of_header(SpeexHeader *header) { CAMLparam0(); CAMLlocal2(ret, tmp); ret = caml_alloc_tuple(13); int i = 0; tmp = caml_alloc_string(SPEEX_HEADER_STRING_LENGTH); memcpy(Bytes_val(tmp), header->speex_string, SPEEX_HEADER_STRING_LENGTH); Store_field(ret, i++, tmp); tmp = caml_alloc_string(SPEEX_HEADER_VERSION_LENGTH); memcpy(Bytes_val(tmp), header->speex_version, SPEEX_HEADER_VERSION_LENGTH); Store_field(ret, i++, tmp); #define svh(v) Store_field(ret, i++, Val_int(header->v)); svh(speex_version_id); svh(header_size); svh(rate); Store_field(ret, i++, caml_callback(*caml_named_value("caml_speex_mode_of_int"), Val_int(header->mode))); svh(mode_bitstream_version); svh(nb_channels); svh(bitrate); svh(frame_size); Store_field(ret, i++, Val_bool(header->vbr)); svh(frames_per_packet); svh(extra_headers); CAMLreturn(ret); } CAMLprim value caml_speex_init_header(value rate, value chans, value mode, value fpp, value vbr) { CAMLparam1(mode); struct SpeexMode *m = Mode_val(mode); SpeexHeader header; speex_init_header(&header, Int_val(rate), 1, m); header.frames_per_packet = Int_val(fpp); header.vbr = Int_val(vbr); header.nb_channels = Int_val(chans); CAMLreturn(value_of_header(&header)); } CAMLprim value caml_speex_encode_header(value v, value o_comments) { CAMLparam2(v, o_comments); CAMLlocal1(ret); ogg_packet op; int packet_size; SpeexHeader header; char *vendor_string = "ocaml-speex by the savonet team (http://savonet.sf.net/)"; char *comments; int comments_length; int i; ret = caml_alloc_tuple(2); unsigned char *data = (unsigned char *)speex_header_to_packet( header_of_value(v, &header), &packet_size); op.packet = data; op.bytes = packet_size; op.b_o_s = 1; op.e_o_s = 0; op.granulepos = 0; op.packetno = 0; Store_field(ret, 0, value_of_packet(&op)); free(data); /* Comment Packet */ comment_init(&comments, &comments_length, vendor_string); for (i = 0; i < Wosize_val(o_comments); i++) comment_add(&comments, &comments_length, (char *)Bytes_val(Field(o_comments, i))); op.packet = (unsigned char *)comments; op.bytes = comments_length; op.b_o_s = 0; op.e_o_s = 0; op.granulepos = 0; op.packetno = 1; Store_field(ret, 1, value_of_packet(&op)); free(comments); CAMLreturn(ret); } CAMLprim value caml_speex_header_of_packet(value packet) { CAMLparam1(packet); CAMLlocal1(ret); ogg_packet *op = Packet_val(packet); if (op->bytes < sizeof(SpeexHeader)) caml_invalid_argument("not a speex header"); caml_enter_blocking_section(); SpeexHeader *header = speex_packet_to_header((char *)op->packet, op->bytes); caml_leave_blocking_section(); if (header == NULL) caml_invalid_argument("not a speex header"); ret = value_of_header(header); speex_header_free(header); CAMLreturn(ret); } /* Encoder API */ typedef struct cenc_t { int position; SpeexBits bits; void *enc; int fpp; } cenc_t; #define Enc_val(v) (*((cenc_t **)Data_custom_val(v))) static void finalize_speex_enc(value v) { cenc_t *enc = Enc_val(v); speex_bits_destroy(&enc->bits); speex_encoder_destroy(enc->enc); free(enc); } static struct custom_operations speex_enc_ops = { "ocaml_speex_enc", finalize_speex_enc, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default}; CAMLprim value ocaml_speex_enc_init(value m, value fpp) { CAMLparam1(m); CAMLlocal1(ret); cenc_t *cen = malloc(sizeof(cenc_t)); if (cen == NULL) caml_raise_out_of_memory(); SpeexMode *mode = Mode_val(m); void *enc = speex_encoder_init(mode); if (enc == NULL) caml_raise_out_of_memory(); speex_bits_init(&cen->bits); cen->enc = enc; cen->position = 0; cen->fpp = Int_val(fpp); ret = caml_alloc_custom(&speex_enc_ops, sizeof(cenc_t *), 1, 0); Enc_val(ret) = cen; CAMLreturn(ret); } CAMLprim value ocaml_speex_encoder_ctl_get(value e, value n) { CAMLparam1(e); cenc_t *cenc = Enc_val(e); void *enc = cenc->enc; int ret; if (speex_encoder_ctl(enc, Int_val(n), &ret) == -2) caml_invalid_argument("wrong argument in speex_encoder_ctl"); CAMLreturn(Val_int(ret)); } CAMLprim value ocaml_speex_encoder_ctl_set(value e, value n, value x) { CAMLparam1(e); cenc_t *cenc = Enc_val(e); void *enc = cenc->enc; int arg = Int_val(x); if (speex_encoder_ctl(enc, Int_val(n), &arg) == -2) caml_invalid_argument("wrong argument in speex_encoder_ctl"); CAMLreturn(Val_unit); } CAMLprim value ocaml_speex_encode_page(value e_state, value o_chans, value o_stream_state, value feed) { CAMLparam3(e_state, feed, o_stream_state); CAMLlocal2(v, ret); ogg_stream_state *os = Stream_state_val(o_stream_state); cenc_t *cenc = Enc_val(e_state); void *enc = cenc->enc; ogg_page og; ogg_packet op; int state = cenc->position - 1; int len; int frame_size; int fpp = cenc->fpp; int chans = Int_val(o_chans); speex_encoder_ctl(enc, SPEEX_GET_FRAME_SIZE, &frame_size); int i; float *data = malloc(sizeof(float) * frame_size * chans); if (data == NULL) caml_raise_out_of_memory(); char *cbits = malloc(sizeof(char) * frame_size * chans); if (cbits == NULL) { free(data); caml_raise_out_of_memory(); } int nbBytes; /* Is there an audio page flushed? If not, work until there is. */ do { if (ogg_stream_eos(os)) { free(data); free(cbits); caml_raise_constant(*caml_named_value("ocaml_speex_eos_exn")); } /* Read and process more audio. */ v = caml_callback_exn(feed, Val_unit); if Is_exception_result (v) { free(data); free(cbits); cenc->position = state + 1; caml_raise(Extract_exception(v)); } len = Wosize_val(v) / Double_wosize; if (len != frame_size * chans) { free(data); free(cbits); cenc->position = state + 1; caml_raise_constant(*caml_named_value("ocaml_speex_invfrlen_exn")); } for (i = 0; i < len; i++) data[i] = Double_field(v, i); caml_enter_blocking_section(); if (chans == 2) speex_encode_stereo(data, frame_size, &cenc->bits); speex_encode(enc, data, &cenc->bits); caml_leave_blocking_section(); state++; if ((state + 1) % fpp != 0) continue; speex_bits_insert_terminator(&cenc->bits); nbBytes = speex_bits_write(&cenc->bits, cbits, frame_size * fpp); speex_bits_reset(&cenc->bits); op.packet = (unsigned char *)cbits; op.bytes = nbBytes; op.b_o_s = 0; op.e_o_s = 0; op.granulepos = (state + 1) * frame_size; op.packetno = 2 + state / fpp; /* Put the packet in the ogg stream. */ ogg_stream_packetin(os, &op); } while (ogg_stream_pageout(os, &og) <= 0); cenc->position = state + 1; ret = value_of_page(&og); free(data); free(cbits); CAMLreturn(ret); } CAMLprim value ocaml_speex_encode_page_int(value e_state, value o_chans, value o_stream_state, value feed) { CAMLparam3(e_state, feed, o_stream_state); CAMLlocal2(v, ret); ogg_stream_state *os = Stream_state_val(o_stream_state); cenc_t *cenc = Enc_val(e_state); void *enc = cenc->enc; ogg_page og; ogg_packet op; int state = cenc->position - 1; int len; int chans = Int_val(o_chans); int frame_size; int fpp = cenc->fpp; speex_encoder_ctl(enc, SPEEX_GET_FRAME_SIZE, &frame_size); int i; spx_int16_t *data = malloc(sizeof(spx_int16_t) * frame_size * chans); if (data == NULL) caml_raise_out_of_memory(); char *cbits = malloc(sizeof(char) * frame_size * chans); if (cbits == NULL) { free(data); caml_raise_out_of_memory(); } int nbBytes; /* Is there an audio page flushed? If not, work until there is. */ do { if (ogg_stream_eos(os)) { free(data); free(cbits); caml_raise_constant(*caml_named_value("ocaml_speex_eos_exn")); } /* Read and process more audio. */ v = caml_callback_exn(feed, Val_unit); if Is_exception_result (v) { free(data); free(cbits); cenc->position = state + 1; caml_raise(Extract_exception(v)); } len = Wosize_val(v); if (len != frame_size * chans) { free(data); free(cbits); cenc->position = state + 1; caml_raise_constant(*caml_named_value("ocaml_speex_invfrlen_exn")); } for (i = 0; i < len; i++) data[i] = Int_val(Field(v, i)); caml_enter_blocking_section(); if (chans == 2) speex_encode_stereo_int(data, frame_size, &cenc->bits); speex_encode_int(enc, data, &cenc->bits); caml_leave_blocking_section(); state++; if ((state + 1) % fpp != 0) continue; speex_bits_insert_terminator(&cenc->bits); nbBytes = speex_bits_write(&cenc->bits, cbits, frame_size); speex_bits_reset(&cenc->bits); op.packet = (unsigned char *)cbits; op.bytes = nbBytes; op.b_o_s = 0; op.e_o_s = 0; op.granulepos = (state + 1) * frame_size; op.packetno = 2 + state / fpp; /* Put the packet in the ogg stream. */ ogg_stream_packetin(os, &op); } while (ogg_stream_pageout(os, &og) <= 0); cenc->position = state + 1; ret = value_of_page(&og); free(data); free(cbits); CAMLreturn(ret); } CAMLprim value ocaml_speex_encoder_eos(value v, value o_stream_state) { CAMLparam2(v, o_stream_state); ogg_packet op; ogg_stream_state *os = Stream_state_val(o_stream_state); cenc_t *cenc = Enc_val(v); int state = cenc->position - 1; void *enc = cenc->enc; int frame_size; speex_encoder_ctl(enc, SPEEX_GET_FRAME_SIZE, &frame_size); op.packet = (unsigned char *)NULL; op.bytes = 0; op.b_o_s = 0; op.e_o_s = 1; op.granulepos = (state + 1) * frame_size; op.packetno = 2 + state; ogg_stream_packetin(os, &op); CAMLreturn(Val_unit); } /* Decoder API */ typedef struct cdec_t { SpeexStereoState *stereo; SpeexBits bits; void *dec; } cdec_t; #define Dec_val(v) (*((cdec_t **)Data_custom_val(v))) static void finalize_speex_dec(value v) { cdec_t *cdec = Dec_val(v); speex_stereo_state_destroy(cdec->stereo); speex_bits_destroy(&cdec->bits); speex_decoder_destroy(cdec->dec); free(cdec); } static struct custom_operations speex_dec_ops = { "ocaml_speex_dec", finalize_speex_dec, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default}; CAMLprim value ocaml_speex_dec_init(value m) { CAMLparam1(m); CAMLlocal1(ret); SpeexMode *mode = Mode_val(m); void *dec = speex_decoder_init(mode); if (dec == NULL) caml_raise_out_of_memory(); SpeexStereoState *stereo = speex_stereo_state_init(); if (stereo == NULL) caml_raise_out_of_memory(); cdec_t *cdec = malloc(sizeof(cdec_t)); if (cdec == NULL) caml_raise_out_of_memory(); cdec->dec = dec; speex_bits_init(&cdec->bits); cdec->stereo = stereo; SpeexCallback callback; callback.callback_id = SPEEX_INBAND_STEREO; callback.func = speex_std_stereo_request_handler; callback.data = stereo; speex_decoder_ctl(dec, SPEEX_SET_HANDLER, &callback); ret = caml_alloc_custom(&speex_dec_ops, sizeof(cdec_t *), 1, 0); Dec_val(ret) = cdec; CAMLreturn(ret); } CAMLprim value ocaml_speex_decoder_ctl_get(value e, value n) { CAMLparam1(e); cdec_t *cdec = Dec_val(e); void *dec = cdec->dec; int ret; if (speex_decoder_ctl(dec, Int_val(n), &ret) == -2) caml_invalid_argument("wrong argument in speex_decoder_ctl"); CAMLreturn(Val_int(ret)); } CAMLprim value ocaml_speex_decoder_ctl_set(value e, value n, value x) { CAMLparam1(e); cdec_t *cdec = Dec_val(e); void *dec = cdec->dec; int arg = Int_val(x); if (speex_decoder_ctl(dec, Int_val(n), &arg) == -2) caml_invalid_argument("wrong argument in speex_decoder_ctl"); CAMLreturn(Val_unit); } CAMLprim value ocaml_speex_decoder_decode(value e, value o_chans, value s, value add) { CAMLparam3(e, s, add); CAMLlocal2(ret, v); ogg_stream_state *os = Stream_state_val(s); cdec_t *cdec = Dec_val(e); void *dec = cdec->dec; SpeexStereoState *stereo = cdec->stereo; int chans = Int_val(o_chans); int err; ogg_packet op; int frame_size; speex_decoder_ctl(dec, SPEEX_GET_FRAME_SIZE, &frame_size); float *out = malloc(sizeof(float) * frame_size * chans); if (out == NULL) caml_raise_out_of_memory(); int i; int n; while (1) { err = ogg_stream_packetout(os, &op); if (err <= 0) { free(out); if (err == 0) caml_raise_constant(*caml_named_value("ogg_exn_not_enough_data")); else caml_raise_constant(*caml_named_value("ogg_exn_out_of_sync")); } /* Copy Ogg packet to Speex bitstream */ caml_enter_blocking_section(); speex_bits_read_from(&cdec->bits, (char *)op.packet, op.bytes); caml_leave_blocking_section(); while (1) { caml_enter_blocking_section(); n = speex_decode(dec, &cdec->bits, out); caml_leave_blocking_section(); if (n == -1) break; if (chans == 2) speex_decode_stereo(out, frame_size, stereo); ret = caml_alloc(frame_size * chans * Double_wosize, Double_array_tag); for (i = 0; i < frame_size * chans; i++) Store_double_field(ret, i, out[i]); v = caml_callback_exn(add, ret); if Is_exception_result (v) { free(out); caml_raise(Extract_exception(v)); } }; } free(out); CAMLreturn(Val_unit); } CAMLprim value ocaml_speex_decoder_decode_int(value e, value o_chans, value s, value add) { CAMLparam3(e, s, add); CAMLlocal2(ret, v); ogg_stream_state *os = Stream_state_val(s); cdec_t *cdec = Dec_val(e); void *dec = cdec->dec; SpeexStereoState *stereo = cdec->stereo; int chans = Int_val(o_chans); int err; ogg_packet op; int frame_size; speex_decoder_ctl(dec, SPEEX_GET_FRAME_SIZE, &frame_size); spx_int16_t *out = malloc(sizeof(spx_int16_t) * frame_size * chans); if (out == NULL) caml_raise_out_of_memory(); int i; int n; while (1) { err = ogg_stream_packetout(os, &op); if (err <= 0) { free(out); if (err == 0) caml_raise_constant(*caml_named_value("ogg_exn_not_enough_data")); else caml_raise_constant(*caml_named_value("ogg_exn_out_of_sync")); } /* Copy Ogg packet to Speex bitstream */ speex_bits_read_from(&cdec->bits, (char *)op.packet, op.bytes); while (1) { caml_enter_blocking_section(); n = speex_decode_int(dec, &cdec->bits, out); caml_leave_blocking_section(); if (n == -1) break; if (chans == 2) speex_decode_stereo_int(out, frame_size, stereo); ret = caml_alloc_tuple(frame_size * chans); for (i = 0; i < frame_size * chans; i++) Store_field(ret, i, Int_val(out[i])); v = caml_callback_exn(add, ret); if Is_exception_result (v) { free(out); caml_raise(Extract_exception(v)); } }; } free(out); CAMLreturn(Val_unit); } /* Ogg skeleton support */ /* Wrappers */ static void write32le(unsigned char *ptr, ogg_uint32_t v) { ptr[0] = v & 0xff; ptr[1] = (v >> 8) & 0xff; ptr[2] = (v >> 16) & 0xff; ptr[3] = (v >> 24) & 0xff; } static void write64le(unsigned char *ptr, ogg_int64_t v) { ogg_uint32_t hi = v >> 32; ptr[0] = v & 0xff; ptr[1] = (v >> 8) & 0xff; ptr[2] = (v >> 16) & 0xff; ptr[3] = (v >> 24) & 0xff; ptr[4] = hi & 0xff; ptr[5] = (hi >> 8) & 0xff; ptr[6] = (hi >> 16) & 0xff; ptr[7] = (hi >> 24) & 0xff; } /* Values from http://xiph.org/ogg/doc/skeleton.html */ #define FISBONE_IDENTIFIER "fisbone\0" #define FISBONE_MESSAGE_HEADER_OFFSET 44 #define FISBONE_SIZE 52 /* Values from speexenc.c in speexenc */ CAMLprim value ocaml_speex_skeleton_fisbone(value serial, value _header, value start, value content) { CAMLparam4(serial, _header, start, content); CAMLlocal1(packet); ogg_packet op; SpeexHeader header; header_of_value(_header, &header); int len = FISBONE_SIZE + caml_string_length(content); memset(&op, 0, sizeof(op)); op.packet = malloc(len); if (op.packet == NULL) caml_raise_out_of_memory(); memset(op.packet, 0, len); /* it will be the fisbone packet for the speex audio */ memcpy(op.packet, FISBONE_IDENTIFIER, 8); /* identifier */ write32le( op.packet + 8, FISBONE_MESSAGE_HEADER_OFFSET); /* offset of the message header fields */ write32le(op.packet + 12, Nativeint_val(serial)); /* serialno of the vorbis stream */ write32le(op.packet + 16, 2 + header.extra_headers); /* number of header packet */ /* granulerate, temporal resolution of the bitstream in Hz */ write64le(op.packet + 20, (ogg_int64_t)header.rate); /* granulerate numerator */ write64le(op.packet + 28, (ogg_int64_t)1); /* granulerate denominator */ write64le(op.packet + 36, (ogg_int64_t)Int64_val(start)); /* start granule */ write32le(op.packet + 44, 3); /* preroll, for speex its 3 */ *(op.packet + 48) = 0; /* granule shift, always 0 for speex */ memcpy(op.packet + FISBONE_SIZE, String_val(content), caml_string_length(content)); op.b_o_s = 0; op.e_o_s = 0; op.bytes = len; packet = value_of_packet(&op); free(op.packet); CAMLreturn(packet); } ocaml-xiph-1.0.0/theora.opam000066400000000000000000000014371474662033600157310ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "1.0.0" synopsis: "Bindings to libtheora" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] license: "LGPL-2.1-only" homepage: "https://github.com/savonet/ocaml-xiph" bug-reports: "https://github.com/savonet/ocaml-xiph/issues" depends: [ "conf-libtheora" "conf-pkg-config" "dune" {>= "2.8"} "dune-configurator" "ogg" {= version} "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] dev-repo: "git+https://github.com/savonet/ocaml-xiph.git" x-maintenance-intent: ["(latest)"] ocaml-xiph-1.0.0/theora.opam.template000066400000000000000000000000431474662033600175330ustar00rootroot00000000000000x-maintenance-intent: ["(latest)"] ocaml-xiph-1.0.0/theora/000077500000000000000000000000001474662033600150465ustar00rootroot00000000000000ocaml-xiph-1.0.0/theora/config/000077500000000000000000000000001474662033600163135ustar00rootroot00000000000000ocaml-xiph-1.0.0/theora/config/discover.ml000066400000000000000000000011211474662033600204560ustar00rootroot00000000000000module C = Configurator.V1 let () = C.main ~name:"theora-pkg-config" (fun c -> let default : C.Pkg_config.package_conf = { libs = ["-ltheoraenc"; "-ltheoradec"]; cflags = [] } in let conf = match C.Pkg_config.get c with | None -> default | Some pc -> ( match C.Pkg_config.query pc ~package:"theoradec theoraenc" with | None -> default | Some deps -> deps) in C.Flags.write_sexp "c_flags.sexp" ("-fPIC" :: conf.cflags); C.Flags.write_sexp "c_library_flags.sexp" conf.libs) ocaml-xiph-1.0.0/theora/config/dune000066400000000000000000000000751474662033600171730ustar00rootroot00000000000000(executable (name discover) (libraries dune.configurator)) ocaml-xiph-1.0.0/theora/dune000066400000000000000000000010361474662033600157240ustar00rootroot00000000000000(library (name theora) (public_name theora) (synopsis "OCaml bindings for libtheora") (libraries ogg) (modules theora) (foreign_stubs (language c) (names theora_stubs) (flags (:include c_flags.sexp))) (c_library_flags (:include c_library_flags.sexp))) (library (name theora_decoder) (public_name theora.decoder) (synopsis "Theora decoder for the ogg-decoder library") (libraries ogg.decoder theora) (modules theora_decoder)) (rule (targets c_flags.sexp c_library_flags.sexp) (action (run ./config/discover.exe))) ocaml-xiph-1.0.0/theora/examples/000077500000000000000000000000001474662033600166645ustar00rootroot00000000000000ocaml-xiph-1.0.0/theora/examples/dune000066400000000000000000000000651474662033600175430ustar00rootroot00000000000000(executable (name thtranscode) (libraries theora)) ocaml-xiph-1.0.0/theora/examples/thtranscode.ml000066400000000000000000000107151474662033600215400ustar00rootroot00000000000000(* Shamelessly inspired of http://theora.org/doc/libtheora-1.0beta1/ *) exception No_theora open Theora let infile = ref "input.ogg" let outfile = ref "output.ogg" let debug = ref false let quality = ref 40 let () = Arg.parse [ ("-d", Arg.Set debug, "Show debugging messages"); ("-o", Arg.Set_string outfile, "Output file"); ("-q", Arg.Set_int quality, "Quality of the compression"); ("-i", Arg.Set_string infile, "Input file"); ] ignore "thranscode [options]" let in_init () = let sync, fd = Ogg.Sync.create_from_file !infile in let rec fill os = let page = Ogg.Sync.read sync in try (* We drop pages which are not for us.. *) if Ogg.Page.serialno page = Ogg.Stream.serialno os then Ogg.Stream.put_page os page with Ogg.Bad_data -> fill os (* Do not care about page that are not for us.. *) in (* Test wether the stream is theora *) let test_theora () = (* Get First page *) let page = Ogg.Sync.read sync in (* Check wether this is a b_o_s *) if not (Ogg.Page.bos page) then raise No_theora; (* Create a stream with this ID *) let serial = Ogg.Page.serialno page in Printf.printf "Testing stream %nx\n" serial; let os = Ogg.Stream.create ~serial () in Ogg.Stream.put_page os page; let packet = Ogg.Stream.get_packet os in (* Test header. Do not catch anything, first page should be sufficient *) if not (Decoder.check packet) then raise Not_found; Printf.printf "Got a theora stream !\n"; let dec = Decoder.create () in (* Decode headers *) let rec f packet = try Decoder.headerin dec packet with Ogg.Not_enough_data -> let rec g () = try let packet = Ogg.Stream.get_packet os in f packet with Ogg.Not_enough_data -> fill os; g () in g () in let dec, info, vendor, comments = f packet in (serial, os, dec, info, vendor, comments) in (* Now find a theora stream *) let rec init () = try test_theora () with | Not_found -> Printf.printf "This stream was not theora..\n"; init () | No_theora -> Printf.printf "No theora stream was found..\n%!"; raise No_theora in let serial, os, t, info, vendor, comments = init () in Printf.printf "Ogg logical stream %nx is Theora %dx%d %.02f fps video\n" serial info.frame_width info.frame_height (float_of_int info.fps_numerator /. float_of_int info.fps_denominator); Printf.printf "Encoded frame content is %dx%d with %dx%d offset\n" info.picture_width info.picture_height info.picture_x info.picture_y; Printf.printf "YUV4MPEG2 W%d H%d F%d:%d I%c A%d:%d\n" info.frame_width info.frame_height info.fps_numerator info.fps_denominator 'p' info.aspect_numerator info.aspect_denominator; Printf.printf "Vendor: %s\n" vendor; List.iter (fun (x, y) -> Printf.printf "%s: %s\n" x y) comments; flush_all (); (t, os, fill, info, fd) let out_init info = let oc = open_out !outfile in let out s = output_string oc s; flush oc in let os = Ogg.Stream.create () in let settings = { Encoder.keyframe_frequency = None; vp3_compatible = None; soft_target = None; buffer_delay = None; speed = None; } in let comments = [("artitst", "test artist"); ("title", "test title")] in let t = Encoder.create info settings comments in let s_o_p (h, b) = h ^ b in Encoder.encode_header t os; out (s_o_p (Ogg.Stream.flush_page os)); (t, os, out) let () = let dec, is, fill, info, fd = in_init () in let info = { info with target_bitrate = 0; quality = !quality } in let enc, os, out = out_init info in let latest_yuv = ref None in let rec generator () = try let yuv = Decoder.get_yuv dec is in latest_yuv := Some yuv; yuv with | Ogg.Not_enough_data when not (Ogg.Stream.eos is) -> fill is; generator () | Duplicate_frame -> ( (* Got a duplicate frame, sending previous one ! *) match !latest_yuv with Some x -> x | None -> raise Internal_error) in let s_o_p (h, b) = h ^ b in Printf.printf "Starting transcoding loop !\n%!"; begin try while true do let op = Encoder.encode_page enc os generator in let op = s_o_p op in out op done with Ogg.Not_enough_data -> () end; List.iter (fun p -> out (s_o_p p)) (Ogg.Stream.terminate os); Unix.close fd; Gc.full_major () ocaml-xiph-1.0.0/theora/theora.ml000066400000000000000000000147121474662033600166670ustar00rootroot00000000000000(* * Copyright 2007-2011 Savonet team * * This file is part of ocaml-theora. * * ocaml-theora 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 2 of the License, or * (at your option) any later version. * * ocaml-theora 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 ocaml-theora; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** * Functions for encoding theora files using libtheora. * * @author Samuel Mimram * @author Romain Beauxis *) exception Internal_error exception Invalid_data exception Bad_packet exception Header_not_theora exception Bad_header exception Not_implemented exception Bitstream_version_too_high exception Unknown_error of int exception Duplicate_frame exception Done exception Not_initialized let () = Callback.register_exception "theora_exn_fault" Internal_error; Callback.register_exception "theora_exn_version" Bitstream_version_too_high; Callback.register_exception "theora_exn_bad_packet" Bad_packet; Callback.register_exception "theora_exn_notformat" Header_not_theora; Callback.register_exception "theora_exn_bad_header" Bad_header; Callback.register_exception "theora_exn_not_implemented" Not_implemented; Callback.register_exception "theora_exn_inval" Invalid_data; Callback.register_exception "theora_exn_unknown" (Unknown_error 0); Callback.register_exception "theora_exn_dup_frame" Duplicate_frame; Callback.register_exception "theora_exn_not_enough_data" Ogg.Not_enough_data; Callback.register_exception "theora_exn_end_of_file" End_of_file external version_string : unit -> string = "ocaml_theora_version_string" let version_string = version_string () external version_number : unit -> int = "ocaml_theora_version_number" let version_number = let n = version_number () in (n lsr 16, (n lsr 8) land 0xff, n land 0xff) type colorspace = | CS_unspecified | CS_ITU_REC_470M | CS_ITU_REC_470BG | CS_NSPACES type pixelformat = PF_420 | PF_reserved | PF_422 | PF_444 type info = { frame_width : int; (** The encoded frame width. *) frame_height : int; (** The encoded frame height. *) picture_width : int; (** The displayed picture width. *) picture_height : int; (** The displayed picture height. *) picture_x : int; (** The X offset of the displayed picture. *) picture_y : int; (** The Y offset of the displayed picture. *) colorspace : colorspace; (** The color space. *) pixel_fmt : pixelformat; (** The pixel format. *) target_bitrate : int; (** The target bit-rate in bits per second. *) quality : int; (** The target quality level. *) keyframe_granule_shift : int; (** The amount to shift to extract the last keyframe number from the granule position. *) version_major : int; version_minor : int; version_subminor : int; fps_numerator : int; fps_denominator : int; aspect_numerator : int; aspect_denominator : int; } external default_granule_shift : unit -> int = "ocaml_theora_default_granuleshift" let default_granule_shift = default_granule_shift () type data_buffer = (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t type yuv_buffer = { y_width : int; y_height : int; y_stride : int; y : data_buffer; u_width : int; u_height : int; u_stride : int; u : data_buffer; v_width : int; v_height : int; v_stride : int; v : data_buffer; } let encoder_tag = "ocaml-theora by the savonet team (http://savonet.sf.net/)" external is_keyframe : Ogg.Stream.packet -> int = "ocaml_theora_ogg_packet_iskeyframe" let is_keyframe op = match is_keyframe op with 1 -> true | 0 -> false | _ -> raise Invalid_data module Encoder = struct type t type settings = { keyframe_frequency : int option; vp3_compatible : bool option; soft_target : bool option; buffer_delay : int option; speed : int option; } external create : info -> settings -> (string * string) array -> t = "ocaml_theora_encode_init" let create info params comments = let comments = ("ENCODER", encoder_tag) :: comments in create info params (Array.of_list comments) external encode_header : t -> Ogg.Stream.stream -> bool = "ocaml_theora_encode_header" let encode_header enc os = let rec f () = if not (encode_header enc os) then f () in f () external encode_buffer : t -> Ogg.Stream.stream -> yuv_buffer -> unit = "ocaml_theora_encode_buffer" let encode_page enc os generator = let rec f () = try let yuv = generator () in encode_buffer enc os yuv; Ogg.Stream.get_page os with Ogg.Not_enough_data -> f () in f () external frames_of_granulepos : t -> Int64.t -> Int64.t = "ocaml_theora_encoder_frame_of_granulepos" external eos : t -> Ogg.Stream.stream -> unit = "ocaml_theora_encode_eos" end module Decoder = struct type decoder type t external check : Ogg.Stream.packet -> bool = "caml_theora_check" external create : unit -> decoder = "ocaml_theora_create_dec" external headerin : decoder -> Ogg.Stream.packet -> info * string array = "ocaml_theora_dec_headerin" let headerin dec p = let info, comments = headerin dec p in let vendor, comments = match Array.to_list comments with e :: l -> (e, l) | [] -> ("", []) in let split s = try let pos = String.index s '=' in (String.sub s 0 pos, String.sub s (pos + 1) (String.length s - pos - 1)) with Not_found -> ("", s) in (Obj.magic dec, info, vendor, List.map split comments) external frames_of_granulepos : t -> Int64.t -> Int64.t = "ocaml_theora_decoder_frame_of_granulepos" external get_yuv : t -> Ogg.Stream.stream -> yuv_buffer = "ocaml_theora_decode_YUVout" end module Skeleton = struct external fisbone : Nativeint.t -> info -> Int64.t -> string -> Ogg.Stream.packet = "ocaml_theora_skeleton_fisbone" let fisbone ?(start_granule = Int64.zero) ?(headers = [("Content-type", "video/theora")]) ~serialno ~info () = let concat s (h, v) = Printf.sprintf "%s%s: %s\r\n" s h v in let s = List.fold_left concat "" headers in fisbone serialno info start_granule s end ocaml-xiph-1.0.0/theora/theora.mli000066400000000000000000000177771474662033600170560ustar00rootroot00000000000000(* * Copyright 2007-2009 Samuel Mimram, Romain Beauxis * * This file is part of ocaml-theora. * * ocaml-theora 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 2 of the License, or * (at your option) any later version. * * ocaml-theora 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 ocaml-theora; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** * Functions for encoding theora files using libtheora. * * @author Samuel Mimram * @author Romain Beauxis *) (** {2 Exceptions} *) (** General failure. *) exception Internal_error (** Library encountered invalid internal data. *) exception Invalid_data (** An unhandled error happened. *) exception Unknown_error of int (** The decoded packet represented a dropped frame. * The player can continue to display the current frame, * as the contents of the decoded frame buffer have not * changed. *) exception Duplicate_frame (** Exceptions used by the decoding module. *) exception Done exception Not_initialized exception Bad_packet exception Header_not_theora exception Bad_header exception Not_implemented (** {2 General functions} *) (** * Human-readable string to identify the encoder vendor and version. *) val version_string : string (** major, minor and sub version numbers of the encoder. *) val version_number : int * int * int (** Determines whether a theora packet is a key frame or not. * * raises [Invalid_data] if The packet is not a video data * packet. *) val is_keyframe : Ogg.Stream.packet -> bool (** {2 Types and datastructures} *) (** A Colorspace. *) type colorspace = | CS_unspecified (** The colorspace is unknown or unspecified *) | CS_ITU_REC_470M (** This is the best option for 'NTSC' content *) | CS_ITU_REC_470BG (** This is the best option for 'PAL' content *) | CS_NSPACES (** This marks the end of the defined colorspaces *) (** * A Chroma subsampling * * These enumerate the available chroma subsampling options supported * by the theora format. See Section 4.4 of the specification for * exact definitions. *) type pixelformat = | PF_420 (** Chroma subsampling by 2 in each direction (4:2:0) *) | PF_reserved (** Reserved value *) | PF_422 (** Horizonatal chroma subsampling by 2 (4:2:2) *) | PF_444 (** No chroma subsampling at all (4:4:4) *) (** Theora bitstream info. *) type info = { frame_width : int; (** The encoded frame width. *) frame_height : int; (** The encoded frame height. *) picture_width : int; (** The displayed picture width. *) picture_height : int; (** The displayed picture height. *) picture_x : int; (** The X offset of the displayed picture. *) picture_y : int; (** The Y offset of the displayed picture. *) colorspace : colorspace; (** The color space. *) pixel_fmt : pixelformat; (** The pixel format. *) target_bitrate : int; (** The target bit-rate in bits per second. *) quality : int; (** The target quality level. *) keyframe_granule_shift : int; (** The amount to shift to extract the last keyframe number from the granule position. *) version_major : int; version_minor : int; version_subminor : int; fps_numerator : int; fps_denominator : int; aspect_numerator : int; aspect_denominator : int; } val default_granule_shift : int type data_buffer = (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t (** * A YUV buffer for passing uncompressed frames to and from the codec. * This holds a Y'CbCr frame in planar format. The CbCr planes can be * subsampled and have their own separate dimensions and row stride * offsets. Note that the strides may be negative in some * configurations. For theora the width and height of the largest plane * must be a multiple of 16. The actual meaningful picture size and * offset are stored in the [info] structure; frames returned by * the decoder may need to be cropped for display. * * All samples are 8 bits. Within each plane samples are ordered by * row from the top of the frame to the bottom. Within each row samples * are ordered from left to right. *) type yuv_buffer = { y_width : int; y_height : int; y_stride : int; y : data_buffer; u_width : int; u_height : int; u_stride : int; u : data_buffer; v_width : int; v_height : int; v_stride : int; v : data_buffer; } (** {2 Encoding} *) module Encoder : sig type t type settings = { keyframe_frequency : int option; vp3_compatible : bool option; soft_target : bool option; buffer_delay : int option; speed : int option; } (** Initialize a [state] handle for decoding. *) val create : info -> settings -> (string * string) list -> t (** * Fills the given stream with the header packets. *) val encode_header : t -> Ogg.Stream.stream -> unit (** * Encode data until a page is filled. *) val encode_page : t -> Ogg.Stream.stream -> (unit -> yuv_buffer) -> Ogg.Page.t (** Encode a buffer. *) val encode_buffer : t -> Ogg.Stream.stream -> yuv_buffer -> unit (** Convert a granulepos to an absolute frame index, starting at 0. * The granulepos is interpreted in the context of a given theora_state handle. *) val frames_of_granulepos : t -> Int64.t -> Int64.t (** Set end of stream *) val eos : t -> Ogg.Stream.stream -> unit [@@alert deprecated "This function generates invalid bitstream. Please use \ Ogg.Stream.terminate instead!"] end module Decoder : sig (** Type for an uninitialized decoder. *) type decoder (** Type for an initialized decoder. *) type t (** * Check wether an ogg logical stream contains theora data * * This function shall be called just after you put * the first page in the stream. See examples/thdecode.ml * * Raises [Ogg.Bad_data] if the stream does not contain theora data. *) val check : Ogg.Stream.packet -> bool (** Initialize the decoding structure. * The decoder should then be processed with [headerin]. *) val create : unit -> decoder (** Add one packet from the stream and try to parse theora headers. * * Returns an initialized decoder. * * Raises [Ogg.Not_enough_data] is decoding header needs another packet. * * This function should be called with the first packets of the stream * until it returns the requested values. It may consume at most 5 packets * (3 header packet, 1 additional packet and the initial video packet) *) val headerin : decoder -> Ogg.Stream.packet -> t * info * string * (string * string) list (** * Output the next available frame of decoded YUV data. * * Raises [Ogg.Not_enough_data] if the Ogg.Stream.stream which * has been used to initialize the handler does not contain * enought data. You should submit a new page to it, and * run this function again until it returns. * * Raises [Not_initialized] if the decoder was not properly * initialized with [headerin]. *) val get_yuv : t -> Ogg.Stream.stream -> yuv_buffer (** Convert a granulepos to an absolute frame index, starting at 0. * The granulepos is interpreted in the context of a given theora_state handle. *) val frames_of_granulepos : t -> Int64.t -> Int64.t end module Skeleton : sig (** Generate a theora fisbone packet with * these parameters, to use in an ogg skeleton. * Default value for [start_granule] is [Int64.zero], * Default value for [headers] is ["Content-type","video/theora"] * * See: http://xiph.org/ogg/doc/skeleton.html. *) val fisbone : ?start_granule:Int64.t -> ?headers:(string * string) list -> serialno:Nativeint.t -> info:info -> unit -> Ogg.Stream.packet end ocaml-xiph-1.0.0/theora/theora_decoder.ml000066400000000000000000000056141474662033600203550ustar00rootroot00000000000000(* * Copyright 2007-2011 Savonet team * * This file is part of ocaml-theora. * * ocaml-theora 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 2 of the License, or * (at your option) any later version. * * ocaml-theora 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 ocaml-theora; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) let check = Theora.Decoder.check let decoder ~fill:_ os = let decoder = Theora.Decoder.create () in let data = ref None in let latest_yuv = ref None in let os = ref os in let init () = match !data with | Some (dec, info, m) -> (dec, info, m) | None -> let packet = Ogg.Stream.get_packet !os in let decoder, info, vendor, m = Theora.Decoder.headerin decoder packet in let meta = (vendor, m) in data := Some (decoder, info, meta); (decoder, info, meta) in let decode feed = let decoder, info, _ = init () in let ret = try let yuv = Theora.Decoder.get_yuv decoder !os in latest_yuv := Some yuv; yuv with Theora.Duplicate_frame -> ( match !latest_yuv with | Some yuv -> yuv | None -> raise Theora.Internal_error) in let format = match info.Theora.pixel_fmt with | Theora.PF_420 -> Ogg_decoder.Yuvj_420 | Theora.PF_reserved -> assert false | Theora.PF_422 -> Ogg_decoder.Yuvj_422 | Theora.PF_444 -> Ogg_decoder.Yuvj_444 in let ret = { Ogg_decoder.format; frame_width = info.Theora.frame_width; frame_height = info.Theora.frame_height; y_stride = ret.Theora.y_stride; uv_stride = ret.Theora.u_stride; y = ret.Theora.y; u = ret.Theora.u; v = ret.Theora.v; } in feed ret in let info () = let _, info, m = init () in ( { Ogg_decoder.fps_numerator = info.Theora.fps_numerator; fps_denominator = info.Theora.fps_denominator; width = info.Theora.frame_width; height = info.Theora.frame_height; }, m ) in let restart ~fill:_ new_os = os := new_os in let samples_of_granulepos pos = let decoder, _, _ = init () in Theora.Decoder.frames_of_granulepos decoder pos in Ogg_decoder.Video { Ogg_decoder.name = "theora"; info; decode; restart; samples_of_granulepos; } let register () = Hashtbl.add Ogg_decoder.ogg_decoders "theora" (check, decoder) ocaml-xiph-1.0.0/theora/theora_decoder.mli000066400000000000000000000016511474662033600205230ustar00rootroot00000000000000(* * Copyright 2007-2011 Savonet team * * This file is part of ocaml-theora. * * ocaml-theora 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 2 of the License, or * (at your option) any later version. * * ocaml-theora 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 ocaml-theora; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Implementation of the theora decoder * for the [Ogg_demuxer] module. *) (** Register the decoder. *) val register : unit -> unit ocaml-xiph-1.0.0/theora/theora_stubs.c000066400000000000000000000504471474662033600177260ustar00rootroot00000000000000/* * Copyright 2007-2009 Samuel Mimram and Romain Beauxis * * This file is part of ocaml-theora. * * ocaml-theora 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 2 of the License, or * (at your option) any later version. * * ocaml-theora 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 ocaml-theora; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ #include #include #include #include #include #include #include #include #include #include #include #include #include #include #ifndef Bytes_val #define Byles_val String_val #endif /***** Error handling ******/ static void check_err(int n) { switch (n) { case 0: return; case TH_EFAULT: caml_raise_constant(*caml_named_value("theora_exn_fault")); case TH_EINVAL: caml_raise_constant(*caml_named_value("theora_exn_inval")); case TH_EVERSION: caml_raise_constant(*caml_named_value("theora_exn_version")); case TH_EBADPACKET: caml_raise_constant(*caml_named_value("theora_exn_bad_packet")); case TH_ENOTFORMAT: caml_raise_constant(*caml_named_value("theora_exn_notformat")); case TH_EBADHEADER: caml_raise_constant(*caml_named_value("theora_exn_bad_header")); case TH_EIMPL: caml_raise_constant(*caml_named_value("theora_exn_not_implemented")); case TH_DUPFRAME: caml_raise_constant(*caml_named_value("theora_exn_dup_frame")); default: caml_raise_with_arg(*caml_named_value("theora_exn_unknown"), Val_int(n)); } } /***** Version *****/ CAMLprim value ocaml_theora_version_string(value unit) { return caml_copy_string(th_version_string()); } CAMLprim value ocaml_theora_version_number(value unit) { return Val_int(th_version_number()); } /***** Helper functions *****/ static th_colorspace cs_of_val(value v) { switch (Int_val(v)) { case 0: return TH_CS_UNSPECIFIED; case 1: return TH_CS_ITU_REC_470M; case 2: return TH_CS_ITU_REC_470BG; case 3: return TH_CS_NSPACES; default: assert(0); } } static value val_of_cs(th_colorspace c) { switch (c) { case TH_CS_UNSPECIFIED: return Int_val(0); case TH_CS_ITU_REC_470M: return Int_val(1); case TH_CS_ITU_REC_470BG: return Int_val(2); case TH_CS_NSPACES: return Int_val(3); default: assert(0); } } static th_pixel_fmt pf_of_val(value v) { switch (Int_val(v)) { case 0: return TH_PF_420; case 1: return TH_PF_RSVD; case 2: return TH_PF_422; case 3: return TH_PF_444; default: assert(0); } } static value val_of_pf(th_pixel_fmt p) { switch (p) { case TH_PF_420: return Int_val(0); case TH_PF_RSVD: return Int_val(1); case TH_PF_422: return Int_val(2); case TH_PF_444: return Int_val(3); default: assert(0); } } /* ti is *not* allocated: codec_setup may be allocated by * theora_info_init and its memory lost. You better check what you need */ static th_info *info_of_val(value v, th_info *ti) { int i = 0; ti->frame_width = Int_val(Field(v, i++)); ti->frame_height = Int_val(Field(v, i++)); ti->pic_width = Int_val(Field(v, i++)); ti->pic_height = Int_val(Field(v, i++)); ti->pic_x = Int_val(Field(v, i++)); ti->pic_y = Int_val(Field(v, i++)); ti->colorspace = cs_of_val(Field(v, i++)); ti->pixel_fmt = pf_of_val(Field(v, i++)); ti->target_bitrate = Int_val(Field(v, i++)); ti->quality = Int_val(Field(v, i++)); ti->keyframe_granule_shift = Int_val(Field(v, i++)); ti->version_major = Int_val(Field(v, i++)); ti->version_minor = Int_val(Field(v, i++)); ti->version_subminor = Int_val(Field(v, i++)); ti->fps_numerator = Int_val(Field(v, i++)); ti->fps_denominator = Int_val(Field(v, i++)); ti->aspect_numerator = Int_val(Field(v, i++)); ti->aspect_denominator = Int_val(Field(v, i++)); return ti; } static value val_of_info(th_info *ti) { CAMLparam0(); CAMLlocal1(v); int i = 0; v = caml_alloc_tuple(18); Store_field(v, i++, Val_int(ti->frame_width)); Store_field(v, i++, Val_int(ti->frame_height)); Store_field(v, i++, Val_int(ti->pic_width)); Store_field(v, i++, Val_int(ti->pic_height)); Store_field(v, i++, Val_int(ti->pic_x)); Store_field(v, i++, Val_int(ti->pic_y)); Store_field(v, i++, val_of_cs(ti->colorspace)); Store_field(v, i++, val_of_pf(ti->pixel_fmt)); Store_field(v, i++, Val_int(ti->target_bitrate)); Store_field(v, i++, Val_int(ti->quality)); Store_field(v, i++, Val_int(ti->keyframe_granule_shift)); Store_field(v, i++, Val_int(ti->version_major)); Store_field(v, i++, Val_int(ti->version_minor)); Store_field(v, i++, Val_int(ti->version_subminor)); Store_field(v, i++, Val_int(ti->fps_numerator)); Store_field(v, i++, Val_int(ti->fps_denominator)); Store_field(v, i++, Val_int(ti->aspect_numerator)); Store_field(v, i++, Val_int(ti->aspect_denominator)); CAMLreturn(v); } static void yuv_of_val(value v, th_ycbcr_buffer buffer) { int i = 0; struct caml_ba_array *ba; /* Y plane */ buffer[0].width = Int_val(Field(v, i++)); buffer[0].height = Int_val(Field(v, i++)); buffer[0].stride = Int_val(Field(v, i++)); ba = Caml_ba_array_val(Field(v, i++)); if (ba->dim[0] < buffer[0].stride * buffer[0].height) caml_raise_constant(*caml_named_value("theora_exn_inval")); buffer[0].data = (unsigned char *)ba->data; /* Cb plane */ buffer[1].width = Int_val(Field(v, i++)); buffer[1].height = Int_val(Field(v, i++)); buffer[1].stride = Int_val(Field(v, i++)); ba = Caml_ba_array_val(Field(v, i++)); if (ba->dim[0] < buffer[1].stride * buffer[1].height) caml_raise_constant(*caml_named_value("theora_exn_inval")); buffer[1].data = (unsigned char *)ba->data; /* Cr plane */ buffer[2].width = Int_val(Field(v, i++)); buffer[2].height = Int_val(Field(v, i++)); buffer[2].stride = Int_val(Field(v, i++)); ba = Caml_ba_array_val(Field(v, i++)); if (ba->dim[0] < buffer[2].stride * buffer[2].height) caml_raise_constant(*caml_named_value("theora_exn_inval")); buffer[2].data = (unsigned char *)ba->data; return; } /* The result must be freed afterwards! */ /* This should not be called in a blocking section. */ static value val_of_yuv(th_ycbcr_buffer buffer) { CAMLparam0(); CAMLlocal4(ret, y, u, v); int i = 0; intnat len; ret = caml_alloc_tuple(12); unsigned char *data; /* Y plane */ Store_field(ret, i++, Val_int(buffer[0].width)); Store_field(ret, i++, Val_int(buffer[0].height)); Store_field(ret, i++, Val_int(buffer[0].stride)); len = buffer[0].stride * buffer[0].height; y = caml_ba_alloc(CAML_BA_C_LAYOUT | CAML_BA_UINT8, 1, NULL, &len); data = Caml_ba_data_val(y); memcpy(data, buffer[0].data, len); Store_field(ret, i++, y); /* Cb plane */ Store_field(ret, i++, Val_int(buffer[1].width)); Store_field(ret, i++, Val_int(buffer[1].height)); Store_field(ret, i++, Val_int(buffer[1].stride)); len = buffer[1].stride * buffer[1].height; u = caml_ba_alloc(CAML_BA_C_LAYOUT | CAML_BA_UINT8, 1, NULL, &len); data = Caml_ba_data_val(u); memcpy(data, buffer[1].data, len); Store_field(ret, i++, u); /* Cr plane */ Store_field(ret, i++, Val_int(buffer[2].width)); Store_field(ret, i++, Val_int(buffer[2].height)); Store_field(ret, i++, Val_int(buffer[2].stride)); len = buffer[2].stride * buffer[2].height; v = caml_ba_alloc(CAML_BA_C_LAYOUT | CAML_BA_UINT8, 1, NULL, &len); data = Caml_ba_data_val(v); memcpy(data, buffer[2].data, len); Store_field(ret, i++, v); CAMLreturn(ret); } CAMLprim value ocaml_theora_default_granuleshift(value unit) { CAMLparam0(); th_info info; th_info_init(&info); int ret = info.keyframe_granule_shift; th_info_clear(&info); CAMLreturn(Int_val(ret)); } CAMLprim value ocaml_theora_ogg_packet_iskeyframe(value _op) { CAMLparam1(_op); ogg_packet *op = Packet_val(_op); CAMLreturn(Val_int(th_packet_iskeyframe(op))); } /** Encoding API **/ typedef struct enc_state_t { th_enc_ctx *ts; th_info ti; th_comment tc; ogg_int64_t granulepos; ogg_int64_t packetno; } enc_state_t; #define Theora_enc_state_val(v) (*((enc_state_t **)Data_custom_val(v))) static void finalize_enc_state(value s) { enc_state_t *state = Theora_enc_state_val(s); th_encode_free(state->ts); th_info_clear(&state->ti); th_comment_clear(&state->tc); free(state); } static struct custom_operations enc_state_ops = { "ocaml_enc_theora_state", finalize_enc_state, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default}; /* Thanks you * http://www.linux-nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.php#ref_option */ #define Val_none Val_int(0) #define Some_val(v) Field(v, 0) CAMLprim value ocaml_theora_encode_init(value info, value params, value comments) { CAMLparam3(info, params, comments); CAMLlocal2(ans, c); enc_state_t *state = malloc(sizeof(enc_state_t)); th_info_init(&state->ti); info_of_val(info, &state->ti); th_comment_init(&state->tc); int i; for (i = 0; i < Wosize_val(comments); i++) th_comment_add_tag(&state->tc, (char *)Bytes_val(Field(Field(comments, i), 0)), (char *)Bytes_val(Field(Field(comments, i), 1))); state->ts = th_encode_alloc(&state->ti); if (state->ts == NULL) { th_info_clear(&state->ti); th_comment_clear(&state->tc); free(state); check_err(TH_EINVAL); } state->granulepos = 0; state->packetno = 0; /* Apply settings */ int j = 0; int v; c = Field(params, j++); if (c != Val_none) { v = Int_val(Some_val(c)); check_err(th_encode_ctl(state->ts, TH_ENCCTL_SET_KEYFRAME_FREQUENCY_FORCE, &v, sizeof(int))); } c = Field(params, j++); if (c != Val_none) { v = 0; if (Some_val(c) == Val_true) v = 1; check_err(th_encode_ctl(state->ts, TH_ENCCTL_SET_VP3_COMPATIBLE, &v, sizeof(int))); } c = Field(params, j++); if (c != Val_none) { if (Some_val(c) == Val_true) { v = TH_RATECTL_CAP_UNDERFLOW; check_err( th_encode_ctl(state->ts, TH_ENCCTL_SET_RATE_FLAGS, &v, sizeof(int))); } } c = Field(params, j++); if (c != Val_none) { v = Int_val(Some_val(c)); check_err( th_encode_ctl(state->ts, TH_ENCCTL_SET_RATE_BUFFER, &v, sizeof(int))); } c = Field(params, j++); if (c != Val_none) { v = Int_val(Some_val(c)); check_err(th_encode_ctl(state->ts, TH_ENCCTL_SET_SPLEVEL, &v, sizeof(int))); } ans = caml_alloc_custom(&enc_state_ops, sizeof(enc_state_t *), 1, 0); Theora_enc_state_val(ans) = state; CAMLreturn(ans); } CAMLprim value ocaml_theora_encoder_frame_of_granulepos(value t_state, value gpos) { CAMLparam2(t_state, gpos); enc_state_t *state = Theora_enc_state_val(t_state); CAMLreturn(caml_copy_int64(th_granule_frame(state->ts, Int64_val(gpos)))); } CAMLprim value ocaml_theora_encode_header(value t_state, value o_stream_state) { CAMLparam2(t_state, o_stream_state); enc_state_t *state = Theora_enc_state_val(t_state); ogg_stream_state *os = Stream_state_val(o_stream_state); ogg_packet op; int ret; ret = th_encode_flushheader(state->ts, &state->tc, &op); if (ret < 0) check_err(ret); if (ret == 0) CAMLreturn(Val_true); else { state->granulepos = op.granulepos; state->packetno = op.packetno; ogg_stream_packetin(os, &op); CAMLreturn(Val_false); } } CAMLprim value ocaml_theora_encode_buffer(value t_state, value o_stream_state, value frame) { CAMLparam3(t_state, o_stream_state, frame); CAMLlocal1(v); enc_state_t *state = Theora_enc_state_val(t_state); ogg_stream_state *os = Stream_state_val(o_stream_state); th_ycbcr_buffer yb; ogg_packet op; int ret = 1; if (ogg_stream_eos(os)) caml_raise_constant(*caml_named_value("theora_exn_end_of_file")); /* Encode the theora packet. */ yuv_of_val(frame, yb); caml_enter_blocking_section(); ret = th_encode_ycbcr_in(state->ts, yb); caml_leave_blocking_section(); if (ret != 0) /* TODO: * \retval OC_EINVAL Encoder is not ready, or is finished. * \retval -1 The size of the given frame differs from those previously * input */ check_err(ret); ret = 1; while (ret > 0) { ret = th_encode_packetout(state->ts, 0, &op); if (ret > 0) { state->granulepos = op.granulepos; state->packetno = op.packetno; ogg_stream_packetin(os, &op); } } if (ret < 0) check_err(ret); CAMLreturn(Val_unit); } CAMLprim value ocaml_theora_encode_eos(value t_state, value o_stream_state) { CAMLparam2(t_state, o_stream_state); enc_state_t *state = Theora_enc_state_val(t_state); ogg_stream_state *os = Stream_state_val(o_stream_state); ogg_packet op; int ret; ogg_int64_t iframe; ogg_int64_t pframe; /* TODO: a proper eos should be acheived using an empty ogg page with the * eos marker.. */ /* Try to grab a packet */ ret = th_encode_packetout(state->ts, 1, &op); if (ret <= 0) { check_err(ret); /* No packet was produced: we bake our own ! */ op.packet = (unsigned char *)NULL; op.bytes = 0; op.b_o_s = 0; op.e_o_s = 1; /* Set the granulepos as a new frame */ iframe = state->granulepos >> state->ti.keyframe_granule_shift; pframe = state->granulepos & ~iframe; op.granulepos = (iframe << state->ti.keyframe_granule_shift) | (pframe + 1); op.packetno = state->packetno + 1; } ogg_stream_packetin(os, &op); CAMLreturn(Val_unit); } /** Decoding API **/ typedef struct dec_state_t { th_dec_ctx *ts; th_info ti; th_comment tc; th_setup_info *tsi; int init; ogg_packet init_packet; } dec_state_t; #define Theora_dec_state_val(v) (*((dec_state_t **)Data_custom_val(v))) static void finalize_dec_state(value s) { dec_state_t *state = Theora_dec_state_val(s); if (state->ts != NULL) th_decode_free(state->ts); th_info_clear(&state->ti); th_comment_clear(&state->tc); if (state->tsi != NULL) th_setup_free(state->tsi); free(state); } static struct custom_operations dec_state_ops = { "ocaml_dec_theora_state", finalize_dec_state, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default}; CAMLprim value caml_theora_check(value packet) { CAMLparam1(packet); ogg_packet *op = Packet_val(packet); th_info ti; th_comment tc; th_setup_info *tsi = NULL; th_comment_init(&tc); th_info_init(&ti); int ret; ret = th_decode_headerin(&ti, &tc, &tsi, op); th_comment_clear(&tc); th_info_clear(&ti); if (tsi != NULL) th_setup_free(tsi); if (ret > 0) CAMLreturn(Val_true); else CAMLreturn(Val_false); } CAMLprim value ocaml_theora_create_dec(value unit) { CAMLparam0(); CAMLlocal1(ret); dec_state_t *state = malloc(sizeof(dec_state_t)); if (state == NULL) caml_raise_out_of_memory(); th_comment_init(&state->tc); th_info_init(&state->ti); state->ts = NULL; state->tsi = NULL; state->init_packet.packet = NULL; ret = caml_alloc_custom(&dec_state_ops, sizeof(dec_state_t *), 1, 0); Theora_dec_state_val(ret) = state; CAMLreturn(ret); } CAMLprim value ocaml_theora_dec_headerin(value decoder, value packet) { CAMLparam1(packet); CAMLlocal4(ret, t, comment, tmp); dec_state_t *state = Theora_dec_state_val(decoder); ogg_packet *op = Packet_val(packet); int v; v = th_decode_headerin(&state->ti, &state->tc, &state->tsi, op); if (v < 0) caml_raise_constant(*caml_named_value("theora_exn_inval")); if (v == 0) { /* Keep this packet for the first YUV decoding.. */ memcpy(&state->init_packet, op, sizeof(ogg_packet)); state->init = 1; comment = caml_alloc_tuple(state->tc.comments + 1); Store_field(comment, 0, caml_copy_string(state->tc.vendor)); if (state->tc.comments) { int i; int len; for (i = 0; i < state->tc.comments; i++) { if (state->tc.user_comments[i]) { len = state->tc.comment_lengths[i]; tmp = caml_alloc_string(len); memcpy(Bytes_val(tmp), state->tc.user_comments[i], len); Store_field(comment, i + 1, tmp); } } } state->ts = th_decode_alloc(&state->ti, state->tsi); ret = caml_alloc_tuple(2); Store_field(ret, 0, val_of_info(&state->ti)); Store_field(ret, 1, comment); CAMLreturn(ret); } else { caml_raise_constant(*caml_named_value("theora_exn_not_enough_data")); } } CAMLprim value ocaml_theora_decode_YUVout(value decoder, value _os) { CAMLparam2(decoder, _os); ogg_stream_state *os = Stream_state_val(_os); dec_state_t *state = Theora_dec_state_val(decoder); th_ycbcr_buffer yb; ogg_packet op; int ret; if (state->init != 1) { ret = ogg_stream_packetout(os, &op); if (ret == 0) caml_raise_constant(*caml_named_value("ogg_exn_not_enough_data")); if (ret == -1) caml_raise_constant(*caml_named_value("ogg_exn_out_of_sync")); /* TODO: use the third argument (granulepos of the decoded packet) */ check_err(th_decode_packetin(state->ts, &op, NULL)); } else { check_err(th_decode_packetin(state->ts, &state->init_packet, NULL)); state->init = 0; } caml_enter_blocking_section(); th_decode_ycbcr_out(state->ts, yb); caml_leave_blocking_section(); CAMLreturn(val_of_yuv(yb)); } CAMLprim value ocaml_theora_decoder_frame_of_granulepos(value t_state, value gpos) { CAMLparam2(t_state, gpos); dec_state_t *state = Theora_dec_state_val(t_state); CAMLreturn(caml_copy_int64(th_granule_frame(state->ts, Int64_val(gpos)))); } /* Ogg skeleton interface */ /* Wrappers */ static void write32le(unsigned char *ptr, ogg_uint32_t v) { ptr[0] = v & 0xff; ptr[1] = (v >> 8) & 0xff; ptr[2] = (v >> 16) & 0xff; ptr[3] = (v >> 24) & 0xff; } static void write64le(unsigned char *ptr, ogg_int64_t v) { ogg_uint32_t hi = v >> 32; ptr[0] = v & 0xff; ptr[1] = (v >> 8) & 0xff; ptr[2] = (v >> 16) & 0xff; ptr[3] = (v >> 24) & 0xff; ptr[4] = hi & 0xff; ptr[5] = (hi >> 8) & 0xff; ptr[6] = (hi >> 16) & 0xff; ptr[7] = (hi >> 24) & 0xff; } /* Values from http://xiph.org/ogg/doc/skeleton.html */ #define FISBONE_IDENTIFIER "fisbone\0" #define FISBONE_MESSAGE_HEADER_OFFSET 44 #define FISBONE_SIZE 52 /* Code from theorautils.c in ffmpeg2theora */ CAMLprim value ocaml_theora_skeleton_fisbone(value serial, value info, value start, value content) { CAMLparam4(serial, info, start, content); CAMLlocal1(packet); ogg_packet op; th_info ti; info_of_val(info, &ti); int len = FISBONE_SIZE + caml_string_length(content); memset(&op, 0, sizeof(op)); op.packet = malloc(len); if (op.packet == NULL) caml_raise_out_of_memory(); memset(op.packet, 0, len); /* it will be the fisbone packet for the theora video */ memcpy(op.packet, FISBONE_IDENTIFIER, 8); /* identifier */ write32le( op.packet + 8, FISBONE_MESSAGE_HEADER_OFFSET); /* offset of the message header fields */ write32le(op.packet + 12, Nativeint_val(serial)); /* serialno of the theora stream */ write32le(op.packet + 16, 3); /* number of header packets */ /* granulerate, temporal resolution of the bitstream in samples/microsecond */ write64le(op.packet + 20, (ogg_int64_t)ti.fps_numerator); /* granulrate numerator */ write64le(op.packet + 28, (ogg_int64_t)ti.fps_denominator); /* granulrate denominator */ write64le(op.packet + 36, (ogg_int64_t)Int64_val(start)); /* start granule */ write32le(op.packet + 44, 0); /* preroll, for theora its 0 */ *(op.packet + 48) = ti.keyframe_granule_shift; /* granule shift */ memcpy(op.packet + FISBONE_SIZE, String_val(content), caml_string_length(content)); /* message header field */ op.b_o_s = 0; op.e_o_s = 0; op.bytes = len; packet = value_of_packet(&op); free(op.packet); CAMLreturn(packet); } ocaml-xiph-1.0.0/vorbis.opam000066400000000000000000000014671474662033600157560ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "1.0.0" synopsis: "Bindings to libvorbis" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] license: "LGPL-2.1-only" homepage: "https://github.com/savonet/ocaml-xiph" bug-reports: "https://github.com/savonet/ocaml-xiph/issues" depends: [ "conf-libvorbis" "conf-pkg-config" "ocaml" {>= "4.03.0"} "dune" {>= "2.8"} "dune-configurator" "ogg" {= version} "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] dev-repo: "git+https://github.com/savonet/ocaml-xiph.git" x-maintenance-intent: ["(latest)"] ocaml-xiph-1.0.0/vorbis.opam.template000066400000000000000000000000431474662033600175550ustar00rootroot00000000000000x-maintenance-intent: ["(latest)"] ocaml-xiph-1.0.0/vorbis/000077500000000000000000000000001474662033600150705ustar00rootroot00000000000000ocaml-xiph-1.0.0/vorbis/config/000077500000000000000000000000001474662033600163355ustar00rootroot00000000000000ocaml-xiph-1.0.0/vorbis/config/discover.ml000066400000000000000000000011671474662033600205120ustar00rootroot00000000000000module C = Configurator.V1 let () = C.main ~name:"vorbis-pkg-config" (fun c -> let default : C.Pkg_config.package_conf = { libs = ["-lvorbis"; "-lvorbisfile"; "-lvorbisenc"]; cflags = [] } in let conf = match C.Pkg_config.get c with | None -> default | Some pc -> ( match C.Pkg_config.query pc ~package:"vorbis vorbisfile vorbisenc" with | None -> default | Some deps -> deps) in C.Flags.write_sexp "c_flags.sexp" conf.cflags; C.Flags.write_sexp "c_library_flags.sexp" conf.libs) ocaml-xiph-1.0.0/vorbis/config/dune000066400000000000000000000000751474662033600172150ustar00rootroot00000000000000(executable (name discover) (libraries dune.configurator)) ocaml-xiph-1.0.0/vorbis/dune000066400000000000000000000010361474662033600157460ustar00rootroot00000000000000(library (name vorbis) (public_name vorbis) (synopsis "OCaml bindings for libvorbis") (libraries ogg) (modules vorbis) (foreign_stubs (language c) (names vorbis_stubs) (flags (:include c_flags.sexp))) (c_library_flags (:include c_library_flags.sexp))) (library (name vorbis_decoder) (public_name vorbis.decoder) (synopsis "Vorbis decoder for the ogg-decoder library") (libraries ogg.decoder vorbis) (modules vorbis_decoder)) (rule (targets c_flags.sexp c_library_flags.sexp) (action (run ./config/discover.exe))) ocaml-xiph-1.0.0/vorbis/examples/000077500000000000000000000000001474662033600167065ustar00rootroot00000000000000ocaml-xiph-1.0.0/vorbis/examples/dune000066400000000000000000000003241474662033600175630ustar00rootroot00000000000000(executable (name ogg2wav) (modules ogg2wav) (libraries vorbis)) (executable (name stream2wav) (modules stream2wav) (libraries vorbis)) (executable (name wav2ogg) (modules wav2ogg) (libraries vorbis)) ocaml-xiph-1.0.0/vorbis/examples/ogg2wav.ml000066400000000000000000000130771474662033600206240ustar00rootroot00000000000000(* * Copyright 2003 Savonet team * * This file is part of OCaml-Vorbis. * * OCaml-Vorbis 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 2 of the License, or * (at your option) any later version. * * OCaml-Vorbis 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 OCaml-Vorbis; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** * An ogg to wav converter using OCaml-Vorbis. * * @author Samuel Mimram *) let bufsize = 1024 let src = ref "" let dst = ref "" open Unix let output_int chan n = output_char chan (char_of_int ((n lsr 0) land 0xff)); output_char chan (char_of_int ((n lsr 8) land 0xff)); output_char chan (char_of_int ((n lsr 16) land 0xff)); output_char chan (char_of_int ((n lsr 24) land 0xff)) let output_short chan n = output_char chan (char_of_int ((n lsr 0) land 0xff)); output_char chan (char_of_int ((n lsr 8) land 0xff)) let progress_bar = let spin = ref 0 in fun title pos tot -> let nbeq = 40 in let n = min (100. *. float_of_int pos /. float_of_int tot) 100. in let e = int_of_float (n /. 100. *. float_of_int nbeq) in Printf.printf "\r%s %6.2f%% [" title n; for _ = 1 to e do Printf.printf "=" done; if e != nbeq then Printf.printf ">"; for _ = e + 2 to nbeq do Printf.printf " " done; Printf.printf "] "; incr spin; if !spin > 4 then spin := 1; Printf.printf "%c%!" (if n = 100. then ' ' else ( match !spin with | 1 -> '|' | 2 -> '/' | 3 -> '-' | 4 -> '\\' | _ -> failwith "this did not happen")) let usage = "usage: ogg2wav [options] source destination" let use_ba = ref false let use_alloc = ref false let _ = Arg.parse [ ("-ba", Arg.Set use_ba, "Use big arrays"); ("-alloc", Arg.Set use_alloc, "Use alloc API"); ] (let pnum = ref (-1) in fun s -> incr pnum; match !pnum with | 0 -> src := s | 1 -> dst := s | _ -> Printf.eprintf "Error: too many arguments\n"; exit 1) usage; if !src = "" || !dst = "" then ( Printf.printf "%s\n" usage; exit 1); let df, dfd = Vorbis.File.Decoder.openfile !src in let infos = Vorbis.File.Decoder.info df (-1) in let vdr, cmt = Vorbis.File.Decoder.comments df (-1) in let duration = Vorbis.File.Decoder.duration df (-1) in let samples = Vorbis.File.Decoder.samples df (-1) in let chans = infos.Vorbis.audio_channels in Printf.printf "Input file characteristics: vorbis codec v%d, %d channels, %d Hz, %.02f \ s, %d samples\n" infos.Vorbis.vorbis_version chans infos.Vorbis.audio_samplerate duration samples; Printf.printf "* vendor: %s\n" vdr; List.iter (fun (c, v) -> Printf.printf "* %s: %s\n" (String.lowercase_ascii c) v) cmt; (* Using vorbis to decode the ogg. *) Printf.printf "\n"; let tmpdst, oc = Filename.open_temp_file ~mode:[Open_binary] "ogg2wav" ".raw" in (let decode = if !use_ba then ( let process len buf = for i = 0 to len - 1 do for c = 0 to chans - 1 do let s = int_of_float (buf.(c).{i} *. 32767.) in output_short oc s done done; len in if !use_alloc then fun () -> if chans = 0 then 0 else ( let buf = Vorbis.File.Decoder.decode_float_alloc_ba df bufsize in process (Bigarray.Array1.dim buf.(0)) buf) else ( let buf = Array.init chans (fun _ -> Bigarray.Array1.create Bigarray.float32 Bigarray.c_layout bufsize) in fun () -> let len = Vorbis.File.Decoder.decode_float_ba df buf 0 bufsize in process len buf)) else ( let buf = Bytes.create (16 * bufsize) in fun () -> let r = Vorbis.File.Decoder.decode df buf 0 bufsize in output oc buf 0 r; r / 4) in let pos = ref 0 in let tot = samples in try while true do let r = decode () in pos := !pos + r; progress_bar "Decoding ogg:" !pos tot done; close_out oc; Unix.close dfd with End_of_file -> close_out oc; Unix.close dfd); Printf.printf "\n"; (* Do the wav stuff. *) let datalen = (stat tmpdst).st_size in let ic = open_in_bin tmpdst in let oc = open_out_bin !dst in output_string oc "RIFF"; output_int oc (4 + 24 + 8 + datalen); output_string oc "WAVE"; output_string oc "fmt "; output_int oc 16; output_short oc 1; (* WAVE_FORMAT_PCM *) output_short oc 2; (* channels *) output_int oc 44100; (* freq *) output_int oc (44100 * 2 * 2); (* bytes / s *) output_short oc (2 * 2); (* block alignment *) output_short oc 16; (* bits per sample *) output_string oc "data"; output_int oc datalen; (let buflen = 256 * 1024 in let buf = Bytes.create buflen in let r = ref 1 in let pos = ref 0 in let tot = datalen in while !r <> 0 do r := input ic buf 0 buflen; output oc buf 0 !r; pos := !pos + !r; progress_bar "Tagging wav: " !pos tot done); close_in ic; close_out oc; Unix.unlink tmpdst; Printf.printf "\n"; Gc.full_major () ocaml-xiph-1.0.0/vorbis/examples/stream2wav.ml000066400000000000000000000146151474662033600213420ustar00rootroot00000000000000(* * Copyright 2003 Savonet team * * This file is part of OCaml-Vorbis. * * OCaml-Vorbis 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 2 of the License, or * (at your option) any later version. * * OCaml-Vorbis 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 OCaml-Vorbis; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** * An ogg to wav converter using OCaml-Vorbis stream interface. * * @author Samuel Mimram *) (* $Id$ *) let bufsize = 1024 let src = ref "" let dst = ref "" open Unix let output_int chan n = output_char chan (char_of_int ((n lsr 0) land 0xff)); output_char chan (char_of_int ((n lsr 8) land 0xff)); output_char chan (char_of_int ((n lsr 16) land 0xff)); output_char chan (char_of_int ((n lsr 24) land 0xff)) let output_short chan n = output_char chan (char_of_int ((n lsr 0) land 0xff)); output_char chan (char_of_int ((n lsr 8) land 0xff)) let progress_bar = let spin = ref 0 in fun title pos tot -> let nbeq = 40 in let n = min (100. *. float_of_int pos /. float_of_int tot) 100. in let e = int_of_float (n /. 100. *. float_of_int nbeq) in Printf.printf "\r%s %6.2f%% [" title n; for _ = 1 to e do Printf.printf "=" done; if e != nbeq then Printf.printf ">"; for _ = e + 2 to nbeq do Printf.printf " " done; Printf.printf "] "; incr spin; if !spin > 4 then spin := 1; Printf.printf "%c%!" (if n = 100. then ' ' else ( match !spin with | 1 -> '|' | 2 -> '/' | 3 -> '-' | 4 -> '\\' | _ -> failwith "this did not happen")) let usage = "usage: stream2wav [options] source destination" let _ = Arg.parse [] (let pnum = ref (-1) in fun s -> incr pnum; match !pnum with | 0 -> src := s | 1 -> dst := s | _ -> Printf.eprintf "Error: too many arguments\n"; exit 1) usage; if !src = "" || !dst = "" then ( Printf.printf "%s\n" usage; exit 1); let sync, _ = Ogg.Sync.create_from_file !src in let eos = ref false in let rec fill os = let page = Ogg.Sync.read sync in try Ogg.Stream.put_page os page; if Ogg.Page.eos page then eos := true with Ogg.Bad_data -> fill os (*Do not care about page that are not for us.. *) in (* Test wether the stream contains vorbis *) let test_vorbis () = (* Get First page *) let page = Ogg.Sync.read sync in (* Check wether this is a b_o_s *) if not (Ogg.Page.bos page) then raise Not_found; (* Create a stream with this ID *) let serial = Ogg.Page.serialno page in let os = Ogg.Stream.create ~serial () in Ogg.Stream.put_page os page; (* Get first packet *) let packet = Ogg.Stream.get_packet os in if not (Vorbis.Decoder.check_packet packet) then raise Not_found; fill os; let page = Ogg.Sync.read sync in Ogg.Stream.put_page os page; let packet2 = Ogg.Stream.get_packet os in fill os; let page = Ogg.Sync.read sync in Ogg.Stream.put_page os page; let packet3 = Ogg.Stream.get_packet os in let decoder = Vorbis.Decoder.init packet packet2 packet3 in Printf.printf "Got a vorbis stream !\n"; flush_all (); (serial, os, decoder) in let rec init () = try test_vorbis () with (* Not_found is not catched: ogg stream always start with all b_o_s and we don't care about sequenced streams here *) | Ogg.Bad_data | Not_found -> Printf.printf "This stream was not vorbis..\n"; flush_all (); init () in let _, os, decoder = init () in let infos = Vorbis.Decoder.info decoder in let vdr, cmt = Vorbis.Decoder.comments decoder in Printf.printf "Input stream characteristics: vorbis codec v%d, %d channels, %d Hz\n" infos.Vorbis.vorbis_version infos.Vorbis.audio_channels infos.Vorbis.audio_samplerate; Printf.printf "* vendor: %s\n" vdr; List.iter (fun (c, v) -> Printf.printf "* %s: %s\n" (String.lowercase_ascii c) v) cmt; flush_all (); (* Using vorbis to decode the ogg. *) print_newline (); Printf.printf "Decoding stream..\n"; flush_all (); let tmpdst, oc = Filename.open_temp_file ~mode:[Open_binary] "stream2wav" ".raw" in (let chan _ = Array.make bufsize 0. in let buf = Array.init infos.Vorbis.audio_channels chan in try while true do try let r = Vorbis.Decoder.decode_pcm decoder os buf 0 bufsize in (* Yea, dirty quick hack ! *) let buf = Array.map (fun x -> Array.sub x 0 r) buf in let buf = Array.map (Array.map (fun x -> int_of_float (x *. 32767.))) buf in let chans = Array.length buf in Array.iteri (fun x _ -> for i = 0 to chans - 1 do output_short oc buf.(i).(x) done) buf.(0) with Ogg.Not_enough_data -> fill os done; close_out oc with _ -> close_out oc); Printf.printf "\n"; (* Do the wav stuff. *) let samplerate = infos.Vorbis.audio_samplerate in let datalen = (stat tmpdst).st_size in let ic = open_in_bin tmpdst in let oc = open_out_bin !dst in output_string oc "RIFF"; output_int oc (4 + 24 + 8 + datalen); output_string oc "WAVE"; output_string oc "fmt "; output_int oc 16; output_short oc 1; (* WAVE_FORMAT_PCM *) output_short oc infos.Vorbis.audio_channels; (* channels *) output_int oc samplerate; (* freq *) output_int oc (samplerate * 2 * 2); (* bytes / s *) output_short oc (2 * 2); (* block alignment *) output_short oc 16; (* bits per sample *) output_string oc "data"; output_int oc datalen; (let buflen = 256 * 1024 in let buf = Bytes.create buflen in let r = ref 1 in let pos = ref 0 in let tot = datalen in while !r <> 0 do r := input ic buf 0 buflen; output oc buf 0 !r; pos := !pos + !r; progress_bar "Tagging wav: " !pos tot done); close_in ic; close_out oc; Unix.unlink tmpdst; Printf.printf "\n"; Gc.full_major () ocaml-xiph-1.0.0/vorbis/examples/wav2ogg.ml000066400000000000000000000133401474662033600206150ustar00rootroot00000000000000(* * Copyright 2003 Savonet team * * This file is part of OCaml-Vorbis. * * OCaml-Vorbis 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 2 of the License, or * (at your option) any later version. * * OCaml-Vorbis 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 OCaml-Vorbis; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** * An wav to ogg converter using OCaml-Vorbis. * * @author Samuel Mimram, and many others... *) open Vorbis let src = ref "" let dst = ref "" let buflen = ref 1024 let input_string chan len = let ans = Bytes.create len in (* TODO: check length *) ignore (input chan ans 0 len); Bytes.unsafe_to_string ans let input_int chan = let buf = input_string chan 4 in int_of_char buf.[0] + (int_of_char buf.[1] lsl 8) + (int_of_char buf.[2] lsl 16) + (int_of_char buf.[3] lsl 24) let input_short chan = let buf = input_string chan 2 in int_of_char buf.[0] + (int_of_char buf.[1] lsl 8) let bitrate = ref 128000 let usage = "usage: wav2ogg [options] source destination" let use_ba = ref false let _ = Arg.parse [ ( "--bitrate", Arg.Int (fun b -> bitrate := b * 1000), "Bitrate, in kilobits per second, defaults to 128kbps" ); ( "--buflen", Arg.Int (fun i -> buflen := i), "Size of chunks successively encoded" ); ("-ba", Arg.Set use_ba, "Use big arrays"); ] (let pnum = ref (-1) in fun s -> incr pnum; match !pnum with | 0 -> src := s | 1 -> dst := s | _ -> Printf.eprintf "Error: too many arguments\n"; exit 1) usage; if !src = "" || !dst = "" then ( Printf.printf "%s\n" usage; exit 1); let ic = open_in_bin !src in let oc = open_out_bin !dst in (* TODO: improve! *) if input_string ic 4 <> "RIFF" then invalid_arg "No RIFF tag"; ignore (input_string ic 4); if input_string ic 4 <> "WAVE" then invalid_arg "No WAVE tag"; if input_string ic 4 <> "fmt " then invalid_arg "No fmt tag"; let _ = input_int ic in let _ = input_short ic in (* TODO: should be 1 *) let channels = input_short ic in let infreq = input_int ic in let _ = input_int ic in (* bytes / s *) let _ = input_short ic in (* block align *) let bits = input_short ic in let fos buf = let len = String.length buf / (2 * channels) in let ans = Array.init channels (fun _ -> Array.make len 0.) in for i = 0 to len - 1 do for c = 0 to channels - 1 do let n = int_of_char buf.[(2 * channels * i) + (2 * c)] + (int_of_char buf.[(2 * channels * i) + (2 * c) + 1] lsl 8) in let n = if n land (1 lsl 15) = 0 then n else (n land 0b111111111111111) - 32768 in ans.(c).(i) <- float n /. 32768.; ans.(c).(i) <- max (-1.) (min 1. ans.(c).(i)) done done; ans in let baos buf = let len = String.length buf / (2 * channels) in let ans = Array.init channels (fun _ -> Bigarray.Array1.create Bigarray.float32 Bigarray.c_layout len) in for i = 0 to len - 1 do for c = 0 to channels - 1 do let n = int_of_char buf.[(2 * channels * i) + (2 * c)] + (int_of_char buf.[(2 * channels * i) + (2 * c) + 1] lsl 8) in let n = if n land (1 lsl 15) = 0 then n else (n land 0b111111111111111) - 32768 in ans.(c).{i} <- float n /. 32768.; ans.(c).{i} <- max (-1.) (min 1. ans.(c).{i}) done done; ans in let enc = Encoder.create channels infreq (-1) !bitrate (-1) in let os = Ogg.Stream.create () in let encode buf = if !use_ba then ( let fbuf = baos buf in Encoder.encode_buffer_float_ba enc os fbuf 0 (Bigarray.Array1.dim fbuf.(0))) else ( let fbuf = fos buf in Encoder.encode_buffer_float enc os fbuf 0 (Array.length fbuf.(0))) in let start = Unix.time () in Printf.printf "Input detected: PCM WAVE %d channels, %d Hz, %d bits\n%!" channels infreq bits; Printf.printf "Encoding to: OGG %d channels, %d Hz, %d kbps\nPlease wait...\n%!" channels infreq !bitrate; Encoder.headerout enc os [("ARTIST", "test")]; (* skip headers *) let rec aux () = let tag = input_string ic 4 in match tag with | "LIST" -> let n = input_int ic in let _ = input_string ic n in aux () | "data" -> () | _ -> invalid_arg "No data tag" in aux (); (* This ensures the actual audio data will start on a new page, as per * spec. *) let ph, pb = Ogg.Stream.flush_page os in output_string oc (ph ^ pb); let buflen = !buflen in let buf = Bytes.create buflen in begin try while true do try really_input ic buf 0 buflen; encode (Bytes.unsafe_to_string buf); while true do let ph, pb = Ogg.Stream.get_page os in output_string oc (ph ^ pb) done with Ogg.Not_enough_data -> () done with End_of_file -> () end; Encoder.end_of_stream enc os; begin try while true do let ph, pb = Ogg.Stream.get_page os in output_string oc (ph ^ pb) done with Ogg.Not_enough_data -> () end; close_in ic; close_out oc; Printf.printf "Finished in %.0f seconds.\n" (Unix.time () -. start); Gc.full_major () ocaml-xiph-1.0.0/vorbis/vorbis.ml000066400000000000000000000243161474662033600167340ustar00rootroot00000000000000(* * Copyright 2003-2011 Savonet team * * This file is part of Ocaml-vorbis. * * Ocaml-vorbis 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 2 of the License, or * (at your option) any later version. * * Ocaml-vorbis 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 Ocaml-vorbis; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** * Decode from or encode to the Ogg Vorbis compressed audio format; or get * informations about an Ogg Vorbis file. * * @author Samuel Mimram *) (* $Id$ *) exception Invalid_parameters exception Invalid_channels exception Could_not_open_file exception Not_vorbis exception Hole_in_data exception Bad_link exception Version_mismatch exception Bad_header exception Read_error exception Internal_fault exception Invalid_argument exception Not_implemented exception Unknown_error of int exception Not_audio exception False exception Utf8_failure of string (* New register exception printer *) let string_of_exc e = let f s = Some s in match e with | Invalid_parameters -> f "Invalid vorbis parameters" | Invalid_channels -> f "Invalid vorbis channels" | Could_not_open_file -> f "Vorbis: could not open file" | Not_vorbis -> f "Bitstream is not Vorbis data" | Hole_in_data -> f "Interruption in the vorbis data (one of: garbage between pages, \ loss of sync followed by recapture, or a corrupt page)" | Bad_link -> f "An invalid vorbis stream section was supplied, or the requested \ link is corrupt" | Version_mismatch -> f "Vorbis bitstream version mismatch" | Bad_header -> f "Invalid Vorbis bitstream header" | Read_error -> f "Vorbis: read error" | Internal_fault -> f "Internal vorbis logic fault; indicates a bug or heap/stack \ corruption" | Invalid_argument -> f "Invalid vorbis setup request, e.g. out of range argument" | Not_implemented -> f "Unimplemented vorbis feature (e.g. -0.2 quality is only available \ in aoTuV's implementation)" | Unknown_error i -> f (Printf.sprintf "Unknown vorbis error %i (it should not have happened, please \ report)" i) | Not_audio -> f "Ogg packet doesn't contain audio data" | False -> f "Vorbis call returned a 'false' status (eg, playback is not in \ progress, and thus there is no instantaneous bitrate information to \ report.)" | Utf8_failure s -> f (Printf.sprintf "UTF8 failure in string: %S" s) | _ -> None let () = Printexc.register_printer string_of_exc let _ = Callback.register_exception "vorbis_exn_invalid_parameters" Invalid_parameters; Callback.register_exception "vorbis_exn_invalid_channels" Invalid_channels; Callback.register_exception "vorbis_exn_could_not_open_file" Could_not_open_file; Callback.register_exception "vorbis_exn_not_vorbis" Not_vorbis; Callback.register_exception "vorbis_exn_hole_in_data" Hole_in_data; Callback.register_exception "vorbis_exn_bad_link" Bad_link; Callback.register_exception "vorbis_exn_version_mismatch" Version_mismatch; Callback.register_exception "vorbis_exn_bad_header" Bad_header; Callback.register_exception "vorbis_exn_read_error" Read_error; Callback.register_exception "vorbis_exn_internal_fault" Internal_fault; Callback.register_exception "vorbis_exn_invalid" Invalid_argument; Callback.register_exception "vorbis_exn_not_implemented" Not_implemented; Callback.register_exception "vorbis_exn_not_audio" Not_audio; Callback.register_exception "vorbis_exn_unknown_error" (Unknown_error 0); Callback.register_exception "vorbis_exn_false" False; Callback.register_exception "vorbis_exn_utf8_failure" (Utf8_failure "") let tags m () = let ans = ref [] in let add t v = ans := (t, v) :: !ans in Hashtbl.iter add m; List.rev !ans let encoder_tag = "ocaml-vorbis by the savonet team (http://savonet.sf.net/)" module Encoder = struct type t external create : int -> int -> int -> int -> int -> t = "ocaml_vorbis_analysis_init" external create_vbr : int -> int -> float -> t = "ocaml_vorbis_analysis_init_vbr" external reset : t -> unit = "ocaml_vorbis_reset" external headerout_packetout : t -> (string * string) array -> Ogg.Stream.packet * Ogg.Stream.packet * Ogg.Stream.packet = "ocaml_vorbis_analysis_headerout" let headerout_packetout ?(encoder = encoder_tag) state tags = let tags = Array.of_list (tags @ [("ENCODER", encoder)]) in headerout_packetout state tags let headerout ?encoder state os tags = let p1, p2, p3 = headerout_packetout ?encoder state tags in Ogg.Stream.put_packet os p1; Ogg.Stream.put_packet os p2; Ogg.Stream.put_packet os p3 external get_channels : t -> int = "ocaml_vorbis_encode_get_channels" external encode_buffer_float : t -> Ogg.Stream.stream -> float array array -> int -> int -> unit = "ocaml_vorbis_encode_float" external encode_buffer_float_ba : t -> Ogg.Stream.stream -> (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t array -> int -> int -> unit = "ocaml_vorbis_encode_float_ba" external time_of_granulepos : t -> Int64.t -> Nativeint.t = "ocaml_vorbis_encode_time_of_granulepos" (* We encode a buffer with 0 samples to finish * the stream, according to the documentation of * vorbis_analysis_wrote: * "A value of zero means all input data has been provided and * the compressed stream should be finalized." *) let end_of_stream enc os = let chans = get_channels enc in let data = Array.make chans [||] in encode_buffer_float enc os data 0 0 end let split_comment comment = try let equal_pos = String.index_from comment 0 '=' in let c1 = String.uppercase_ascii (String.sub comment 0 equal_pos) in let c2 = String.sub comment (equal_pos + 1) (String.length comment - equal_pos - 1) in (c1, c2) with Not_found -> (comment, "") type bitstream = int type info = { vorbis_version : int; audio_channels : int; audio_samplerate : int; bitrate_upper : int; bitrate_nominal : int; bitrate_lower : int; bitrate_window : int; } module File = struct module Decoder = struct type t external create : (int -> string * int) -> (int -> Unix.seek_command -> int) -> (unit -> int) -> t = "ocaml_vorbis_open_dec_stream" let openfile_with_fd fd = try create (fun n -> let buf = Bytes.create n in let r = Unix.read fd buf 0 n in (Bytes.unsafe_to_string buf, r)) (fun n cmd -> Unix.lseek fd n cmd) (fun () -> Unix.lseek fd 0 Unix.SEEK_CUR) with e -> Unix.close fd; raise e let openfile f = let fd = Unix.openfile f [Unix.O_RDONLY] 0o400 in (openfile_with_fd fd, fd) external decode_float : t -> float array array -> int -> int -> int = "ocaml_vorbis_decode_float" external decode_float_alloc : t -> int -> float array array = "ocaml_vorbis_decode_float_alloc" external decode_float_ba : t -> (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t array -> int -> int -> int = "ocaml_vorbis_decode_float_ba" external decode_float_alloc_ba : t -> int -> (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t array = "ocaml_vorbis_decode_float_alloc_ba" external decode : t -> bool -> int -> bool -> bytes -> int -> int -> int = "ocaml_vorbis_decode_byte" "ocaml_vorbis_decode" let decode df ?(big_endian = false) ?(sample_size = 2) ?(signed = true) buf ofs len = decode df big_endian sample_size signed buf ofs len external bitstream : t -> int = "ocaml_vorbis_get_dec_file_bitstream" external comments : t -> int -> string * string array = "ocaml_vorbis_get_dec_file_comments" let comments df bitstream = let vd, cmts = comments df bitstream in (vd, Array.to_list (Array.map split_comment cmts)) external info : t -> int -> info = "ocaml_vorbis_decoder_info" external bitrate : t -> int -> int = "ocaml_vorbis_decoder_bitrate" external duration : t -> int -> float = "ocaml_vorbis_decoder_time_total" external streams : t -> int = "ocaml_vorbis_decoder_streams" external serialnumber : t -> int -> int = "ocaml_vorbis_decoder_serialnumber" external samples : t -> int -> int = "ocaml_vorbis_decoder_pcm_total" end end module Decoder = struct type t external init : Ogg.Stream.packet -> Ogg.Stream.packet -> Ogg.Stream.packet -> t = "ocaml_vorbis_synthesis_init" external info : t -> info = "ocaml_vorbis_val_info_of_decoder" external comments : t -> string * string array = "ocaml_vorbis_val_comments_of_decoder" let comments dec = let vend, cmts = comments dec in (vend, Array.to_list (Array.map split_comment cmts)) external check_packet : Ogg.Stream.packet -> bool = "ocaml_vorbis_check_packet" external decode_pcm : t -> Ogg.Stream.stream -> float array array -> int -> int -> int = "ocaml_vorbis_decode_pcm" external decode_pcm_ba : t -> Ogg.Stream.stream -> (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t array -> int -> int -> int = "ocaml_vorbis_decode_pcm_ba" external restart : t -> unit = "ocaml_vorbis_synthesis_restart" end module Skeleton = struct external fisbone : Nativeint.t -> Int64.t -> Int64.t -> string -> Ogg.Stream.packet = "ocaml_vorbis_skeleton_fisbone" let fisbone ?(start_granule = Int64.zero) ?(headers = [("Content-type", "audio/vorbis")]) ~serialno ~samplerate () = let concat s (h, v) = Printf.sprintf "%s%s: %s\r\n" s h v in let s = List.fold_left concat "" headers in fisbone serialno samplerate start_granule s end ocaml-xiph-1.0.0/vorbis/vorbis.mli000066400000000000000000000246351474662033600171110ustar00rootroot00000000000000(* * Copyright 2003-2011 The Savonet team * * This file is part of Ocaml-vorbis. * * Ocaml-vorbis 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 2 of the License, or * (at your option) any later version. * * Ocaml-vorbis 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 Ocaml-vorbis; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** * Decode from or encode to the Ogg Vorbis compressed audio format; * or get informations about an Ogg Vorbis file. * * @author Samuel Mimram, Julien Cristau, David Baelde *) (* $Id$ *) (** {1 Exceptions} *) (** The call returned a 'false' status (eg, ov_bitrate_instant * can return OV_FALSE if playback is not in progress, and thus * there is no instantaneous bitrate information to report. *) exception False (** Some parameters are invalid for this function. *) exception Invalid_parameters (** The given number of channels is invalid. *) exception Invalid_channels (** Invalid setup request, e.g. out of range argument. *) exception Invalid_argument (** The given file could not be opened. *) exception Could_not_open_file (** Bitstream is not Vorbis data. *) exception Not_vorbis (** Invalid Vorbis bitstream header. *) exception Bad_header (** A read from media returned an error. *) exception Read_error (** Ogg packet doesn't contain audio data *) exception Not_audio (** Internal logic fault; indicates a bug or heap/stack corruption. *) exception Internal_fault (** Indicates there was an interruption in the data (one of: garbage between * pages, loss of sync followed by recapture, or a corrupt page). *) exception Hole_in_data (** Indicates that an invalid stream section was supplied, * or the requested link is corrupt. *) exception Bad_link (** Invalid Vorbis bitstream header. *) exception Version_mismatch (** Unimplemented mode. *) exception Not_implemented (** An unknown error happened (it should not have happened, please report). *) exception Unknown_error of int (** Error while converting utf8. *) exception Utf8_failure of string (** Return a string representation * of an exception *) val string_of_exc : exn -> string option (** {1 Useful types} *) (** Index of a logical bitstream. The special value -1 means the physical * bitsream. *) type bitstream = int (** Vorbis informations about a file. *) type info = { vorbis_version : int; (** version of vorbis codec, must be 0 *) audio_channels : int; (** number of audio channels *) audio_samplerate : int; (** samplerate in Hertz *) bitrate_upper : int; bitrate_nominal : int; bitrate_lower : int; bitrate_window : int; } (** Create a list of vorbis tags. *) val tags : (string, string) Hashtbl.t -> unit -> (string * string) list (** {1 Operations with vorbis streams} *) (** {2 Encoding} *) module Encoder : sig (** Internal state of an encoder. *) type t (** [create chans rate max_br nom_br min_br] creates a new encoder with * [chans] channels, with sample rate [rate] Hz and with respectively [max_br], * [nom_br] and [min_br] as maximal, nominal and minimal bitrates (in bps). *) val create : int -> int -> int -> int -> int -> t (** [create_vbr chans rate quality] creates a new encoder in variable bitrate * with [chans] channels, with sample rate [rate] Hz and with quality * [quality], which should be between -1 and 1 (1 is the best). *) val create_vbr : int -> int -> float -> t val reset : t -> unit (** Encode a header given a list of tags. *) val headerout : ?encoder:string -> t -> Ogg.Stream.stream -> (string * string) list -> unit (** Encoder a header, but do not submit packet to * Ogg Stream. Usefull when multiplexing ogg streams * since the all first packets of each streams must be packed * in the initial pages. *) val headerout_packetout : ?encoder:string -> t -> (string * string) list -> Ogg.Stream.packet * Ogg.Stream.packet * Ogg.Stream.packet (** Get the number of audio channels expected by * the encoder. *) val get_channels : t -> int (** Encode a buffer of PCM data. * The PCM data array must have at least the expected * number of channels. Otherwise, the function raises [Invalid_channels]. *) val encode_buffer_float : t -> Ogg.Stream.stream -> float array array -> int -> int -> unit val encode_buffer_float_ba : t -> Ogg.Stream.stream -> (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t array -> int -> int -> unit (** Convert a granulepos to absolute time in seconds. The granulepos is * interpreted in the context of a given encoder, and gives * the end time of a frame's presentation as used in Ogg mux ordering. *) val time_of_granulepos : t -> Int64.t -> Nativeint.t val end_of_stream : t -> Ogg.Stream.stream -> unit end (** {2 Decoding} *) module Decoder : sig (** Internal decoder state *) type t (** Initialize decoder. Needs the first 3 packets of the ogg logical * stream. Use [check_packet] to check against the first one. *) val init : Ogg.Stream.packet -> Ogg.Stream.packet -> Ogg.Stream.packet -> t (** Get vorbis infos from the decoder *) val info : t -> info (** Get vorbis comments from the decoder *) val comments : t -> string * (string * string) list (** Check wether a ogg packet contains vorbis data. * Usefull for parsing ogg containers with multiple streams. *) val check_packet : Ogg.Stream.packet -> bool (** [decode_pcm dec stream buffer pos offset] decodes pcm float data * from [stream]. The floats are written in [buffer], starting at * position [pos]. The function returns the number of samples actually written.*) val decode_pcm : t -> Ogg.Stream.stream -> float array array -> int -> int -> int (** [decode_pcm_ba dec stream buffer pos offset] decodes pcm float data * from [stream]. The floats are written in [buffer], starting at * position [pos]. The function returns the number of samples actually written.*) val decode_pcm_ba : t -> Ogg.Stream.stream -> (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t array -> int -> int -> int (** Restart the decoder *) val restart : t -> unit end (** {1 Operations with vorbis files} *) (** {2 Decoding} *) module File : sig module Decoder : sig (** Internal state of a decoder. *) type t (** [create read_func seek_func tell_func params] opens a * stream like [openfile] for decoding but callbacks are used to * manipulate the data. [read_func] should return the requested amount of bytes * (or less if it is the end of file), [seek_funk] should return 0 if the seek * was ok or -1 if the stream is not seekable, [tell_func] should return the current * offset or -1 if there is no notion of offset in the stream. * Raises: [Read_error], [Not_vorbis], [Version_mismatch], [Bad_header], [Internal_fault]. *) val create : (int -> string * int) -> (int -> Unix.seek_command -> int) -> (unit -> int) -> t (** Open a vorbis file for decoding. *) val openfile : string -> t * Unix.file_descr val openfile_with_fd : Unix.file_descr -> t (** [decode_float dec buff ofs len] decodes [len] samples in each channel and puts * the result in [buff] starting at position [ofs]. * @raise Hole_in_data if there was an interruption of the data. * @raise Invalid_parameters if all the data cannot fit in the buffer starting at the given position. *) val decode_float : t -> float array array -> int -> int -> int val decode_float_alloc : t -> int -> float array array (** [decode_float_ba dec buff ofs len] decodes [len] samples in each channel and puts * the result in [buff] starting at position [ofs]. * @raise Hole_in_data if there was an interruption of the data. * @raise Invalid_parameters if all the data cannot fit in the buffer starting at the given position. *) val decode_float_ba : t -> (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t array -> int -> int -> int val decode_float_alloc_ba : t -> int -> (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t array (** Same as [decode_float] but decodes to integers. *) val decode : t -> ?big_endian:bool -> ?sample_size:int -> ?signed:bool -> bytes -> int -> int -> int (** Get the number of logical bitstreams within a physical bitstream. *) val streams : t -> int (** Get the index of the sequential logical bitstream currently being decoded * (incremented at chaining boundaries even for non-seekable streams). For * seekable streams, it represents the actual chaining index within the * physical bitstream. *) val bitstream : t -> bitstream (** Get the vorbis comments from a vorbis file. The second argument is the * number of the logical bitstream (the current bitstream is used if it is set * to [None]). *) val comments : t -> bitstream -> string * (string * string) list (** Get the vorbis information from the stream header of a bitstream. *) val info : t -> bitstream -> info (** Get the bitrate of a bitsream (in bps). *) val bitrate : t -> bitstream -> int (** Get the total pcm samples of a bitstream. *) val samples : t -> bitstream -> int (** Get the duration in seconds of a bitstream. *) val duration : t -> bitstream -> float (** Get the serial number of a bitstream. *) val serialnumber : t -> bitstream -> int end end module Skeleton : sig (** Generate a vorbis fisbone packet with * these parameters, to use in an ogg skeleton. * Default value for [start_granule] is [Int64.zero], * Default value for [headers] is ["Content-type","audio/vorbis"] * * See: http://xiph.org/ogg/doc/skeleton.html. *) val fisbone : ?start_granule:Int64.t -> ?headers:(string * string) list -> serialno:Nativeint.t -> samplerate:Int64.t -> unit -> Ogg.Stream.packet end ocaml-xiph-1.0.0/vorbis/vorbis_decoder.ml000066400000000000000000000064771474662033600204310ustar00rootroot00000000000000(* * Copyright 2003-2011 Savonet team * * This file is part of Ocaml-vorbis. * * Ocaml-vorbis 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 2 of the License, or * (at your option) any later version. * * Ocaml-vorbis 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 Ocaml-vorbis; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * *) let check = Vorbis.Decoder.check_packet let buflen = 1024 let decoder ~fill:_ os = let decoder = ref None in let packet1 = ref None in let packet2 = ref None in let packet3 = ref None in let os = ref os in let init () = match !decoder with | None -> let packet1 = match !packet1 with | None -> let p = Ogg.Stream.get_packet !os in packet1 := Some p; p | Some p -> p in let packet2 = match !packet2 with | None -> let p = Ogg.Stream.get_packet !os in packet2 := Some p; p | Some p -> p in let packet3 = match !packet3 with | None -> let p = Ogg.Stream.get_packet !os in packet3 := Some p; p | Some p -> p in let d = Vorbis.Decoder.init packet1 packet2 packet3 in let info = Vorbis.Decoder.info d in let meta = Vorbis.Decoder.comments d in decoder := Some (d, info, meta); (d, info, meta) | Some d -> d in let info () = let _, info, meta = init () in ( { Ogg_decoder.channels = info.Vorbis.audio_channels; sample_rate = info.Vorbis.audio_samplerate; }, meta ) in let restart ~fill:_ new_os = os := new_os; let d, _, _ = init () in Vorbis.Decoder.restart d in let decode ~decode_pcm ~make_pcm ~sub_pcm feed = let decoder, info, _ = init () in let chan _ = make_pcm buflen in let buf = Array.init info.Vorbis.audio_channels chan in try let ret = decode_pcm decoder !os buf 0 buflen in feed (Array.map (fun x -> sub_pcm x 0 ret) buf) with (* Apparently, we should hide this one.. *) | Vorbis.False -> raise Ogg.Not_enough_data in let decoder ~decode_pcm ~make_pcm ~sub_pcm = { Ogg_decoder.name = "vorbis"; info; decode = decode ~decode_pcm ~make_pcm ~sub_pcm; restart; samples_of_granulepos = (fun x -> x); } in Ogg_decoder.Audio_both ( decoder ~decode_pcm:Vorbis.Decoder.decode_pcm ~make_pcm:(fun len -> Array.create_float len) ~sub_pcm:Array.sub, decoder ~decode_pcm:Vorbis.Decoder.decode_pcm_ba ~make_pcm:(Bigarray.Array1.create Bigarray.float32 Bigarray.c_layout) ~sub_pcm:Bigarray.Array1.sub ) let register () = Hashtbl.add Ogg_decoder.ogg_decoders "vorbis" (check, decoder) ocaml-xiph-1.0.0/vorbis/vorbis_decoder.mli000066400000000000000000000016601474662033600205670ustar00rootroot00000000000000(* * Copyright 2003-2011 Savonet team * * This file is part of Ocaml-vorbis. * * Ocaml-vorbis 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 2 of the License, or * (at your option) any later version. * * Ocaml-vorbis 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 Ocaml-vorbis; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** This module provides a vorbis decoder for * the [Ogg_demuxer] module. *) (** Register the vorbis decoder *) val register : unit -> unit ocaml-xiph-1.0.0/vorbis/vorbis_stubs.c000066400000000000000000001005221474662033600177600ustar00rootroot00000000000000/* * Copyright 2007 Samuel Mimram * * This file is part of ocaml-vorbis. * * ocaml-vorbis 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 2 of the License, or * (at your option) any later version. * * ocaml-vorbis 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 Ocaml-vorbis; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ /* * Libvorbis bindings for OCaml. * * @author Samuel Mimram */ #define CAML_NAME_SPACE #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #ifndef Bytes_val #define Bytes_val String_val #endif static inline float clip(float s) { if (s < -1) { return -1; } else if (s > 1) { return 1; } else return s; } static void raise_err(int ret) { switch (ret) { case OV_FALSE: caml_raise_constant(*caml_named_value("vorbis_exn_false")); case OV_HOLE: caml_raise_constant(*caml_named_value("vorbis_exn_hole_in_data")); case OV_EREAD: caml_raise_constant(*caml_named_value("vorbis_exn_read_error")); case OV_EFAULT: caml_raise_constant(*caml_named_value("vorbis_exn_internal_fault")); case OV_ENOTVORBIS: caml_raise_constant(*caml_named_value("vorbis_exn_not_vorbis")); case OV_EBADHEADER: caml_raise_constant(*caml_named_value("vorbis_exn_bad_header")); case OV_EVERSION: caml_raise_constant(*caml_named_value("vorbis_exn_version_mismatch")); case OV_EBADLINK: caml_raise_constant(*caml_named_value("vorbis_exn_bad_link")); case OV_EINVAL: caml_raise_constant(*caml_named_value("vorbis_exn_invalid")); case OV_EIMPL: caml_raise_constant(*caml_named_value("vorbis_exn_not_implemented")); case OV_ENOTAUDIO: caml_raise_constant(*caml_named_value("vorbis_exn_not_audio")); default: caml_raise_with_arg(*caml_named_value("vorbis_exn_unknown_error"), Val_int(ret)); } } /**** Decoding *****/ typedef struct { vorbis_dsp_state vd; vorbis_block vb; vorbis_info vi; vorbis_comment vc; } decoder_t; #define Decoder_val(v) (*((decoder_t **)Data_custom_val(v))) #define Decoder_dsp_state_val(v) (&Decoder_val(v)->vd) #define Decoder_info_val(v) (&Decoder_val(v)->vi) #define Comment_val(v) (&Decoder_val(v)->vc) #define Block_val(v) (&Decoder_val(v)->vb) static void finalize_decoder(value e) { decoder_t *dec = Decoder_val(e); vorbis_block_clear(&dec->vb); vorbis_dsp_clear(&dec->vd); vorbis_info_clear(&dec->vi); vorbis_comment_clear(&dec->vc); free(dec); } static struct custom_operations decoder_ops = { "ocaml_decoder_t", finalize_decoder, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default}; CAMLprim value ocaml_vorbis_val_info_of_decoder(value vorbis_t) { CAMLparam1(vorbis_t); CAMLlocal1(v); int i = 0; v = caml_alloc_tuple(7); vorbis_info *vi = Decoder_info_val(vorbis_t); Store_field(v, i++, Val_int(vi->version)); Store_field(v, i++, Val_int(vi->channels)); Store_field(v, i++, Val_long(vi->rate)); Store_field(v, i++, Val_long(vi->bitrate_upper)); Store_field(v, i++, Val_long(vi->bitrate_nominal)); Store_field(v, i++, Val_long(vi->bitrate_lower)); Store_field(v, i++, Val_long(vi->bitrate_window)); CAMLreturn(v); } CAMLprim value ocaml_vorbis_val_comments_of_decoder(value decoder) { CAMLparam1(decoder); CAMLlocal2(ans, cmts); int i; vorbis_comment *vc = Comment_val(decoder); cmts = caml_alloc_tuple(vc->comments); for (i = 0; i < vc->comments; i++) Store_field(cmts, i, caml_copy_string(vc->user_comments[i])); ans = caml_alloc_tuple(2); if (vc->vendor != NULL) Store_field(ans, 0, caml_copy_string(vc->vendor)); else Store_field(ans, 0, caml_copy_string("(null)")); Store_field(ans, 1, cmts); CAMLreturn(ans); } CAMLprim value ocaml_vorbis_check_packet(value packet) { CAMLparam1(packet); ogg_packet *op = Packet_val(packet); vorbis_info vi; vorbis_comment vc; vorbis_info_init(&vi); vorbis_comment_init(&vc); int ret = 1; if (vorbis_synthesis_headerin(&vi, &vc, op) < 0) ret = 0; vorbis_info_clear(&vi); vorbis_comment_clear(&vc); CAMLreturn(Val_int(ret)); } CAMLprim value ocaml_vorbis_synthesis_init(value packet, value packet2, value packet3) { CAMLparam3(packet, packet2, packet3); CAMLlocal1(ans); ogg_packet *op = Packet_val(packet); ogg_packet *op2 = Packet_val(packet2); ogg_packet *op3 = Packet_val(packet3); int ret; decoder_t *vt = malloc(sizeof(decoder_t)); if (vt == NULL) caml_raise_out_of_memory(); vorbis_info_init(&vt->vi); vorbis_comment_init(&vt->vc); ret = vorbis_synthesis_headerin(&vt->vi, &vt->vc, op); if (ret < 0) { vorbis_info_clear(&vt->vi); vorbis_comment_clear(&vt->vc); free(vt); raise_err(ret); } ret = vorbis_synthesis_headerin(&vt->vi, &vt->vc, op2); if (ret < 0) { vorbis_info_clear(&vt->vi); vorbis_comment_clear(&vt->vc); free(vt); raise_err(ret); } ret = vorbis_synthesis_headerin(&vt->vi, &vt->vc, op3); if (ret < 0) { vorbis_info_clear(&vt->vi); vorbis_comment_clear(&vt->vc); free(vt); raise_err(ret); } vorbis_synthesis_init(&vt->vd, &vt->vi); vorbis_block_init(&vt->vd, &vt->vb); ans = caml_alloc_custom(&decoder_ops, sizeof(decoder_t *), 1, 0); Decoder_val(ans) = vt; CAMLreturn(ans); } CAMLprim value ocaml_vorbis_decode_pcm(value vorbis_state, value stream_state, value buf, value _pos, value _len) { CAMLparam3(vorbis_state, stream_state, buf); CAMLlocal2(buffer, chan); ogg_stream_state *os = Stream_state_val(stream_state); ogg_packet op; vorbis_block *vb = Block_val(vorbis_state); vorbis_dsp_state *vd = Decoder_dsp_state_val(vorbis_state); vorbis_info *vi = Decoder_info_val(vorbis_state); int pos = Int_val(_pos); int len = Int_val(_len); float **pcm; int samples; int i, j, ret; int total_samples = 0; while (1) { while (total_samples < len) { caml_release_runtime_system(); samples = vorbis_synthesis_pcmout(vd, &pcm); caml_acquire_runtime_system(); if (samples < 0) raise_err(samples); if (samples == 0) break; if (samples > len - total_samples) samples = len - total_samples; if (Wosize_val(buf) != vi->channels) caml_raise_constant(*caml_named_value("vorbis_exn_invalid_channels")); for (i = 0; i < vi->channels; i++) { chan = Field(buf, i); if (Wosize_val(chan) / Double_wosize - pos < samples) caml_raise_constant(*caml_named_value("vorbis_exn_invalid")); for (j = 0; j < samples; j++) Store_double_field(chan, pos + j, clip(pcm[i][j])); } pos += samples; total_samples += samples; caml_release_runtime_system(); ret = vorbis_synthesis_read(vd, samples); caml_acquire_runtime_system(); if (ret < 0) raise_err(ret); } if (total_samples == len) CAMLreturn(Val_int(total_samples)); caml_release_runtime_system(); ret = ogg_stream_packetout(os, &op); caml_acquire_runtime_system(); /* returned values are: * 1: ok * 0: not enough data. in this case * we return the number of samples * decoded if > 0 and raise * Ogg_not_enough_data otherwise * -1: out of sync */ if (ret == 0) { if (total_samples > 0) CAMLreturn(Val_int(total_samples)); else caml_raise_constant(*caml_named_value("ogg_exn_not_enough_data")); } if (ret == -1) caml_raise_constant(*caml_named_value("ogg_exn_out_of_sync")); caml_release_runtime_system(); ret = vorbis_synthesis(vb, &op); caml_acquire_runtime_system(); if (ret == 0) { caml_release_runtime_system(); ret = vorbis_synthesis_blockin(vd, vb); caml_acquire_runtime_system(); } if (ret < 0) raise_err(ret); } CAMLreturn(Val_int(total_samples)); } CAMLprim value ocaml_vorbis_decode_pcm_ba(value vorbis_state, value stream_state, value buf, value _pos, value _len) { CAMLparam3(vorbis_state, stream_state, buf); CAMLlocal2(buffer, chan); ogg_stream_state *os = Stream_state_val(stream_state); ogg_packet op; vorbis_block *vb = Block_val(vorbis_state); vorbis_dsp_state *vd = Decoder_dsp_state_val(vorbis_state); vorbis_info *vi = Decoder_info_val(vorbis_state); int pos = Int_val(_pos); int len = Int_val(_len); float **pcm; int samples; int i, j, ret; int total_samples = 0; while (1) { while (total_samples < len) { caml_release_runtime_system(); samples = vorbis_synthesis_pcmout(vd, &pcm); caml_acquire_runtime_system(); if (samples < 0) raise_err(samples); if (samples == 0) break; if (samples > len - total_samples) samples = len - total_samples; if (Wosize_val(buf) != vi->channels) caml_raise_constant(*caml_named_value("vorbis_exn_invalid_channels")); for (i = 0; i < vi->channels; i++) { chan = Field(buf, i); if (Caml_ba_array_val(chan)->dim[0] - pos < samples) caml_raise_constant(*caml_named_value("vorbis_exn_invalid")); for (j = 0; j < samples; j++) ((float *)Caml_ba_data_val(chan))[pos + j] = clip(pcm[i][j]); } pos += samples; total_samples += samples; caml_release_runtime_system(); ret = vorbis_synthesis_read(vd, samples); caml_acquire_runtime_system(); if (ret < 0) raise_err(ret); } if (total_samples == len) CAMLreturn(Val_int(total_samples)); caml_release_runtime_system(); ret = ogg_stream_packetout(os, &op); caml_acquire_runtime_system(); /* returned values are: * 1: ok * 0: not enough data. in this case * we return the number of samples * decoded if > 0 and raise * Ogg_not_enough_data otherwise * -1: out of sync */ if (ret == 0) { if (total_samples > 0) CAMLreturn(Val_int(total_samples)); else caml_raise_constant(*caml_named_value("ogg_exn_not_enough_data")); } if (ret == -1) caml_raise_constant(*caml_named_value("ogg_exn_out_of_sync")); caml_release_runtime_system(); ret = vorbis_synthesis(vb, &op); caml_acquire_runtime_system(); if (ret == 0) { caml_release_runtime_system(); ret = vorbis_synthesis_blockin(vd, vb); caml_acquire_runtime_system(); } if (ret < 0) raise_err(ret); } CAMLreturn(Val_int(total_samples)); } CAMLprim value ocaml_vorbis_synthesis_restart(value s) { CAMLparam1(s); vorbis_synthesis_restart(Decoder_dsp_state_val(s)); CAMLreturn(Val_unit); } /***** Encoding *****/ typedef struct { vorbis_dsp_state vd; vorbis_block vb; vorbis_info vi; ogg_packet op; } encoder_t; #define Encoder_val(v) (*((encoder_t **)Data_custom_val(v))) #define Enc_dsp_state_val(v) (&Encoder_val(v)->vd) static void finalize_encoder(value e) { encoder_t *enc = Encoder_val(e); vorbis_block_clear(&enc->vb); vorbis_dsp_clear(&enc->vd); vorbis_info_clear(&enc->vi); free(enc); } static struct custom_operations encoder_ops = { "ocaml_vorbis_encoder", finalize_encoder, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default}; CAMLprim value ocaml_vorbis_analysis_init(value channels, value rate, value max_bitrate, value nominal_bitrate, value min_bitrate) { encoder_t *enc = malloc(sizeof(encoder_t)); value ans; int err; vorbis_info_init(&enc->vi); err = vorbis_encode_init(&enc->vi, Int_val(channels), Int_val(rate), Int_val(max_bitrate), Int_val(nominal_bitrate), Int_val(min_bitrate)); if (err) { vorbis_info_clear(&enc->vi); raise_err(err); } vorbis_analysis_init(&enc->vd, &enc->vi); vorbis_block_init(&enc->vd, &enc->vb); ans = caml_alloc_custom(&encoder_ops, sizeof(encoder_t *), 1, 0); Encoder_val(ans) = enc; return ans; } CAMLprim value ocaml_vorbis_analysis_init_vbr(value channels, value rate, value quality) { encoder_t *enc = malloc(sizeof(encoder_t)); value ans; int err; vorbis_info_init(&enc->vi); err = vorbis_encode_init_vbr(&enc->vi, Int_val(channels), Int_val(rate), Double_val(quality)); if (err) { vorbis_info_clear(&enc->vi); raise_err(err); } vorbis_analysis_init(&enc->vd, &enc->vi); vorbis_block_init(&enc->vd, &enc->vb); ans = caml_alloc_custom(&encoder_ops, sizeof(encoder_t *), 1, 0); Encoder_val(ans) = enc; return ans; } CAMLprim value ocaml_vorbis_reset(value vdsp) { encoder_t *enc = Encoder_val(vdsp); vorbis_block_clear(&enc->vb); vorbis_dsp_clear(&enc->vd); vorbis_info_clear(&enc->vi); vorbis_analysis_init(&enc->vd, &enc->vi); vorbis_block_init(&enc->vd, &enc->vb); return Val_unit; } CAMLprim value ocaml_vorbis_analysis_headerout(value vdsp, value comments) { CAMLparam2(vdsp, comments); CAMLlocal4(ret, p1, p2, p3); vorbis_dsp_state *vd = Enc_dsp_state_val(vdsp); vorbis_comment vc; ogg_packet header, header_comm, header_code; int i; vorbis_comment_init(&vc); for (i = 0; i < Wosize_val(comments); i++) vorbis_comment_add_tag(&vc, String_val(Field(Field(comments, i), 0)), String_val(Field(Field(comments, i), 1))); vorbis_analysis_headerout(vd, &vc, &header, &header_comm, &header_code); vorbis_comment_clear(&vc); ret = caml_alloc_tuple(3); Store_field(ret, 0, value_of_packet(&header)); Store_field(ret, 1, value_of_packet(&header_comm)); Store_field(ret, 2, value_of_packet(&header_code)); CAMLreturn(ret); } CAMLprim value ocaml_vorbis_encode_get_channels(value vdsp) { CAMLparam1(vdsp); encoder_t *enc = Encoder_val(vdsp); CAMLreturn(Val_int(enc->vi.channels)); } CAMLprim value ocaml_vorbis_encode_float(value vdsp, value vogg, value data, value _offs, value _len) { CAMLparam3(vdsp, vogg, data); encoder_t *enc = Encoder_val(vdsp); vorbis_block *vb = &enc->vb; vorbis_dsp_state *vd = Enc_dsp_state_val(vdsp); ogg_stream_state *os = Stream_state_val(vogg); ogg_packet *op = &enc->op; int offs = Int_val(_offs); int len = Int_val(_len); float **vorbis_buffer; int c, i; value datac; int channels = enc->vi.channels; if (Wosize_val(data) != channels) caml_raise_constant(*caml_named_value("vorbis_exn_invalid_channels")); vorbis_buffer = vorbis_analysis_buffer(vd, len); for (c = 0; c < channels; c++) { datac = Field(data, c); for (i = 0; i < len; i++) vorbis_buffer[c][i] = Double_field(datac, i + offs); } caml_release_runtime_system(); vorbis_analysis_wrote(vd, len); /* TODO: split the encoding part? */ while (vorbis_analysis_blockout(vd, vb) == 1) { /* Analysis, assume we want to use bitrate management. */ vorbis_analysis(vb, NULL); vorbis_bitrate_addblock(vb); /* Weld packets into the bitstream. */ while (vorbis_bitrate_flushpacket(vd, op)) ogg_stream_packetin(os, op); } caml_acquire_runtime_system(); CAMLreturn(Val_unit); } CAMLprim value ocaml_vorbis_encode_float_ba(value vdsp, value vogg, value data, value _ofs, value _len) { CAMLparam3(vdsp, vogg, data); encoder_t *enc = Encoder_val(vdsp); vorbis_block *vb = &enc->vb; vorbis_dsp_state *vd = Enc_dsp_state_val(vdsp); ogg_stream_state *os = Stream_state_val(vogg); ogg_packet *op = &enc->op; float **vorbis_buffer; int ofs = Int_val(_ofs); int len = Int_val(_len); int c, i; value datac; int channels = enc->vi.channels; if (Wosize_val(data) != channels) caml_raise_constant(*caml_named_value("vorbis_exn_invalid_channels")); if (channels == 0) CAMLreturn(Val_unit); if (Caml_ba_array_val(Field(data, 0))->dim[0] < ofs + len) caml_failwith("Invalid length or offset"); vorbis_buffer = vorbis_analysis_buffer(vd, len); for (c = 0; c < channels; c++) { for (i = 0; i < len; i++) { vorbis_buffer[c][i] = ((float *)Caml_ba_data_val(Field(data, c)))[i + ofs]; } } caml_release_runtime_system(); vorbis_analysis_wrote(vd, len); /* TODO: split the encoding part? */ while (vorbis_analysis_blockout(vd, vb) == 1) { /* Analysis, assume we want to use bitrate management. */ vorbis_analysis(vb, NULL); vorbis_bitrate_addblock(vb); /* Weld packets into the bitstream. */ while (vorbis_bitrate_flushpacket(vd, op)) ogg_stream_packetin(os, op); } caml_acquire_runtime_system(); CAMLreturn(Val_unit); } CAMLprim value ocaml_vorbis_encode_time_of_granulepos(value v_state, value gpos) { CAMLparam2(v_state, gpos); encoder_t *enc = Encoder_val(v_state); ogg_int64_t granulepos = Int64_val(gpos); CAMLreturn(caml_copy_nativeint(vorbis_granule_time(&enc->vd, granulepos))); } /***** File Decoding *****/ /* This should be malloced since we might want to register *_func as global * root. */ typedef struct { OggVorbis_File *ovf; int bitstream; value read_func; value seek_func; value tell_func; } myvorbis_dec_file_t; #define Decfile_val(v) (*((myvorbis_dec_file_t **)Data_custom_val(v))) static void finalize_dec_file(value _df) { myvorbis_dec_file_t *df = Decfile_val(_df); ov_clear(df->ovf); free(df->ovf); df->ovf = NULL; caml_remove_global_root(&df->read_func); caml_remove_global_root(&df->seek_func); caml_remove_global_root(&df->tell_func); free(df); } static struct custom_operations decfile_ops = { "ocaml_vorbis_decfile", finalize_dec_file, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default}; static size_t read_func_cb(void *ptr, size_t size, size_t nmemb, void *datasource) { myvorbis_dec_file_t *df = datasource; value ret; int len; caml_acquire_runtime_system(); ret = caml_callback(df->read_func, Val_int(size * nmemb)); len = Int_val(Field(ret, 1)); memcpy(ptr, String_val(Field(ret, 0)), len); caml_release_runtime_system(); return len; } static int seek_func_cb(void *datasource, ogg_int64_t offset, int whence) { myvorbis_dec_file_t *df = datasource; int cmd; int ret; switch (whence) { case SEEK_SET: cmd = 0; break; case SEEK_CUR: cmd = 1; break; case SEEK_END: cmd = 2; break; default: assert(0); } caml_acquire_runtime_system(); ret = Int_val(caml_callback2(df->seek_func, Val_int(offset), Val_int(cmd))); caml_release_runtime_system(); return ret; } static long tell_func_cb(void *datasource) { myvorbis_dec_file_t *df = datasource; int ret; caml_acquire_runtime_system(); ret = Int_val(caml_callback(df->tell_func, Val_unit)); caml_release_runtime_system(); return ret; } static ov_callbacks callbacks = {.read_func = read_func_cb, .seek_func = seek_func_cb, .close_func = NULL, .tell_func = tell_func_cb}; CAMLprim value ocaml_vorbis_open_dec_stream(value read_func, value seek_func, value tell_func, value params) { CAMLparam4(read_func, seek_func, tell_func, params); CAMLlocal1(block); int ret = 0; myvorbis_dec_file_t *df; df = malloc(sizeof(myvorbis_dec_file_t)); df->ovf = (OggVorbis_File *)malloc(sizeof(OggVorbis_File)); df->bitstream = 0; caml_register_global_root(&df->read_func); df->read_func = read_func; caml_register_global_root(&df->seek_func); df->seek_func = seek_func; caml_register_global_root(&df->tell_func); df->tell_func = tell_func; caml_release_runtime_system(); ret = ov_open_callbacks(df, df->ovf, NULL, 0, callbacks); caml_acquire_runtime_system(); if (ret < 0) { caml_remove_global_root(&df->tell_func); caml_remove_global_root(&df->seek_func); caml_remove_global_root(&df->read_func); free(df->ovf); free(df); raise_err(ret); } block = caml_alloc_custom(&decfile_ops, sizeof(myvorbis_dec_file_t *), 0, 1); Decfile_val(block) = df; CAMLreturn(block); } CAMLprim value ocaml_vorbis_decode(value d_f, value be_, value ss_, value signed_, value buf_, value ofs_, value len_) { CAMLparam2(d_f, buf_); myvorbis_dec_file_t *df = Decfile_val(d_f); int ret = 0; int ofs = Int_val(ofs_); int len = Int_val(len_); int big_endian = Bool_val(be_); int sample_size = Int_val(ss_); int sign = Bool_val(signed_); char *buf; if (!df->ovf) caml_raise_constant(*caml_named_value("vorbis_exn_invalid_parameters")); if (ofs + len > caml_string_length(buf_)) caml_raise_constant(*caml_named_value("vorbis_exn_invalid_parameters")); /* TODO: this buffer could be allocated once when creating the decoder * and reused for every decoding pass. This might be useful to reduce * load or memory fragmentation if needed. */ buf = malloc(len); /* We have to make sure that when a callback is called, the ocaml master lock * has been released. Callbacks are responsible for taking it back if they * need to call ocaml code. */ caml_release_runtime_system(); ret = ov_read(df->ovf, buf, len, big_endian, sample_size, sign, &df->bitstream); caml_acquire_runtime_system(); if (ret <= 0) { free(buf); ret ? raise_err(ret) : caml_raise_end_of_file(); } memcpy(Bytes_val(buf_) + ofs, buf, ret); free(buf); CAMLreturn(Val_int(ret)); } CAMLprim value ocaml_vorbis_decode_byte(value *argv, int argn) { return ocaml_vorbis_decode(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ocaml_vorbis_decode_float(value d_f, value dst, value ofs_, value len_) { CAMLparam2(d_f, dst); myvorbis_dec_file_t *df = Decfile_val(d_f); int ret = 0; int ofs = Int_val(ofs_); int len = Int_val(len_); float **buf; int chans, c, i; if (!df->ovf) caml_raise_constant(*caml_named_value("vorbis_exn_invalid_parameters")); chans = df->ovf->vi->channels; if (chans > Wosize_val(dst)) caml_raise_constant(*caml_named_value("vorbis_exn_invalid_parameters")); if (Wosize_val(dst) < 1 || Wosize_val(Field(dst, 0)) / Double_wosize - ofs < len) caml_raise_constant(*caml_named_value("vorbis_exn_invalid_parameters")); /* We have to make sure that when a callback is called, the ocaml master lock * has been released. Callbacks are responsible for taking it back if they * need to call ocaml code. */ caml_release_runtime_system(); ret = ov_read_float(df->ovf, &buf, len, &df->bitstream); caml_acquire_runtime_system(); if (ret <= 0) ret ? raise_err(ret) : caml_raise_end_of_file(); for (c = 0; c < chans; c++) for (i = 0; i < ret; i++) Store_double_field(Field(dst, c), i + ofs, clip(buf[c][i])); CAMLreturn(Val_int(ret)); } CAMLprim value ocaml_vorbis_decode_float_alloc(value d_f, value len_) { CAMLparam1(d_f); CAMLlocal2(ans, ansc); myvorbis_dec_file_t *df = Decfile_val(d_f); int ret = 0; int len = Int_val(len_); float **buf; int chans, c, i; if (!df->ovf) caml_raise_constant(*caml_named_value("vorbis_exn_invalid_parameters")); chans = df->ovf->vi->channels; /* We have to make sure that when a callback is called, the ocaml master lock * has been released. Callbacks are responsible for taking it back if they * need to call ocaml code. */ caml_release_runtime_system(); ret = ov_read_float(df->ovf, &buf, len, &df->bitstream); caml_acquire_runtime_system(); if (ret <= 0) ret ? raise_err(ret) : caml_raise_end_of_file(); ans = caml_alloc_tuple(chans); for (c = 0; c < chans; c++) { ansc = caml_alloc(ret * Double_wosize, Double_array_tag); Store_field(ans, c, ansc); for (i = 0; i < ret; i++) Store_double_field(ansc, i, clip(buf[c][i])); } CAMLreturn(ans); } CAMLprim value ocaml_vorbis_decode_float_ba(value d_f, value dst, value ofs_, value len_) { CAMLparam2(d_f, dst); myvorbis_dec_file_t *df = Decfile_val(d_f); int ret = 0; int ofs = Int_val(ofs_); int len = Int_val(len_); float **buf; int chans, c, i; if (!df->ovf) caml_raise_constant(*caml_named_value("vorbis_exn_invalid_parameters")); chans = df->ovf->vi->channels; if (chans > Wosize_val(dst)) caml_raise_constant(*caml_named_value("vorbis_exn_invalid_parameters")); if (Wosize_val(dst) < 1 || Caml_ba_array_val(Field(dst, 0))->dim[0] - ofs < len) caml_raise_constant(*caml_named_value("vorbis_exn_invalid_parameters")); /* We have to make sure that when a callback is called, the ocaml master lock * has been released. Callbacks are responsible for taking it back if they * need to call ocaml code. */ caml_release_runtime_system(); ret = ov_read_float(df->ovf, &buf, len, &df->bitstream); caml_acquire_runtime_system(); if (ret <= 0) ret ? raise_err(ret) : caml_raise_end_of_file(); for (c = 0; c < chans; c++) for (i = 0; i < ret; i++) ((float *)Caml_ba_data_val(Field(dst, c)))[i + ofs] = buf[c][i]; CAMLreturn(Val_int(ret)); } CAMLprim value ocaml_vorbis_decode_float_alloc_ba(value d_f, value len_) { CAMLparam1(d_f); CAMLlocal2(ans, ansc); myvorbis_dec_file_t *df = Decfile_val(d_f); int ret = 0; int len = Int_val(len_); float **buf; int chans, c, i; if (!df->ovf) caml_raise_constant(*caml_named_value("vorbis_exn_invalid_parameters")); chans = df->ovf->vi->channels; /* We have to make sure that when a callback is called, the ocaml master lock * has been released. Callbacks are responsible for taking it back if they * need to call ocaml code. */ caml_release_runtime_system(); ret = ov_read_float(df->ovf, &buf, len, &df->bitstream); caml_acquire_runtime_system(); if (ret <= 0) ret ? raise_err(ret) : caml_raise_end_of_file(); ans = caml_alloc_tuple(chans); for (c = 0; c < chans; c++) { ansc = caml_ba_alloc_dims(CAML_BA_FLOAT32 | CAML_BA_C_LAYOUT, 1, NULL, ret); Store_field(ans, c, ansc); for (i = 0; i < ret; i++) ((float *)Caml_ba_data_val(ansc))[i] = clip(buf[c][i]); } CAMLreturn(ans); } CAMLprim value ocaml_vorbis_get_dec_file_bitstream(value d_f) { myvorbis_dec_file_t *df = Decfile_val(d_f); return Val_int(df->bitstream); } CAMLprim value ocaml_vorbis_decoder_info(value d_f, value bs) { CAMLparam1(d_f); CAMLlocal1(ans); myvorbis_dec_file_t *df = Decfile_val(d_f); int bitstream = Int_val(bs); vorbis_info *vi; caml_release_runtime_system(); vi = ov_info(df->ovf, bitstream); caml_acquire_runtime_system(); assert(vi); ans = caml_alloc_tuple(7); Store_field(ans, 0, Val_int(vi->version)); Store_field(ans, 1, Val_int(vi->channels)); Store_field(ans, 2, Val_int(vi->rate)); Store_field(ans, 3, Val_int(vi->bitrate_upper)); Store_field(ans, 4, Val_int(vi->bitrate_nominal)); Store_field(ans, 5, Val_int(vi->bitrate_lower)); Store_field(ans, 6, Val_int(vi->bitrate_window)); CAMLreturn(ans); } CAMLprim value ocaml_vorbis_get_dec_file_comments(value d_f, value link_) { CAMLparam2(d_f, link_); CAMLlocal2(ans, cmts); myvorbis_dec_file_t *df = Decfile_val(d_f); int link = Int_val(link_); int i; vorbis_comment *vc; caml_release_runtime_system(); vc = ov_comment(df->ovf, link); caml_acquire_runtime_system(); if (!vc) /* TODO: better error */ caml_raise_with_arg(*caml_named_value("vorbis_exn_unknown_error"), Val_int(666)); cmts = caml_alloc_tuple(vc->comments); for (i = 0; i < vc->comments; i++) Store_field(cmts, i, caml_copy_string(vc->user_comments[i])); ans = caml_alloc_tuple(2); if (vc->vendor != NULL) Store_field(ans, 0, caml_copy_string(vc->vendor)); else Store_field(ans, 0, caml_copy_string("(null)")); Store_field(ans, 1, cmts); CAMLreturn(ans); } CAMLprim value ocaml_vorbis_decoder_bitrate(value d_f, value bs) { CAMLparam1(d_f); myvorbis_dec_file_t *df = Decfile_val(d_f); int bitstream = Int_val(bs); long ret; caml_release_runtime_system(); ret = ov_bitrate(df->ovf, bitstream); caml_acquire_runtime_system(); CAMLreturn(Val_int(ret)); } CAMLprim value ocaml_vorbis_decoder_time_total(value d_f, value bs) { CAMLparam1(d_f); myvorbis_dec_file_t *df = Decfile_val(d_f); int bitstream = Int_val(bs); double ret; caml_release_runtime_system(); ret = ov_time_total(df->ovf, bitstream); caml_acquire_runtime_system(); CAMLreturn(caml_copy_double(ret)); } CAMLprim value ocaml_vorbis_decoder_pcm_total(value d_f, value bs) { CAMLparam1(d_f); myvorbis_dec_file_t *df = Decfile_val(d_f); int bitstream = Int_val(bs); ogg_int64_t ret; caml_release_runtime_system(); ret = ov_pcm_total(df->ovf, bitstream); caml_acquire_runtime_system(); CAMLreturn(Val_int(ret)); } CAMLprim value ocaml_vorbis_decoder_streams(value d_f) { CAMLparam1(d_f); myvorbis_dec_file_t *df = Decfile_val(d_f); long ret; caml_release_runtime_system(); ret = ov_streams(df->ovf); caml_acquire_runtime_system(); CAMLreturn(Val_int(ret)); } CAMLprim value ocaml_vorbis_decoder_serialnumber(value d_f, value bs) { CAMLparam1(d_f); myvorbis_dec_file_t *df = Decfile_val(d_f); int bitstream = Int_val(bs); long ret; caml_release_runtime_system(); ret = ov_serialnumber(df->ovf, bitstream); caml_acquire_runtime_system(); CAMLreturn(Val_int(ret)); } /* Ogg skeleton interface */ /* Wrappers */ static void write32le(unsigned char *ptr, ogg_uint32_t v) { ptr[0] = v & 0xff; ptr[1] = (v >> 8) & 0xff; ptr[2] = (v >> 16) & 0xff; ptr[3] = (v >> 24) & 0xff; } static void write64le(unsigned char *ptr, ogg_int64_t v) { ogg_uint32_t hi = v >> 32; ptr[0] = v & 0xff; ptr[1] = (v >> 8) & 0xff; ptr[2] = (v >> 16) & 0xff; ptr[3] = (v >> 24) & 0xff; ptr[4] = hi & 0xff; ptr[5] = (hi >> 8) & 0xff; ptr[6] = (hi >> 16) & 0xff; ptr[7] = (hi >> 24) & 0xff; } /* Values from http://xiph.org/ogg/doc/skeleton.html */ #define FISBONE_IDENTIFIER "fisbone\0" #define FISBONE_MESSAGE_HEADER_OFFSET 44 #define FISBONE_SIZE 52 /* Code from theorautils.c in ffmpeg2theora */ CAMLprim value ocaml_vorbis_skeleton_fisbone(value serial, value samplerate, value start, value content) { CAMLparam4(serial, samplerate, start, content); CAMLlocal1(packet); ogg_packet op; int len = FISBONE_SIZE + caml_string_length(content); memset(&op, 0, sizeof(op)); op.packet = malloc(len); if (op.packet == NULL) caml_raise_out_of_memory(); memset(op.packet, 0, len); /* it will be the fisbone packet for the vorbis audio */ memcpy(op.packet, FISBONE_IDENTIFIER, 8); /* identifier */ write32le( op.packet + 8, FISBONE_MESSAGE_HEADER_OFFSET); /* offset of the message header fields */ write32le(op.packet + 12, Nativeint_val(serial)); /* serialno of the vorbis stream */ write32le(op.packet + 16, 3); /* number of header packet */ /* granulerate, temporal resolution of the bitstream in Hz */ write64le(op.packet + 20, (ogg_int64_t)Int64_val(samplerate)); /* granulerate numerator */ write64le(op.packet + 28, (ogg_int64_t)1); /* granulerate denominator */ write64le(op.packet + 36, (ogg_int64_t)Int64_val(start)); /* start granule */ write32le(op.packet + 44, 2); /* preroll, for vorbis its 2 */ *(op.packet + 48) = 0; /* granule shift, always 0 for vorbis */ memcpy(op.packet + FISBONE_SIZE, String_val(content), caml_string_length(content)); op.b_o_s = 0; op.e_o_s = 0; op.bytes = len; packet = value_of_packet(&op); free(op.packet); CAMLreturn(packet); }