unadspdlib.pas

Voice Commnucation Components for Delphi

(*

	  DSPDLib
	----------------------------------------------
	  This source code cannot be used without
	  proper license granted to you as a private
	  person or an entity by the Lake of Soft, Ltd

	  Visit http://lakeofsoft.com/ for more information.

	  Copyright (c) 2006, 2007 Lake of Soft, Ltd
		     All rights reserved
	----------------------------------------------

	  created by:
		DSP Lib team, Jun-Aug 2006
		
	  modified by:
		Lake, Mar-Apr 2007

	----------------------------------------------

*)


{$i unaDef.inc }

unit
  unaDSPDlib;

{DP:UNIT
  General purpose DSP library in native Delphi code. 
}

interface

uses
  Windows, unaTypes, unaDSPLibH, unaClasses;

const
  //
  DSPL_P_TYPE_I = $01000000;	// must not overlap with DSPL_PID and other parameter IDs !!
  DSPL_P_TYPE_F = $02000000;
  DSPL_P_TYPE_C = $03000000;

type
  //
  // --  --
  //
  punaDspDLibParam = ^unaDspDLibParam;
  unaDspDLibParam = packed record
    //
    r_id: dspl_id;
    //
    case int of

      0: (r0_int: dspl_int);
      1: (r1_float: dspl_float);
      2: (r2_chunk: dspl_chunk);

  end;

  // --  --
  unaDspDProcessor = class;

  {DP:CLASS
    This class contains general DSP Lib parameter.
  }
  unaDspDLibParams = class(unaIdList)
  private
    f_processor: unaDspDProcessor;
  protected
    procedure releaseItem(index: unsigned; doFree: unsigned); override;
    function getId(item: pointer): int64; override;
  public
    constructor create(processor: unaDspDProcessor);
  end;


  {DP:CLASS
    This class implements a basic DSP Lib root. It uses methods of unaDspDProcessor class for implementation.
  }
  unaDspDLibRoot = class(unaDspLibAbstract)
  protected
    function dspl_create(object_id: dspl_id): dspl_handle; override;
    function dspl_destroy(handle: dspl_handle): dspl_result; override;
    function dspl_process(handle: dspl_handle; nSamples: dspl_int): dspl_result; override;
    function dspl_version(): pAnsiChar; override;
    //
    function dspl_setf(handle: dspl_handle; param_id: dspl_id; value: dspl_float): dspl_result; override;
    function dspl_seti(handle: dspl_handle; param_id: dspl_id; value: dspl_int): dspl_result; override;
    function dspl_setc(handle: dspl_handle; param_id: dspl_id; chunk: pdspl_float; length: dspl_int): dspl_result; override;
    //
    function dspl_geti(handle: dspl_handle; param: dspl_id): dspl_int; override;
    function dspl_getf(handle: dspl_handle; param: dspl_id): dspl_float; override;
    function dspl_getc(handle: dspl_handle; param: dspl_id): pdspl_chunk; override;
    //
    function dspl_getID(handle: dspl_handle): dspl_int; override;
    //
    function dspl_isseti(handle: dspl_handle; param: dspl_id): dspl_result; override;
    function dspl_issetf(handle: dspl_handle; param: dspl_id): dspl_result; override;
    function dspl_issetc(handle: dspl_handle; param: dspl_id): dspl_result; override;
  public
    constructor create();
  end;


  {DP:CLASS
    This is general purpose DSP Lib processor.
  }
  unaDspDProcessor = class (unaObject)
  private
    f_id: dspl_id;
    f_params: unaDspDLibParams;
  protected
    {$IFDEF DEBUG }
    f_nameFull: string;
    f_nameShort: string;
    {$ENDIF }
    f_modified: bool;
    //
    function process(nSamples: dspl_int): dspl_result; virtual; abstract;
    function idIsINOUT(id: dspl_id): bool;
  public
    {DP:METHOD
      Creates a DSP Lib processor. ID could be one of the following:
      <UL>
	<LI>(DSPL_OID or DSPL_EQ2B): creates EQ Two Band processor.</LI>
	<LI>(DSPL_OID or DSPL_EQMB): creates EQ Multi-Band processor.</LI>
	<LI>(DSPL_OID or DSPL_LD): creates Level Detector processor.</LI>
	<LI>(DSPL_OID or DSPL_DYNPROC): creates Dynamic Processor.</LI>
	<LI>(DSPL_OID or DSPL_SPEECHPROC): creates Speech Processor.</LI>
	<LI>(DSPL_OID or DSPL_ND): creates Noise Detection processor.</LI>
	<LI>(DSPL_OID or DSPL_MBSP): creates Multi-band Splitter processor.</LI>
      </UL>
    }
    constructor create(id: dspl_id);
    procedure AfterConstruction(); override;
    procedure BeforeDestruction(); override;
    //
    {DP:METHOD
      Sets integer parameter. Parameter ID and value meaning depends on processor type.
    }
    function seti(param_id: dspl_id; value: dspl_int): dspl_result;
    {DP:METHOD
      Sets float parameter. Parameter ID and value meaning depends on processor type.
    }
    function setf(param_id: dspl_id; value: dspl_float): dspl_result;
    {DP:METHOD
      Sets array parameter. Parameter ID and value meaning depends on processor type.
    }
    function setc(param_id: dspl_id; chunk: pdspl_float; length: dspl_int): dspl_result;
    //
    {DP:METHOD
      Returns integer parameter. Parameter ID and value meaning depends on processor type.
    }
    function geti(param_id: dspl_id): dspl_int;
    {DP:METHOD
      Returns float parameter. Parameter ID and value meaning depends on processor type.
    }
    function getf(param_id: dspl_id): dspl_float;
    {DP:METHOD
      Returns array parameter. Parameter ID and value meaning depends on processor type.
    }
    function getc(param_id: dspl_id): pdspl_chunk;
    //
    {DP:METHOD
      Returns true if specified integer parameter is set.
    }
    function isseti(param_id: dspl_id): dspl_result;
    {DP:METHOD
      Returns true if specified float parameter is set.
    }
    function issetf(param_id: dspl_id): dspl_result;
    {DP:METHOD
      Returns true if specified array parameter is set.
    }
    function issetc(param_id: dspl_id): dspl_result;
    //
    {DP:METHOD
      Returns processor's ID.
    }
    property id: dspl_id read f_id;
    //
    {$IFDEF DEBUG }
    property nameFull: string read f_nameFull;
    property nameShort: string read f_nameShort;
    {$ENDIF }
  end;


  {DP:CLASS
    Two Band Parametric Equalizer
  }
  unaDspDL_EQ2B = class(unaDspDProcessor)
  private
    f1in1, f1in2, f1out1, f1out2,
    f2in1, f2in2, f2out1, f2out2: dspl_float;
    //
    biq_f1: pdspl_biq_values;
    biq_f2: pdspl_biq_values;
    biq_f1_buff_size: dspl_int;
    biq_f2_buff_size: dspl_int;
    //
    function prepare_biq(band, len: dspl_int; var step: dspl_int; buf: pdspl_biq_values; var buff_size: dspl_int): pdspl_biq_values;
  protected
    function process(nSamples: dspl_int): dspl_result; override;
  public
    constructor create();
    procedure AfterConstruction(); override;
    procedure BeforeDestruction(); override;
  end;


  {DP:CLASS
    Multiband Equalizer/Filter
  }
  unaDspDL_EQMB = class(unaDspDProcessor)
  private
    //
    num_filtres: dspl_int;
    hpfs: pdspl_biq_valuesArray;
    acc,   bcc: pFloatArray;
    zin1,  zin2,
    zout1, zout2: pFloatArray;
    //
    buffer_length: dspl_int;
  protected
    function process(nSamples: dspl_int): dspl_result; override;
  public
    constructor create();
    procedure AfterConstruction(); override;
    procedure BeforeDestruction(); override;
  end;


  {DP:CLASS
    Level Detector
  }
  unaDspDL_LD = class(unaDspDProcessor)
  private
    peak_buffer: pDoubleArray;
    //
    peak_value,
    alpha,
    beta: dspl_double;
    //
    ld_out: dspl_double;
    peak_pos: dspl_int;
    pb_pos: dspl_int;
    pb_size: dspl_int;
    //
    ld_peak: bool;
  protected
    function process(nSamples: dspl_int): dspl_result; override;
  public
    constructor create();
    procedure AfterConstruction(); override;
    procedure BeforeDestruction(); override;
  end;


  {DP:CLASS
    Multiband Splitter
  }
  unaDspDL_MbSp = class(unaDspDProcessor)
  private
    num_bands: dspl_int;
    num_filtres: dspl_int;
    hi_order: dspl_int;
    hpfs: pdspl_biq_valuesArray;
    //
    mout: pFloatArrayPArray;
    acc: pFloatArray;
    bcc: pFloatArray;
    gain_ref: dspl_float;
    zin1,  zin2,  zout1,  zout2:  pFloatArray;
    z2in1, z2in2, z2out1, z2out2: pFloatArray;
    //
    buffer_length: dspl_int;
  protected
    function process(nSamples: dspl_int): dspl_result; override;
  public
    constructor create();
    procedure AfterConstruction(); override;
    procedure BeforeDestruction(); override;
  end;


  {DP:CLASS
    Noise Level Detector
  }
  unaDspDL_ND = class(unaDspDProcessor)
  private
    bp: unaDspDL_EQ2B;
    bl: unaDspDL_LD;
    sl: unaDspDL_LD;
    pl: unaDspDL_LD;
    //
    bl_buf: pdspl_float;
    sl_buf: pdspl_float;
    bp_buf: pdspl_float;
    pl_buf: pdspl_float;
    //
    lr: dspl_float;
    sensivity: dspl_float;
    noise_level: dspl_float;
    dr: dspl_float;
    smoothing: dspl_float;
    //
    buffer_length: dspl_int;
  protected
    function process(nSamples: dspl_int): dspl_result; override;
  public
    constructor create();
    procedure AfterConstruction(); override;
    procedure BeforeDestruction(); override;
  end;


  {DP:CLASS
    Dynamic Processor
  }
  unaDspDL_DynProc = class(unaDspDProcessor)
  private
    level_detector: unaDspDL_LD;
    //
    ld_buffer: pdspl_float;
    ld_buffer_size: dspl_int;
    //
    alpha, beta, th,
    aratio_inv, bratio_inv, ascale, bscale,
    gain_env, gr_env: dspl_double;
    //
    nsot: dspl_int;
  protected
    function process(nSamples: dspl_int): dspl_result; override;
  public
    constructor create();
    procedure AfterConstruction(); override;
    procedure BeforeDestruction(); override;
  end;


  {DP:CLASS
    Speech Processor
  }
  unaDspDL_SpeechProc = class(unaDspDProcessor)
  private
    hp: unaDspDL_EQ2B;
    enh: unaDspDL_EQ2B;
    //
    agc: unaDspDL_DynProc;
    comp: unaDspDL_DynProc;
    ng: unaDspDL_DynProc;
    lim: unaDspDL_DynProc;
    ds: unaDspDL_DynProc;
    //
    acca: pdspl_float;
    accb: pdspl_float;
    hp_out: pdspl_float;
    la_buf: pdspl_float;
    la_in: pdspl_float;
    //
    buffer_length: dspl_int;
    la_size: dspl_int;
    la_pos: dspl_int;
  protected
    function process(nSamples: dspl_int): dspl_result; override;
  public
    constructor create();
    procedure AfterConstruction(); override;
    procedure BeforeDestruction(); override;
  end;


