unadsplibautomation.pas

Voice Commnucation Components for Delphi

      //
      p := channel;
      for i := 0 to samples - 1 do begin
	//
	case (f_bits) of

	   8: f_inBuf[i] := (pArray(data)[p] - $80) / $FF;
	  16: f_inBuf[i] := pSmallIntArray(data)[p] / $7FFF;
	  24: f_inBuf[i] := pInt32Array(data)[p] / $7FFFFF;
	  32: f_inBuf[i] := pFloatArray(data)[p];

	end;
	//
	inc(p, f_channels);
      end;
    end;
  end;
end;

// --  --
procedure unaDSPLibAutomat.convertFloatOut(data: pointer; samples, channel: int);
var
  i: int;
  p: int;
begin
  if (1 = f_channels) and (1 > channel) and (32 = f_bits) then begin
    //
    // no need to transcode
    move(f_outBuf^, data^, samples * sizeOf(f_outBuf[0]));
  end
  else begin
    //
    if (channel < f_channels) then begin
      //
      p := channel;
      for i := 0 to samples - 1 do begin
	//
	if (f_outBuf[i] > 1.0) then
	  f_outBuf[i] := 1.0;
	//
	if (f_outBuf[i] < -1.0) then
	  f_outBuf[i] := -1.0;
	//
	case (f_bits) of

	   8: pArray(data)[p] 	      := trunc(f_outBuf[i] * $FF + $80);
	  16: pSmallIntArray(data)[p] := trunc(f_outBuf[i] * $7FFF);
	  24: pInt32Array(data)[p]    := trunc(f_outBuf[i] * $7FFFFF);
	  32: pFloatArray(data)[p]    := f_outBuf[i];

	end;
	//
	inc(p, f_channels);
      end;
    end;
  end;
end;

// --  --
constructor unaDSPLibAutomat.create(root: unaDspLibAbstract);
begin
  f_root := root;
  //
  f_gate := unaInProcessGate.create();
  f_objects := unaDSPLibObjectList.create(self);
  f_objectParams := unaStringList.create();
  f_subAutos := unaObjectList.create();
  f_multiOutBuf := unaRecordList.create();
  f_multiOutBufSize := 0;
  //
  inherited create();
end;

// --  --
procedure unaDSPLibAutomat.assignBuf2obj(obj: dspl_handle);
var
  n: dspl_int;
begin
  root.setc(obj, DSPL_PID or DSPL_P_IN,  pdspl_float(f_inBuf),  f_bufSize);
  root.setc(obj, DSPL_PID or DSPL_P_OUT, pdspl_float(f_outBuf), f_bufSize);
  //
  if (isMultiOutObj(obj)) then begin
    //
    n := root.geti(obj, DSPL_PID or DSPL_P_OTHER);	// number of out buffers
    while (0 < n) do begin
      //
      dec(n);
      root.setc(obj, DSPL_PID or DSPL_P_OUT or n, pdspl_float(f_multiOutBuf.get(n)), f_multiOutBufSize);
    end;
  end;
end;

// --  --
function unaDSPLibAutomat.dspl_objCount(): int;
begin
  result := int(f_objects.count);
end;

// --  --
function unaDSPLibAutomat.dspl_objDrop(index: int): dspl_result;
var
  obj: dspl_handle;
  i: int;
begin
  result := false;
  //
  if (f_gate.enter(3000)) then begin
    try
      obj := dspl_objGet(index);
      if (DSPL_INVALID_HANDLE <> obj) then begin
	//
	result := f_objects.removeByIndex(index);	// obj will be destroyed by DSPLib in that call
	if (result) then begin
	  //
	  // remove all params for this object as well
	  i := 0;
	  while (i < int(f_objectParams.count)) do begin
	    //
	    if (1 = pos(int2str(obj) + '.', f_objectParams.get(i))) then begin
	      //
	      f_objectParams.removeByIndex(i);
	    end
	    else
	      inc(i);
	    //
	  end;
	  //
	  f_subAutosDirty := true;
	end;
      end;
      //
    finally
      f_gate.leave();
    end;
  end;
end;

// --  --
function unaDSPLibAutomat.dspl_objGet(index: int): dspl_handle;
begin
  result := dspl_handle(f_objects.get(index));
end;

