unadspdlib.pas

Voice Commnucation Components for Delphi

	    theta := alpha
	  else
	    theta := beta;
          //
	  ld_out := ld_out * theta;
	  ld_out := ld_out + ld_in * (1.0 - theta);
	  //
	  if (ld_peak) then
	    outa^ := ld_out
	  else
	    outa^ := pow(ld_out, 0.5);
	  //
	  inc(ina);
	  inc(outa);
	end;	// for ...
	//
	f_modified := false;
	//
      end;
    end;
  end;
end;


{ unaDspDL_MbSp }

// --  --
procedure unaDspDL_MbSp.AfterConstruction();
var
  i: int;
begin
  seti(DSPL_PID or DSPL_P_OTHER, 0);
  setc(DSPL_PID or DSPL_P_FRQ, nil, 0);
  setf(DSPL_PID or DSPL_P_Q, pow(2.0, -0.5));
  //
  setc(DSPL_PID or DSPL_P_IN, nil, 0);
  //
  for i := 0 to 255 - 1 do
    setc(DSPL_PID or DSPL_P_OUT or i, nil, 0);
  //
  inherited;
end;

// --  --
procedure unaDspDL_MbSp.BeforeDestruction();
begin
  inherited;
  //
  mrealloc(hpfs);
  mrealloc(mout);
  mrealloc(zin1);
  mrealloc(zin2);
  mrealloc(zout1);
  mrealloc(zout2);
  mrealloc(z2in1);
  mrealloc(z2in2);
  mrealloc(z2out1);
  mrealloc(z2out2);
  mrealloc(acc);
  mrealloc(bcc);
end;

// --  --
constructor unaDspDL_MbSp.create();
begin
  {$IFDEF DEBUG }
  f_nameFull := c_DSPL_OBJNAMES_FULL[DSPL_MBSP];
  f_nameShort := c_DSPL_OBJNAMES_SHORT[DSPL_MBSP];
  {$ENDIF }
  //
  num_filtres := 0;
  hpfs := nil;
  mout := nil;
  zin1 := nil;
  zin2 := nil;
  zout1 := nil;
  zout2 := nil;
  z2in1 := nil;
  z2in2 := nil;
  z2out1 := nil;
  z2out2 := nil;
  acc := nil;
  bcc := nil;
  //
  buffer_length := 0;
  hi_order := 0;
  //
  inherited create(DSPL_OID or DSPL_MBSP);
end;

// --  --
function unaDspDL_MbSp.process(nSamples: dspl_int): dspl_result;
var
  max_slope: dspl_float;
  ina: pFloatArray;
  in_len: dspl_int;
  frqs: pFloatArray;
  q: dspl_float;
  i: int;
  pfa: pFloatArray;
  fin: pdspl_float;
  fout: pdspl_float;
  lin: pdspl_float;
  j: dspl_int;
  lpout: dspl_float;
