unadspdlib.pas

Voice Commnucation Components for Delphi

    f_modified := false;
    //
    result := DSPL_SUCCESS;
  end;
end;

// --  --
function unaDspDL_EQ2B.prepare_biq(band: dspl_int; len: dspl_int; var step: dspl_int; buf: pdspl_biq_values; var buff_size: dspl_int): pdspl_biq_values;
var
  t: int;
  btype: dspl_int;
  gain_c, frq_c, q_c: dspl_float;
  gain_s, frq_s, q_s: dspl_int;
  gain, frq, q: pdspl_float;
  b: pdspl_biq_values;
begin
  if ((nil = getc(DSPL_PID or DSPL_P_GAIN or band).r_fp) and
      (nil = getc(DSPL_PID or DSPL_P_Q or band).r_fp) and
      (nil = getc(DSPL_PID or DSPL_P_FRQ or band).r_fp)
     ) then begin
    //
    // -- static biq --
    //
    if (f_modified) then begin
      //
      if (1 <> buff_size) then begin
	//
	mrealloc(buf, sizeOf(buf^));
	buff_size := 1;
      end;
      //
      dspl_biq(geti(DSPL_PID or DSPL_P_TYPE or band),
	       getf(DSPL_PID or DSPL_P_GAIN or band),
	       getf(DSPL_PID or DSPL_P_FRQ or band),
	       getf(DSPL_PID or DSPL_P_Q or band),
	       buf^,
	       true
	      );
      //
    end;
    //
    step := 0;
  end
  else begin
    //
    // -- dynamic biq --
    //
    if (buff_size < len) then begin
      //
      mrealloc(buf, sizeOf(buf^) * len);
      buff_size := len;
    end;
    //
    btype := geti(DSPL_PID or DSPL_P_TYPE or band);
    gain_s := 1;
    frq_s := 1;
    q_s := 1;
    //
    gain := getc(DSPL_PID or DSPL_P_GAIN or band).r_fp;
    frq := getc(DSPL_PID or DSPL_P_FRQ or band).r_fp;
    q := getc(DSPL_PID or DSPL_P_Q or band).r_fp;
    //
    if (nil = gain) then begin
      //
      gain_s := 0;
      gain_c := getf(DSPL_PID or DSPL_P_GAIN or band);
      gain := @gain_c;
    end;
    //
    if (nil = frq) then begin
      //
      frq_s := 0;
      frq_c := getf(DSPL_PID or DSPL_P_FRQ or band);
      frq := @frq_c;
    end;
    //
    if (nil = q) then begin
      //
      q_s := 0;
      q_c := getf(DSPL_PID or DSPL_P_Q or band);
      q := @q_c;
    end;
    //
    if (0 < len) then begin
      //
      b := buf;
      for t := 0 to len - 1 do begin
	//
	dspl_biq(btype, gain^, frq^, q^, b^, true);
	//
	inc(gain, gain_s);
	inc(frq, frq_s);
	inc(q, q_s);
	inc(b, t);
      end;
    end;
    //
    step := 1;
  end;
  //
  result := buf;
end;

// --  --
constructor unaDspDL_EQ2B.create();
begin
  {$IFDEF DEBUG }
  f_nameFull := c_DSPL_OBJNAMES_FULL[DSPL_EQ2B];
  f_nameShort := c_DSPL_OBJNAMES_SHORT[DSPL_EQ2B];
  {$ENDIF }
  //
  biq_f1 := nil;
  biq_f2 := nil;
  biq_f1_buff_size := 0;
  biq_f2_buff_size := 0;
  //
  f1in1 := 0;
  f1in2 := 0;
  f1out1 := 0;
  f1out2 := 0;
  f2in1 := 0;
  f2in2 := 0;
  f2out1 := 0;
  f2out2 := 0;
  //
  inherited create(DSPL_OID or DSPL_EQ2B);
end;


{ unaDspDL_EQMB }