implementation


uses
  Math, unaUtils;


{ unaDspDLibParams }

// --  --
constructor unaDspDLibParams.create(processor: unaDspDProcessor);
begin
  f_processor := processor;
  //
  inherited create(false);
  //
  autoFree := true;
end;

// --  --
function unaDspDLibParams.getId(item: pointer): int64;
begin
  if (nil <> item) then
    result := punaDspDLibParam(item).r_id
  else
    result := 0;
end;

// --  --
procedure unaDspDLibParams.releaseItem(index, doFree: unsigned);
var
  p: pointer;
  id: dspl_int;
begin
  if (mapDoFree(doFree)) then begin
    //
    p := get(index);
    if (p <> nil) then
      id := punaDspDLibParam(p).r_id
    else
      id := 0;
    //
    if (
	(nil <> p) and
	(nil <> punaDspDLibParam(p).r2_chunk.r_fp) and
	(DSPL_P_TYPE_C = ($0F000000 and id)) and
	(not f_processor.idIsINOUT(id))
       ) then begin
      // IN/OUT buffers are always assigned by value, so no additional memory is taken
      // other buffers are allocated by copy, so we need to release the memory
      //
      mrealloc(punaDspDLibParam(p).r2_chunk.r_fp);
    end;
    //
    mrealloc(p);
  end;
