409 lines
11 KiB
PHP

{
$Log: acs_audio.inc,v $
Revision 1.7 2006/08/31 20:10:56 z0m3ie
*** empty log message ***
Revision 1.6 2006/07/04 17:12:45 z0m3ie
ACS 2.4 alt wiederhergestellt (unterschiedliche Sampleformate ...)
Revision 1.3 2006/01/01 18:46:40 z0m3ie
*** empty log message ***
Revision 1.2 2005/12/26 17:31:39 z0m3ie
fixed some problems in acs_dsfiles
fixed some problems in acs_vorbis
reworked all buffers
Revision 1.1 2005/12/19 18:36:26 z0m3ie
*** empty log message ***
Revision 1.6 2005/12/18 17:01:54 z0m3ie
delphi compatibility
Revision 1.5 2005/12/04 16:54:34 z0m3ie
All classes are renamed, Style TACS... than T... to avoid conflicts with other components (eg TMixer is TACSMixer now)
Revision 1.4 2005/11/27 16:50:34 z0m3ie
add ACS VolumeQuerry
make ACS_VolumeQuerry localizeable
some little errorfixes (buffersize for linuxdrivers was initially 0)
make TAudioIn workable
Revision 1.3 2005/10/02 16:51:31 z0m3ie
*** empty log message ***
Revision 1.2 2005/09/18 19:29:00 z0m3ie
more progress on driver handling
}
function GetAudioDeviceInfo(DevID : Integer; OutputDev : Boolean) : TACSDeviceInfo;
var
WIC : TWaveInCaps;
i : Integer;
begin
if OutputDev then
begin
if DevID >= OutputChannelsCount then
raise EACSException.Create(Format(strChannelnotavailable,[DevId]));
end else
begin
if DevID >= InputChannelsCount then
raise EACSException.Create(Format(strChannelnotavailable,[DevId]));
end;
if OutputDev then waveOutGetDevCaps(DevID, @WIC, SizeOf(WIC))
else waveInGetDevCaps(DevID, @WIC, SizeOf(WIC));
i := 0;
while WIC.szPname[i] <> #0 do Inc(i);
SetLength(Result.DeviceName, i);
Move(WIC.szPname[0], Result.DeviceName[1], i);
Result.Formats := [];
if (WIC.dwFormats and WAVE_FORMAT_1M08) <> 0 then Result.Formats := Result.Formats + [af1M08];
if (WIC.dwFormats and WAVE_FORMAT_1M16) <> 0 then Result.Formats := Result.Formats + [af1M16];
if (WIC.dwFormats and WAVE_FORMAT_1S08) <> 0 then Result.Formats := Result.Formats + [af1S08];
if (WIC.dwFormats and WAVE_FORMAT_1S16) <> 0 then Result.Formats := Result.Formats + [af1S16];
if (WIC.dwFormats and WAVE_FORMAT_2M08) <> 0 then Result.Formats := Result.Formats + [af2M08];
if (WIC.dwFormats and WAVE_FORMAT_2M16) <> 0 then Result.Formats := Result.Formats + [af2M16];
if (WIC.dwFormats and WAVE_FORMAT_2S08) <> 0 then Result.Formats := Result.Formats + [af2S08];
if (WIC.dwFormats and WAVE_FORMAT_2S16) <> 0 then Result.Formats := Result.Formats + [af2S16];
if (WIC.dwFormats and WAVE_FORMAT_4M08) <> 0 then Result.Formats := Result.Formats + [af4M08];
if (WIC.dwFormats and WAVE_FORMAT_4M16) <> 0 then Result.Formats := Result.Formats + [af4M16];
if (WIC.dwFormats and WAVE_FORMAT_4S08) <> 0 then Result.Formats := Result.Formats + [af4S08];
if (WIC.dwFormats and WAVE_FORMAT_4S16) <> 0 then Result.Formats := Result.Formats + [af4S16];
Result.DrvVersion := WIC.vDriverVersion;
if WIC.wChannels = 1 then Result.Stereo := False else Result.Stereo := True;
end;
procedure WaveOutProc(hwo, Msg : LongWord; Instance : Pointer; Param1, Param2 : LongWord); stdcall;
var
Audio : TStdAudioOut;
begin
EnterCriticalSection(CrSecO);
if Msg = WOM_DONE then
begin
Audio := TStdAudioOut(Instance);
Audio.AddBlockToChain(PWaveHdr(Param1));
end;
LeaveCriticalSection(CrSecO);
end;
procedure WaveInProc(hwi, Msg : LongWord; Instance : Pointer; Param1, Param2 : LongWord); stdcall;
var
Audio : TStdAudioIn;
begin
EnterCriticalSection(CrSecI);
if Msg = WIM_DATA then
begin
Audio := TStdAudioIn(Instance);
Audio.AddBlockToChain(PWaveHdr(Param1));
end;
LeaveCriticalSection(CrSecI);
end;
procedure TStdAudioOut.AddBlockToChain(WH : PWaveHdr);
begin
WH.lpNext := nil;
EOC^ := WH;
EOC := @WH.lpNext;
Dec(aBlock);
end;
procedure TStdAudioOut.SetDevice;
begin
if Busy then raise EACSException.Create(strBusy);
if OutputChannelsCount = 0 then FBaseChannel := 0 else
if Ch < OutputChannelsCount then FBaseChannel := Ch
else raise EACSException.Create(Format(strChannelnotavailable,[Ch]));
end;
procedure TStdAudioOut.Prepare;
var
WF : TPCMWaveFormat;
begin
// No exceptions here!
FInput.Init;
WF.wf.wFormatTag := WAVE_FORMAT_PCM;
WF.wf.nChannels := FInput.Channels;
WF.wf.nSamplesPerSec := FInput.SampleRate;
WF.wBitsPerSample := FInput.BitsPerSample;
WF.wf.nAvgBytesPerSec := WF.wf.nSamplesPerSec*WF.wBitsPerSample div 8;
WF.wf.nBlockAlign := WF.wf.nChannels * WF.wBitsPerSample div 8;
waveOutOpen(@_audio_fd, FBaseChannel, @WF, DWORD(@WaveOutProc), DWORD(Self), CALLBACK_FUNCTION or WAVE_MAPPED);
aBlock := 0;
FBuffer := AllocMem(FBufferSize);
EOC := @BlockChain;
end;
procedure TStdAudioOut.Done;
var
Tmp : PWaveHdr;
begin
if _audio_fd <> -1 then
begin
while aBlock > 0 do;
Tmp := BlockChain;
while Tmp <> nil do
begin
BlockChain := Tmp.lpNext;
waveOutUnprepareHeader(_audio_fd, Tmp, SizeOf(TWaveHdr));
FreeMem(Tmp.lpData);
Dispose(Tmp);
Tmp := BlockChain;
end;
EOC := @BlockChain;
waveOutClose(_audio_fd);
FreeMem(FBuffer);
_audio_fd := -1;
end;
FInput.Flush;
end;
function TStdAudioOut.DoOutput(Abort : Boolean):Boolean;
var
Len, i, k, vCoef : Integer;
P : Pointer;
P1 : PACSBuffer8;
P2 : PACSBuffer16;
Tmp : PWaveHdr;
begin
// No exceptions Here
Result := True;
if not Busy then Exit;
if Abort or (not CanOutput) then
begin
Result := False;
Exit;
end;
Tmp := BlockChain; // clear pending data blocks
while Tmp <> nil do
begin
BlockChain := Tmp.lpNext;
waveOutUnprepareHeader(_audio_fd, Tmp, SizeOf(TWaveHdr));
FreeMem(Tmp.lpData);
Dispose(Tmp);
Tmp := BlockChain;
end;
EOC := @BlockChain;
(* Write more than one block. This is needed for audio sources like
Vorbis codec that return data in small chunks. *)
for k := aBlock to FReadChunks do
begin
GetMem(P, FBufferSize div FReadChunks);
while InputLock do;
InputLock := True;
Len := Finput.GetData(P, FBufferSize div FReadChunks);
InputLock := False;
if Len > 0 then Result := True
else
begin
Result := False;
FreeMem(P);
Exit;
end;
if FVolume < 255 then
begin
vCoef := Round(FVolume/255);
if FInput.BitsPerSample = 16 then
begin
P2 := P;
for i := 0 to (Len shr 1) -1 do
P2[i] := P2[i]*vCoef;
end else
begin
P1 := P;
for i := 0 to Len - 1 do
P1[i] := P1[i]*vCoef;
end;
end;
WriteBlock(P, Len);
end;
end;
constructor TStdAudioOut.Create;
begin
inherited Create(AOwner);
FBaseChannel := 0;
FVolume := 255;
_audio_fd := -1;
Delay := 6;
FReadChunks := 8;
FBufferSize := $8000;
end;
destructor TStdAudioOut.Destroy;
begin
if _audio_fd <> -1 then WaveOutClose(_audio_fd);
inherited Destroy;
end;
destructor TStdAudioIn.Destroy;
begin
waveInClose(_audio_fd);
inherited Destroy;
end;
procedure TStdAudioIn.OpenAudio;
var
WF : TPCMWaveFormat;
begin
WF.wf.wFormatTag := WAVE_FORMAT_PCM;
WF.wf.nChannels := FChan;
WF.wf.nSamplesPerSec := FFreq;
WF.wBitsPerSample := FBPS;
WF.wf.nAvgBytesPerSec := WF.wf.nSamplesPerSec*WF.wBitsPerSample div 8;
WF.wf.nBlockAlign := WF.wf.nChannels * WF.wBitsPerSample div 8;
if FOpened = 0 then
begin
waveInOpen(@_audio_fd, FBaseChannel, @WF, DWORD(@WaveInProc), DWORD(Self), CALLBACK_FUNCTION or WAVE_MAPPED);
end;
Inc(FOpened);
end;
procedure TStdAudioIn.CloseAudio;
begin
if FOpened = 1 then
begin
waveInClose(_audio_fd);
FreeMem(FBuffer);
end;
if FOpened > 0 then Dec(FOpened);
end;
function TStdAudioIn.GetBPS : Integer;
begin
Result := FBPS;
end;
function TStdAudioIn.GetCh : Integer;
begin
Result := FChan;
end;
function TStdAudioIn.GetSR : Integer;
begin
Result := FFreq;
end;
procedure TStdAudioIn.Init;
begin
if Busy then raise EACSException.Create(strBusy);
BufEnd := 0;
BufStart := 1;
FPosition := 0;
FRecBytes := FRecTime * (GetBPS div 8) * GetCh * GetSR;
FBusy := True;
OpenAudio;
waveInStart(_audio_fd);
BlockChain := nil;
FSize := FRecBytes;
aBlock := 0;
EOC := @BlockChain;
end;
procedure TStdAudioIn.Flush;
var
Tmp : PWaveHdr;
begin
while aBlock > 0 do; // wait until pending data blocks are put to the chain
waveInReset(_audio_fd); // return all pending data blocks
sleep(10);
Tmp := BlockChain; // clear pending data blocks
while Tmp <> nil do
begin
BlockChain := Tmp.lpNext;
waveInUnprepareHeader(_audio_fd, Tmp, SizeOf(TWaveHdr));
FreeMem(Tmp.lpData);
Dispose(Tmp);
Tmp := BlockChain;
end;
CloseAudio;
FBusy := False;
end;
procedure TStdAudioIn.SetDevice;
begin
if Busy then raise EACSException.Create(strBusy);
if Ch < InputChannelsCount then FBaseChannel := Ch
else raise EACSException.Create(Format(strChannelnotavailable,[Ch]));
end;
function TStdAudioIn.GetData(Buffer : Pointer; oBufferSize : Integer): Integer;
var
Tmp : PWaveHdr;
begin
if not Busy then raise EACSException.Create(strStreamnotopen);
if FRecBytes >= 0 then
if (FPosition >= FRecBytes) then
begin
Result := 0;
Exit;
end;
while aBlock < FBlocksCount do
NewBlock;
if BufStart > BufEnd then
begin
BufStart := 1;
while BlockChain = nil do
sleep(10);
TMP := BlockChain;
BlockChain := BlockChain.lpNext;
if BlockChain = nil then
EOC := @BlockChain;
Move(Tmp.lpData[0], FBuffer[1], Tmp.dwBytesRecorded);
BufEnd := Tmp.dwBytesRecorded;
waveInUnprepareHeader(_audio_fd, Tmp, SizeOf(TWaveHdr));
FreeMem(Tmp.lpData);
Dispose(Tmp);
end;
if BufferSize < (BufEnd - BufStart + 1) then
Result := BufferSize
else
Result := BufEnd - BufStart + 1;
Move(FBuffer[BufStart], Buffer^, Result);
Inc(BufStart, Result);
Inc(FPosition, Result);
end;
procedure TStdAudioOut.WriteBlock;
var
WH : PWaveHdr;
begin
Inc(aBlock);
New(WH);
WH.lpData := P;
WH.dwBufferLength := Len;
WH.dwLoops := 0;
WH.dwFlags := 0;
waveOutPrepareHeader(_audio_fd, WH, SizeOf(TWaveHdr));
waveOutWrite(_audio_fd, WH, SizeOf(TWaveHdr));
end;
procedure TStdAudioIn.NewBlock;
var
WH : PWaveHdr;
begin
New(WH);
GetMem(WH.lpData, BufferSize div FBlocksCount);
WH.dwBufferLength := BufferSize div FBlocksCount;
WH.dwFlags := 0;
waveInPrepareHeader(_audio_fd, WH, SizeOf(TWaveHdr));
waveInAddBuffer(_audio_fd, WH, SizeOf(TWaveHdr));
Inc(aBlock);
end;
function CountChannels : Integer;
begin
OutputChannelsCount := waveOutGetNumDevs;
InputChannelsCount := waveInGetNumDevs;
end;
procedure TStdAudioIn.AddBlockToChain(WH : PWaveHdr);
begin
WH.lpNext := nil;
EOC^ := WH;
EOC := @WH.lpNext;
Dec(aBlock);
end;