unit MainUnit;

interface

// {$DEFINE FILE_OUT}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, Gauges, ComCtrls, LibV, StdCtrls;

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    FileSubMenu: TMenuItem;
    OpenItem: TMenuItem;
    N1: TMenuItem;
    ExitItem: TMenuItem;
    ProcessSubmenu: TMenuItem;
    StartStopItem: TMenuItem;
    HelpSubMenu: TMenuItem;
    AboutItem: TMenuItem;
    GAmplitude: TGauge;
    MainPanel: TPanel;
    AmpPanel: TPanel;
    Splitter1: TSplitter;
    StatusBar: TStatusBar;
    WFPanel: TPanel;
    TB_1_Lo: TTrackBar;
    TB_1_Hi: TTrackBar;
    TB_2_Lo: TTrackBar;
    TB_2_Hi: TTrackBar;
    TBPanel: TPanel;
    OpenDialog: TOpenDialog;
    p: TTrackBar;
    u: TTrackBar;
    Label1: TLabel;
    Label2: TLabel;
    procedure ExitItemClick(Sender: TObject);
    procedure TBPanelResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure OpenItemClick(Sender: TObject);
    procedure TB_1_LoChange(Sender: TObject);
    procedure TB_2_LoChange(Sender: TObject);
    procedure TB_1_HiChange(Sender: TObject);
    procedure TB_2_HiChange(Sender: TObject);
    procedure StartStopItemClick(Sender: TObject);
    procedure pKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure uKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  private
    CurrentInput : vhandle_t;
    CurrentOutput : vhandle_t;
    Processing : Boolean;
    function  OpenInput(name:PChar):Boolean;
    procedure FreeCurrentInput;
    function  BeginProcessing:Boolean;
    procedure EndProcessing;
    procedure OnIdle(Sender:TObject;var Done:Boolean);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

// =======================================================================
//      Thread safety is of no concern, so use global data for speed
// =======================================================================

const
  SIZE_POWER = 14;
  INBLK_SIZE = 16384;

var
  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;

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

  left_scale : vec_t = 1;
  right_scale : vec_t = 1;
  OutSamples : array[0..2*INBLK_SIZE-1] of s16_t;

// This routine adds samples from left and right channels and stores
// result as 4-byte floating point value

procedure Mix2Channels;assembler;
const
  one_half : vec_t = 0.5;
asm
  push ebx
  push esi

  mov ecx, INBLK_SIZE
  dec ecx

  mov esi, offset RawSamples
  mov ebx, offset Samples

  xor edx, edx
  xor eax, eax

@@l1:
  fild word ptr [esi + ecx * 4]
  fild word ptr [esi + ecx * 4 + 2]
  faddp
  fld  one_half
  fmulp
  fstp dword ptr[ebx + ecx * 4]
  dec ecx
  jge  @@l1

  pop esi
  pop ebx
end;

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

procedure Collect2Channels(left_scale,right_scale:vec_t);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

@@l1:
  fld dword ptr[ebx + esi * 4]
  fld left_scale
  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 right_scale
  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 @@l1

  pop esi
  pop ebx
end;

function ReadStereoInput(CurrentInput:vhandle_t):Integer;
var
  tail, bytes_read : u32_t;
begin
  bytes_read := LibV.fileRead(CurrentInput,@RawSamples,INBLK_SIZE shl 2);
  tail := (INBLK_SIZE shl 2) - bytes_read;
  if tail > 0 then
    memZero(@(RawSamples[bytes_read]),tail);
  Mix2Channels;
  Result := bytes_read;
end;

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

procedure ApplyWindow;
var
  win_open,win_close,i : integer;
begin
  memZero(@FreqReal1,INBLK_SIZE * sizeof(vec_t));
  memZero(@FreqReal2,INBLK_SIZE * sizeof(vec_t));
  memZero(@FreqImag1,INBLK_SIZE * sizeof(vec_t));
  memZero(@FreqImag2,INBLK_SIZE * sizeof(vec_t));

  win_open := MainForm.TB_1_Lo.Position;
  win_close := MainForm.TB_1_Hi.Position;
  for i:=win_open to win_close do
  begin
    FreqReal1[i] := FreqReal[i];
		FreqReal1[INBLK_SIZE-i-1] := FreqReal[INBLK_SIZE-i-1];
    FreqImag1[i] := FreqImag[i];
		FreqImag1[INBLK_SIZE-i-1] := FreqImag[INBLK_SIZE-i-1];
  end;

  win_open := MainForm.TB_2_Lo.Position;
  win_close := MainForm.TB_2_Hi.Position;
  for i:=win_open to win_close do
  begin
    FreqReal2[i] := FreqReal[i];
		FreqReal2[INBLK_SIZE-i-1] := FreqReal[INBLK_SIZE-i-1];
    FreqImag2[i] := FreqImag[i];
		FreqImag2[INBLK_SIZE-i-1] := FreqImag[INBLK_SIZE-i-1];
  end;

end;

const
  prev_max = 5;
  prev_mid = 3;
  s_mid = 13;
  s_max = 16;