end;


// biquad coefficients calculation
//
procedure dspl_biq(btype: dspl_int; gain: dspl_float; w: dspl_float; q: dspl_float; var r: dspl_biq_values; norm: bool);
var
  A: dspl_double;
  w2pi: dspl_double;
  cosw: dspl_double;
  sinw: dspl_double;
  alpha: dspl_double;
  alpha_div_a: dspl_double;
  alpha2sqrtA: dspl_double;
  a0_1: dspl_double;
begin
  //const dspl_double pi=2.0*asin(1);
  try
    //
    A := pow(gain, 0.5);
    w2pi := 2 * pi * w;
    cosw := cos(w2pi);
    sinw := sin(w2pi);
    alpha := sinw / (2 * q);
    //
    case (btype) of

      //
      DSPL_BIQ_LP: begin
	//
	r.b1 := 1.0 - cosw;
	r.b0 := 0.5 * r.b1;
	r.b2 := r.b0;
	//
	r.a0 := 1.0 + alpha;
	r.a1 := -2.0 * cosw;
	r.a2 := 1.0 - alpha;
      end;

      //
      DSPL_BIQ_HP: begin
	//
	r.b1 := -cosw - 1.0;
	r.b0 := -0.5 * r.b1;
	r.b2 := r.b0;
	//
	r.a0 := 1.0 + alpha;
	r.a1 := -2.0 * cosw;
	r.a2 := 1.0 - alpha;
      end;

      //
      DSPL_BIQ_PEAK: begin
	//
	alpha_div_a := alpha / A;
	//
	r.b0 := 1.0 + alpha * A;
	r.b1 := -2.0 * cosw;
	r.b2 := 1.0 - alpha * A;
	//
	r.a0 := 1.0 + alpha_div_a;
	r.a1 := r.b1;
	r.a2 := 1.0 - alpha_div_a;
      end;

      //
      DSPL_BIQ_LS: begin
	//
	alpha2sqrtA := 2.0 * pow(A, 0.5) * alpha;
	//
	r.b0 :=       A * ((A + 1.0) - (A - 1.0) * cosw + alpha2sqrtA);
	r.b1 := 2.0 * A * ((A - 1.0) - (A + 1.0) * cosw);
	r.b2 :=       A * ((A + 1.0) - (A - 1.0) * cosw - alpha2sqrtA);
	//
	r.a0 :=            (A + 1.0) + (A - 1.0) * cosw + alpha2sqrtA;
	r.a1 :=    -2.0 * ((A - 1.0) + (A + 1.0) * cosw );