Changeset 6711

Show
Ignore:
Timestamp:
07/01/09 17:41:55 (14 months ago)
Author:
smimram
Message:

ADSR envelopes, we now have a decent sound :)

Location:
trunk/liquidsoap/src/synth
Files:
2 modified

Legend:

Unmodified
Added
Removed

  • trunk/liquidsoap/src/synth/synth.ml

    r6707 r6711  
    1111  method note_off : int -> float -> unit 
    1212 
    13   method synth : float -> float array array -> int -> int -> unit 
     13  method synth : float -> float array array -> int -> int -> float array array -> unit 
    1414 
    1515  method reset : unit 
    … …  
    4747    (* Limit the number of notes for now. TODO: parameter *) 
    4848    (* if List.length notes > 16 then notes <- List.rev (List.tl (List.rev notes)); *) 
    49     notes <- (n, ref (self#note_init n v))::notes 
     49    notes <- (n, self#note_init n v)::notes 
    5050 
    5151  method note_off n (v:float) = 
    … …  
    5353    notes <- List.filter (fun (m, _) -> m <> n) notes 
    5454 
    55   method synth_note_mono (gs:'gs) (ns:'ns) (freq:float) (buf:float array) (ofs:int) (len:int) = gs, ns 
     55  method synth_note_mono (gs:'gs) (ns:'ns) (freq:float) (buf:float array) (ofs:int) (len:int) = gs 
    5656 
    5757  method synth_note gs ns freq buf ofs len = 
    58     let s = ref None in 
    59     let chans = Array.length buf in 
    60       for c = 0 to chans - 1 do 
    61         s := Some (self#synth_note_mono gs ns freq buf.(c) ofs len) 
     58    let s = self#synth_note_mono gs ns freq buf.(0) ofs len in 
     59      for c = 1 to Array.length buf - 1 do 
     60        Float_pcm.float_blit buf.(0) ofs buf.(c) ofs len 
    6261      done; 
    63       match !s with 
    64         | Some s -> s 
    65         | None -> gs, ns 
    66  
    67   method synth freq buf ofs len = 
     62      s 
     63 
     64  (* tmpbuf is used to generate notes separately. It should be of length at 
     65   * least len. *) 
     66  method synth freq buf ofs len tmpbuf = 
    6867    let gs = ref self#state in 
    6968      List.iter 
    7069        (fun (_, ns) -> 
    71            let gs', ns' = self#synth_note self#state !ns freq buf ofs len in 
    72              gs := gs'; 
    73              ns := ns' 
     70           let gs' = self#synth_note self#state ns freq tmpbuf 0 len in 
     71             Float_pcm.add buf ofs tmpbuf 0 len; 
     72             gs := gs' 
    7473        ) notes; 
    7574      state <- Some !gs 
    76 end 
     75 
     76  method adsr adsr st buf ofs len = 
     77    let a,(d:int),s,(r:int) = adsr in 
     78    let state, state_pos = st in 
     79      match state with 
     80        | 0 -> 
     81            let fa = float a in 
     82              for c = 0 to Array.length buf - 1 do 
     83                let bufc = buf.(c) in 
     84                for i = 0 to min len (a - state_pos) - 1 do 
     85                  bufc.(ofs + i) <- float (state_pos + i) /. fa *. bufc.(ofs + i) 
     86                done 
     87              done; 
     88              if len < a - state_pos then 
     89                0, state_pos + len 
     90              else 
     91                self#adsr adsr (1,0) buf (ofs + a - state_pos) (len - (a - state_pos)) 
     92        | 1 -> 
     93            let fd = float d in 
     94              for c = 0 to Array.length buf - 1 do 
     95                let bufc = buf.(c) in 
     96                for i = 0 to min len (d - state_pos) - 1 do 
     97                  bufc.(ofs + i) <- (1. -. float (state_pos + i) /. fd *. (1. -. s)) *. bufc.(ofs + i) 
     98                done 
     99              done; 
     100              if len < d - state_pos then 
     101                1, state_pos + len 
     102              else 
     103                self#adsr adsr (2,0) buf (ofs + d - state_pos) (len - (d - state_pos)) 
     104        | 2 -> 
     105            Float_pcm.multiply buf ofs len s; 
     106            st 
     107        | 3 -> 
     108            let fr = float r in 
     109              for c = 0 to Array.length buf - 1 do 
     110                let bufc = buf.(c) in 
     111                for i = 0 to min len (r - state_pos) - 1 do 
     112                  bufc.(ofs + i) <- s *. (1. -. float (state_pos + i) /. fr) *. bufc.(ofs + i) 
     113                done 
     114              done; 
     115              if len < r - state_pos then 
     116                3, state_pos + len 
     117              else 
     118                self#adsr adsr (4,0) buf (ofs + r - state_pos) (len - (r - state_pos)) 
     119        | 4 -> 
     120            Printf.printf "state 4\n%!"; 
     121            Float_pcm.blankify buf ofs len; 
     122            st 
     123        | _ -> assert false 
     124end 
     125 
     126type adsr_state = int * int (* state (A/D/S/R/dead), position in the state *) 
     127 
     128(** Initial adsr state. *) 
     129let adsr_init () = 0, 0 
     130 
     131(** Convert adsr in seconds to samples. *) 
     132let samples_of_adsr (a,d,s,r) = 
     133  Fmt.samples_of_seconds a, Fmt.samples_of_seconds d, s, Fmt.samples_of_seconds r 
    77134 
    78135type simple_gs = unit 
    … …  
    80137type simple_ns = 
    81138    { 
    82       simple_phase : float; 
     139      mutable simple_phase : float; 
    83140      simple_freq : float; 
    84141      simple_ampl : float; 
     142      mutable simple_adsr : adsr_state; 
    85143    } 
    86144 
    87 class simple f = 
     145class simple ?adsr f = 
    88146object (self) 
    89   inherit [simple_gs, simple_ns] base 
     147  inherit [simple_gs, simple_ns] base as super 
     148 
     149  val adsr = 
     150    match adsr with 
     151      | Some adsr -> Some (samples_of_adsr adsr) 
     152      | None -> None 
    90153 
    91154  method state_init = () 
    92155 
    93   method note_init n v = { simple_phase = 0.; simple_freq = freq_of_note n; simple_ampl = v } 
     156  method note_init n v = 
     157    { 
     158      simple_phase = 0.; 
     159      simple_freq = freq_of_note n; 
     160      simple_ampl = v; 
     161      simple_adsr = adsr_init (); 
     162    } 
     163 
     164  method note_off n v = 
     165    if adsr = None then 
     166      super#note_off n v 
     167    else 
     168      List.iter (fun (nn, ns) -> if nn = n then ns.simple_adsr <- (3,0)) notes 
    94169 
    95170  method synth_note_mono gs ns freq buf ofs len = 
    96171    let phase i = ns.simple_phase +. float i /. freq *. ns.simple_freq in 
    97172      for i = ofs to ofs + len - 1 do 
    98         buf.(i) <- buf.(i) +. volume *. ns.simple_ampl *. f (phase i) 
     173        buf.(i) <- volume *. ns.simple_ampl *. f (phase i) 
    99174      done; 
    100       gs, { ns with simple_phase = fst (modf (phase len)) } 
    101 end 
    102  
    103 class sine = object inherit simple (fun x -> sin (x *. 2. *. pi)) end 
    104  
    105 class square = object inherit simple (fun x -> let x = fst (modf x) in if x < 0.5 then 1. else -1.) end 
    106  
    107 class saw = 
     175      ns.simple_phase <- fst (modf (phase len)); 
     176      match adsr with 
     177        | Some adsr -> 
     178            ns.simple_adsr <- self#adsr adsr ns.simple_adsr [|buf|] ofs len; 
     179            gs 
     180        | None -> gs 
     181 
     182  method synth freq buf ofs len tmpbuf = 
     183    if adsr <> None then 
     184      notes <- List.filter (fun (_, ns) -> fst ns.simple_adsr < 4) notes; 
     185    super#synth freq buf ofs len tmpbuf 
     186end 
     187 
     188class sine ?adsr () = object inherit simple ?adsr (fun x -> sin (x *. 2. *. pi)) end 
     189 
     190class square ?adsr () = object inherit simple ?adsr (fun x -> let x = fst (modf x) in if x < 0.5 then 1. else -1.) end 
     191 
     192class saw ?adsr () = 
    108193object 
    109   inherit simple 
     194  inherit simple ?adsr 
    110195    (fun x -> 
    111196       let x = fst (modf x) in 

  • trunk/liquidsoap/src/synth/synth_op.ml

    r6709 r6711  
    3838  method abort_track = source#abort_track 
    3939 
     40  val tmpbuf = Frame.make () 
     41 
    4042  method private get_frame buf = 
    4143    let offset = AFrame.position buf in 
    … …  
    4648    let position = AFrame.position buf in 
    4749    let sps = float (Fmt.samples_per_second ()) in 
     50    let tmpbuf = AFrame.get_float_pcm tmpbuf in 
    4851    let rec process evs off = 
    4952      match evs with 
    5053        | (t,e)::tl -> 
    5154            let t = Fmt.samples_of_ticks t in 
    52               synth#synth sps b off (t - off); 
     55              synth#synth sps b off (t - off) tmpbuf; 
    5356              ( 
    5457                match e with 
    … …  
    6366              process tl t 
    6467        | [] -> 
    65             synth#synth sps b off (position - off) 
     68            synth#synth sps b off (position - off) tmpbuf 
    6669    in 
    6770      process evs offset 
    … …  
    7376      "channel", Lang.int_t, Some (Lang.int 0), Some "MIDI channel to handle."; 
    7477      "volume", Lang.float_t, Some (Lang.float 0.3), Some "Initial volume."; 
     78      "attack", Lang.float_t, Some (Lang.float 0.02), Some "Envelope attack (in seconds)."; 
     79      "decay", Lang.float_t, Some (Lang.float 0.01), Some "Envelope decay (in seconds)."; 
     80      "sustain", Lang.float_t, Some (Lang.float 0.9), Some "Envelope sustain level."; 
     81      "release", Lang.float_t, Some (Lang.float 0.05), Some "Envelope release (in seconds)."; 
    7582      "", Lang.source_t, None, None 
    7683    ] 
    … …  
    8188       let chan = Lang.to_int (f "channel") in 
    8289       let volume = Lang.to_float (f "volume") in 
     90       let adsr = 
     91         Lang.to_float (f "attack"), 
     92         Lang.to_float (f "decay"), 
     93         Lang.to_float (f "sustain"), 
     94         Lang.to_float (f "release") 
     95       in 
    8396       let src = Lang.to_source (f "") in 
    84          new synth (obj ()) src chan volume); 
     97         new synth (obj adsr) src chan volume); 
    8598  Lang.add_operator ("synth.all." ^ name) 
    8699    [ 
     100      "attack", Lang.float_t, Some (Lang.float 0.02), Some "Envelope attack (in seconds)."; 
     101      "decay", Lang.float_t, Some (Lang.float 0.01), Some "Envelope decay (in seconds)."; 
     102      "sustain", Lang.float_t, Some (Lang.float 0.9), Some "Envelope sustain level."; 
     103      "release", Lang.float_t, Some (Lang.float 0.01), Some "Envelope release (in seconds)."; 
    87104      "", Lang.source_t, None, None 
    88105    ] 
    … …  
    92109       let f v = List.assoc v p in 
    93110       let src = Lang.to_source (f "") in 
    94        let synths = Array.init (Fmt.midi_channels ()) (fun c -> 1, new synth (obj ()) src c 1.) in 
     111       let adsr = 
     112         Lang.to_float (f "attack"), 
     113         Lang.to_float (f "decay"), 
     114         Lang.to_float (f "sustain"), 
     115         Lang.to_float (f "release") 
     116       in 
     117       let synths = Array.init (Fmt.midi_channels ()) (fun c -> 1, new synth (obj adsr) src c 1.) in 
    95118       let synths = Array.to_list synths in 
    96119         new Add.add ~renorm:false synths 
    … …  
    99122    ) 
    100123 
    101 let () = register (fun () -> (new Synth.sine :> Synth.synth)) "sine" "Sine synthesizer." 
    102 let () = register (fun () -> (new Synth.square :> Synth.synth)) "square" "Square synthesizer." 
    103 let () = register (fun () -> (new Synth.saw :> Synth.synth)) "saw" "Saw synthesizer." 
     124let () = register (fun adsr -> (new Synth.sine ~adsr () :> Synth.synth)) "sine" "Sine synthesizer." 
     125let () = register (fun adsr -> (new Synth.square ~adsr () :> Synth.synth)) "square" "Square synthesizer." 
     126let () = register (fun adsr -> (new Synth.saw ~adsr () :> Synth.synth)) "saw" "Saw synthesizer."