// // The graphics engine GLXEngine. The unit of GXScene for Delphi // unit GXS.SoundManager; (* Base classes and interface for GLScene Sound System *) interface {$I Stage.Defines.inc} uses System.Classes, System.SysUtils, System.Types, Stage.VectorTypes, Stage.VectorGeometry, GXS.BaseClasses, GXS.XCollection, GXS.SoundFileObjects, GXS.Scene, GXS.Cadencer, Stage.Utils, GXS.ImageUtils; type // Stores a single PCM coded sound sample. TgxSoundSample = class(TCollectionItem) private FName: string; FData: TgxSoundFile; FTag: Integer; protected procedure DefineProperties(Filer: TFiler); override; procedure ReadData(Stream: TStream); virtual; procedure WriteData(Stream: TStream); virtual; function GetDisplayName: string; override; procedure SetData(const val: TgxSoundFile); public constructor Create(Collection: TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure LoadFromFile(const fileName: string); procedure PlayOnWaveOut; function Sampling: TgxSoundSampling; function LengthInBytes: Integer; function LengthInSamples: Integer; function LengthInSec: Single; // This Tag is reserved for sound manager use only property ManagerTag: Integer read FTag write FTag; published property Name: string read FName write FName; property Data: TgxSoundFile read FData write SetData stored False; end; TgxSoundSamples = class(TCollection) protected owner: TComponent; function GetOwner: TPersistent; override; procedure SetItems(index: Integer; const val: TgxSoundSample); function GetItems(index: Integer): TgxSoundSample; public constructor Create(AOwner: TComponent); function Add: TgxSoundSample; function FindItemID(ID: Integer): TgxSoundSample; property Items[index: Integer]: TgxSoundSample read GetItems write SetItems; default; function GetByName(const aName: string): TgxSoundSample; function AddFile(const fileName: string; const sampleName: string = ''): TgxSoundSample; end; TgxSoundLibrary = class(TComponent) private FSamples: TgxSoundSamples; protected procedure SetSamples(const val: TgxSoundSamples); procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Samples: TgxSoundSamples read FSamples write SetSamples; end; TgxSoundSourceChange = (sscTransformation, sscSample, sscStatus); TgxSoundSourceChanges = set of TgxSoundSourceChange; TgxBSoundEmitter = class; // Base class for origin of sound playback. TgxBaseSoundSource = class(TCollectionItem) private FBehaviourToNotify: TgxBSoundEmitter; // private only, NOT persistent, not assigned FPriority: Integer; FOrigin: TgxBaseSceneObject; // NOT persistent FVolume: Single; FMinDistance, FMaxDistance: Single; FInsideConeAngle, FOutsideConeAngle: Single; FConeOutsideVolume: Single; FSoundLibraryName: string; // used for persistence FSoundLibrary: TgxSoundLibrary; // persistence via name FSoundName: string; FMute: Boolean; FPause: Boolean; FChanges: TgxSoundSourceChanges; // NOT persistent, not assigned FNbLoops: Integer; FTag: Cardinal; // NOT persistent, not assigned FFrequency: Integer; protected procedure WriteToFiler(writer: TWriter); procedure ReadFromFiler(reader: TReader); function GetDisplayName: string; override; procedure SetPriority(const val: Integer); procedure SetOrigin(const val: TgxBaseSceneObject); procedure SetVolume(const val: Single); procedure SetMinDistance(const val: Single); procedure SetMaxDistance(const val: Single); procedure SetInsideConeAngle(const val: Single); procedure SetOutsideConeAngle(const val: Single); procedure SetConeOutsideVolume(const val: Single); function GetSoundLibrary: TgxSoundLibrary; procedure SetSoundLibrary(const val: TgxSoundLibrary); procedure SetSoundName(const val: string); procedure SetMute(const val: Boolean); procedure SetPause(const val: Boolean); procedure SetNbLoops(const val: Integer); procedure SetFrequency(const val: Integer); public constructor Create(Collection: TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; property Changes: TgxSoundSourceChanges read FChanges; function Sample: TgxSoundSample; // This Tag is reserved for sound manager use only property ManagerTag: Cardinal read FTag write FTag; (* Origin object for the sound sources. Absolute object position/orientation are taken into account, the object's TgxBInertia is considered if any. If origin is nil, the source is assumed to be static at the origin. Note : since TCollectionItem do not support the "Notification" scheme, it is up to the Origin object to take care of updating this property prior to release/destruction. *) property Origin: TgxBaseSceneObject read FOrigin write SetOrigin; published property SoundLibrary: TgxSoundLibrary read GetSoundLibrary write SetSoundLibrary; property SoundName: string read FSoundName write SetSoundName; // Volume of the source, [0.0; 1.0] range property Volume: Single read FVolume write SetVolume; // Nb of playing loops. property NbLoops: Integer read FNbLoops write SetNbLoops default 1; property Mute: Boolean read FMute write SetMute default False; property Pause: Boolean read FPause write SetPause default False; (* Sound source priority, the higher the better. When maximum number of sound sources is reached, only the sources with the highest priority will continue to play, however, even non-playing sources should be tracked by the manager, thus allowing an "unlimited" amount of sources from the application point of view. *) property Priority: Integer read FPriority write SetPriority default 0; // Min distance before spatial attenuation occurs. 1.0 by default property MinDistance: Single read FMinDistance write SetMinDistance; { Max distance, if source is further away, it will not be heard. 100.0 by default } property MaxDistance: Single read FMaxDistance write SetMaxDistance; { Inside cone angle, [0°; 360°]. Sound volume is maximal within this cone. See DirectX SDK for details. } property InsideConeAngle: Single read FInsideConeAngle write SetInsideConeAngle; { Outside cone angle, [0°; 360°]. Between inside and outside cone, sound volume decreases between max and cone outside volume. See DirectX SDK for details. } property OutsideConeAngle: Single read FOutsideConeAngle write SetOutsideConeAngle; { Cone outside volume, [0.0; 1.0] range. See DirectX SDK for details. } property ConeOutsideVolume: Single read FConeOutsideVolume write SetConeOutsideVolume; { Sample custom playback frequency. Values null or negative are interpreted as 'default frequency'. } property Frequency: Integer read FFrequency write SetFrequency default -1; end; (* Origin of sound playback. Just publishes the 'Origin' property. Note: "orientation" is the the source's Direction, ie. the "Z" vector. *) TgxSoundSource = class(TgxBaseSoundSource) public destructor Destroy; override; published property Origin; end; TgxSoundSources = class(TCollection) protected owner: TComponent; function GetOwner: TPersistent; override; procedure SetItems(index: Integer; const val: TgxSoundSource); function GetItems(index: Integer): TgxSoundSource; function Add: TgxSoundSource; function FindItemID(ID: Integer): TgxSoundSource; public constructor Create(AOwner: TComponent); property Items[index: Integer]: TgxSoundSource read GetItems write SetItems; default; end; // EAX standard sound environments TgxSoundEnvironment = (seDefault, sePaddedCell, seRoom, seBathroom, seLivingRoom, seStoneroom, seAuditorium, seConcertHall, seCave, seArena, seHangar, seCarpetedHallway, seHallway, seStoneCorridor, seAlley, seForest, seCity, seMountains, seQuarry, sePlain, seParkingLot, seSewerPipe, seUnderWater, seDrugged, seDizzy, sePsychotic); (* Base class for sound manager components. The sound manager component is the interface to a low-level audio API (like DirectSound), there can only be one active manager at any time (this class takes care of this). Subclass should override the DoActivate and DoDeActivate protected methods to "initialize/unitialize" their sound layer, actual data releases should occur in destructor however. *) TgxSoundManager = class(TgxCadenceAbleComponent) private FActive: Boolean; FMute: Boolean; FPause: Boolean; FMasterVolume: Single; FListener: TgxBaseSceneObject; FLastListenerPosition: TVector4f; FSources: TgxSoundSources; FMaxChannels: Integer; FOutputFrequency: Integer; FUpdateFrequency: Single; FDistanceFactor: Single; FRollOffFactor: Single; FDopplerFactor: Single; FSoundEnvironment: TgxSoundEnvironment; FLastUpdateTime, FLastDeltaTime: Single; // last time UpdateSources was fired, not persistent FCadencer: TgxCadencer; procedure SetActive(const val: Boolean); procedure SetMute(const val: Boolean); procedure SetPause(const val: Boolean); procedure WriteDoppler(writer: TWriter); procedure ReadDoppler(reader: TReader); protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure SetSources(const val: TgxSoundSources); procedure SetMasterVolume(const val: Single); procedure SetListener(const val: TgxBaseSceneObject); procedure SetMaxChannels(const val: Integer); procedure SetOutputFrequency(const val: Integer); procedure SetUpdateFrequency(const val: Single); function StoreUpdateFrequency: Boolean; procedure SetCadencer(const val: TgxCadencer); procedure SetDistanceFactor(const val: Single); function StoreDistanceFactor: Boolean; procedure SetRollOffFactor(const val: Single); function StoreRollOffFactor: Boolean; procedure SetDopplerFactor(const val: Single); procedure SetSoundEnvironment(const val: TgxSoundEnvironment); procedure Loaded; override; procedure DefineProperties(Filer: TFiler); override; procedure ListenerCoordinates(var position, velocity, direction, up: TVector4f); function DoActivate: Boolean; virtual; // Invoked AFTER all sources have been stopped procedure DoDeActivate; virtual; { Effect mute of all sounds. Default implementation call MuteSource for all non-muted sources with "True" as parameter. } function DoMute: Boolean; virtual; { Effect un-mute of all sounds. Default implementation call MuteSource for all non-muted sources with "False" as parameter. } procedure DoUnMute; virtual; { Effect pause of all sounds. Default implementation call PauseSource for all non-paused sources with "True" as parameter. } function DoPause: Boolean; virtual; { Effect un-pause of all sounds. Default implementation call PauseSource for all non-paused sources with "True" as parameter. } procedure DoUnPause; virtual; procedure NotifyMasterVolumeChange; virtual; procedure Notify3DFactorsChanged; virtual; procedure NotifyEnvironmentChanged; virtual; // Called when a source will be freed procedure KillSource(aSource: TgxBaseSoundSource); virtual; { Request to update source's data in low-level sound API. Default implementation just clears the "Changes" flags. } procedure UpdateSource(aSource: TgxBaseSoundSource); virtual; procedure MuteSource(aSource: TgxBaseSoundSource; muted: Boolean); virtual; procedure PauseSource(aSource: TgxBaseSoundSource; paused: Boolean); virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; { Manual request to update all sources to reflect changes. Default implementation invokes UpdateSource for all known sources. } procedure UpdateSources; virtual; { Stop and free all sources. } procedure StopAllSources; { Progress notification for time synchronization. This method will call UpdateSources depending on the last time it was performed and the value of the UpdateFrequency property. } procedure DoProgress(const progressTime: TgxProgressTimes); override; { Sound manager API reported CPU Usage. Returns -1 when unsupported. } function CPUUsagePercent: Single; virtual; { True if EAX is supported. } function EAXSupported: Boolean; virtual; published { Activation/deactivation of the low-level sound API } property Active: Boolean read FActive write SetActive default False; { Maximum number of sound output channels. While some drivers will just ignore this value, others cannot dynamically adjust the maximum number of channels (you need to de-activate and re-activate the manager for this property to be taken into account). } property MaxChannels: Integer read FMaxChannels write SetMaxChannels default 8; { Sound output mixing frequency. Commonly used values ar 11025, 22050 and 44100. Note that most driver cannot dynamically adjust the output frequency (you need to de-ativate and re-activate the manager for this property to be taken into account). } property OutputFrequency: Integer read FOutputFrequency write SetOutputFrequency default 44100; { Request to mute all sounds. All sound requests should be handled as if sound is unmuted though, however drivers should try to take a CPU advantage of mute over MasterVolume=0 } property Mute: Boolean read FMute write SetMute default False; { Request to pause all sound, sound output should be muted too. When unpausing, all sound should resume at the point they were paused. } property Pause: Boolean read FPause write SetPause default False; { Master Volume adjustement in the [0.0; 1.0] range. Driver should take care of properly clamping the master volume. } property MasterVolume: Single read FMasterVolume write SetMasterVolume; { Scene object that materializes the listener. The sceneobject's AbsolutePosition and orientation are used to define the listener coordinates, velocity is automatically calculated (if you're using DoProgress or connected the manager to a cadencer). If this property is nil, the listener is assumed to be static at the NullPoint coordinate, facing Z axis, with up being Y (ie. the default orientation). } property Listener: TgxBaseSceneObject read FListener write SetListener; { Currently active and playing sound sources. } property Sources: TgxSoundSources read FSources write SetSources; { Update frequency for time-based control (DoProgress). Default value is 10 Hz (frequency is clamped in the 1Hz-60Hz range). } property UpdateFrequency: Single read FUpdateFrequency write SetUpdateFrequency stored StoreUpdateFrequency; { Cadencer for time-based control. } property Cadencer: TgxCadencer read FCadencer write SetCadencer; { Engine relative distance factor, compared to 1.0 meters. Equates to 'how many units per meter' your engine has. } property DistanceFactor: Single read FDistanceFactor write SetDistanceFactor stored StoreDistanceFactor; { Sets the global attenuation rolloff factor. Normally volume for a sample will scale at 1 / distance. This gives a logarithmic attenuation of volume as the source gets further away (or closer). Setting this value makes the sound drop off faster or slower. The higher the value, the faster volume will fall off. } property RollOffFactor: Single read FRollOffFactor write SetRollOffFactor stored StoreRollOffFactor; { Engine relative Doppler factor, compared to 1.0 meters. Equates to 'how many units per meter' your engine has. } property DopplerFactor: Single read FDopplerFactor write SetDopplerFactor stored False; { Sound environment (requires EAX compatible soundboard). } property Environment: TgxSoundEnvironment read FSoundEnvironment write SetSoundEnvironment default seDefault; end; { A sound emitter behaviour, plug it on any object to make it noisy. This behaviour is just an interface to a TgxSoundSource, for editing convenience. } TgxBSoundEmitter = class(TgxBehaviour) private FPlaying: Boolean; // used at design-time ONLY FSource: TgxBaseSoundSource; FPlayingSource: TgxSoundSource; protected procedure WriteToFiler(writer: TWriter); override; procedure ReadFromFiler(reader: TReader); override; procedure Loaded; override; procedure SetSource(const val: TgxBaseSoundSource); procedure SetPlaying(const val: Boolean); function GetPlaying: Boolean; procedure NotifySourceDestruction(aSource: TgxSoundSource); public constructor Create(aOwner: TXCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; class function FriendlyName: string; override; class function FriendlyDescription: string; override; class function UniqueItem: Boolean; override; procedure DoProgress(const progressTime: TgxProgressTimes); override; property PlayingSource: TgxSoundSource read FPlayingSource; published property Source: TgxBaseSoundSource read FSource write SetSource; property Playing: Boolean read GetPlaying write SetPlaying default False; end; function ActiveSoundManager: TgxSoundManager; function GetSoundLibraryByName(const aName: string): TgxSoundLibrary; function GetOrCreateSoundEmitter(behaviours: TgxBehaviours): TgxBSoundEmitter; overload; function GetOrCreateSoundEmitter(obj: TgxBaseSceneObject): TgxBSoundEmitter; overload; var // If this variable is true, errors in GLSM may be displayed to the user vVerboseGLSMErrors: Boolean = True; implementation // ----------------------------------------------------------- var vActiveSoundManager: TgxSoundManager; vSoundLibraries: TList; function ActiveSoundManager: TgxSoundManager; begin Result := vActiveSoundManager; end; function GetSoundLibraryByName(const aName: string): TgxSoundLibrary; var i: Integer; begin Result := nil; if Assigned(vSoundLibraries) then for i := 0 to vSoundLibraries.Count - 1 do if TgxSoundLibrary(vSoundLibraries[i]).Name = aName then begin Result := TgxSoundLibrary(vSoundLibraries[i]); Break; end; end; function GetOrCreateSoundEmitter(behaviours: TgxBehaviours): TgxBSoundEmitter; var i: Integer; begin i := behaviours.IndexOfClass(TgxBSoundEmitter); if i >= 0 then Result := TgxBSoundEmitter(behaviours[i]) else Result := TgxBSoundEmitter.Create(behaviours); end; function GetOrCreateSoundEmitter(obj: TgxBaseSceneObject): TgxBSoundEmitter; begin Result := GetOrCreateSoundEmitter(obj.Behaviours); end; // ------------------ // ------------------ TgxSoundSample ------------------ // ------------------ constructor TgxSoundSample.Create(Collection: TCollection); begin inherited Create(Collection); end; destructor TgxSoundSample.Destroy; begin FData.Free; inherited Destroy; end; procedure TgxSoundSample.Assign(Source: TPersistent); begin if Source is TgxSoundSample then begin FName := TgxSoundSample(Source).Name; FData.Free; FData := TgxSoundFile(TgxSoundSample(Source).Data.CreateCopy(Self)); end else inherited Assign(Source); // Assign error end; procedure TgxSoundSample.DefineProperties(Filer: TFiler); begin Filer.DefineBinaryProperty('BinData', ReadData, WriteData, Assigned(FData)); end; procedure TgxSoundSample.ReadData(Stream: TStream); var n: Integer; clName: AnsiString; begin with Stream do begin Read(n, SizeOf(Integer)); SetLength(clName, n); if n > 0 then Read(clName[1], n); FData := TgxSoundFileClass(FindClass(string(clName))).Create(Self); FData.LoadFromStream(Stream); end; end; procedure TgxSoundSample.WriteData(Stream: TStream); var n: Integer; buf: AnsiString; begin with Stream do begin n := Length(FData.ClassName); Write(n, SizeOf(Integer)); buf := AnsiString(FData.ClassName); if n > 0 then Write(buf[1], n); FData.SaveToStream(Stream); end; end; function TgxSoundSample.GetDisplayName: string; var s: string; begin if Assigned(FData) then begin if Data.Sampling.NbChannels > 1 then s := 's' else s := ''; Result := Format('%s (%d Hz, %d bits, %d channel%s, %.2f sec)', [Name, Data.Sampling.Frequency, Data.Sampling.BitsPerSample, Data.Sampling.NbChannels, s, LengthInSec]) end else Result := Format('%s (empty)', [Name]); end; procedure TgxSoundSample.LoadFromFile(const fileName: string); var sfc: TgxSoundFileClass; begin FData.Free; sfc := GetGLSoundFileFormats.FindExt(ExtractFileExt(fileName)); if Assigned(sfc) then begin FData := sfc.Create(Self); FData.LoadFromFile(fileName); end else FData := nil; Assert(Data <> nil, 'Could not load ' + fileName + ', make sure you include the unit required to load this format in your uses clause.'); Name := ExtractFileName(fileName); end; procedure TgxSoundSample.PlayOnWaveOut; begin if Assigned(FData) then FData.PlayOnWaveOut; end; // TgxSoundSample // function TgxSoundSample.Sampling: TgxSoundSampling; begin if Assigned(FData) then Result := FData.Sampling else Result := nil; end; function TgxSoundSample.LengthInBytes: Integer; begin if Assigned(FData) then Result := FData.LengthInBytes else Result := 0; end; function TgxSoundSample.LengthInSamples: Integer; begin if Assigned(FData) then Result := FData.LengthInSamples else Result := 0; end; function TgxSoundSample.LengthInSec: Single; begin if Assigned(FData) then Result := FData.LengthInSec else Result := 0; end; procedure TgxSoundSample.SetData(const val: TgxSoundFile); begin FData.Free; if Assigned(val) then FData := TgxSoundFile(val.CreateCopy(Self)) else FData := nil; end; // ------------------ // ------------------ TgxSoundSamples ------------------ // ------------------ constructor TgxSoundSamples.Create(AOwner: TComponent); begin Owner := AOwner; inherited Create(TgxSoundSample); end; function TgxSoundSamples.GetOwner: TPersistent; begin Result := Owner; end; procedure TgxSoundSamples.SetItems(index: Integer; const val: TgxSoundSample); begin inherited Items[index] := val; end; function TgxSoundSamples.GetItems(index: Integer): TgxSoundSample; begin Result := TgxSoundSample(inherited Items[index]); end; function TgxSoundSamples.Add: TgxSoundSample; begin Result := (inherited Add) as TgxSoundSample; end; function TgxSoundSamples.FindItemID(ID: Integer): TgxSoundSample; begin Result := (inherited FindItemID(ID)) as TgxSoundSample; end; function TgxSoundSamples.GetByName(const aName: string): TgxSoundSample; var i: Integer; begin Result := nil; for i := 0 to Count - 1 do if CompareText(Items[i].Name, aName) = 0 then begin Result := Items[i]; Break; end; end; function TgxSoundSamples.AddFile(const fileName: string; const sampleName: string = ''): TgxSoundSample; begin Result := Add; Result.LoadFromFile(fileName); if sampleName <> '' then Result.Name := sampleName; end; // ------------------ // ------------------ TgxSoundLibrary ------------------ // ------------------ constructor TgxSoundLibrary.Create(AOwner: TComponent); begin inherited Create(AOwner); FSamples := TgxSoundSamples.Create(Self); vSoundLibraries.Add(Self); end; destructor TgxSoundLibrary.Destroy; begin vSoundLibraries.Remove(Self); FSamples.Free; inherited Destroy; end; procedure TgxSoundLibrary.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; end; procedure TgxSoundLibrary.SetSamples(const val: TgxSoundSamples); begin FSamples.Assign(val); end; // ------------------ // ------------------ TgxBaseSoundSource ------------------ // ------------------ constructor TgxBaseSoundSource.Create(Collection: TCollection); begin inherited Create(Collection); FChanges := [sscTransformation, sscSample, sscStatus]; FVolume := 1.0; FMinDistance := 1.0; FMaxDistance := 100.0; FInsideConeAngle := 360; FOutsideConeAngle := 360; FConeOutsideVolume := 0.0; FNbLoops := 1; FFrequency := -1; end; destructor TgxBaseSoundSource.Destroy; begin inherited Destroy; end; function TgxBaseSoundSource.GetDisplayName: string; begin Result := Format('%s', [FSoundName]); end; procedure TgxBaseSoundSource.Assign(Source: TPersistent); begin if Source is TgxBaseSoundSource then begin FPriority := TgxBaseSoundSource(Source).FPriority; FOrigin := TgxBaseSoundSource(Source).FOrigin; FVolume := TgxBaseSoundSource(Source).FVolume; FMinDistance := TgxBaseSoundSource(Source).FMinDistance; FMaxDistance := TgxBaseSoundSource(Source).FMaxDistance; FInsideConeAngle := TgxBaseSoundSource(Source).FInsideConeAngle; FOutsideConeAngle := TgxBaseSoundSource(Source).FOutsideConeAngle; FConeOutsideVolume := TgxBaseSoundSource(Source).FConeOutsideVolume; FSoundLibraryName := TgxBaseSoundSource(Source).FSoundLibraryName; FSoundLibrary := TgxBaseSoundSource(Source).FSoundLibrary; FSoundName := TgxBaseSoundSource(Source).FSoundName; FMute := TgxBaseSoundSource(Source).FMute; FPause := TgxBaseSoundSource(Source).FPause; FChanges := [sscTransformation, sscSample, sscStatus]; FNbLoops := TgxBaseSoundSource(Source).FNbLoops; FFrequency := TgxBaseSoundSource(Source).FFrequency; end else inherited Assign(Source); end; procedure TgxBaseSoundSource.WriteToFiler(writer: TWriter); begin inherited; with writer do begin WriteInteger(0); // Archive Version 0 WriteInteger(FPriority); WriteFloat(FVolume); WriteFloat(FMinDistance); WriteFloat(FMaxDistance); WriteFloat(FInsideConeAngle); WriteFloat(FOutsideConeAngle); WriteFloat(FConeOutsideVolume); if Assigned(FSoundLibrary) then WriteString(FSoundLibrary.Name) else WriteString(FSoundLibraryName); WriteString(FSoundName); WriteBoolean(FMute); WriteBoolean(FPause); WriteInteger(FNbLoops); // WriteInteger(FFrequency); end; end; procedure TgxBaseSoundSource.ReadFromFiler(reader: TReader); begin inherited; with reader do begin ReadInteger; // ignore archiveVersion FPriority := ReadInteger; FVolume := ReadFloat; FMinDistance := ReadFloat; FMaxDistance := ReadFloat; FInsideConeAngle := ReadFloat; FOutsideConeAngle := ReadFloat; FConeOutsideVolume := ReadFloat; FSoundLibraryName := ReadString; FSoundLibrary := nil; FSoundName := ReadString; FMute := ReadBoolean; FPause := ReadBoolean; FChanges := [sscTransformation, sscSample, sscStatus]; FNbLoops := ReadInteger; // FFrequency:=ReadInteger; end; end; function TgxBaseSoundSource.Sample: TgxSoundSample; begin if SoundLibrary <> nil then Result := FSoundLibrary.Samples.GetByName(FSoundName) else Result := nil; end; procedure TgxBaseSoundSource.SetPriority(const val: Integer); begin if val <> FPriority then begin FPriority := val; Include(FChanges, sscStatus); end; end; procedure TgxBaseSoundSource.SetOrigin(const val: TgxBaseSceneObject); begin if val <> FOrigin then begin FOrigin := val; Include(FChanges, sscTransformation); end; end; procedure TgxBaseSoundSource.SetVolume(const val: Single); begin if val <> FVolume then begin FVolume := ClampValue(val, 0, 1); Include(FChanges, sscStatus); end; end; procedure TgxBaseSoundSource.SetMinDistance(const val: Single); begin if val <> FMinDistance then begin FMinDistance := ClampValue(val, 0); Include(FChanges, sscStatus); end; end; procedure TgxBaseSoundSource.SetMaxDistance(const val: Single); begin if val <> FMaxDistance then begin FMaxDistance := ClampValue(val, 0); Include(FChanges, sscStatus); end; end; procedure TgxBaseSoundSource.SetInsideConeAngle(const val: Single); begin if val <> FInsideConeAngle then begin FInsideConeAngle := ClampValue(val, 0, 360); Include(FChanges, sscStatus); end; end; procedure TgxBaseSoundSource.SetOutsideConeAngle(const val: Single); begin if val <> FOutsideConeAngle then begin FOutsideConeAngle := ClampValue(val, 0, 360); Include(FChanges, sscStatus); end; end; procedure TgxBaseSoundSource.SetConeOutsideVolume(const val: Single); begin if val <> FConeOutsideVolume then begin FConeOutsideVolume := ClampValue(val, 0, 1); Include(FChanges, sscStatus); end; end; function TgxBaseSoundSource.GetSoundLibrary: TgxSoundLibrary; begin if (FSoundLibrary = nil) and (FSoundLibraryName <> '') then FSoundLibrary := GetSoundLibraryByName(FSoundLibraryName); Result := FSoundLibrary; end; procedure TgxBaseSoundSource.SetSoundLibrary(const val: TgxSoundLibrary); begin if val <> FSoundLibrary then begin FSoundLibrary := val; if Assigned(FSoundLibrary) then FSoundLibraryName := FSoundLibrary.Name else FSoundLibraryName := ''; Include(FChanges, sscSample); end; end; procedure TgxBaseSoundSource.SetSoundName(const val: string); begin if val <> FSoundName then begin FSoundName := val; Include(FChanges, sscSample); end; end; procedure TgxBaseSoundSource.SetPause(const val: Boolean); begin if val <> FPause then begin FPause := val; if Collection <> nil then TgxSoundManager(TgxSoundSources(Collection).owner).PauseSource(Self, FPause); end; end; procedure TgxBaseSoundSource.SetNbLoops(const val: Integer); begin if val <> FNbLoops then begin FNbLoops := val; Include(FChanges, sscSample); end; end; procedure TgxBaseSoundSource.SetFrequency(const val: integer); begin if val <> FFrequency then begin FFrequency := val; Include(FChanges, sscStatus); end; end; procedure TgxBaseSoundSource.SetMute(const val: Boolean); begin if val <> FMute then begin FMute := val; if Collection <> nil then TgxSoundManager(TgxSoundSources(Collection).owner).MuteSource(Self, FMute); end; end; // ------------------ // ------------------ TgxSoundSource ------------------ // ------------------ destructor TgxSoundSource.Destroy; begin if Assigned(FBehaviourToNotify) then FBehaviourToNotify.NotifySourceDestruction(Self); if Collection <> nil then ((Collection as TgxSoundSources).Owner as TgxSoundManager).KillSource(Self); inherited; end; // ------------------ // ------------------ TgxSoundSources ------------------ // ------------------ constructor TgxSoundSources.Create(AOwner: TComponent); begin Owner := AOwner; inherited Create(TgxSoundSource); end; function TgxSoundSources.GetOwner: TPersistent; begin Result := Owner; end; procedure TgxSoundSources.SetItems(index: Integer; const val: TgxSoundSource); begin inherited Items[index] := val; end; function TgxSoundSources.GetItems(index: Integer): TgxSoundSource; begin Result := TgxSoundSource(inherited Items[index]); end; function TgxSoundSources.Add: TgxSoundSource; begin Result := (inherited Add) as TgxSoundSource; end; function TgxSoundSources.FindItemID(ID: Integer): TgxSoundSource; begin Result := (inherited FindItemID(ID)) as TgxSoundSource; end; // ------------------ // ------------------ TgxSoundManager ------------------ // ------------------ constructor TgxSoundManager.Create(AOwner: TComponent); begin inherited Create(AOwner); FSources := TgxSoundSources.Create(Self); FMasterVolume := 1.0; FOutputFrequency := 44100; FMaxChannels := 8; FUpdateFrequency := 10; FLastUpdateTime := -1e30; FDistanceFactor := 1.0; FRollOffFactor := 1.0; FDopplerFactor := 1.0; end; destructor TgxSoundManager.Destroy; begin Active := False; Listener := nil; FSources.Free; inherited Destroy; end; procedure TgxSoundManager.Notification(AComponent: TComponent; Operation: TOperation); begin if Operation = opRemove then begin if AComponent = FListener then Listener := nil; if AComponent = FCadencer then Cadencer := nil; end; inherited; end; procedure TgxSoundManager.SetActive(const val: Boolean); begin if (csDesigning in ComponentState) or (csLoading in ComponentState) then FActive := val else if val <> FActive then begin if val then begin if Assigned(vActiveSoundManager) then vActiveSoundManager.Active := False; if DoActivate then begin FActive := True; vActiveSoundManager := Self; end; end else begin try StopAllSources; DoDeActivate; finally FActive := val; vActiveSoundManager := nil; end; end; end; end; function TgxSoundManager.DoActivate: Boolean; begin Result := True; end; procedure TgxSoundManager.DoDeActivate; begin StopAllSources; end; procedure TgxSoundManager.SetMute(const val: Boolean); begin if val <> FMute then begin if val then begin if DoMute then FMute := True end else begin DoUnMute; FMute := False; end; end; end; function TgxSoundManager.DoMute: Boolean; var i: Integer; begin for i := 0 to Sources.Count - 1 do if not Sources[i].Mute then MuteSource(Sources[i], True); Result := True; end; procedure TgxSoundManager.DoUnMute; var i: Integer; begin for i := 0 to Sources.Count - 1 do if not Sources[i].Mute then MuteSource(Sources[i], False); end; procedure TgxSoundManager.SetPause(const val: Boolean); begin if val <> FPause then begin if val then begin if DoPause then FPause := True end else begin DoUnPause; FPause := False; end; end; end; procedure TgxSoundManager.Loaded; begin inherited; if Active and (not (csDesigning in ComponentState)) then begin FActive := False; Active := True; end; end; procedure TgxSoundManager.DefineProperties(Filer: TFiler); begin inherited; Filer.DefineProperty('Doppler', ReadDoppler, WriteDoppler, (DopplerFactor <> 1)); end; procedure TgxSoundManager.WriteDoppler(writer: TWriter); begin writer.WriteFloat(DopplerFactor); end; procedure TgxSoundManager.ReadDoppler(reader: TReader); begin FDopplerFactor := reader.ReadFloat; end; function TgxSoundManager.DoPause: Boolean; var i: Integer; begin for i := 0 to Sources.Count - 1 do if not Sources[i].Pause then PauseSource(Sources[i], True); Result := True; end; procedure TgxSoundManager.DoUnPause; var i: Integer; begin for i := 0 to Sources.Count - 1 do if not Sources[i].Pause then PauseSource(Sources[i], False); end; procedure TgxSoundManager.SetMasterVolume(const val: Single); begin if val < 0 then FMasterVolume := 0 else if val > 1 then FMasterVolume := 1 else FMasterVolume := val; NotifyMasterVolumeChange; end; procedure TgxSoundManager.SetMaxChannels(const val: Integer); begin if val <> FMaxChannels then begin if val < 1 then FMaxChannels := 1 else FMaxChannels := val; end; end; procedure TgxSoundManager.SetOutputFrequency(const val: Integer); begin if val <> FOutputFrequency then begin if val < 11025 then FOutputFrequency := 11025 else FOutputFrequency := val; end; end; procedure TgxSoundManager.SetUpdateFrequency(const val: Single); begin FUpdateFrequency := ClampValue(val, 1, 60); end; function TgxSoundManager.StoreUpdateFrequency: Boolean; begin Result := (FUpdateFrequency <> 10); end; procedure TgxSoundManager.SetCadencer(const val: TgxCadencer); begin if val <> FCadencer then begin if Assigned(FCadencer) then FCadencer.UnSubscribe(Self); FCadencer := val; if Assigned(FCadencer) then FCadencer.Subscribe(Self); end; end; procedure TgxSoundManager.SetDistanceFactor(const val: Single); begin if val <= 0 then FDistanceFactor := 1 else FDistanceFactor := val; Notify3DFactorsChanged; end; function TgxSoundManager.StoreDistanceFactor: Boolean; begin Result := (FDistanceFactor <> 1); end; procedure TgxSoundManager.SetRollOffFactor(const val: Single); begin if val <= 0 then FRollOffFactor := 1 else FRollOffFactor := val; Notify3DFactorsChanged; end; function TgxSoundManager.StoreRollOffFactor: Boolean; begin Result := (FRollOffFactor <> 1); end; procedure TgxSoundManager.SetDopplerFactor(const val: Single); begin if val < 0 then FDopplerFactor := 0 else if val > 10 then FDopplerFactor := 10 else FDopplerFactor := val; Notify3DFactorsChanged; end; procedure TgxSoundManager.SetSoundEnvironment(const val: TgxSoundEnvironment); begin if val <> FSoundEnvironment then begin FSoundEnvironment := val; NotifyEnvironmentChanged; end; end; procedure TgxSoundManager.ListenerCoordinates(var position, velocity, direction, up: TVector4f); var right: TVector4f; begin if Listener <> nil then begin position := Listener.AbsolutePosition; if FLastDeltaTime <> 0 then begin velocity := VectorSubtract(position, FLastListenerPosition); ScaleVector(velocity, 1 / FLastDeltaTime); end; FLastListenerPosition := position; if (Listener is TgxCamera) and (TgxCamera(Listener).TargetObject <> nil) then begin // special case of the camera targeting something direction := TgxCamera(Listener).AbsoluteVectorToTarget; NormalizeVector(direction); up := Listener.AbsoluteYVector; right := VectorCrossProduct(direction, up); up := VectorCrossProduct(right, direction); end else begin direction := Listener.AbsoluteZVector; up := Listener.AbsoluteYVector; end; end else begin position := NullHmgPoint; velocity := NullHmgVector; direction := ZHmgVector; up := YHmgVector; end; end; procedure TgxSoundManager.NotifyMasterVolumeChange; begin // nothing end; procedure TgxSoundManager.Notify3DFactorsChanged; begin // nothing end; procedure TgxSoundManager.NotifyEnvironmentChanged; begin // nothing end; procedure TgxSoundManager.SetListener(const val: TgxBaseSceneObject); begin if Assigned(FListener) then FListener.RemoveFreeNotification(Self); FListener := val; if Assigned(FListener) then FListener.FreeNotification(Self); end; procedure TgxSoundManager.SetSources(const val: TgxSoundSources); begin FSources.Assign(val); end; procedure TgxSoundManager.KillSource(aSource: TgxBaseSoundSource); begin // nothing end; procedure TgxSoundManager.UpdateSource(aSource: TgxBaseSoundSource); begin aSource.FChanges := []; end; procedure TgxSoundManager.MuteSource(aSource: TgxBaseSoundSource; muted: Boolean); begin // nothing end; procedure TgxSoundManager.PauseSource(aSource: TgxBaseSoundSource; paused: Boolean); begin // nothing end; procedure TgxSoundManager.UpdateSources; var i: Integer; begin for i := Sources.Count - 1 downto 0 do UpdateSource(Sources[i]); end; procedure TgxSoundManager.StopAllSources; var i: Integer; begin for i := Sources.Count - 1 downto 0 do Sources.Delete(i); end; procedure TgxSoundManager.DoProgress(const progressTime: TgxProgressTimes); begin if not Active then Exit; with progressTime do if newTime - FLastUpdateTime > 1 / FUpdateFrequency then begin FLastDeltaTime := newTime - FLastUpdateTime; FLastUpdateTime := newTime; UpdateSources; end; end; function TgxSoundManager.CPUUsagePercent: Single; begin Result := -1; end; function TgxSoundManager.EAXSupported: Boolean; begin Result := False; end; // ------------------ // ------------------ TgxBSoundEmitter ------------------ // ------------------ constructor TgxBSoundEmitter.Create(aOwner: TXCollection); begin inherited Create(aOwner); FSource := TgxSoundSource.Create(nil); end; destructor TgxBSoundEmitter.Destroy; begin if Assigned(FPlayingSource) then FPlayingSource.Free; FSource.Free; inherited Destroy; end; procedure TgxBSoundEmitter.Assign(Source: TPersistent); begin if Source is TgxBSoundEmitter then begin FSource.Assign(TgxBSoundEmitter(Source).FSource); end; inherited Assign(Source); end; procedure TgxBSoundEmitter.WriteToFiler(writer: TWriter); begin inherited; with writer do begin WriteInteger(0); // Archive Version 0 FSource.WriteToFiler(writer); WriteBoolean(FPlaying); end; end; procedure TgxBSoundEmitter.ReadFromFiler(reader: TReader); begin inherited; with reader do begin ReadInteger; // ignore archiveVersion FSource.ReadFromFiler(reader); FPlaying := ReadBoolean; end; end; procedure TgxBSoundEmitter.Loaded; begin inherited; if not (csDesigning in OwnerBaseSceneObject.ComponentState) then SetPlaying(FPlaying); end; class function TgxBSoundEmitter.FriendlyName: string; begin Result := 'Sound Emitter'; end; class function TgxBSoundEmitter.FriendlyDescription: string; begin Result := 'A simple sound emitter behaviour'; end; class function TgxBSoundEmitter.UniqueItem: Boolean; begin Result := False; end; procedure TgxBSoundEmitter.DoProgress(const progressTime: TgxProgressTimes); begin // nothing, yet end; procedure TgxBSoundEmitter.SetSource(const val: TgxBaseSoundSource); begin FSource.Assign(val); end; procedure TgxBSoundEmitter.SetPlaying(const val: Boolean); begin if csDesigning in OwnerBaseSceneObject.ComponentState then FPlaying := val else if ActiveSoundManager <> nil then begin if val <> Playing then begin if val then begin FPlayingSource := ActiveSoundManager.Sources.Add; FPlayingSource.FBehaviourToNotify := Self; FPlayingSource.Assign(FSource); FPlayingSource.Origin := OwnerBaseSceneObject; end else FPlayingSource.Free; end; end else if vVerboseGLSMErrors then InformationDlg('No Active Sound Manager.'#13#10'Make sure manager is created before emitter'); end; function TgxBSoundEmitter.GetPlaying: Boolean; begin if csDesigning in OwnerBaseSceneObject.ComponentState then Result := FPlaying else Result := Assigned(FPlayingSource); end; procedure TgxBSoundEmitter.NotifySourceDestruction(aSource: TgxSoundSource); begin Assert(FPlayingSource = aSource); FPlayingSource := nil; end; initialization // --------------------------------------------------------- RegisterClasses([TgxSoundLibrary]); RegisterXCollectionItemClass(TgxBSoundEmitter); vSoundLibraries := TList.Create; finalization // ----------------------------------------------------------- if Assigned(vActiveSoundManager) then vActiveSoundManager.Active := False; vSoundLibraries.Free; vSoundLibraries := nil; UnregisterXCollectionItemClass(TgxBSoundEmitter); end.