Add peak operator.

CHANGES

@@ -1,3 +1,11 @@
+x.y.z ()
+========
+
+New:
+
+- Added peak and peak.stereo (#364)
+
+
 1.2.1 (01-07-2016)
 ========
 

src/Makefile

@@ -131,7 +131,7 @@ operators = \
 	operators/mixing_table.ml operators/prepend.ml \
 	operators/midi_routing.ml operators/sleeper.ml \
 	operators/time_warp.ml operators/resample.ml \
-	operators/chord.ml operators/video_text.ml operators/rms_op.ml
+	operators/chord.ml operators/video_text.ml operators/window_op.ml
 
 $(call conditional_compilation,operators,$(W_SOUNDTOUCH),operators/soundtouch_op.ml)
 $(call conditional_compilation,operators,$(W_SOUNDTOUCH),operators/st_bpm.ml)

src/operators/rms_op.ml → src/operators/window_op.ml

@@ -22,26 +22,30 @@
 
 open Source
 
-class rms ~kind duration source =
+type mode = RMS | Peak
+
+class window ~kind mode duration source =
   let channels = (Frame.type_of_kind kind).Frame.audio in
 object
-  inherit operator kind [source] ~name:"rms"
+  inherit operator kind [source] ~name:(match mode with RMS -> "rms" | Peak -> "peak")
 
   method stype = source#stype
   method is_ready = source#is_ready
   method remaining = source#remaining
   method abort_track = source#abort_track
 
-  (** Sum of squares. *)
-  val sq = Array.make channels 0.
-  (** Duration of the sum of squares in samples. *)
-  val mutable sq_dur = 0
-  (** Last computed rms. *)
-  val mutable rms = Array.make channels 0.
+  (** Accumulator (e.g. sum of squares). *)
+  val acc = Array.make channels 0.
+
+  (** Duration of the accumlated data. *)
+  val mutable acc_dur = 0
+
+  (** Last computed value (rms or peak). *)
+  val mutable value = Array.make channels 0.
 
   val m = Mutex.create ()
 
-  method rms = Tutils.mutexify m (fun () -> rms) ()
+  method value = Tutils.mutexify m (fun () -> value) ()
 
   method private get_frame buf =
     let offset = AFrame.position buf in
@@ -54,38 +58,51 @@ object
       for i = offset to position - 1 do
         for c = 0 to channels - 1 do
           let x = buf.(c).(i) in
-          sq.(c) <- sq.(c) +. x *. x
+          match mode with
+          | RMS -> acc.(c) <- acc.(c) +. x *. x
+          | Peak -> acc.(c) <- max acc.(c) (abs_float x)
         done;
-        sq_dur <- sq_dur + 1;
-        if sq_dur >= duration then
-          let dur = float sq_dur in
-          let rms' = Array.init channels
-            (fun i ->
-              let r = sqrt (sq.(i) /. dur) in
-              sq.(i) <- 0.;
-              r)
+        acc_dur <- acc_dur + 1;
+        if acc_dur >= duration then
+          let dur = float acc_dur in
+          let value' =
+            Array.init
+              channels
+              (fun i ->
+                match mode with
+                | RMS ->
+                   let v = sqrt (acc.(i) /. dur) in
+                   acc.(i) <- 0.;
+                   v
+                | Peak ->
+                   let v = acc.(i) in
+                   acc.(i) <- 0.;
+                   v
+              )
           in
-          sq_dur <- 0;
-          Tutils.mutexify m (fun () -> rms <- rms') ()
+          acc_dur <- 0;
+          Tutils.mutexify m (fun () -> value <- value') ()
       done
 end
 
-let declare suffix format fun_ret_t f_rms =
+let declare mode suffix format fun_ret_t f_ans =
   let k = Lang.kind_type_of_kind_format ~fresh:3 format in
   let return_t =
     Lang.product_t
       (Lang.fun_t [] fun_ret_t)
       (Lang.source_t k)
   in
-  Lang.add_builtin ("rms"^suffix)
+  let name = match mode with RMS -> "rms" | Peak -> "peak" in
+  let doc = match mode with RMS -> "RMS volume" | Peak -> "peak volume" in
+  Lang.add_builtin (name^suffix)
     ~category:(Lang.string_of_category Lang.Visualization)
-    ~descr:"Get current audio RMS volume of the source. \
+    ~descr:("Get current "^doc^" of the source. \
             Returns a pair @(f,s)@ where s is a new source and \
             @f@ is a function of type @() -> float@ and \
-            returns the current RMS of the source."
+            returns the current "^doc^" of the source.")
     [
       "id", Lang.string_t,Some (Lang.string ""), Some "Force the value of the source ID.";
-      "duration", Lang.float_getter_t 2, Some (Lang.float 0.5), Some "Duration of the RMS window (in seconds). A value <= 0, means that RMS computation should not be performed.";
+      "duration", Lang.float_getter_t 2, Some (Lang.float 0.5), Some "Duration of the window (in seconds). A value <= 0, means that computation should not be performed.";
       "", Lang.source_t k, None, None
     ]
     return_t
@@ -96,19 +113,22 @@ let declare suffix format fun_ret_t f_rms =
       let duration = Lang.to_float_getter (f "duration") in
       let (_,t) = Lang.of_product_t t in
       let kind = Lang.frame_kind_of_kind_type (Lang.of_source_t t) in
-      let s = new rms ~kind duration src in
+      let s = new window ~kind mode duration src in
       if id <> "" then s#set_id id;
-      let f = Lang.val_fun [] ~ret_t:fun_ret_t (fun _ _ -> f_rms s#rms) in
+      let f = Lang.val_fun [] ~ret_t:fun_ret_t (fun _ _ -> f_ans s#value) in
       Lang.product f (Lang.source (s :> Source.source)))
 
 let () =
-  let f rms =
-    let r = Array.fold_left (+.) 0. rms in
-    let r = r /. float (Array.length rms) in
-    Lang.float r
+  let mean value =
+    let x = Array.fold_left (+.) 0. value in
+    let x = x /. float (Array.length value) in
+    Lang.float x
   in
-  let f_stereo rms =
-    Lang.product (Lang.float rms.(0)) (Lang.float rms.(1))
+  let stereo value =
+    Lang.product (Lang.float value.(0)) (Lang.float value.(1))
   in
-  declare "" Lang.any_fixed Lang.float_t f;
-  declare ".stereo" (Lang.any_fixed_with ~audio:2 ()) (Lang.product_t Lang.float_t Lang.float_t) f_stereo
+  declare RMS "" Lang.any_fixed Lang.float_t mean;
+  declare RMS ".stereo" (Lang.any_fixed_with ~audio:2 ()) (Lang.product_t Lang.float_t Lang.float_t) stereo;
+  declare Peak "" Lang.any_fixed Lang.float_t mean;
+  declare Peak ".stereo" (Lang.any_fixed_with ~audio:2 ()) (Lang.product_t Lang.float_t Lang.float_t) stereo
+