begin
  max_slope := pow(2.0, -0.5);
  //
  ina := pFloatArray(getc(DSPL_PID or DSPL_P_IN).r_fp);
  in_len := getc(DSPL_PID or DSPL_P_IN).r_len;
  //
  if (in_len < nSamples) then
    result := DSPL_FAILURE
  else begin
    //
    result := DSPL_SUCCESS;
    //
    if (f_modified) then begin
      //
      num_bands := geti(DSPL_PID or DSPL_P_OTHER);
      if ((2 > num_bands) or (255 < num_bands)) then
	result := DSPL_FAILURE
      else begin
	//
	if (num_filtres <> num_bands - 1) then begin
	  //
	  num_filtres := num_bands - 1;
	  //
	  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);
	  //
	  mrealloc(z2in1,  sizeOf(z2in1[0])  * num_filtres);
	  mrealloc(z2in2,  sizeOf(z2in2[0])  * num_filtres);
	  mrealloc(z2out1, sizeOf(z2out1[0]) * num_filtres);
	  mrealloc(z2out2, sizeOf(z2out2[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;
	    //
	    z2in1[i] := 0.0;
	    z2in2[i] := 0.0;
	    z2out1[i] := 0.0;
	    z2out2[i] := 0.0;
	  end;
	end;
	//
	if (getc(DSPL_PID or DSPL_P_FRQ).r_len <> num_filtres) then
	  result := DSPL_FAILURE
	else begin
	  //
	  // prepare filter coefs
	  frqs := pFloatArray(getc(DSPL_PID or DSPL_P_FRQ).r_fp);
	  q := getf(DSPL_PID or DSPL_P_Q);
	  //
	  gain_ref := 1.0;
	  //
	  if (q > max_slope) then begin
	    //
	    q := q / 2.0;
	    hi_order := 1;
	    gain_ref := 0.5;
	  end;
	  //
	  for i := 0 to num_filtres - 1 do
	    dspl_biq(DSPL_BIQ_LP, 1.0, frqs[i], q, hpfs[i], true);
          //
	  // prepare, depending on selected mode
	  mrealloc(mout, sizeOf(mout[0]) * num_bands);
	  for i := 0 to num_bands - 1 do begin
	    //
	    mout[i] := pFloatArray(getc(DSPL_PID or DSPL_P_OUT or i).r_fp);
	    //
	    if (getc(DSPL_PID or DSPL_P_OUT or i).r_len <> in_len) then begin
	      //
	      result := DSPL_FAILURE;
	      break;
	    end;
	  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;
	    //
	    if (nil = mout) then
	      result := DSPL_FAILURE;
	  end;
	end;
      end;
    end;	// if (modified) ...
    //
    if (DSPL_SUCCESS = result) then begin
      //
      for i := 0 to num_filtres - 1 do begin
	//
	if (0 <> hi_order) then
	  dspl_eqmb_filter(hpfs[i], ina, bcc, z2in1[i], z2in2[i], z2out1[i], z2out2[i], nSamples);
	//
	if (0 <> hi_order) then
	  pfa := bcc
	else
	  pfa := ina;
	//
	dspl_eqmb_filter(hpfs[i], pfa, mout[i], zin1[i], zin2[i], zout1[i], zout2[i], nSamples);
	//
	// output
	fin := pdspl_float(acc);
	fout := pdspl_float(mout[i]);
	j := nSamples;
	//
	if (i > 0) then
	  //
	  while (j > 0) do begin
	    //
	    dec(j);
	    //
	    lpout := fout^;
	    fout^ := fout^ - fin^;
	    fin^ := lpout;
	    //
	    inc(fout);
	    inc(fin);
	  end
	else
	  //
	  while (j > 0) do begin
	    //
	    dec(j);
	    //
	    fin^ := fout^;
	    //
	    inc(fout);
	    inc(fin);
	  end;
	//
      end; // for filters..
      //
      fin := pdspl_float(acc);
      fout := pdspl_float(mout[num_filtres]);
      lin := pdspl_float(ina);
      //
      j := nSamples;
      while (j > 0) do begin
	//
	dec(j);
	//
	fout^ := lin^ - fin^;
	//
	inc(fout);
	inc(fin);
	inc(lin);
      end;
      //
      f_modified := false;
    end;
  end;
end;


{ unaDspDL_ND }

// --  --
procedure unaDspDL_ND.AfterConstruction();
begin
  setc(DSPL_PID or DSPL_P_IN, nil, 0);
  setc(DSPL_PID or DSPL_P_OUT, nil, 0);
  //
  setf(DSPL_PID or DSPL_P_NFRQ or DSPL_ND_SAMPLE_RATE, DSPL_DEFAULT_SAMPLE_FRQ);
  setf(DSPL_PID or DSPL_P_NFRQ or DSPL_ND_BAND_HP, 300.0);
  setf(DSPL_PID or DSPL_P_NFRQ or DSPL_ND_BAND_LP, 3000.0);
  //
  setf(DSPL_PID or DSPL_P_THRESHOLD or 0, 0.7);
  //
  setf(DSPL_PID or DSPL_P_OTHER or 0, 1.0);
  //
  inherited;
end;

// --  --
procedure unaDspDL_ND.BeforeDestruction();
begin
  inherited;
  //
  mrealloc(bl_buf);
  mrealloc(bp_buf);
  mrealloc(sl_buf);
  mrealloc(pl_buf);
  //
  freeAndNil(bp);
  freeAndNil(bl);
  freeAndNil(sl);
  freeAndNil(pl);
end;

// --  --
constructor unaDspDL_ND.create();
begin
  {$IFDEF DEBUG }
  f_nameFull := c_DSPL_OBJNAMES_FULL[DSPL_ND];
  f_nameShort := c_DSPL_OBJNAMES_SHORT[DSPL_ND];
  {$ENDIF }
  //
  bp := unaDspDL_EQ2B.create();
  bl := unaDspDL_LD.create();
  sl := unaDspDL_LD.create();
  pl := unaDspDL_LD.create();
  //
  bl_buf := nil;
  pl_buf := nil;
  sl_buf := nil;
  bp_buf := nil;
  //
  lr := 1;
  dr := 0;
  //
  inherited create(DSPL_OID or DSPL_ND);
end;

// --  --
function unaDspDL_ND.process(nSamples: dspl_int): dspl_result;
var
  in_chunk: dspl_chunk;
  out_chunk: dspl_chunk;
  outa: pdspl_float;
  ina: pdspl_float;
  out_len: dspl_int;
  slope: dspl_double;
  sample_rate: dspl_float;
  i: dspl_int;
  acc: pdspl_float;
  sll: pdspl_float;
  bll: pdspl_float;
  pll: pdspl_float;
begin
  in_chunk := getc(DSPL_PID or DSPL_P_IN)^;
  out_chunk := getc(DSPL_PID or DSPL_P_OUT)^;
  //
  outa := nil;
  if (nil <> out_chunk.r_fp) then
    outa := out_chunk.r_fp;
  //
  ina := in_chunk.r_fp;
  //
  out_len := nSamples;
  if (out_len > in_chunk.r_len) then
    //
    result := DSPL_FAILURE
  else begin
    //
    result := DSPL_SUCCESS;
    if (f_modified) then begin
      //
      noise_level := db2v(-25.0);
      //
      if (buffer_length < out_len) then begin
	//
	buffer_length := out_len;
	//
	mrealloc(sl_buf, sizeOf(sl_buf^) * buffer_length);
	mrealloc(bp_buf, sizeOf(bp_buf^) * buffer_length);
	mrealloc(bl_buf, sizeOf(bl_buf^) * buffer_length);
	mrealloc(pl_buf, sizeOf(pl_buf^) * buffer_length);
      end;
      //
      slope := pow(2.0, -0.5);
      //
      sample_rate := getf(DSPL_PID or DSPL_P_NFRQ or DSPL_ND_SAMPLE_RATE);
      //
      bp.seti(DSPL_PID or DSPL_P_TYPE or DSPL_EQ2B_BAND1, DSPL_EQ2B_HP);
      bp.setf(DSPL_PID or DSPL_P_FRQ  or DSPL_EQ2B_BAND1, getf(DSPL_PID or DSPL_P_NFRQ or DSPL_ND_BAND_HP) / sample_rate);
      bp.setf(DSPL_PID or DSPL_P_Q    or DSPL_EQ2B_BAND1, slope);
      //
      bp.seti(DSPL_PID or DSPL_P_TYPE or DSPL_EQ2B_BAND2, DSPL_EQ2B_LP);
      bp.setf(DSPL_PID or DSPL_P_FRQ  or DSPL_EQ2B_BAND2, getf(DSPL_PID or DSPL_P_NFRQ or DSPL_ND_BAND_LP) / sample_rate);
      bp.setf(DSPL_PID or DSPL_P_Q    or DSPL_EQ2B_BAND2, slope);
      //
      bl.seti(DSPL_PID or DSPL_P_TYPE,    DSPL_LD_RMS);
      bl.setf(DSPL_PID or DSPL_P_ATTACK,  0.050 * sample_rate);
      bl.setf(DSPL_PID or DSPL_P_RELEASE, 0.050 * sample_rate);
      //
      sl.seti(DSPL_PID or DSPL_P_TYPE,    DSPL_LD_RMS);
      sl.setf(DSPL_PID or DSPL_P_ATTACK,  0.050 * sample_rate);
      sl.setf(DSPL_PID or DSPL_P_RELEASE, 0.050 * sample_rate);
      //
      pl.seti(DSPL_PID or DSPL_P_TYPE,    DSPL_LD_RMS);
      pl.setf(DSPL_PID or DSPL_P_ATTACK,  0.010 * sample_rate);
      pl.setf(DSPL_PID or DSPL_P_RELEASE, 0.010 * sample_rate);
      pl.setf(DSPL_PID or DSPL_P_OTHER,   0.010 * sample_rate);
      //
      pl.setc(DSPL_PID or DSPL_P_OUT, pl_buf, out_len);
      sl.setc(DSPL_PID or DSPL_P_OUT, sl_buf, out_len);
      bp.setc(DSPL_PID or DSPL_P_OUT, bp_buf, out_len);
      //
      bl.setc(DSPL_PID or DSPL_P_IN,  bp_buf, out_len);
      bl.setc(DSPL_PID or DSPL_P_OUT, bl_buf, out_len);
      //
      sensivity := getf(DSPL_PID or DSPL_P_THRESHOLD);
      smoothing := (getf(DSPL_PID or DSPL_P_OTHER) * sample_rate - 1) / (getf(DSPL_PID or DSPL_P_OTHER) * sample_rate + 1);
      //
    end;	// if (modified) ...
    //
    // ina may change, even if modified = false
    pl.setc(DSPL_PID or DSPL_P_IN, ina, out_len);
    sl.setc(DSPL_PID or DSPL_P_IN, ina, out_len);
    bp.setc(DSPL_PID or DSPL_P_IN, ina, out_len);
    //
    bp.process(nSamples);
    bl.process(nSamples);
    sl.process(nSamples);
    pl.process(nSamples);
    //
    i := nSamples;
    acc := outa;
    sll := sl_buf;
    bll := bl_buf;
    pll := pl_buf;
    //
    while (i > 0) do begin
      //
      dec(i);
      //
      if (bll^ / sll^ > sensivity) then
	noise_level := db2v(-3.0) * pll^ * (1 - smoothing) + smoothing * noise_level;
      //
      if (nil <> outa) then begin
	//
	acc^ := noise_level;
	inc(acc);
      end;
      //
      inc(sll);
      inc(bll);
      inc(pll);
    end;	// while ...
    //
    setf(DSPL_PID or DSPL_P_OUT, noise_level);
    //
    f_modified := false;
  end;
end;


{ unaDspDL_DynProc }

// --  --
procedure unaDspDL_DynProc.AfterConstruction();
begin
  setc(DSPL_PID or DSPL_P_IN or DSPL_DYNPROC_IN, nil, 0);
  setc(DSPL_PID or DSPL_P_IN or DSPL_DYNPROC_SC, nil, 0);
  setc(DSPL_PID or DSPL_P_OUT or 0, nil, 0);
  //
  // Level detector
  seti(DSPL_PID or DSPL_P_TYPE or DSPL_LD, DSPL_LD_RMS);
  setf(DSPL_PID or DSPL_P_ATTACK or DSPL_LD,  44.0);
  setf(DSPL_PID or DSPL_P_RELEASE or DSPL_LD, 44.0);
  setf(DSPL_PID or DSPL_P_OTHER or DSPL_LD,    0.0);
  //
  // Gain Processor
  setf(DSPL_PID or DSPL_P_ATTACK or 0,  220.5);
  setf(DSPL_PID or DSPL_P_RELEASE or 0, 2205.0);
  //
  setf(DSPL_PID or DSPL_P_THRESHOLD or 0, db2v(-12.0));
  //
  setf(DSPL_PID or DSPL_P_RATIO or DSPL_DYNPROC_ABOVE, 4.0);
  setf(DSPL_PID or DSPL_P_RATIO or DSPL_DYNPROC_BELOW, 1.0);
  //
  setf(DSPL_PID or DSPL_P_GAIN or DSPL_DYNPROC_ABOVE, db2v(0.0));
  setf(DSPL_PID or DSPL_P_GAIN or DSPL_DYNPROC_BELOW, db2v(0.0));
  //
  // number of samples over threshold
  seti(DSPL_PID or DSPL_P_OTHER or 0, 0);
  //
  inherited;
end;

// --  --
procedure unaDspDL_DynProc.BeforeDestruction();
begin
  inherited;
  //
  mrealloc(ld_buffer);
  freeAndNil(level_detector);
end;

// --  --
constructor unaDspDL_DynProc.create();
begin
  {$IFDEF DEBUG }
  f_nameFull := c_DSPL_OBJNAMES_FULL[DSPL_DYNPROC];
  f_nameShort := c_DSPL_OBJNAMES_SHORT[DSPL_DYNPROC];
  {$ENDIF }
  //
  level_detector := unaDspDL_LD.create();
  //
  ld_buffer := nil;
  ld_buffer_size := 0;
  gain_env := 0;