// --  --
procedure unaDspDL_EQMB.AfterConstruction();
begin
  seti(DSPL_PID or DSPL_P_OTHER or 0, 0);
  //
  setc(DSPL_PID or DSPL_P_FRQ  or 0, nil, 0);
  setc(DSPL_PID or DSPL_P_GAIN or 0, nil, 0);
  //
  setc(DSPL_PID or DSPL_P_IN   or 0, nil, 0);
  setc(DSPL_PID or DSPL_P_OUT  or 0, nil, 0);
  //
  inherited;
end;

// --  --
procedure unaDspDL_EQMB.BeforeDestruction();
begin
  inherited;
  //
  mrealloc(hpfs);
  mrealloc(zin1);
  mrealloc(zin2);
  mrealloc(zout1);
  mrealloc(zout2);
  mrealloc(acc);
  mrealloc(bcc);
end;

// --  --
constructor unaDspDL_EQMB.create();
begin
  {$IFDEF DEBUG }
  f_nameFull := c_DSPL_OBJNAMES_FULL[DSPL_EQMB];
  f_nameShort := c_DSPL_OBJNAMES_SHORT[DSPL_EQMB];
  {$ENDIF }
  //
  num_filtres := 0;
  //
  hpfs := nil;
  zin1 := nil;
  zin2 := nil;
  //
  zout1 := nil;
  zout2 := nil;
  acc := nil;
  bcc := nil;
  //
  buffer_length := 0;
  //
  inherited create(DSPL_OID or DSPL_EQMB);
end;

// --  --
procedure dspl_eqmb_filter(var hpf: dspl_biq_values; fin: pFloatArray; fout: pFloatArray; var zin1: dspl_float; var zin2: dspl_float; var zout1: dspl_float; var zout2: dspl_float; length: dspl_int);
var
  fin1,
  fin2,
  fout1,
  fout2: dspl_float;
  i, j: int;
begin
  // save filter  state
  fin1 := zin1;
  fin2 := zin2;
  fout1 := zout1;
  fout2 := zout2;
  //
  i := 0;
  j := length;
  while (j > 0) do begin
    //
    dec(j);
    //
    fout[i] := hpf.b0 * fin[i] + hpf.b1 * fin1 + hpf.b2 * fin2 + hpf.a1 * fout1 + hpf.a2 * fout2;
    //
    fin2 := fin1;
    fin1 := fin[i];
    fout2 := fout1;
    fout1 := fout[i];
    //
    inc(i);
  end;
  //
  // restoring filter state
  zin1 := fin1;
  zin2 := fin2;
  zout1 := fout1;
  zout2 := fout2;
end;

// --  --
function unaDspDL_EQMB.process(nSamples: dspl_int): dspl_result;
var
  //max_slope: dspl_float;
  inf: pFloatArray;
  outf: pFloatArray;
  a, b: pFloatArray;
  in_len: int;
  i: int;
  frqs: pFloatArray;
  gain: pFloatArray;
  fl: dspl_float;
  w: dspl_float;