// --  --
function unaDSPLibAutomat.dspl_obj_getf(obj: dspl_handle; channel, param_id: int; out fp: dspl_float): dspl_result;
var
  idx: int;
begin
  result := DSPL_SUCCESS;
  if (0 = channel) then begin
    //
    fp := root.getf(obj, param_id);
  end
  else begin
    //
    result := DSPL_FAILURE;
    dec(channel);
    if (channel < int(f_subAutos.count)) then begin
      //
      idx := dspl_objIndex(obj);
      if (0 <= idx) then begin
	//
	obj := unaDSPLibAutomat(f_subAutos[channel]).dspl_objGet(idx);
	if (0 < obj) then begin
	  //
	  fp := unaDSPLibAutomat(f_subAutos[channel]).root.getf(obj, param_id);
	  result := DSPL_SUCCESS;
	end;
      end;
    end;
  end;
end;

// --  --
function unaDSPLibAutomat.dspl_objIndex(obj: dspl_handle): int;
begin
  result := f_objects.locate(obj);
end;

// --  --
function unaDSPLibAutomat.dspl_objNew(objID: int): dspl_handle;
begin
  result := f_root.createObj(objID);
  if (DSPL_INVALID_HANDLE <> result) then begin
    //
    f_objects.add(result);
    assignBuf2obj(result);
    //
    f_subAutosDirty := true;
  end;  
end;

// --  --
function unaDSPLibAutomat.dspl_objSwap(index1, index2: int): dspl_result;
var
  obj1, obj2: dspl_handle;
begin
  result := DSPL_FAILURE;
  //
  if (lockNonEmptyList(f_objects, 3000)) then begin
    try
      obj1 := dspl_objGet(index1);
      obj2 := dspl_objGet(index1);
      //
      f_objects.setItem(index1, pointer(obj2), 0);	// do not release older item
      f_objects.setItem(index2, pointer(obj1), 0);	// do not release older item
      //
      result := DSPL_SUCCESS;
      //
      f_subAutosDirty := true;
    finally
      f_objects.unlock();
    end;
  end;
end;

// --  --
function unaDSPLibAutomat.dspl_obj_setc(obj: dspl_handle; param_id: int; const value: dspl_chunk): dspl_result;
begin
  result := dspl_obj_setc(obj, param_id, value.r_fp, value.r_len);
end;

// --  --
function unaDSPLibAutomat.dspl_obj_setc(obj: dspl_handle; param_id: int; fp: pdspl_float; len: dspl_int): dspl_result;
var
  i: int;
  val: string;
  index: int;
begin
  if (f_gate.enter(3000)) then begin
    try
      result := f_root.setc(obj, param_id, fp, len);
      if (DSPL_SUCCESS = result) then begin
	//
	if ( ( DSPL_PID or DSPL_P_IN   = (param_id and $F0F00) )
	     or
	     ( DSPL_PID or DSPL_P_OUT  = (param_id and $F0F00) )
	   ) then begin
	  //
	  // there is no need to save IN/OUT buffers in config
	end
	else begin
	  //
	  if ((nil <> fp) and (0 < len)) then
	    val := base64encode(fp, len * sizeOf(fp^))
	  else
	    val := '';
	  //
	  f_objectParams.values[int2str(obj) + '.' + int2str(param_id)] := 'C' + val;
	  //
	  if (not f_subAutosDirty and (0 < f_subAutos.count)) then begin
	    //
	    index := dspl_objIndex(obj);
	    for i := 0 to f_subAutos.count - 1 do begin
	      //
	      if (index < unaDSPLibAutomat(f_subAutos[i]).dspl_objCount()) then begin
		//
		obj := unaDSPLibAutomat(f_subAutos[i]).dspl_objGet(index);
		unaDSPLibAutomat(f_subAutos[i]).dspl_obj_setc(obj, param_id, fp, len);
	      end
	      else begin
		//
		f_subAutosDirty := true;
		break;
	      end;
	    end;
	  end;
	end;
	//
      end;
      //
    finally
      f_gate.leave();
    end;
  end
  else
    result := false;
end;

// --  --
function unaDSPLibAutomat.dspl_obj_setf(obj: dspl_handle; param_id: int; value: dspl_float): dspl_result;
var
  i: int;
  index: int;