var
  Interp1, Interp2 : vhandle_t;
  Interp_x : vector_p;
  TailSamples1, TailSamples2 : vector_p;

procedure InitInterps;
begin
  TailSamples1 := vecAlloc(5);
  TailSamples2 := vecAlloc(5);
  Interp_x := vecAlloc(5);
  memZero(TailSamples1^.elements,5 * sizeof(vec_t));
  memZero(TailSamples2^.elements,5 * sizeof(vec_t));
  Interp_x^.elements[0] := -prev_max;
  Interp_x^.elements[1] := -prev_mid;
  Interp_x^.elements[2] := 0;
  Interp_x^.elements[3] := s_mid;
  Interp_x^.elements[4] := s_max;
  Interp1 := cspCreate(Interp_x,TailSamples1);
  Interp2 := cspCreate(Interp_x,TailSamples2);
end;

procedure FreeInterps;
begin
  memFree(TailSamples1);
  memFree(TailSamples2);
  memFree(Interp_x);
  cspDestroy(Interp1);
  cspDestroy(Interp2);
end;

procedure SmoothTails;
var
  i : integer;
  p, q : vec_t;
  u, v : vec_t;
begin
  p := (MainForm.p.Position - 64) / 128;
  u := (MainForm.u.Position - 64) / 128;

  q := 1 - p;
  v := 1 - u;

  TailSamples1^.elements[2] := p * TailSamples1^.elements[2] + q * Samples1[0];
  TailSamples1^.elements[3] := Samples1[s_mid];
  TailSamples1^.elements[4] := Samples1[s_max];

  TailSamples2^.elements[2] := p * TailSamples2^.elements[2] + q * Samples2[0];
  TailSamples2^.elements[3] := Samples2[s_mid];
  TailSamples2^.elements[4] := Samples2[s_max];

  cspChangeY(Interp1,TailSamples1);
  cspChangeY(Interp2,TailSamples2);

  for i:=0 to s_max do
  begin
    Samples1[i] := v * Samples1[i] + u * cspInterpolate(Interp1,i);
    Samples2[i] := v * Samples2[i] + u * cspInterpolate(Interp2,i);
  end;

  TailSamples1^.elements[0] := Samples1[INBLK_SIZE-prev_max-1];
  TailSamples1^.elements[1] := Samples1[INBLK_SIZE-prev_mid-1];
  TailSamples1^.elements[2] := Samples1[INBLK_SIZE-1];

  TailSamples2^.elements[0] := Samples2[INBLK_SIZE-prev_max-1];
  TailSamples2^.elements[1] := Samples2[INBLK_SIZE-prev_mid-1];
  TailSamples2^.elements[2] := Samples2[INBLK_SIZE-1];
end;


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

procedure WriteStereoOutput(CurrentOutput:vhandle_t;len:u32_t);
begin
  LibV.fileWrite(CurrentOutput,@OutSamples,len);
end;

procedure UpdateIndicator(nsamples:integer);
var
  i : integer;
  sum : vec_t;
begin
  sum := 0;
  if nsamples = 0 then
  begin
    MainForm.GAmplitude.Progress := 0;
    Exit;
  end;
  for i:=0 to nsamples do
    sum := sum + abs(Samples[i]);
  MainForm.GAmplitude.Progress := trunc(sum / (nsamples * 128));
end;

function ProcessNextBlock(in_handle,out_handle:vhandle_t):vboolean;
var
  len : u32_t;
begin
  len := ReadStereoInput(in_handle);
  if len > 0 then
  begin
    UpdateIndicator(len shr 2);
    FFTForward;
    ApplyWindow;
    FFTInverse;
    WriteStereoOutput(out_handle,len);
    Result := True;
    Exit;
  end;
  Result := False;
end;

procedure TMainForm.OnIdle(Sender:TObject;var Done:Boolean);
const
  max_qlen = 16 * INBLK_SIZE;
var
  qlen : u32_t;
begin
  if not Processing then
  begin
    Done := True;
    Exit;
  end;
  repeat
{$IFNDEF FILE_OUT}
    qlen := 0;
    if not fileControl(CurrentOutput,pctl_waveout_get_pending_samples,qlen) then
      break;
    if qlen > max_qlen then
    begin
      timeDelay(1);
      break;
    end;
    if not ProcessNextBlock(CurrentInput,CurrentOutput) then
      fileSeek(CurrentInput,0,SEEK_SET);
{$ELSE}
    if not ProcessNextBlock(CurrentInput,CurrentOutput) then
    begin
      LibV.fileClose(CurrentOutput);
      Done:=True;
      Exit;
    end;
{$ENDIF}
  until False;
  Done := False;
end;

function  TMainForm.OpenInput(name:PChar):Boolean;
var
  nc, freq, bps : u32_t;
  uname : array[0.._MAX_PATH] of char;
  ext : array[0.._MAX_PATH] of char;
