diff --git a/components/fpsound/fpsound.pas b/components/fpsound/fpsound.pas new file mode 100644 index 000000000..92c18d2d0 --- /dev/null +++ b/components/fpsound/fpsound.pas @@ -0,0 +1,79 @@ +{ +A generic library for playing sound with modular backends + +In the future it might be extended to be able to modify and save sound files in +multiple formats too. + +Copyright: Felipe Monteiro de Carvalho 2010-2011 +} +unit fpsound; + +{$mode objfpc} + +interface + +uses + Classes, SysUtils; + +type + TSoundPlayerKind = (spOpenAL, spMPlayer, spFMod, spExtra1); + + TSoundPlayer = class + public + procedure Play; + end; + + { TSoundDocument } + + TSoundDocument = class + private + AStream: TStream; + public + constructor Create; virtual; + destructor Destroy; override; + procedure LoadFromFile(AFileName: string); + procedure Play; + procedure SetSoundPlayer(AKind: TSoundPlayerKind); + end; + +procedure RegisterSoundPlayer(APlayer: TSoundPlayer; AKind: TFPSoundPlayerKind); + +implementation + +var + GSoundPlayers: array[TSoundPlayerKind] of TSoundPlayer = (nil, nil, nil, nil); + +procedure RegisterSoundPlayer(APlayer: TSoundPlayer; AKind: TFPSoundPlayerKind); +begin + GSoundPlayers[AKind] := APlayer; +end; + +{ TSoundDocument } + +constructor TSoundDocument.Create; +begin + +end; + +destructor TSoundDocument.Destroy; +begin + inherited Destroy; +end; + +procedure TSoundDocument.LoadFromFile(AFileName: string); +begin + +end; + +procedure TSoundDocument.Play; +begin + +end; + +procedure TSoundDocument.SetSoundPlayer(AKind: TFPSoundPlayerKind); +begin + +end; + +end. + diff --git a/components/fpsound/fpsound_openal.pas b/components/fpsound/fpsound_openal.pas new file mode 100644 index 000000000..572584c16 --- /dev/null +++ b/components/fpsound/fpsound_openal.pas @@ -0,0 +1,432 @@ +{ +} +unit fpsound_openal; + +{$mode objfpc} + +interface + +uses + Classes, SysUtils, openal, fpsound_wav, fpsound; + +// openal +const + // Note: if you lower the al_bufcount, then you have to modify the al_polltime also! + al_bufcount = 4; + al_polltime = 100; + +var + al_device : PALCdevice; + al_context : PALCcontext; + +type + TOpenALPlayer = class(TObject) + private + public + source : TStream; + codec_bs : Longword; + OPCSoundWasInitialized: Boolean; + OPCSoundStreamIsLoaded: Boolean; + al_source : ALuint; + al_format : Integer; + al_buffers : array[0..al_bufcount-1] of ALuint; + al_bufsize : Longword; + al_readbuf : Pointer; + al_rate : Longword; + wave : TWaveReader; + procedure OPCSoundOpenALPlay(); + procedure OPCSoundOpenALLoadWavFromStream(AStream: TStream); + procedure OPCSoundOpenALInitialize(); + procedure OPCSoundOpenALFinalize(); + procedure alStop; + function alProcess: Boolean; + end; + +implementation + +type + TWAVHeader = record + RIFFHeader: array [1..4] of AnsiChar; + FileSize: longint; + WAVEHeader: array [1..4] of AnsiChar; + FormatHeader: array [1..4] of AnsiChar; + FormatHeaderSize: longint; + FormatCode: Word; + ChannelNumber: Word; + SampleRate: longint; + BytesPerSecond: longint; + BytesPerSample: Word; + BitsPerSample: Word; + end; + +var + buffer : Cardinal; + source : Cardinal; + sourcepos: array [0..2] of Single=(0.0, 0.0, 0.0); + sourcevel: array [0..2] of Single=(0.0, 0.0, 0.0); + listenerpos: array [0..2] of Single=(0.0, 0.0, 0.0); + listenervel: array [0..2] of Single=(0.0, 0.0, 0.0); + listenerori: array [0..5] of Single=(0.0, 0.0, -1.0, 0.0, 1.0, 0.0); + Context: PALCcontext; + Device: PALCdevice; + +function LoadWavStream(Stream: TStream; var format: integer; var data: Pointer; + var size: LongInt; var freq: LongInt; var loop: LongInt): Boolean; +var + WavHeader: TWavHeader; + readname: pansichar; + name: ansistring; + readint: longint; +begin + Result:=False; + + size:=0; + data:=nil; + + //Read wav header + stream.Read(WavHeader, sizeof(TWavHeader)); + + //Determine SampleRate + freq:=WavHeader.SampleRate; + + //Detemine waveformat + if WavHeader.ChannelNumber = 1 then + case WavHeader.BitsPerSample of + 8: format := AL_FORMAT_MONO8; + 16: format := AL_FORMAT_MONO16; + end; + + if WavHeader.ChannelNumber = 2 then + case WavHeader.BitsPerSample of + 8: format := AL_FORMAT_STEREO8; + 16: format := AL_FORMAT_STEREO16; + end; + + //go to end of wavheader + stream.seek((8-44)+12+4+WavHeader.FormatHeaderSize+4,soFromCurrent); //hmm crappy... + + getmem(readname,4); //only alloc memory once, thanks to zy. + //loop to rest of wave file data chunks + repeat + //read chunk name + stream.Read(readname^, 4); + name := readname[0]+readname[1]+readname[2]+readname[3]; + if name='data' then + begin + //Get the size of the wave data + stream.Read(readint,4); + size:=readint; + //if WavHeader.BitsPerSample = 8 then size:=size+8; //fix for 8bit??? + //Read the actual wave data + getmem(data,size); + stream.Read(Data^, size); + + //Decode wave data if needed + if WavHeader.FormatCode=$0011 then + begin + //TODO: add code to decompress IMA ADPCM data + end; + if WavHeader.FormatCode=$0055 then + begin + //TODO: add code to decompress MP3 data + end; + Result:=True; + end + else + begin + //Skip unknown chunk(s) + stream.Read(readint,4); + stream.Position:=stream.Position+readint; + end; + until stream.Position>=stream.size; + freemem(readname); + + loop:= 0; +end; + +procedure alutLoadWAVFile(fname: string; var format: Integer; var data: Pointer; + var size: LongInt; var freq: LongInt; var loop: LongInt); +var + Stream : TFileStream; +begin + Stream:=TFileStream.Create(fname,$0000); + LoadWavStream(Stream, format, data, size, freq, loop); + Stream.Free; +end; + +procedure OPCSoundPlayStreamEx(AStream: TStream); +var + format: Integer; + size: LongInt; + freq: LongInt; + loop: LongInt; + data: Pointer; +begin + AlSourceStop(source); + + AlGenBuffers(1, @buffer); + loop:=0; + LoadWavStream(AStream, format, data, size, freq, loop); + AlBufferData(buffer, format, data, size, freq); + + if data<>nil then freemem(data); + + AlGenSources(1, @source); + AlSourcei(source, AL_BUFFER, buffer); + AlSourcef(source, AL_PITCH, 1.0); + AlSourcef(source, AL_GAIN, 1.0); + AlSourcefv(source, AL_POSITION, @sourcepos); + AlSourcefv(source, AL_VELOCITY, @sourcevel); + // Under windows, AL_LOOPING = AL_TRUE breaks queueing, no idea why + // AlSourcei(source, AL_LOOPING, AL_TRUE); + + AlListenerfv(AL_POSITION, @listenerpos); + AlListenerfv(AL_VELOCITY, @listenervel); + AlListenerfv(AL_ORIENTATION, @listenerori); + AlSourcePlay(source); +end; + +{$DEFINE OPC_SOUND_OPENAL_THREAD} + +{$ifdef WINDOWS}uses Windows; {$endif} + +type + TOpenALThread = class(TThread) + private + + public + FAOwner: TStream; + constructor Create(aOwner: TStream); + destructor Destroy; override; + procedure Execute; override; + procedure DoOpenALPlay; + end; + +var + TheLastThread: TOpenALThread; + +procedure OPCSoundInitialize(); +begin + +end; + +procedure ResetOpenALThread; +begin + if (TheLastThread <> nil) and (not TheLastThread.Terminated) then + begin + try + {$IFDEF MSWINDOWS} + TerminateThread(TheLastThread.Handle, 0); + {$ELSE} + TheLastThread.Terminate; + {$ENDIF} + except + end; + end; +end; + +procedure OPCSoundLoadWavFromStream(AStream: TStream); +begin + {$IFDEF OPC_SOUND_OPENAL_THREAD} + ResetOpenALThread; + TheLastThread := TOpenALThread.Create(AStream); + {$ELSE} + OPCSoundPlayStreamEx(AStream); + {$ENDIF} +end; + +procedure OPCSoundPlay(); +begin + {$IFDEF OPC_SOUND_OPENAL_THREAD} + + {$ELSE} + OPCAudioPlayer.OPCSoundOpenALInitialize(); + OPCAudioPlayer.OPCSoundOpenALPlay(); + OPCAudioPlayer.OPCSoundOpenALFinalize(); + {$ENDIF} +end; + +procedure OPCSoundFinalize(); +begin + {$IFDEF OPC_SOUND_OPENAL_THREAD} + ResetOpenALThread; + {$ELSE} + OPCAudioPlayer.OPCSoundOpenALFinalize(); + {$ENDIF} +end; + +procedure OPCSoundPlayStream(AStream: TStream); +begin + OPCSoundLoadWavFromStream(AStream); +end; + +constructor TOpenALThread.Create(aOwner: TStream); +begin + inherited Create(False); + FAOwner := aOwner; + FreeOnTerminate := True; +end; + +destructor TOpenALThread.Destroy; +begin + + inherited Destroy; +end; + +procedure TOpenALThread.Execute; +begin + Synchronize(@DoOpenALPlay); +end; + +procedure TOpenALThread.DoOpenALPlay; +begin + OPCSoundPlayStreamEx(FAOwner); +end; + +/// + +procedure TOPCAudioPlayer.alStop; +begin + alSourceStop(al_source); + alSourceRewind(al_source); + alSourcei(al_source, AL_BUFFER, 0); +end; + +function TOPCAudioPlayer.alProcess: Boolean; +var + processed : ALint; + buffer : ALuint; + sz : Integer; +begin + alGetSourcei(al_source, AL_BUFFERS_PROCESSED, processed); + while (processed > 0) and (processed <= al_bufcount) do + begin + alSourceUnqueueBuffers(al_source, 1, @buffer); + sz:=wave.ReadBuf(al_readbuf^, al_bufsize); + if sz <= 0 then + begin + Exit(False); + end; + alBufferData(buffer, al_format, al_readbuf, sz, al_rate); + alSourceQueueBuffers(al_source, 1, @buffer); + Dec(processed); + end; + Result := True; +end; + +procedure TOPCAudioPlayer.OPCSoundOpenALPlay(); +var + i: Integer; + queued : Integer; + done : Boolean; +begin + if not OPCSoundStreamIsLoaded then Exit; + + alSourceStop(al_source); + alSourceRewind(al_source); + alSourcei(al_source, AL_BUFFER, 0); + + for i := 0 to al_bufcount - 1 do + begin + if wave.ReadBuf(al_readbuf^, al_bufsize) = 0 then + Break; + + alBufferData(al_buffers[i], al_format, al_readbuf, al_bufsize, al_rate); + alSourceQueueBuffers(al_source, 1, @al_buffers[i]); + end; + + // Under windows, AL_LOOPING = AL_TRUE breaks queueing, no idea why + alSourcei(al_source, AL_LOOPING, AL_FALSE); + alSourcePlay(al_source); + + done:=False; + queued:=0; + repeat + if alProcess then begin + alGetSourcei(al_source, AL_BUFFERS_QUEUED, queued); + done:=queued=0; + end; + Sleep(al_polltime); + until done; +end; + +procedure TOPCAudioPlayer.OPCSoundOpenALLoadWavFromStream(AStream: TStream); +var + Filename: String; + queued : Integer; + done : Boolean; +begin + if AStream = nil then + begin + OPCSoundStreamIsLoaded := False; + Exit; + end + else + OPCSoundStreamIsLoaded := True; + + FreeAndNil(source); + // define codec + source := AStream; + + // inittialize codec + wave:=TWaveReader.Create; + if not wave.LoadFromStream(source) then + raise Exception.Create('[OPCSoundLoadWavFromStream] unable to read WAVE format'); + + if wave.fmt.Format<>1 then + raise Exception.Create('[OPCSoundLoadWavFromStream] WAVE files with compression aren''t supported'); + + if wave.fmt.Channels=2 then begin + if wave.fmt.BitsPerSample=8 then al_format:=AL_FORMAT_STEREO8 + else al_format:=AL_FORMAT_STEREO16 + end else begin + if wave.fmt.BitsPerSample=8 then al_format:=AL_FORMAT_MONO8 + else al_format:=AL_FORMAT_MONO16 + end; + + codec_bs:=2*wave.fmt.Channels; + + //al_bufsize := 20000 - (20000 mod codec_bs); + al_bufsize := 20000 - (20000 mod codec_bs); + al_rate:=wave.fmt.SampleRate; +// WriteLn('Blocksize : ', codec_bs); +// WriteLn('Rate : ', wave.fmt.SampleRate); +// WriteLn('Channels : ', wave.fmt.Channels); +// WriteLn('OpenAL Buffers : ', al_bufcount); +// WriteLn('OpenAL Buffer Size : ', al_bufsize); + + alProcess(); +end; + +procedure TOPCAudioPlayer.OPCSoundOpenALInitialize(); +begin + OPCSoundWasInitialized := True; + + alDistanceModel(AL_INVERSE_DISTANCE_CLAMPED); + alGenSources(1, @al_source); + alGenBuffers(al_bufcount, @al_buffers); + + GetMem(al_readbuf, al_bufsize); +end; + +procedure TOPCAudioPlayer.OPCSoundOpenALFinalize(); +begin + // finalize openal + alDeleteSources(1, @al_source); + alDeleteBuffers(al_bufcount, @al_buffers); + FreeMem(al_readbuf); + +// wave.fStream := nil; +// source := nil; + + // finalize codec + wave.Free; + + // close file +// source.Free; +end; + +finalization + //if OPCSoundWasInitialized then OPCSoundOpenALFinalize(); +end. + diff --git a/components/fpsound/fpsound_pkg.lpk b/components/fpsound/fpsound_pkg.lpk new file mode 100644 index 000000000..4958c3cd5 --- /dev/null +++ b/components/fpsound/fpsound_pkg.lpk @@ -0,0 +1,41 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/fpsound/fpsound_pkg.pas b/components/fpsound/fpsound_pkg.pas new file mode 100644 index 000000000..61b3d2c82 --- /dev/null +++ b/components/fpsound/fpsound_pkg.pas @@ -0,0 +1,20 @@ +{ This file was automatically created by Lazarus. Do not edit! + This source is only used to compile and install the package. + } + +unit fpsound_pkg; + +interface + +uses + fpsound_openal, fpsound, fpsound_wav, LazarusPackageIntf; + +implementation + +procedure Register; +begin +end; + +initialization + RegisterPackage('fpsound_pkg', @Register); +end. diff --git a/components/fpsound/fpsound_wav.pas b/components/fpsound/fpsound_wav.pas new file mode 100644 index 000000000..f49598b1d --- /dev/null +++ b/components/fpsound/fpsound_wav.pas @@ -0,0 +1,141 @@ +{ +} +unit fpsound_wav; + +{$mode objfpc} + +interface + +uses + Classes, SysUtils; + +// WAVE UTILS + +type + TRiffHeader = packed record + ID : array [0..3] of char; + Size : LongWord; + Format : array [0..3] of char; + end; + + TWaveFormat = packed record + ID : array [0..3] of char; + Size : LongWord; + Format : Word; + Channels : Word; + SampleRate : LongWord; + ByteRate : LongWord; + BlockAlign : Word; + BitsPerSample : Word; + end; + + TDataChunk = packed record + Id : array [0..3] of char; + Size : LongWord; + end; + + { TWaveReader } + + TWaveReader = class(TObject) + private + loaded : Boolean; + chunkdata : TDataChunk; + chunkpos : Int64; + pos : Int64; + eof : Boolean; + public + fmt : TWaveFormat; + fStream : TStream; + function LoadFromStream(AStream: TStream): Boolean; + function ReadBuf(var Buffer; BufferSize: Integer): Integer; + end; + +implementation + +const + ID_RIFF = 'RIFF'; + ID_WAVE = 'WAVE'; + ID_fmt = 'fmt '; + ID_data = 'data'; + +{ TWaveReader } + +function TWaveReader.LoadFromStream(AStream:TStream):Boolean; +var + riff : TRiffHeader; +begin + fStream:=AStream; + loaded:=True; + try + Result:=fStream.Read(riff, sizeof(riff))=sizeof(riff); + riff.Size:=LEtoN(riff.Size); + Result:=Result and (riff.ID=ID_RIFF) and (riff.Format=ID_WAVE); + if not Result then Exit; + + Result:=fStream.Read(fmt, sizeof(fmt))=sizeof(fmt); + fmt.Size:=LEtoN(fmt.Size); + fmt.Format:=LEtoN(fmt.Format); + fmt.Channels:=LEtoN(fmt.Channels); + fmt.SampleRate:=LEtoN(fmt.SampleRate); + fmt.ByteRate:=LEtoN(fmt.ByteRate); + fmt.BlockAlign:=LEtoN(fmt.BlockAlign); + fmt.BitsPerSample:=LEtoN(fmt.BitsPerSample); + + Result:=fmt.ID=ID_fmt; + pos:=-1; + except + Result:=False; + Exit; + end; +end; + +function Min(a,b: Integer): Integer; +begin + if a=chunkdata.Size then begin + if pos<0 then + fstream.Position:=sizeof(TRiffHeader)+Int64(fmt.Size)+sizeof(TDataChunk) + else + fstream.Position:=pos+chunkdata.size+SizeOf(chunkdata); + + eof:=pos>=fStream.Size; + if not eof then begin + pos:=fStream.Position; + sz:=fstream.Read(chunkdata, sizeof(chunkdata)); + chunkdata.Size:=LEtoN(chunkdata.Size); + if (sz<>sizeof(chunkdata)) or (chunkdata.Id<>ID_data) then + chunkpos:=chunkdata.Size + else + chunkpos:=0; + end; + end else begin + sz:=Min(BufferSize, chunkdata.Size-chunkpos); + fStream.Position:=pos+sizeof(chunkdata)+chunkpos; + sz:=fStream.Read(p[i], sz); + if sz<0 then Exit; + inc(chunkpos, sz); + inc(i, sz); + end; + end; + Result:=i; +end; + +end. +