begin
  if (f_gate.enter(3000)) then begin
    try
      result := f_root.setf(obj, param_id, value);
      if (DSPL_SUCCESS = result) then begin
	//
	f_objectParams.values[int2str(obj) + '.' + int2str(param_id)] := 'F' + base64encode(@value, sizeOf(value));
	//
	if (not f_subAutosDirty and (0 < f_subAutos.count)) then begin
	  //
	  index := dspl_objIndex(obj);
	  for i := 0 to f_subAutos.count - 1 do begin
	    //
	    if (index < unaDSPLibAutomat(f_subAutos[i]).dspl_objCount()) then begin
	      //
	      obj := unaDSPLibAutomat(f_subAutos[i]).dspl_objGet(index);
	      unaDSPLibAutomat(f_subAutos[i]).dspl_obj_setf(obj, param_id, value);
	    end
	    else begin
	      //
	      f_subAutosDirty := true;
	      break;
	    end;
	  end;
	end;
      end;
      //
    finally
      f_gate.leave();
    end;
  end
  else
    result := false;
end;

// --  --
function unaDSPLibAutomat.dspl_obj_seti(obj: dspl_handle; param_id: int; value: dspl_int): dspl_result;
var
  i: int;
  index: int;
begin
  if (f_gate.enter(3000)) then begin
    try
      result := f_root.seti(obj, param_id, value);
      if (DSPL_SUCCESS = result) then begin
	//
	f_objectParams.values[int2str(obj) + '.' + int2str(param_id)] := 'I' + base64encode(@value, sizeOf(value));
	//
	if (isMultiOutObj(obj) and (DSPL_PID or DSPL_P_OTHER = param_id)) then
	  // number of out buffers may change, so check buffer allocation once more
	  bufAllocate(f_multiOutBufSize, true);
	//
	if (not f_subAutosDirty and (0 < f_subAutos.count)) then begin
	  //
	  index := dspl_objIndex(obj);
	  for i := 0 to f_subAutos.count - 1 do begin
	    //
	    if (index < unaDSPLibAutomat(f_subAutos[i]).dspl_objCount()) then begin
	      //
	      obj := unaDSPLibAutomat(f_subAutos[i]).dspl_objGet(index);
	      unaDSPLibAutomat(f_subAutos[i]).dspl_obj_seti(obj, param_id, value);
	    end
	    else begin
	      //
	      f_subAutosDirty := true;
	      break;
	    end;
	  end;
	end;
      end;
      //
    finally
      f_gate.leave();
    end;
  end
  else
    result := false;
end;

// --  --
function unaDSPLibAutomat.getMultiOutData(channel, n: uint; out data: pdspl_float; out nSamples: uint): HRESULT;
var
  buf: unaList;
begin
  if (0 = channel) then
    buf := f_multiOutBuf
  else begin
    //
    if (channel <= f_subAutos.count) then
      buf := unaDSPLibAutomat(f_subAutos[channel - 1]).f_multiOutBuf
    else
      buf := nil;
    //
  end;
  //
  if (nil <> buf) then begin
    //
    if (n < buf.count) then begin
      //
      data := buf[n];
      nSamples := f_multiOutBufSize;
      //
      result := S_OK;
    end
    else
      result := E_FAIL;
    //
  end
  else
    result := E_FAIL;
  //
end;

// --  --
function unaDSPLibAutomat.getOutData(channel: uint; out data: pdspl_float; out nSamples: uint): HRESULT;
begin
  result := S_OK;
  //
  if (0 = channel) then begin
    //
    data := pointer(f_outBuf);
    nSamples := f_bufSize;
  end
  else begin
    //
    if (channel <= f_subAutos.count) then begin
      //
      data := pointer(unaDSPLibAutomat(f_subAutos[channel - 1]).f_outBuf);
      nSamples := unaDSPLibAutomat(f_subAutos[channel - 1]).f_bufSize;
    end
    else
      result := E_FAIL;
    //
  end;
end;

// --  --
function unaDSPLibAutomat.isMultiOutID(id: dspl_int): bool;
begin
  result := (DSPL_OID or DSPL_MBSP = id);
end;

// --  --
function unaDSPLibAutomat.isMultiOutObj(obj: dspl_handle): bool;
begin
  result := isMultiOutID(root.getID(obj));
