(* with octaviation.
 *)

open Printf;;

open Util;;
open Aclib;;
open Event;;
open Vec;;
open Evvec;;

(*
Gc.set { (Gc.get()) with Gc.verbose = 4 };;
*)

(* 
 * BUGS:
 * I'm not doing sub-sample positioning of the envelope -- doesn't matter much.
 * power shouldn't vary w/ ffund, bw?  bw vs. rise/fall is hard to avoid.
 * or peak amplitude shouldn't vary?  I dunno.
 *)
let fof tmax
    ffund phase0 octavi
    fform bw db
    rise fall dur
    risetab
    =
  let times = phasor_wrap tmax ffund phase0
  in let octmul oct i =
    let (octf, octi) = modfi oct
    in let pow2 = 1 lsl octi            (* 2^octi *)
    in if 0 < (i land (pow2 - 1)) then 0.0
       else if 0 = (i land pow2) then 1.0 else 1.0-.octf

  in let unflattened = V.mapi (fun i t -> 
    let fform = (V.peek (int t) fform)
    and octm = octmul (V.peek (int t) octavi) i
    in let ping = if octm=0.0 then V.const 0 0.0
    else let ampl = octm *. (db2amp (V.peek (int t) db))
         in let burst = osc_sine dur fform ((frac t) *. fform) 
         in let kenv = exp(~-.pi*.bw)
         in let env = V.iterate dur (fun x -> kenv *. x) 1.0
         in let smooth_ph =   
           EV.pwl dur 0.0 [| 0.5 @@ rise; 0.5 @@ (dur-fall); 1.0 @@ dur |]
         in let smooth = tablei risetab smooth_ph
         in V.map3 (fun x y z -> ampl *. x*.y*.z) burst env smooth
    in ping @@ (int t)
                             ) times
  in EV.vfold (+.) 0.0 unflattened

let fof3 tmax 
    ffund octavi
    (fform1, db1)
    (fform2, db2) 
    (fform3, db3) 
    bw rise fall dur
    risetab sinetab
    =
  let myfof fform db = 
    fof tmax 
      ffund 0.0 octavi      (* XXX ought to adjust phases to avoid notches *)
      fform bw db
      rise fall dur 
      risetab
  in let x1 = myfof fform1 db1
     and x2 = myfof fform2 db2
     and x3 = myfof fform3 db3
  in V.map3 (fun x1 x2 x3 -> x1+.x2+.x3) x1 x2 x3

(*** octaviation sweep *)
let ar = 16000.0;;
let n = 32000;;
let octavi = V.count_n_upto 0.0 2.0 n;;
let ffund = V.const n (300.0 /. ar);;
let fform = V.const n (800.0 /. ar);;
let db = V.const n 0.0;;
let bw = 200.0 /. ar;;
let rise = int (0.002 *. ar);;
let fall = int (0.003 *. ar);;
let dur  = int (0.010 *. ar);;
let risetab = blackman3 128;;
let sinetab = osc_sine 1025 (1.0/.1024.0) 0.0;;

let x = fof n 
    ffund 0.0 octavi
    fform bw db
    rise fall dur 
    risetab;;

V.print_text_float x;;

(*** formant sweep *
let ar = 16000.0;;
let n = 16000;;
let octavi = V.const n 0.0;;
let ffund = V.const n (100.0 /. ar);;
let fform = V.count_n_upto (150.0 /. ar) (1000.0 /. ar) n;;
let db = V.const n 0.0;;
let bw = 200.0 /. ar;;
let rise = int (0.002 *. ar);;
let fall = int (0.003 *. ar);;
let dur  = int (0.010 *. ar);;
let risetab = blackman3 128;;
let sinetab = osc_sine 1025 (1.0/.1024.0) 0.0;;

let x = fof n 
    octavi ffund 
    fform db
    bw rise fall dur 
    risetab sinetab;;

V.print_text_float x;;

*)

(*** vox *
let ar = 16000.0;;
let n = 32000;;
let octavi = V.const n 0.0;;
let vibr = vibrato n (6.0 /. ar) (2.0 /. ar) 1.0 0.0;;
let ffund = V.map2 (+.) (V.const n (110.0 /. ar)) vibr;;
let bw = 100.0 /. ar;;
let rise = int (0.002 *. ar);;
let fall = int (0.003 *. ar);;
let dur  = int (0.020 *. ar);;
let risetab = blackman3 128;;
let sinetab = osc_sine 1025 (1.0/.1024.0) 0.0;;

(*
let phoneme_ah = ((730.0, -1.0), (1090.0, -5.0),  (2440.0, -28.0));;
let phoneme_ee = ((270.0, -4.0), (2290.0, -24.0), (3010.0, -28.0));;
*)

let ah_f1 =  730.0 /. ar;;   let ah_db1 =  -1.0;;
let ah_f2 = 1090.0 /. ar;;   let ah_db2 =  -5.0;;
let ah_f3 = 2440.0 /. ar;;   let ah_db3 = -28.0;;

let ee_f1 =  270.0 /. ar;;   let ee_db1 =  -1.0;;
let ee_f2 = 2290.0 /. ar;;   let ee_db2 = -24.0;;
let ee_f3 = 3010.0 /. ar;;   let ee_db3 = -28.0;;

let n1 =   n / 3;;
let n2 = 2*n / 3;;
let  f1 = EV.pwl n ah_f1  [| ah_f1  @@ n1; ee_f1  @@ n2; ee_f1  @@ n |];;
let  f2 = EV.pwl n ah_f2  [| ah_f2  @@ n1; ee_f2  @@ n2; ee_f2  @@ n |];;
let  f3 = EV.pwl n ah_f3  [| ah_f3  @@ n1; ee_f3  @@ n2; ee_f3  @@ n |];;
let db1 = EV.pwl n ah_db1 [| ah_db1 @@ n1; ee_db1 @@ n2; ee_db1 @@ n |];;
let db2 = EV.pwl n ah_db2 [| ah_db2 @@ n1; ee_db2 @@ n2; ee_db2 @@ n |];;
let db3 = EV.pwl n ah_db3 [| ah_db3 @@ n1; ee_db3 @@ n2; ee_db3 @@ n |];;

let x = fof3 n octavi ffund
    (f1, db1)
    (f2, db2)
    (f3, db3)
    bw rise fall dur
    risetab sinetab;;

V.print_text_float x;;

*)