begin
  FreeCurrentInput;
  LibV.libvDosPathToUnixPath(uname,name);
  fsSplitPath(uname,nil,nil,ext);
  if strComp(ext,'mp3')=0 then
    CurrentInput := LibV.mp3Open(uname)
  else
    CurrentInput := LibV.wavOpenRead(uname);
  Result := CurrentInput <> LIBV_INVALID_HANDLE;
  if Result then
  begin
    nc := LibV.wavNumChannels(CurrentInput);
    freq := LibV.wavSamplingFrequency(CurrentInput);
    bps := LibV.wavBitsPerSample(CurrentInput);
    if (nc <> 2) or (freq <> 44100) or (bps <> 16) then
    begin
      Windows.MessageBox(Handle,'FreqConv','Only 16-bit 44.1 kHz stereo input supported',0);
      FreeCurrentInput;
      Result := False;
    end;
  end;
end;

procedure TMainForm.FreeCurrentInput;
begin
  EndProcessing;
  if CurrentInput <> LIBV_INVALID_HANDLE then
  begin
    LibV.fileClose(CurrentInput);
    CurrentInput := LIBV_INVALID_HANDLE;
  end;
end;

function  TMainForm.BeginProcessing:Boolean;
begin
  if Processing then
  begin
    Result := True;
    Exit;
  end;
  if CurrentInput = LIBV_INVALID_HANDLE then
  begin
    Result := False;
    Exit;
  end;
  Processing := True;
  StartStopItem.Caption := 'Stop processing';
  Result := Processing;
end;

procedure TMainForm.EndProcessing;
begin
  if not Processing then
    Exit;
  StartStopItem.Caption := 'Start processing';
  Processing := False;
end;

// =======================================================================
// ***                       Message handlers                          ***
// =======================================================================
procedure TMainForm.FormCreate(Sender: TObject);
var
  tb_max : integer;
begin
  Processing := False;
  CurrentInput := LIBV_INVALID_HANDLE;
  tb_max := (INBLK_SIZE shr 1) - 1;
  TB_1_Hi.Max := tb_max;
  TB_1_Lo.Max := tb_max;
  TB_2_Hi.Max := tb_max;
  TB_2_Lo.Max := tb_max;
  TB_1_Lo.Position := 0;
  TB_1_Hi.Position := tb_max;
  TB_2_Lo.Position := 0;
  TB_2_Hi.Position := tb_max;
  InitInterps;
{$IFNDEF FILE_OUT}
  CurrentOutput := wavePlaybackOpen(2,44100,16);
  if CurrentOutput = LIBV_INVALID_HANDLE then
  begin
    Windows.MessageBox(NULL,'FreqConv','Unable to open waveform output',0);
    Exit;
  end;
{$ELSE}
  CurrentOutput := wavOpenWrite('//f/out.wav',2,44100,16);
{$ENDIF}
  Application.OnIdle := Self.OnIdle;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  EndProcessing;
  FreeCurrentInput;
  Application.OnIdle := nil;
  FreeInterps;
{$IFNDEF FILE_OUT}
  fileClose(CurrentOutput);
{$ENDIF}
end;

procedure TMainForm.TBPanelResize(Sender: TObject);
begin
  TB_1_Lo.Width := TBPanel.Width-4;
  TB_1_Hi.Width := TBPanel.Width-4;
  TB_2_Lo.Width := TBPanel.Width-4;
  TB_2_Hi.Width := TBPanel.Width-4;
end;

procedure TMainForm.ExitItemClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.OpenItemClick(Sender: TObject);
begin
  if OpenDialog.Execute then
    StartStopItem.Enabled := OpenInput(PChar(OpenDialog.FileName));
end;

procedure TMainForm.TB_1_LoChange(Sender: TObject);
begin
  if TB_1_Hi.Position < TB_1_Lo.Position then
    TB_1_Hi.Position := TB_1_Lo.Position;
end;

procedure TMainForm.TB_2_LoChange(Sender: TObject);
begin
  if TB_2_Hi.Position < TB_2_Lo.Position then
    TB_2_Hi.Position := TB_2_Lo.Position;
end;

procedure TMainForm.TB_1_HiChange(Sender: TObject);
begin
  if TB_1_Hi.Position < TB_1_Lo.Position then
    TB_1_Lo.Position := TB_1_Hi.Position;
end;

procedure TMainForm.TB_2_HiChange(Sender: TObject);
begin
  if TB_2_Hi.Position < TB_2_Lo.Position then
    TB_2_Lo.Position := TB_2_Hi.Position;
end;

procedure TMainForm.StartStopItemClick(Sender: TObject);
begin
  if Processing then
    EndProcessing
  else
    BeginProcessing;
end;

procedure TMainForm.pKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_ESCAPE: p.Position := 64;
    VK_SPACE: p.Position := 128;
    VK_RETURN: p.Position := 192;
  end;
end;

procedure TMainForm.uKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_ESCAPE: u.Position := 64;
    VK_SPACE: u.Position := 128;
    VK_RETURN: u.Position := 192;
  end;
end;


// We use 4-byte floating point assembly, so complain if sizeof(vec_t) != 4
{$IFDEF CONFIG_DOUBLEVEC}
initialization
  Windows.MessageBox(NULL,'LibV conflict','vec_t must be 4-byte float',MB_ICONHAND);
  ExitProcess(0);
{$ENDIF} {CONFIG_DOUBLEVEC}

end.