begin
  //  max_slope := pow(2.0, -0.5);
  //
  inf :=  pFloatArray(getc(DSPL_PID or DSPL_P_IN).r_fp);
  outf := pFloatArray(getc(DSPL_PID or DSPL_P_OUT).r_fp);
  //
  result := DSPL_SUCCESS;
  //
  in_len := getc(DSPL_PID or DSPL_P_IN).r_len;
  if (in_len < nSamples) then
    //
    result := DSPL_FAILURE
  else begin
    //
    if (f_modified) then begin
      //
      if (in_len <> getc(DSPL_PID or DSPL_P_OUT).r_len) then
	//
	result := DSPL_FAILURE
      else begin
	//
	if (num_filtres <> geti(DSPL_PID or DSPL_P_OTHER)) then begin
	  //
	  num_filtres := geti(DSPL_PID or DSPL_P_OTHER);
	  if ((num_filtres < 1) or (num_filtres > 32)) then
	    //
	    result := DSPL_FAILURE
	  else begin
	    //
	    mrealloc(hpfs,  sizeOf(hpfs[0]) * num_filtres);
	    //
	    mrealloc(zin1,  sizeOf(zin1[0])  * num_filtres);
	    mrealloc(zin2,  sizeOf(zin2[0])  * num_filtres);
	    mrealloc(zout1, sizeOf(zout1[0]) * num_filtres);
	    mrealloc(zout2, sizeOf(zout2[0]) * num_filtres);
	    //
	    for i := 0 to num_filtres - 1 do begin
	      //
	      zin1[i] := 0.0;
	      zin2[i] := 0.0;
	      zout1[i] := 0.0;
	      zout2[i] := 0.0;
	    end;
	    //
	  end;
	end;
	//
	if (DSPL_SUCCESS = result) then
	  if (getc(DSPL_PID or DSPL_P_FRQ).r_len < num_filtres) then
	    result := DSPL_FAILURE;
	//
	if (DSPL_SUCCESS = result) then
	  if (getc(DSPL_PID or DSPL_P_GAIN).r_len < num_filtres) then
	    result := DSPL_FAILURE;
	//
	if (DSPL_SUCCESS = result) then begin
	  // prepare filter coefs
	  frqs := pFloatArray(getc(DSPL_PID or DSPL_P_FRQ).r_fp);
	  gain := pFloatArray(getc(DSPL_PID or DSPL_P_GAIN).r_fp);
	  //
	  for i := 0 to num_filtres - 1 do begin
	    //
	    if ((frqs[i] < 1e-10) or (frqs[i] > 1.0)) then begin
	      //
	      result := DSPL_FAILURE;
	      break;
	    end;
	    //
	    if ((i > 0) and (i < num_filtres - 1)) then
	      //
	      fl := max(frqs[i] / frqs[i - 1], frqs[i + 1] / frqs[i])
	    else
	      if (i = 0) then
		fl := frqs[i + 1] / frqs[i]
	      else
		fl := frqs[i] / frqs[i - 1];
	    //
	    w := 2.0 * pi * frqs[i];
	    //
	    dspl_biq(DSPL_BIQ_PEAK, gain[i], frqs[i], 0.5 / (sinh(log2(fl) * 0.5 * w / sin(w))), hpfs[i], true);
	  end;
	  //
	  if (DSPL_SUCCESS = result) then begin
	    //
	    if (buffer_length <> in_len) then begin
	      //
	      buffer_length := in_len;
	      mrealloc(acc, sizeOf(acc[0]) * buffer_length);
	      //
	      mrealloc(bcc, sizeOf(bcc[0]) * buffer_length);
	    end;
	  end;
	  //
	end;
      end;	// if (in_len is OK)
    end;	// if (modified) then ...
    //
    if (DSPL_SUCCESS = result) then begin
      //
      for i := 0 to num_filtres - 1 do begin
	//
	if (0 = i) then
	  a := inf
	else
	  if (0 = (i and $01)) then
	    a := bcc
	  else
	    a := acc;
	//
	if (i = num_filtres - 1) then
	  b := outf
	else
	  if (0 = (i and $1)) then
	    b := acc
	  else
	    b := bcc;

	//
	dspl_eqmb_filter(hpfs[i], a, b, zin1[i], zin2[i], zout1[i], zout2[i], nSamples);
      end;
      //
      f_modified := false;
    end;
  end;
end;


{ unaDspDL_LD }

// --  --
procedure unaDspDL_LD.AfterConstruction();
begin
  setc(DSPL_PID or DSPL_P_IN,  nil, 0);
  setc(DSPL_PID or DSPL_P_OUT, nil, 0);
  //
  seti(DSPL_PID or DSPL_P_TYPE, DSPL_LD_RMS);
  //
  setf(DSPL_PID or DSPL_P_ATTACK,  44.1);
  setf(DSPL_PID or DSPL_P_RELEASE, 88.2);
  setf(DSPL_PID or DSPL_P_OTHER,   0.0);
  //
  inherited;
end;

// --  --
procedure unaDspDL_LD.BeforeDestruction();
begin
  inherited;
  //
  mrealloc(peak_buffer);
