Unit UnitPlayer;

interface


function Player_Init(samplerate: Integer; bitpersample: Integer): boolean;
procedure Player_Start();
procedure Player_Stop();
procedure Player_AddData(data: Pointer; len: Integer);


implementation

uses
  Windows, mmSystem, SysUtils;


type
  TQueue = class
  private
    rIndex: Integer;
    wIndex: Integer;
    size: Integer;
    buff: Pointer;
  public
    constructor Create();
    destructor Destroy();
    procedure WriteData(p: Pointer; len: Integer);
    function ReadData(p:Pointer; max: Integer): Integer;
    function Length(): Integer;
  end;

const
  AudioDeviceID = WAVE_MAPPER;
  SamplesPerBlock = 1000;
  No_Buffers = 3;
  QueueSize = 32000;

var
  WaveOut             : HWAVEOUT;
  WaveFmt             : TWaveFormatEx;
  WaveHeader          : array [0..No_Buffers-1] of TWaveHdr;
  ForwardIndex        : Integer;
  ReturnIndex         : Integer;
  ActiveBuffers       : Integer;
  DeviceOpen          : Boolean;
  Active              : Boolean;
  queue               : TQueue;
  WaveBufferSize      : Integer;

/////////////////////////////////////////////////////////////////////////

function Player_GetError(iErr : Integer): String;
var
  pError : PChar;
begin
  GetMem(pError, 256*2);   { make sure there is ample space if WideChar is used }
  waveOutGetErrorText(iErr, pError, 255);
  Result:= StrPas(pError);
  FreeMem(pError);
end;

function Player_AddBuffer(): Boolean;
var
  iErr:integer;
  res: Integer;
begin
  Result:= False;
  with WaveHeader[ForwardIndex] do
  begin
    // Fill buffer
    dwBufferLength:= WaveBufferSize;
    dwFlags:=0;
    dwLoops:=0;
    // copy available data
    res:= 0;//queue.ReadData(lpData, WaveBufferSize);
    // Zero buffer
    FillChar((lpData+res)^, WaveBufferSize - res, 0);
    res:= WaveBufferSize;
  end;
  iErr:= waveOutPrepareHeader(WaveOut, @WaveHeader[ForwardIndex], SizeOf(TWaveHdr));
  if iErr = 0 then
  begin
    iErr:= waveOutWrite(WaveOut, @WaveHeader[ForwardIndex], SizeOf(TWaveHdr));
    if iErr = 0 then
    begin
      ForwardIndex:= (ForwardIndex+1) mod No_Buffers;
      inc(ActiveBuffers);
      Result:= True;
      Exit;
    end;
  end;
end;

procedure PlayerCallBack(hW:HWAVEOUT; uMsg,dwInstance,dwParam1,dwParam2 : DWORD);  stdcall;
begin
  case uMsg of
    wom_OPEN  :
                Active:= true;
    wom_CLOSE :
                Active:= false;
    wom_DONE  :
                if Active then
                begin
                  if (ForwardIndex=ReturnIndex) then
                  begin
                    //if not(FinishedPlaying) then
                    begin
                      //FinishedPlaying:=true;
                      //PostMessage(CloseHandle,mm_wom_CLOSE,0,0);
                    end;
                  end
                  else
                  begin
                    //PostMessage(AddNextOutBufferHandle,wom_DONE,0,0);
                    Player_AddBuffer();
                    ReturnIndex:=(ReturnIndex+1) mod No_Buffers;
                    dec(ActiveBuffers);
                  end;
                end;
  end;
end;

function Player_Init(samplerate: Integer; bitpersample: Integer): boolean;
var
  i: Integer;
begin
  Exit;

  with WaveFmt do
  begin
    wFormatTag:= WAVE_FORMAT_PCM;
    nChannels:= 1;
    nSamplesPerSec:= samplerate;
    nBlockAlign:= (bitpersample div 8) * nChannels;
    nAvgBytesPerSec:= nSamplesPerSec * nBlockAlign;
    WaveBufferSize:= nBlockAlign * SamplesPerBlock;
  end;
  queue:= TQueue.Create;

  for i:=0 to No_Buffers-1 do
  with WaveHeader[i] do
  begin
    GetMem(lpData, WaveBufferSize);
    dwBufferLength:= WaveBufferSize;
    dwBytesRecorded:= 0;
    dwUser:= 0;
    dwFlags:= 0;
    dwLoops:= 0;
    lpNext:= nil;
    reserved:= 0;
  end;

end;

procedure Player_Start();
var
  iErr : Integer;
  i: Integer;
begin
  if not(DeviceOpen) then
  begin
//    Result:=false;
    ForwardIndex:= 0;
    ActiveBuffers:= 0;
    ReturnIndex:= 1;  { necessary since ForwardIndex always is one more than being sent  }
    iErr:= waveOutOpen(@WaveOut, AudioDeviceID, @WaveFmt, DWord(@PlayerCallBack),
                       0, CALLBACK_FUNCTION + WAVE_ALLOWSYNC);
    if (iErr<>0) then
    begin
      //GetError(iErr,'Could not open the output device for playing: ');
      Exit;
    end;
    for i:=1 to No_Buffers do
      Player_AddBuffer();
    DeviceOpen:= True;
  end;
  //  Result:=true;
end;

procedure Player_Pause();
begin
  if DeviceOpen then
    waveOutPause(WaveOut);
end;

procedure Player_Restart();
begin
  if DeviceOpen then
    waveOutRestart(WaveOut);
end;

procedure TPlayer_Reset();
begin
  if DeviceOpen then
    waveOutReset(WaveOut);
end;

procedure TPlayer_BreakLoop();
begin
  if DeviceOpen then
    waveOutBreakLoop(WaveOut);
end;

procedure Player_Stop();
var
  iErr: Integer;
begin
  if not(DeviceOpen) then
  begin
    //FAudio.ErrorMessage:='Player already closed';
    exit;
  end;
  if (Active) then
  begin
    ForwardIndex:= ReturnIndex;
    iErr:= waveOutReset(WaveOut);
    if (iErr<>0) then
    begin
      //FAudio.ErrorMessage:='Error in waveOutReset';
      Exit;
    end;
  end;
//  while Active do Application.ProcessMessages;
end;

procedure Player_AddData(data: Pointer; len: Integer);
begin
  queue.WriteData(data, len);
end;

procedure Player_Free();
var
  i: Integer;
begin
  Player_Stop();
  for i:= 0 to No_Buffers-1 do
    if (WaveHeader[i].lpData<>nil) then
      FreeMem(WaveHeader[i].lpData);
  FreeAndNil(queue);
end;


{ TQueue }

constructor TQueue.Create;
begin
  rIndex:= 0;
  wIndex:= 0;
  size:= 0;
  GetMem(buff, QueueSize);
end;

destructor TQueue.Destroy;
begin
  FreeMem(buff);
end;

function TQueue.Length: Integer;
begin
  Result:= size;
end;

function TQueue.ReadData(p: Pointer; max: Integer): Integer;
var
  pos, len: Integer;
  s: Pointer;
begin
  if (wIndex<rIndex) then
    len:= QueueSize - rIndex
  else
    len:= wIndex - rIndex;
  if (len > max) then
    len:= max;

  Move(Pointer(Integer(buff)+rIndex)^, p^, len);
  Inc(rIndex, len);
  if (rIndex>=queueSize) then
    rIndex:= 0;

//   if (rIndex + max <
end;

procedure TQueue.WriteData(p: Pointer; len: Integer);
var
  l: Integer;
begin
//  bghbbb
//  l:=

end;

end.

