unit ProcMath;

interface

uses Windows,LibV, tgen;

const
  SIZE_POWER = 13;
  INBLK_SIZE = 8192;

function BeginProcessing(Frequencies,Amplitudes,
  Channel1Window,Channel2Window : vector_p):vboolean;

procedure EndProcessing;

procedure IdleProc(Processing:vboolean;var Done:Boolean);

implementation

var
  waveout : vhandle_t = LIBV_INVALID_HANDLE;

  Freq, Amp, WinLeft, WinRight : vector_p;

  Samples : array[0..INBLK_SIZE-1] of vec_t;
  Dummy : array[0..INBLK_SIZE-1] of vec_t;

  FreqReal : array[0..INBLK_SIZE-1] of vec_t;
  FreqImag : array[0..INBLK_SIZE-1] of vec_t;

  FreqReal1 : array[0..INBLK_SIZE-1] of vec_t;
  FreqImag1 : array[0..INBLK_SIZE-1] of vec_t;

  FreqReal2 : array[0..INBLK_SIZE-1] of vec_t;
  FreqImag2 : array[0..INBLK_SIZE-1] of vec_t;

  Samples1 : array[0..INBLK_SIZE-1] of vec_t;
  Samples2 : array[0..INBLK_SIZE-1] of vec_t;

  OutSamples : array[0..2*INBLK_SIZE-1] of s16_t;

// This routine stores float data from 'Samples1' and 'Samples2'
// in packed 16-bit PCM format

procedure Collect2Channels;assembler;
const
  upper_limit : vec_t = MAXSHORT;
asm
  push ebx
  push esi

  mov esi, INBLK_SIZE
  mov ebx, offset Samples1
  mov ecx, offset Samples2
  dec esi
  mov edx, offset OutSamples

@@next_pair:
  fld dword ptr[ebx + esi * 4]
  fld upper_limit
  fmulp
  fcom upper_limit
  fstsw ax
  sahf
  jbe @@_1_ok
  ffree st(0)
  mov word ptr[edx + esi * 4], MAXSHORT
  jmp @@_load_2
@@_1_ok:
  fistp word ptr[edx + esi * 4]
@@_load_2:
  fld dword ptr[ecx + esi * 4]
  fld upper_limit
  fmulp
  fcom upper_limit
  fstsw ax
  sahf
  jbe @@_2_ok
  ffree st(0)
  mov word ptr[edx + esi * 4 + 2], MAXSHORT
  jmp @@_check_end
@@_2_ok:
  fistp word ptr[edx + esi * 4 + 2]
@@_check_end:
  dec esi
  jge @@next_pair

  pop esi
  pop ebx
end;

procedure FFTForward;
begin
  memZero(@Dummy,INBLK_SIZE * sizeof(vec_t));
  fftCalcNip(@FreqReal,@FreqImag,@Samples,@Dummy,SIZE_POWER,1);
end;

procedure ApplyWindows;
var
  wlen,i : integer;
begin
  wlen := INBLK_SIZE-1;
  for i:=0 to wlen do
  begin
    FreqReal1[i] := FreqReal[i] * WinLeft^.elements^[i];
		FreqImag1[i] := FreqImag[i] * WinLeft^.elements^[i];
    FreqReal2[i] := FreqReal[i] * WinRight^.elements^[i];
		FreqImag2[i] := FreqImag[i] * WinRight^.elements^[i];
  end;
end;

procedure FFTInverse;
begin
  fftCalcNip(@Samples1,@Dummy,@FreqReal1,@FreqImag1,SIZE_POWER,-1);
  fftCalcNip(@Samples2,@Dummy,@FreqReal2,@FreqImag2,SIZE_POWER,-1);
end;

procedure WriteStereoOutput;
begin
  LibV.fileWrite(waveout,@OutSamples,INBLK_SIZE * 4);
end;

procedure ProcessNextBlock;
begin
  toneGenerate(@Samples,INBLK_SIZE);
  FFTForward;
  ApplyWindows;
  FFTInverse;
  Collect2Channels;
  WriteStereoOutput;
end;

procedure IdleProc(Processing:vboolean;var Done:Boolean);
const
  max_qlen = 44100 * 5;
var
  qlen : u32_t;
begin
  if not Processing then
  begin
    Done := True;
    Exit;
  end;
  qlen := 0;
  if fileControl(waveout,pctl_waveout_get_pending_samples,qlen) then
    if qlen < max_qlen then
      ProcessNextBlock;
  Done := False;
end;

function BeginProcessing(Frequencies,Amplitudes,
  Channel1Window,Channel2Window : vector_p):vboolean;
begin
  Result := False;
  if not toneInit(Frequencies,Amplitudes) then
    Exit;
  if waveout = LIBV_INVALID_HANDLE then
  begin
    Windows.MessageBox(NULL,
      'Multipass filter','Unable to open waveform output',MB_ICONHAND);
    Exit;
  end;
  Freq := Frequencies;
  Amp := Amplitudes;
  WinLeft := Channel1Window;
  WinRight := Channel2Window;
  Result := True;
end;

procedure EndProcessing;
begin
  wavePlaybackReset(waveout);
end;

initialization
  logStartConsoleLog();
  logUpperLevel(LOG_TRACE);
  waveout := LibV.wavePlaybackOpen(2,44100,16);
finalization
  fileClose(waveout);
end.

