Merge pull request #13 from savonet/switch-to-libflac-for-ogg

Switch to libflac for ogg

CHANGES

@@ -1,8 +1,10 @@
-0.3.2 (unreleased)
+0.4.0 (unreleased)
 =====
 * 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)
 =====

dune-project

@@ -1,5 +1,5 @@
 (lang dune 2.8)
-(version 0.3.2)
+(version 0.4.0)
 (name flac)
 (source (github savonet/ocaml-flac))
 (license GPL-2.0)

examples/encode.ml

@@ -85,43 +85,18 @@ let _ =
       in
       (encode, finish))
     else (
-      let os = Ogg.Stream.create () in
       let oc = open_out !dst in
-      let s_o_f (h, b) = h ^ b in
-      let flush s =
-        let rec f v =
-          try
-            let v = v ^ s_o_f (Ogg.Stream.flush_page s) in
-            f v
-          with Ogg.Not_enough_data -> v
-        in
-        f ""
+      let write_page (header, body) =
+        output_string oc header;
+        output_string oc body
       in
-      let pageout s = s_o_f (Ogg.Stream.get_page s) in
-      let pagesout s =
-        let rec f v =
-          try
-            let n = pageout s in
-            f (v ^ n)
-          with Ogg.Not_enough_data -> v
-        in
-        f ""
-      in
-      let enc, p, l = Flac_ogg.Encoder.create ~comments params os in
-      Ogg.Stream.put_packet os p;
-      output_string oc (flush os);
-      List.iter (Ogg.Stream.put_packet os) l;
-      output_string oc (flush os);
-      flush_outchan oc;
-      let encode buf =
-        Flac.Encoder.process enc Flac_ogg.Encoder.callbacks buf;
-        output_string oc (pagesout os)
-      in
-      let finish () =
-        Flac.Encoder.finish enc Flac_ogg.Encoder.callbacks;
-        output_string oc (flush os);
-        close_out oc
+      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

flac.opam

@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "0.3.2"
+version: "0.4.0"
 synopsis: "Bindings to libflac"
 maintainer: ["The Savonet Team <[email protected]>"]
 authors: ["The Savonet Team <[email protected]>"]

src/flac_ogg.ml

@@ -49,41 +49,41 @@ module Encoder = struct
   type ogg
   type enc
 
-  let callbacks : ogg Flac.Encoder.callbacks =
-    Obj.magic (Flac.Encoder.get_callbacks (fun _ -> raise Flac.Internal))
-
-  type init_c = Ogg.Stream.packet -> unit
+  type t = {
+    encoder : ogg Flac.Encoder.t;
+    callbacks : ogg Flac.Encoder.callbacks;
+    first_pages : Ogg.Page.t list;
+  }
 
   external finalize_encoder_private_values : enc -> unit
     = "ocaml_flac_finalize_ogg_encoder_private_values"
 
   external create :
     (string * string) array ->
     Flac.Encoder.params ->
-    Ogg.Stream.stream ->
-    init_c ->
+    (Ogg.Page.t -> unit) ->
+    nativeint ->
     enc = "ocaml_flac_encoder_ogg_create"
 
-  let create ?(comments = []) params os =
+  external set_write_cb : enc -> (Ogg.Page.t -> unit) -> unit
+    = "ocaml_flac_encoder_ogg_set_write_cb"
+
+  let create ?(comments = []) ~serialno params write_cb =
     if params.Flac.Encoder.channels <= 0 then raise Flac.Encoder.Invalid_data;
     let comments = Array.of_list comments in
-    let ret = Queue.create () in
-    let init_c p = Queue.push p ret in
-    let enc = create comments params os init_c in
-    Gc.finalise finalize_encoder_private_values enc;
-    let rec f acc =
-      try f (Queue.pop ret :: acc)
-      with Queue.Empty -> (
-        match List.rev acc with [] -> raise Flac.Internal | x :: l -> (x, l))
+    let first_pages = Atomic.make [] in
+    let write_first_page p =
+      Atomic.set first_pages (p :: Atomic.get first_pages)
     in
-    let p, l = f [] in
-    (Obj.magic (enc, params), p, l)
-
-  external finish : enc -> unit = "ocaml_flac_encoder_ogg_finish"
-
-  let finish e =
-    let e, _ = Obj.magic e in
-    finish e
+    let enc = create comments params write_first_page serialno in
+    Gc.finalise finalize_encoder_private_values enc;
+    set_write_cb enc write_cb;
+    {
+      encoder = Obj.magic (enc, params);
+      callbacks =
+        Obj.magic (Flac.Encoder.get_callbacks (fun _ -> raise Flac.Internal));
+      first_pages = List.rev (Atomic.get first_pages);
+    }
 end
 
 module Skeleton = struct

src/ogg_flac.mli → src/flac_ogg.mli

@@ -78,32 +78,25 @@ module Encoder : sig
   (** Variant type for ogg/flac encoder *)
   type ogg
 
-  (** Create a set of ogg/flac callbacks to 
-    * encoder an ogg/flac stream *)
-  val callbacks : ogg Flac.Encoder.callbacks
+  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 an initial 
-    * ogg packet, that should be placed in its own
-    * page at the beginning of the ogg stream, and
-    * then the remaining initial packets, containing
-    * comments data, that should be placed in some ogg 
-    * pages before and not containing any audio data. 
-    * See ogg stream documentation for more information 
-    * on ogg data muxing. *)
+    * [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.Stream.stream ->
-    ogg Flac.Encoder.t * Ogg.Stream.packet * Ogg.Stream.packet list
-
-  (** Terminate an ogg/flac encoder. Causes the encoder
-    * to flush remaining encoded data. The encoder should not
-    * be used anymore afterwards. *)
-  val finish : ogg Flac.Encoder.t -> unit
+    (Ogg.Page.t -> unit) ->
+    t
 end
 
 (** Ogg/flac skeleton module *)