end;

// --  --
function unaDSPLibAutomat.processChunk(data: pointer; len: unsigned; channel, nSamples: int; writeOutput: bool): HRESULT;
var
  i, ch: int;
  config: string;
begin
  result := HRESULT(-1);
  if (f_gate.enter(3000)) then begin
    //
    try
      result := S_OK;
      //
      if (0 <= nSamples) then
	nSamples := min(nSamples, bytes2samples(len))
      else
	nSamples := bytes2samples(len);
      //
      if ((0 > channel) and (1 < f_channels)) then begin
	//
	// we have more than one channel, and no specific channel was provided, so we have to make sure sub-automats are ready
	//
	if (f_subAutosDirty) then begin
	  //
	  // we have to assign same objects for all autos we have
	  automatSave(config);
	  if (0 < f_subAutos.count) then begin
	    //
	    for i := 0 to f_subAutos.count - 1 do begin
	      //
	      with (unaDSPLibAutomat(f_subAutos[i])) do begin
		//
		setFormat(self.f_rate, self.f_bits, self.f_channels, true);
		automatLoad(config);
		//
		bufAllocate(nSamples);
	      end;
	    end;
	  end;
	  //
	  f_subAutosDirty := false;
	end;
      end;
      //
      result := bufAllocate(nSamples);
      //
      if (Succeeded(result)) then begin
	//
	if (0 > channel) then begin
	  //
	  for ch := 0 to f_channels - 1 do begin
	    try
	      processChunkChannel(data, ch, nSamples, false, writeOutput);
	    except
	      // ignore excepts, if any, process other channels
	    end;
	  end;
	end
	else
	  result := processChunkChannel(data, channel, nSamples, false, writeOutput);
	//
      end;
      //
    finally
      f_gate.leave();
    end;
  end;
end;

// --  --
function unaDSPLibAutomat.processChunkChannel(data: pointer; channel, nSamples: unsigned; forceProcessByMe, writeOutput: bool): HRESULT;
var
  i: int;
  obj: dspl_handle;
  subAuto: unaDSPLibAutomat;
begin
  result := S_OK;
  //
  if (0 < f_objects.count) then begin
    //
    if ((0 = channel) or forceProcessByMe) then begin
      //
      // channel #0 is always processed using main automat
      for i := 0 to f_objects.count - 1 do begin
	//
	convertFloatIn(data, nSamples, channel);
	obj := dspl_objGet(i);
	try
	  //
	  root.process(obj, nSamples);
	finally
	  if (isMultiOutObj(obj)) then begin
	    //
	    // nothing to convert, output buffers alreay contain all information
	  end
	  else
	    if (writeOutput) then
	      convertFloatOut(data, nSamples, channel);
	end;
      end;
    end
    else begin
      //
      // other channels are always processed using sub-automat(s)
      subAuto := f_subAutos[channel - 1];
      if (nil <> subAuto) then
	result := subAuto.processChunkChannel(data, channel, nSamples, true, writeOutput)	// force processing by this auto
      else
	result := HRESULT(-1);	// no sub-auto for this channel..
    end;
    //
  end
  else
    move(f_inBuf^, f_outBuf^, nSamples * sizeOf(f_outBuf[0]));	// just copy all samples to outbuf when we have no filters
end;

// --  --
function unaDSPLibAutomat.setFormat(rate, bits, channels: int; isSubAuto: bool): HRESULT;
var
  i: int;
begin
  result := E_FAIL;
  //
  if ((0 < rate) and (bits in [8, 16, 24, 32]) and (0 < channels)) then begin
    //
    if (f_gate.enter(3000)) then begin
      //
      try
	f_rate := rate;
	f_bits := bits;
	f_channels := channels;
	//
	if (24 = f_bits) then
	  f_bitsSHR := 32 shr 4
	else
	  f_bitsSHR := f_bits shr 4;
	//
	f_subAutos.clear();
	if ((1 < channels) and not isSubAuto) then begin
	  //
	  for i := 1 to channels - 1 do
	    f_subAutos.add(unaDSPLibAutomat.create(root));
	  //
	  f_subAutosDirty := true;
	end;
	//
	result := S_OK;
      finally
	f_gate.leave();
      end;
    end;
  end;
end;


end.