pax_global_header00006660000000000000000000000064144757203400014520gustar00rootroot0000000000000052 comment=eefd5968ee0667da512de49e87153ba47596cccf ocaml-flac-0.5.0/000077500000000000000000000000001447572034000135205ustar00rootroot00000000000000ocaml-flac-0.5.0/.github/000077500000000000000000000000001447572034000150605ustar00rootroot00000000000000ocaml-flac-0.5.0/.github/workflows/000077500000000000000000000000001447572034000171155ustar00rootroot00000000000000ocaml-flac-0.5.0/.github/workflows/main.yml000066400000000000000000000011031447572034000205570ustar00rootroot00000000000000name: CI on: [push] concurrency: group: ${{ github.workflow }}-${{ github.ref }} cancel-in-progress: true jobs: build_and_test: runs-on: ${{ matrix.os }} strategy: fail-fast: false matrix: os: [ubuntu-latest, macos-latest] steps: - name: Build and test module uses: savonet/build-and-test-ocaml-module@main with: extra-packages: ogg - name: Run CI tests. if: ${{ matrix.os == 'ubuntu-latest' }} run: | eval $(opam env) sudo apt-get install -qq -yy ffmpeg dune build @citest ocaml-flac-0.5.0/.gitignore000066400000000000000000000000721447572034000155070ustar00rootroot00000000000000*~ _build *.byte *.native _tests .merlin *.install .*.sw* ocaml-flac-0.5.0/.ocamlformat000066400000000000000000000003371447572034000160300ustar00rootroot00000000000000version=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-flac-0.5.0/CHANGES000066400000000000000000000035501447572034000145160ustar00rootroot000000000000000.5.0 (2023-09-05) ===== * Cleanup API, get rid of global roots, make ogg encoder and decoder implementation use the main flac module implementation. 0.4.0 (2023-05-09) ===== * Move global roots removal out of custom blocks finalizers to be compliant with OCaml 5 memory model. * Update Ogg encoder API to use flac native ogg support. 0.3.1 (2022-10-11) ===== * Add bindings for `vorbiscomment_entry_name_is_legal` and `vorbiscomment_entry_value_is_legal`, raise exception when submitting invalid metadata at encoder creation. 0.3.0 (08-03-2021) ====== * Switch to dune 0.2.0 (08-10-2020) ====== * Switch to bytes read callback. 0.1.7 (02-05-2020) ====== * Fix exception raised on end of track when decoding ogg streams. * Fix memory leak when calling OCaml code from unregistered C threads (#9). 0.1.6 (12-04-2020) ====== * Fix return status for native and ogg read callbacks (savonet/liquidosoap#1146) 0.1.5 (27-06-2019) ===== * More cleanup. * Make sure input samples always fall withing the [-1;1] range. (#6) * Remove StringCompat, bump OCaml version to >= 4.03 0.1.4 (23-01-2019) ===== * Use caml_acquire_runtime_system/caml_release_runtime_system for clarity * Register global roots using caml_register_generational_global_root * Remove tmp field from encoder and decoder and use proper variable registration when appropriate. * Be specific about each callback registered as global root. 0.1.3 (07-10-2017) ===== * Fixed segfault in encoder. * Fixed compilation with OCaml 4.06 0.1.2 (03-08-2015) ===== * Changed types to match new ocaml-ogg's API. Should be fully backward compatible. * Fix segfault when vendor string is empty. * Swich to Bytes API and String.uppercase_ascii 0.1.1 (25-06-2012) ===== * Fixed incorrect decoding of 24bit flac streams. Thanks to Wittawas Nakkasem for reporting and patching! 0.1.0 (04-07-2011) ====== * Initial release ocaml-flac-0.5.0/COPYING000066400000000000000000000431311447572034000145550ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 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. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. 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 Program or any portion of it, thus forming a work based on the Program, 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) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, 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 Program, 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 Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) 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; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, 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 executable. However, as a special exception, the source code 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. If distribution of executable or 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 counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program 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. 5. 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 Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program 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 to this License. 7. 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 Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program 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 Program. 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. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program 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. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies 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 Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, 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 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. 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 PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively 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 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 Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. ocaml-flac-0.5.0/README.md000066400000000000000000000011011447572034000147700ustar00rootroot00000000000000ocaml-flac ============ This package contains an OCaml interface for the `flac` library Please read the COPYING file before using this software. Prerequisites: ============== - ocaml - libflac - findlib - ocaml-ogg >= 0.7.0 (optional) - dune >= 2.0 Compilation: ============ ``` $ dune build ``` This should build both the native and the byte-code version of the extension library. Installation: ============= Via `opam`: ``` $ opam install flac ``` Via `dune` (for developers): ``` $ dune install ``` This should install the library file in the appropriate place. ocaml-flac-0.5.0/dune-project000066400000000000000000000007441447572034000160470ustar00rootroot00000000000000(lang dune 2.8) (version 0.5.0) (name flac) (source (github savonet/ocaml-flac)) (license GPL-2.0) (authors "The Savonet Team ") (maintainers "The Savonet Team ") (generate_opam_files true) (use_standard_c_and_cxx_flags false) (package (name flac) (synopsis "Bindings to libflac") (depends conf-libflac conf-pkg-config (ocaml (>= 4.03.0)) dune dune-configurator) (depopts (ogg (>= 0.7.4))) ) ocaml-flac-0.5.0/examples/000077500000000000000000000000001447572034000153365ustar00rootroot00000000000000ocaml-flac-0.5.0/examples/.merlin000066400000000000000000000000321447572034000166200ustar00rootroot00000000000000S ../src B ../src PKG ogg ocaml-flac-0.5.0/examples/decode.ml000066400000000000000000000142271447572034000171210ustar00rootroot00000000000000let 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 h.Flac.Decoder.File.callbacks; Flac.Decoder.state h.Flac.Decoder.File.dec h.Flac.Decoder.File.callbacks 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 callbacks = Flac_ogg.Decoder.get_callbacks os write in let dec = Flac.Decoder.create callbacks in let rec info () = try Flac.Decoder.init dec callbacks with Ogg.Not_enough_data -> fill (); info () in let dec, info, meta = info () in let rec process () = try Flac.Decoder.process dec callbacks; Flac.Decoder.state dec callbacks with 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-flac-0.5.0/examples/dune000066400000000000000000000011531447572034000162140ustar00rootroot00000000000000(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-flac-0.5.0/examples/encode.ml000066400000000000000000000075151447572034000171350ustar00rootroot00000000000000let 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 enc.Flac.Encoder.File.callbacks buf in let finish () = Flac.Encoder.finish enc.Flac.Encoder.File.enc enc.Flac.Encoder.File.callbacks; 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; callbacks; first_pages } = Flac_ogg.Encoder.create ~comments ~serialno params write_page in List.iter write_page first_pages; let encode = Flac.Encoder.process encoder callbacks in let finish () = Flac.Encoder.finish encoder callbacks 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-flac-0.5.0/flac.opam000066400000000000000000000014301447572034000153010ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "0.5.0" synopsis: "Bindings to libflac" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] license: "GPL-2.0" homepage: "https://github.com/savonet/ocaml-flac" bug-reports: "https://github.com/savonet/ocaml-flac/issues" depends: [ "conf-libflac" "conf-pkg-config" "ocaml" {>= "4.03.0"} "dune" {>= "2.8"} "dune-configurator" "odoc" {with-doc} ] depopts: [ "ogg" {>= "0.7.4"} ] 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-flac.git" ocaml-flac-0.5.0/src/000077500000000000000000000000001447572034000143075ustar00rootroot00000000000000ocaml-flac-0.5.0/src/config/000077500000000000000000000000001447572034000155545ustar00rootroot00000000000000ocaml-flac-0.5.0/src/config/discover_flac.ml000066400000000000000000000013321447572034000207100ustar00rootroot00000000000000module 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-flac-0.5.0/src/config/discover_flac_ogg.ml000066400000000000000000000011021447572034000215370ustar00rootroot00000000000000module 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-flac-0.5.0/src/config/dune000066400000000000000000000003631447572034000164340ustar00rootroot00000000000000(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-flac-0.5.0/src/config/endianess.c000066400000000000000000000006161447572034000176740ustar00rootroot00000000000000#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-flac-0.5.0/src/dune000066400000000000000000000020511447572034000151630ustar00rootroot00000000000000(library (name flac) (public_name flac) (synopsis "OCaml bindings for libflac") (modules flac flac_impl) (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-flac-0.5.0/src/flac.ml000066400000000000000000000000221447572034000155400ustar00rootroot00000000000000include Flac_impl ocaml-flac-0.5.0/src/flac.mli000066400000000000000000000305021447572034000157170ustar00rootroot00000000000000(* * 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 of an uninitialized decoder. *) type 'a dec (** Type of an initialized decoder. *) type 'a t (** Type of a write callback. *) type write = float array array -> unit (** Type of a read callback. *) type read = bytes -> int -> int -> int (** Type of a collection of callbacks. *) type 'a callbacks = 'a Flac_impl.Decoder.callbacks (** Generic variant type for callbacks and decoder. *) type generic (** Info about decoded FLAC data. *) 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 set of callbacks. *) val get_callbacks : ?seek:(int64 -> unit) -> ?tell:(unit -> int64) -> ?length:(unit -> int64) -> ?eof:(unit -> bool) -> read -> write -> generic callbacks (** Create an uninitialized decoder. *) val create : 'a callbacks -> 'a dec (** Initialize a decoder. The decoder will be used to decode * all metadata. Initial audio data shall be immediatly available * after this call. *) val init : 'a dec -> 'a callbacks -> 'a t * info * comments option (** Decode one frame of audio data. *) val process : 'a t -> 'a callbacks -> 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 : 'a t -> 'a callbacks -> 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 : 'a t -> 'a callbacks -> 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 : 'a t -> 'a callbacks -> bool (** Get the state of a decoder. *) val state : 'a t -> 'a callbacks -> 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} *) (** File variant type for a file decoder *) type file (* Handler for file decoder *) type handle = { fd : Unix.file_descr; dec : file t; (* These callback support [seek] and [tell] * if the underlying [Unix.file_descriptor] * supports them. *) callbacks : file callbacks; 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 -> Unix.file_descr -> handle (** Create a file decoder from a file URI *) val create : write -> 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 'a t (** Type of a write callback *) type write = bytes -> unit (** Type of a set of callbacks *) type 'a callbacks = 'a Flac_impl.Encoder.callbacks (** Generic type for an encoder *) type generic (** 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} *) (** Create a set of encoding callbacks *) val get_callbacks : ?seek:(int64 -> unit) -> ?tell:(unit -> int64) -> write -> generic callbacks (** 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 -> params -> 'a callbacks -> 'a t (** Encode some data *) val process : 'a t -> 'a callbacks -> 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 : 'a t -> 'a callbacks -> 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} *) (** Generic variant type for file encoder *) type file (** Handle for file encoder *) type handle = { fd : Unix.file_descr; enc : file t; callbacks : file callbacks; } (** {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-flac-0.5.0/src/flac_decoder.ml000066400000000000000000000053221447572034000172350ustar00rootroot00000000000000(* * 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 decoder os = let ogg_dec = ref None in let decoder = ref None in let write_ref = ref (fun _ -> ()) in let write ret = let fn = !write_ref in fn ret in let callbacks_ref = ref (Flac_ogg.Decoder.get_callbacks os write) in let get_decoder () = match !decoder with | None -> let ogg_dec = match !ogg_dec with | None -> let dec = Flac.Decoder.create !callbacks_ref in ogg_dec := Some dec; dec | Some dec -> dec in let dec, info, m = Flac.Decoder.init ogg_dec !callbacks_ref in let meta = match m with None -> ("Unknown vendor", []) | Some x -> x 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 feed = write_ref := feed; let decoder, _, _ = get_decoder () in match Flac.Decoder.state decoder !callbacks_ref with | `Search_for_metadata | `Read_metadata | `Search_for_frame_sync | `Read_frame -> Flac.Decoder.process decoder !callbacks_ref (* Ogg decoder is responsible for detecting end of stream vs. end of track. *) | _ -> raise Ogg.Not_enough_data in let restart new_os = (write_ref := fun _ -> ()); let d, _, _ = get_decoder () in (* Flush error are very unlikely. *) assert (Flac.Decoder.flush d !callbacks_ref); callbacks_ref := Flac_ogg.Decoder.get_callbacks new_os write 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-flac-0.5.0/src/flac_decoder.mli000066400000000000000000000016351447572034000174110ustar00rootroot00000000000000(* * 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-flac-0.5.0/src/flac_impl.ml000066400000000000000000000167171447572034000166030ustar00rootroot00000000000000(* * 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 'a dec type 'a t = 'a dec type write = float array array -> unit type read = bytes -> int -> int -> int type 'a callbacks = { read : read; seek : (int64 -> unit) option; tell : (unit -> int64) option; length : (unit -> int64) option; eof : (unit -> bool) option; write : write; } type generic let get_callbacks ?seek ?tell ?length ?eof read write = { read; seek; tell; length; eof; write } (** 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 : 'a dec -> 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 create : 'a callbacks -> 'a dec = "ocaml_flac_decoder_create" external state : 'a t -> 'a callbacks -> state = "ocaml_flac_decoder_state" external init : 'a dec -> 'a callbacks -> unit = "ocaml_flac_decoder_init" let init dec c = init dec c; let info, comments = info dec in (dec, info, comments) external process : 'a t -> 'a callbacks -> unit = "ocaml_flac_decoder_process" external seek : 'a t -> 'a callbacks -> Int64.t -> bool = "ocaml_flac_decoder_seek" external flush : 'a t -> 'a callbacks -> bool = "ocaml_flac_decoder_flush" external reset : 'a t -> 'a callbacks -> bool = "ocaml_flac_decoder_reset" external to_s16le : float array array -> string = "caml_flac_float_to_s16le" module File = struct type file type handle = { fd : Unix.file_descr; dec : file t; callbacks : file callbacks; 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 callbacks = { read; seek = Some seek; tell = Some tell; length = Some length; eof = Some eof; write; } in let dec = create callbacks in let dec, info, comments = init dec callbacks in { fd; comments; callbacks; 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 'a priv type write = bytes -> unit type 'a callbacks = { write : write; seek : (int64 -> unit) option; tell : (unit -> int64) option; } type generic let get_callbacks ?seek ?tell write = { write; seek; tell } 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 'a t = 'a 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 create : (string * string) array -> params -> 'a callbacks -> 'a priv = "ocaml_flac_encoder_create" let create ?(comments = []) p c = if p.channels <= 0 then raise Invalid_data; let comments = Array.of_list comments in let enc = create comments p c in (enc, p) external process : 'a priv -> 'a callbacks -> float array array -> int -> unit = "ocaml_flac_encoder_process" let process (enc, p) c data = if Array.length data <> p.channels then raise Invalid_data; process enc c data p.bits_per_sample external finish : 'a priv -> 'a callbacks -> unit = "ocaml_flac_encoder_finish" let finish (enc, _) c = finish enc c external from_s16le : string -> int -> float array array = "caml_flac_s16le_to_float" module File = struct type file type handle = { fd : Unix.file_descr; enc : file t; callbacks : file callbacks; } 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 callbacks = { write; seek = Some seek; tell = Some tell } in let enc = create ?comments params callbacks in { fd; enc; callbacks } 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-flac-0.5.0/src/flac_ogg.ml000066400000000000000000000073511447572034000164100ustar00rootroot00000000000000(* * 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 type ogg external get_packet_data : Ogg.Stream.packet -> string = "ocaml_flac_decoder_packet_data" let ogg_header_len = 9 let get_callbacks os write : ogg Flac.Decoder.callbacks = let read_data = Buffer.create 1024 in let is_first_packet = ref true in let 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.End_of_stream -> 0 in Flac__Flac_impl.Decoder.get_callbacks read write external check_packet : Ogg.Stream.packet -> bool = "ocaml_flac_decoder_check_ogg" end module Encoder = struct type ogg type enc type t = { encoder : ogg Flac.Encoder.t; callbacks : ogg Flac.Encoder.callbacks; first_pages : Ogg.Page.t list; } external create : (string * string) array -> Flac.Encoder.params -> 'a Flac.Encoder.callbacks -> nativeint -> enc = "ocaml_flac_encoder_ogg_create" let create ?(comments = []) ~serialno params write = if params.Flac.Encoder.channels <= 0 then raise Flac.Encoder.Invalid_data; let comments = Array.of_list comments in let first_pages = ref [] in let header = ref None in let write_wrap write p = match !header with | Some h -> header := None; write (Bytes.unsafe_to_string h, Bytes.unsafe_to_string p) | None -> header := Some p in let write_first_page = write_wrap (fun p -> first_pages := p :: !first_pages) in let callbacks = Flac.Encoder.get_callbacks write_first_page in let enc = create comments params callbacks serialno in assert (!header = None); { encoder = Obj.magic (enc, params); callbacks = Flac__Flac_impl.Encoder.get_callbacks (write_wrap write); 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-flac-0.5.0/src/flac_ogg.mli000066400000000000000000000063221447572034000165560ustar00rootroot00000000000000(* * 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} *) (** Decode ogg/flac data *) module Decoder : sig (** {3 Usage} *) (** Usage is similar to the case * of the native FLAC decoder, using * the appropriate ogg/flac decoding * callbacks. * * The main difference is that in the * case of the ogg/flac decoding, the * exception [Ogg.Not_enough_data] may * be raised if the ogg stream used to * create the decoder does not contain * enough data. In this case, you should * feed more data into the ogg stream and * call the decoding function again. * * This remark is valid for both the * [Flac.Decoder.init] and [Flac.Decoder.process] * functions. *) (** {3 Types} *) (** Variant type for ogg/flac decoder *) type ogg (** Check if an ogg packet is the first * packet of an ogg/flac stream. *) val check_packet : Ogg.Stream.packet -> bool (** Create a set of callbacks to decode an ogg/flac stream *) val get_callbacks : Ogg.Stream.stream -> Flac.Decoder.write -> ogg Flac.Decoder.callbacks end (** Encode ogg/flac data *) module Encoder : sig (** {3 Usage} *) (** Usage is similar to the case * of the native FLAC encoder, using * the appropriate ogg/flac encoding * callbacks. *) (** {3 Types} *) (** Variant type for ogg/flac encoder *) type ogg type t = { encoder : ogg Flac.Encoder.t; callbacks : ogg Flac.Encoder.callbacks; first_pages : Ogg.Page.t list; } (** Create an ogg/flac encoder. * * The returned value contains an encoder value * that can be used with the functions from the * [Flac.Encoder] module, as well as the * corresponding callbacks to use with the various * encoding functions. *) val create : ?comments:(string * string) list -> serialno:Nativeint.t -> Flac.Encoder.params -> (Ogg.Page.t -> unit) -> 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-flac-0.5.0/src/flac_ogg_stubs.c000066400000000000000000000113451447572034000174400ustar00rootroot00000000000000/* 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 #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_create(value comments, value params, value _enc_cb, value _serialno) { CAMLparam4(comments, params, _enc_cb, _serialno); CAMLlocal2(tmp, ret); intnat serialno = Nativeint_val(_serialno); ret = ocaml_flac_encoder_alloc(comments, params); ocaml_flac_encoder *enc = Encoder_val(ret); enc->callbacks = _enc_cb; 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(); enc->callbacks = Val_none; CAMLreturn(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_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-flac-0.5.0/src/flac_stubs.c000066400000000000000000000611071447572034000166050ustar00rootroot00000000000000/* 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))) 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) { /* This callback is executed in non-blocking section. */ 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; ocaml_flac_register_thread(); caml_acquire_runtime_system(); value seek = Dec_read(callbacks->callbacks); if (seek != Val_none) { caml_callback(Some_val(seek), caml_copy_int64(absolute_byte_offset)); caml_release_runtime_system(); return FLAC__STREAM_DECODER_SEEK_STATUS_OK; } caml_release_runtime_system(); return FLAC__STREAM_DECODER_SEEK_STATUS_UNSUPPORTED; } 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; ocaml_flac_register_thread(); caml_acquire_runtime_system(); value tell = Dec_tell(callbacks->callbacks); if (tell != Val_none) { *absolute_byte_offset = (FLAC__uint64)Int64_val(caml_callback(Some_val(tell), Val_unit)); caml_release_runtime_system(); return FLAC__STREAM_DECODER_TELL_STATUS_OK; } caml_release_runtime_system(); return FLAC__STREAM_DECODER_TELL_STATUS_UNSUPPORTED; } 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; ocaml_flac_register_thread(); caml_acquire_runtime_system(); value length = Dec_length(callbacks->callbacks); if (length != Val_none) { *stream_length = (FLAC__uint64)Int64_val(caml_callback(Some_val(length), Val_unit)); caml_release_runtime_system(); return FLAC__STREAM_DECODER_LENGTH_STATUS_OK; } caml_release_runtime_system(); return FLAC__STREAM_DECODER_LENGTH_STATUS_UNSUPPORTED; } static FLAC__bool dec_eof_callback(const FLAC__StreamDecoder *decoder, void *client_data) { ocaml_flac_decoder_callbacks *callbacks = (ocaml_flac_decoder_callbacks *)client_data; ocaml_flac_register_thread(); caml_acquire_runtime_system(); value eof = Dec_eof(callbacks->callbacks); if (eof != Val_none) { int ret = false; if (caml_callback(Some_val(eof), Val_unit) == Val_true) ret = true; caml_release_runtime_system(); return ret; } caml_release_runtime_system(); 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; value data = caml_alloc_string(readlen); caml_register_generational_global_root(&data); value ret = caml_callback3_exn(Dec_read(callbacks->callbacks), data, Val_int(0), Val_int(readlen)); if (Is_exception_result(ret)) { caml_remove_generational_global_root(&data); caml_raise(Extract_exception(ret)); } caml_remove_generational_global_root(&data); memcpy(buffer, String_val(data), 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(); value data = caml_alloc_tuple(channels); caml_register_generational_global_root(&data); int c, i; for (c = 0; c < channels; c++) { Store_field(data, c, caml_alloc(samples * Double_wosize, Double_array_tag)); for (i = 0; i < samples; i++) Store_double_field(Field(data, c), i, sample_to_double(buffer[c][i], bps)); } value ret = caml_callback_exn(Dec_write(callbacks->callbacks), data); if (Is_exception_result(ret)) { caml_remove_generational_global_root(&data); caml_raise(Extract_exception(ret)); } caml_remove_generational_global_root(&data); caml_release_runtime_system(); return FLAC__STREAM_DECODER_WRITE_STATUS_CONTINUE; } value ocaml_flac_decoder_alloc() { CAMLparam0(); 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.callbacks = NULL; 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_create(value callbacks) { CAMLparam1(callbacks); CAMLlocal1(ans); ans = ocaml_flac_decoder_alloc(); ocaml_flac_decoder *dec = Decoder_val(ans); dec->callbacks.callbacks = &callbacks; // 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); caml_acquire_runtime_system(); dec->callbacks.callbacks = NULL; CAMLreturn(ans); } CAMLprim value ocaml_flac_decoder_init(value d, value c) { CAMLparam2(d, c); ocaml_flac_decoder *dec = Decoder_val(d); dec->callbacks.callbacks = &c; // Process metadata caml_release_runtime_system(); FLAC__stream_decoder_process_until_end_of_metadata(dec->decoder); caml_acquire_runtime_system(); dec->callbacks.callbacks = NULL; CAMLreturn(Val_unit); } CAMLprim value ocaml_flac_decoder_state(value d, value c) { CAMLparam2(d, c); ocaml_flac_decoder *dec = Decoder_val(d); dec->callbacks.callbacks = &c; int ret = FLAC__stream_decoder_get_state(dec->decoder); dec->callbacks.callbacks = NULL; 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, value c) { CAMLparam2(d, c); ocaml_flac_decoder *dec = Decoder_val(d); dec->callbacks.callbacks = &c; // Process one frame caml_release_runtime_system(); FLAC__stream_decoder_process_single(dec->decoder); caml_acquire_runtime_system(); dec->callbacks.callbacks = NULL; CAMLreturn(Val_unit); } CAMLprim value ocaml_flac_decoder_seek(value d, value c, value pos) { CAMLparam3(d, c, pos); FLAC__uint64 offset = Int64_val(pos); FLAC_API FLAC__bool ret; ocaml_flac_decoder *dec = Decoder_val(d); dec->callbacks.callbacks = &c; // Process one frame caml_release_runtime_system(); ret = FLAC__stream_decoder_seek_absolute(dec->decoder, offset); caml_acquire_runtime_system(); dec->callbacks.callbacks = NULL; if (ret == true) CAMLreturn(Val_true); else CAMLreturn(Val_false); } CAMLprim value ocaml_flac_decoder_reset(value d, value c) { CAMLparam2(d, c); FLAC_API FLAC__bool ret; ocaml_flac_decoder *dec = Decoder_val(d); dec->callbacks.callbacks = &c; // Process one frame caml_release_runtime_system(); ret = FLAC__stream_decoder_reset(dec->decoder); caml_acquire_runtime_system(); dec->callbacks.callbacks = NULL; if (ret == true) CAMLreturn(Val_true); else CAMLreturn(Val_false); } CAMLprim value ocaml_flac_decoder_flush(value d, value c) { CAMLparam2(d, c); FLAC_API FLAC__bool ret; ocaml_flac_decoder *dec = Decoder_val(d); dec->callbacks.callbacks = &c; // Process one frame caml_release_runtime_system(); ret = FLAC__stream_decoder_flush(dec->decoder); caml_acquire_runtime_system(); dec->callbacks.callbacks = NULL; if (ret == true) CAMLreturn(Val_true); else CAMLreturn(Val_false); } /* Encoder */ 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) { value callbacks = *(value *)client_data; ocaml_flac_register_thread(); caml_acquire_runtime_system(); value buf = caml_alloc_string(bytes); caml_register_generational_global_root(&buf); memcpy(Bytes_val(buf), buffer, bytes); value res = caml_callback_exn(Enc_write(callbacks), buf); if (Is_exception_result(res)) { caml_remove_generational_global_root(&buf); caml_raise(Extract_exception(res)); } caml_remove_generational_global_root(&buf); 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_register_thread(); caml_acquire_runtime_system(); value seek = Enc_seek(*(value *)client_data); if (seek != Val_none) { caml_callback(Some_val(seek), caml_copy_int64(absolute_byte_offset)); caml_release_runtime_system(); return FLAC__STREAM_ENCODER_SEEK_STATUS_OK; } caml_release_runtime_system(); return FLAC__STREAM_ENCODER_SEEK_STATUS_UNSUPPORTED; } static FLAC__StreamEncoderTellStatus enc_tell_callback(const FLAC__StreamEncoder *decoder, FLAC__uint64 *absolute_byte_offset, void *client_data) { ocaml_flac_register_thread(); caml_acquire_runtime_system(); value tell = Enc_tell(*(value *)client_data); if (tell != Val_none) { *absolute_byte_offset = (FLAC__uint64)Int64_val(caml_callback(Some_val(tell), Val_unit)); caml_release_runtime_system(); return FLAC__STREAM_ENCODER_TELL_STATUS_OK; } caml_release_runtime_system(); return FLAC__STREAM_ENCODER_TELL_STATUS_UNSUPPORTED; } 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)))); } 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)))); } value ocaml_flac_encoder_alloc(value comments, value params) { CAMLparam2(comments, 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)))); 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 = Val_none; 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) { 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); if (Field(params, 4) != Val_none) FLAC__stream_encoder_set_total_samples_estimate( enc, Int64_val(Some_val(Field(params, 4)))); CAMLreturn(ret); } CAMLprim value ocaml_flac_encoder_create(value comments, value params, value callbacks) { CAMLparam3(comments, params, callbacks); CAMLlocal1(ret); ret = ocaml_flac_encoder_alloc(comments, params); ocaml_flac_encoder *enc = Encoder_val(ret); enc->callbacks = callbacks; 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(); enc->callbacks = Val_none; CAMLreturn(ret); } 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 cb, value data, value bps) { CAMLparam3(_enc, data, cb); 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)); } enc->callbacks = cb; caml_release_runtime_system(); FLAC__stream_encoder_process(enc->encoder, (const FLAC__int32 *const *)enc->buf, samples); caml_acquire_runtime_system(); enc->callbacks = Val_none; CAMLreturn(Val_unit); } CAMLprim value ocaml_flac_encoder_finish(value _enc, value c) { CAMLparam2(_enc, c); ocaml_flac_encoder *enc = Encoder_val(_enc); enc->callbacks = c; caml_release_runtime_system(); FLAC__stream_encoder_finish(enc->encoder); caml_acquire_runtime_system(); enc->callbacks = Val_none; CAMLreturn(Val_unit); } ocaml-flac-0.5.0/src/flac_stubs.h000066400000000000000000000060011447572034000166020ustar00rootroot00000000000000/* 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 *callbacks; 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; #define Dec_read(v) Field(*v, 0) #define Dec_seek(v) Field(*v, 1) #define Dec_tell(v) Field(*v, 2) #define Dec_length(v) Field(*v, 3) #define Dec_eof(v) Field(*v, 4) #define Dec_write(v) Field(*v, 5) /* 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 { FLAC__StreamEncoder *encoder; FLAC__StreamMetadata *meta; FLAC__int32 **buf; FLAC__int32 *lines; value callbacks; } ocaml_flac_encoder; /* Caml abstract value containing the decoder. */ #define Encoder_val(v) (*((ocaml_flac_encoder **)Data_custom_val(v))) #define Enc_write(v) Field(v, 0) #define Enc_seek(v) Field(v, 1) #define Enc_tell(v) Field(v, 2) value ocaml_flac_encoder_alloc(value comments, 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();