end;

// --  --
constructor unaDspDL_LD.create();
begin
  {$IFDEF DEBUG }
  f_nameFull := c_DSPL_OBJNAMES_FULL[DSPL_LD];
  f_nameShort := c_DSPL_OBJNAMES_SHORT[DSPL_LD];
  {$ENDIF }
  //
  peak_buffer := nil;
  pb_size := 0;
  ld_out := 0.0;
  //
  inherited create(DSPL_OID or DSPL_LD);
end;

// --  --
function unaDspDL_LD.process(nSamples: dspl_int): dspl_result;
var
  gain6db: dspl_float;
  in_chunk: pdspl_chunk;
  out_chunk: pdspl_chunk;
  ina: pdspl_float;
  outa: pdspl_float;
  out_len: dspl_int;
  attack_samples: dspl_float;
  release_samples: dspl_float;
  pb_samples: dspl_float;
  i, t: dspl_int;
  ld_in: dspl_double;
  theta: dspl_double;
begin
  gain6db := db2v(+6.0);
  //
  in_chunk  := getc(DSPL_PID or DSPL_P_IN);
  out_chunk := getc(DSPL_PID or DSPL_P_OUT);
  //
  if (in_chunk.r_len <> out_chunk.r_len) then
    result := DSPL_FAILURE
  else begin
    //
    result := DSPL_SUCCESS;
    //
    ina  := in_chunk.r_fp;
    outa := out_chunk.r_fp;
    //
    if (not assigned(ina) or not assigned(outa)) then
      result := DSPL_FAILURE
    else begin
      //
      out_len := out_chunk.r_len;
      if ((out_len <> in_chunk.r_len) or (out_len < nSamples)) then
	result := DSPL_FAILURE
      else begin
	//
	if (f_modified) then begin
	  //
	  attack_samples  := 0.5 * getf(DSPL_PID or DSPL_P_ATTACK);
	  release_samples := 0.5 * getf(DSPL_PID or DSPL_P_RELEASE);
	  //
	  alpha := attack_samples / (attack_samples + 2.0);
	  beta  := release_samples / (release_samples + 2.0);
	  //
	  ld_peak := (DSPL_LD_PEAK = geti(DSPL_PID or DSPL_P_TYPE));
	  if (ld_peak) then begin
	    //
	    pb_samples := attack_samples;
	    if (issetf(DSPL_PID or DSPL_P_OTHER) and (0 < getf(DSPL_PID or DSPL_P_OTHER))) then
	      pb_samples := 0.5 * getf(DSPL_PID or DSPL_P_OTHER);
	    //
	    if (ceil(pb_samples) <> pb_size) then begin
	      //
	      pb_size := ceil(pb_samples);
	      mrealloc(peak_buffer, sizeOf(peak_buffer[0]) * pb_size);
	      //
	      pb_pos := 0;
	      peak_pos := -1;
	    end;
	  end;
	  //
	end;	// if (modified) ...
	//
	for t := 0 to nSamples - 1 do begin
	  //
	  if (ld_peak) then begin
	    //
	    ld_in := Abs(ina^);
	    //
	    peak_buffer[pb_pos] := ld_in;
	    if (pb_pos = peak_pos) then begin
	      //
	      i := pb_size - 1;
	      //
	      peak_pos := i;
	      peak_value := peak_buffer[i];
	      //
	      while (i > 0) do begin
		//
		dec(i);
		//
		if (peak_value < peak_buffer[i]) then begin
		  //
		  peak_pos := i;
		  peak_value := peak_buffer[i];
		end;
	      end;
	    end
	    else
	      if (ld_in > peak_value) then begin
		//
		peak_value := ld_in;
		peak_pos := pb_pos;
	      end;
	    //
	    inc(pb_pos);
	    if (pb_pos = pb_size) then
	      pb_pos := 0;
	    //
	    ld_in := peak_value;
	  end
	  else
	    ld_in := gain6db * ina^ * ina^;
	  //
	  if (ld_in > ld_out) then