LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   BASS based sound-manager (http://www.un4seen.com/music/, free for freeware).
6

7
   Unsupported feature(s) : 
8
       sound source velocity
9
       looping (sounds are played either once or forever)
10
       source priorities (not relevant, channels are not limited)
11
    
12

13
	 History :  
14
       14/01/14 - PW - Updated to BASS 2.4 thanks to Ian Luck
15
       07/01/10 - DaStr - Fixed a bug with an initial Paused or Muted state of
16
                              sound source and with sscSample in aSource.Changes
17
       07/11/09 - DaStr - Improved FPC compatibility
18
                             (thanks Predator) (BugtrackerID = 2893580)
19
       21/03/08 - DanB - Updated to BASS Version 2.3
20
       15/03/08 - DaStr - Added $I GLScene.inc
21
       09/05/04 - GAK - Updated to BASS Version 2.0, and swapped to Dynamic DLL loading
22
       24/09/02 - EG - BASS activation errors no longer result in Asserts (ignored)
23
       27/02/02 - EG - Added 3D Factors and Environment support
24
       05/02/02 - EG - BASS 1.4 compatibility
25
       05/02/01 - EG - Fixed TGLSMBASS.CPUUsagePercent
26
	    13/01/01 - EG - Creation (compat BASS 0.8)
27
	 
28
}
29
unit GLSMBASS;
30

31
interface
32

33
{$I GLScene.inc}
34

35
uses
36
  Classes, SysUtils, Forms, Controls,
37

38
  //GLScene
39
  GLSound, GLScene, Bass, GLVectorGeometry;
40

41
type
42

43
   // TBASS3DAlgorithm
44
   //
45
   TBASS3DAlgorithm = (algDefault, algOff, algFull, algLight);
46

47
	// TGLSMBASS
48
	//
49
	TGLSMBASS = class (TGLSoundManager)
50
	   private
51
	       
52
         FActivated : Boolean;
53
         FAlgorithm3D : TBASS3DAlgorithm;
54

55
	   protected
56
	       
57
	      function DoActivate : Boolean; override;
58
	      procedure DoDeActivate; override;
59
         procedure NotifyMasterVolumeChange; override;
60
         procedure Notify3DFactorsChanged; override;
61
         procedure NotifyEnvironmentChanged; override;
62

63
         procedure KillSource(aSource : TGLBaseSoundSource); override;
64
         procedure UpdateSource(aSource : TGLBaseSoundSource); override;
65
         procedure MuteSource(aSource : TGLBaseSoundSource; muted : Boolean); override;
66
         procedure PauseSource(aSource : TGLBaseSoundSource; paused : Boolean); override;
67

68
         function GetDefaultFrequency(aSource : TGLBaseSoundSource) : Integer;
69
         
70
      public
71
	       
72
	      constructor Create(AOwner : TComponent); override;
73
	      destructor Destroy; override;
74

75
         procedure UpdateSources; override;
76

77
         function CPUUsagePercent : Single; override;
78
         function EAXSupported : Boolean; override;
79

80
	   published
81
	       
82
         property Algorithm3D : TBASS3DAlgorithm read FAlgorithm3D write FAlgorithm3D default algDefault;
83
	end;
84

85
procedure Register;
86

87
// ---------------------------------------------------------------------
88
// ---------------------------------------------------------------------
89
// ---------------------------------------------------------------------
90
implementation
91
// ---------------------------------------------------------------------
92
// ---------------------------------------------------------------------
93
// ---------------------------------------------------------------------
94

95
type
96
   TBASSInfo =  record
97
      channel : HCHANNEL;
98
      sample : HSAMPLE;
99
   end;
100
   PBASSInfo = ^TBASSInfo;
101

102
procedure Register;
103
begin
104
  RegisterComponents('GLScene', [TGLSMBASS]);
105
end;
106

107
// VectorToBASSVector
108
//
109
procedure VectorToBASSVector(const aVector : TVector; var aBASSVector : BASS_3DVECTOR);
110
begin
111
  aBASSVector.x:=aVector.X;
112
  aBASSVector.y:=aVector.Y;
113
  aBASSVector.z:=-aVector.Z;
114
end;
115

116
// ------------------
117
// ------------------ TGLSMBASS ------------------
118
// ------------------
119

120
// Create
121
//
122
constructor TGLSMBASS.Create(AOwner : TComponent);
123
begin
124
	inherited Create(AOwner);
125
  BASS_Load(bassdll);
126
   MaxChannels:=32;
127
end;
128

129
// Destroy
130
//
131
destructor TGLSMBASS.Destroy;
132
begin
133
	inherited Destroy;
134
  BASS_UnLoad;
135
end;
136

137
// DoActivate
138
//
139
function TGLSMBASS.DoActivate : Boolean;
140
const
141
   c3DAlgo : array [algDefault..algLight] of Integer =
142
      (BASS_3DALG_DEFAULT, BASS_3DALG_OFF, BASS_3DALG_FULL, BASS_3DALG_LIGHT);
143
begin
144
   Assert(bass_isloaded,'BASS DLL is not present');
145

146
   if not BASS_Init(1, OutputFrequency, BASS_DEVICE_3D, Pointer(TWinControl(Owner).Handle), nil) then
147

148
   begin
149
      Result:=False;
150
      Exit;
151
   end;
152
   if not BASS_Start then begin
153
      Result:=False;
154
      Exit;
155
   end;
156
   FActivated:=True;
157
   BASS_SetConfig(BASS_CONFIG_3DALGORITHM, c3DAlgo[FAlgorithm3D]);
158
   NotifyMasterVolumeChange;
159
   Notify3DFactorsChanged;
160
   if Environment<>seDefault then
161
      NotifyEnvironmentChanged;
162
   Result:=True;
163
end;
164

165
// DoDeActivate
166
//
167
procedure TGLSMBASS.DoDeActivate;
168
begin
169
   FActivated:=False;
170
   BASS_Stop;
171
   BASS_Free;
172
end;
173

174
// NotifyMasterVolumeChange
175
//
176
procedure TGLSMBASS.NotifyMasterVolumeChange;
177
begin
178
   if FActivated then
179
      BASS_SetVolume(Round(MasterVolume*100));
180
end;
181

182
// Notify3DFactorsChanged
183
//
184
procedure TGLSMBASS.Notify3DFactorsChanged;
185
begin
186
   if FActivated then
187
      BASS_Set3DFactors(DistanceFactor, RollOffFactor, DopplerFactor);
188
end;
189

190
// NotifyEnvironmentChanged
191
//
192
procedure TGLSMBASS.NotifyEnvironmentChanged;
193
{$IFDEF MSWINDOWS}
194
const
195
   cEnvironmentToBASSConstant : array [seDefault..sePsychotic] of Integer = (
196
      EAX_ENVIRONMENT_GENERIC, EAX_ENVIRONMENT_PADDEDCELL, EAX_ENVIRONMENT_ROOM,
197
      EAX_ENVIRONMENT_BATHROOM, EAX_ENVIRONMENT_LIVINGROOM, EAX_ENVIRONMENT_STONEROOM,
198
      EAX_ENVIRONMENT_AUDITORIUM, EAX_ENVIRONMENT_CONCERTHALL, EAX_ENVIRONMENT_CAVE,
199
      EAX_ENVIRONMENT_ARENA, EAX_ENVIRONMENT_HANGAR, EAX_ENVIRONMENT_CARPETEDHALLWAY,
200
      EAX_ENVIRONMENT_HALLWAY, EAX_ENVIRONMENT_STONECORRIDOR, EAX_ENVIRONMENT_ALLEY,
201
      EAX_ENVIRONMENT_FOREST, EAX_ENVIRONMENT_CITY, EAX_ENVIRONMENT_MOUNTAINS,
202
      EAX_ENVIRONMENT_QUARRY, EAX_ENVIRONMENT_PLAIN, EAX_ENVIRONMENT_PARKINGLOT,
203
      EAX_ENVIRONMENT_SEWERPIPE, EAX_ENVIRONMENT_UNDERWATER, EAX_ENVIRONMENT_DRUGGED,
204
      EAX_ENVIRONMENT_DIZZY, EAX_ENVIRONMENT_PSYCHOTIC);
205
begin
206
   if FActivated and EAXSupported then
207
      BASS_SetEAXParameters(cEnvironmentToBASSConstant[Environment],-1,-1,-1);
208
{$ELSE}
209
begin
210
{$ENDIF}
211

212
end;
213

214
// KillSource
215
//
216
procedure TGLSMBASS.KillSource(aSource : TGLBaseSoundSource);
217
var
218
   p : PBASSInfo;
219
begin
220
   if aSource.ManagerTag<>0 then begin
221
      p:=PBASSInfo(aSource.ManagerTag);
222
      if p.channel<>0 then
223
         if not BASS_ChannelStop(p.channel) then Assert(False);
224
      BASS_SampleFree(p.sample);
225
      FreeMem(p);
226
      aSource.ManagerTag:=0;
227
   end;
228
end;
229

230
// UpdateSource
231
//
232
procedure TGLSMBASS.UpdateSource(aSource : TGLBaseSoundSource);
233
var
234
   i : Integer;
235
   p : PBASSInfo;
236
   objPos, objOri, objVel : TVector;
237
   position, orientation, velocity : BASS_3DVECTOR;
238
   res: Boolean;
239
begin
240
   if (sscSample in aSource.Changes) then
241
   begin
242
     KillSource(aSource);
243
   end;
244

245
   if (aSource.Sample=nil) or (aSource.Sample.Data=nil) or
246
      (aSource.Sample.Data.WAVDataSize=0) then Exit;
247
   if aSource.ManagerTag<>0 then begin
248
      p:=PBASSInfo(aSource.ManagerTag);
249
      if BASS_ChannelIsActive(p.channel)=0 then begin
250
         p.channel:=0;
251
         aSource.Free;
252
         Exit;
253
      end;
254
   end else begin
255
      p:=AllocMem(SizeOf(TBASSInfo));
256
      p.channel:=0;
257
      i:=BASS_SAMPLE_VAM+BASS_SAMPLE_3D+BASS_SAMPLE_OVER_DIST;
258
      if aSource.NbLoops>1 then
259
         i:=i+BASS_SAMPLE_LOOP;
260
      p.sample:=BASS_SampleLoad(True, aSource.Sample.Data.WAVData, 0,
261
                                aSource.Sample.Data.WAVDataSize,
262
                                MaxChannels, i);
263
      Assert(p.sample<>0, 'BASS Error '+IntToStr(Integer(BASS_ErrorGetCode)));
264
      aSource.ManagerTag:=Integer(p);
265
      if aSource.Frequency<=0 then
266
         aSource.Frequency:=-1;
267
   end;
268
   if aSource.Origin<>nil then begin
269
      objPos:=aSource.Origin.AbsolutePosition;
270
      objOri:=aSource.Origin.AbsoluteZVector;
271
      objVel:=NullHmgVector;
272
   end else begin
273
      objPos:=NullHmgPoint;
274
      objOri:=ZHmgVector;
275
      objVel:=NullHmgVector;
276
   end;
277
   VectorToBASSVector(objPos, position);
278
   VectorToBASSVector(objVel, velocity);
279
   VectorToBASSVector(objOri, orientation);
280
   if p.channel=0 then begin
281
      p.channel:=BASS_SampleGetChannel(p.sample,false);
282
      Assert(p.channel<>0);
283
      BASS_ChannelSet3DPosition(p.channel,position, orientation, velocity);
284
      BASS_ChannelSet3DAttributes(p.channel, BASS_3DMODE_NORMAL,
285
                                  aSource.MinDistance, aSource.MaxDistance,
286
                                  Round(aSource.InsideConeAngle),
287
                                  Round(aSource.OutsideConeAngle),
288
                                  Round(aSource.ConeOutsideVolume*100));
289
      if not aSource.Pause then
290
        BASS_ChannelPlay(p.channel,true);
291

292
   end else BASS_ChannelSet3DPosition(p.channel, position, orientation, velocity);
293

294
   if p.channel<>0 then
295
   begin
296
      res := BASS_ChannelSetAttribute(p.channel, BASS_ATTRIB_FREQ, 0);
297
      Assert(res);
298
      if aSource.Mute then
299
        res := BASS_ChannelSetAttribute(p.channel, BASS_ATTRIB_VOL, 0)
300
      else
301
        res := BASS_ChannelSetAttribute(p.channel, BASS_ATTRIB_VOL, aSource.Volume);
302
      Assert(res);
303
   end else aSource.Free;
304
   inherited UpdateSource(aSource);
305
end;
306

307
// MuteSource
308
//
309
procedure TGLSMBASS.MuteSource(aSource : TGLBaseSoundSource; muted : Boolean);
310
var
311
   p : PBASSInfo;
312
   res : Boolean;
313
begin
314
   if aSource.ManagerTag<>0 then begin
315
      p:=PBASSInfo(aSource.ManagerTag);
316
      if muted then
317
         res:=BASS_ChannelSetAttribute(p.channel,  BASS_ATTRIB_VOL, 0)
318
      else res:=BASS_ChannelSetAttribute(p.channel, BASS_ATTRIB_VOL, aSource.Volume);
319
      Assert(res);
320
   end;
321
end;
322

323
// PauseSource
324
//
325
procedure TGLSMBASS.PauseSource(aSource : TGLBaseSoundSource; paused : Boolean);
326
var
327
   p : PBASSInfo;
328
begin
329
   if aSource.ManagerTag<>0 then begin
330
      p:=PBASSInfo(aSource.ManagerTag);
331
      if paused then
332
         BASS_ChannelPause(p.channel)
333
      else BASS_ChannelPlay(p.channel,false);
334
   end;
335
end;
336

337
// UpdateSources
338
//
339
procedure TGLSMBASS.UpdateSources;
340
var
341
   objPos, objVel, objDir, objUp : TVector;
342
   position, velocity, fwd, top : BASS_3DVECTOR;
343
begin
344
   // update listener
345
   ListenerCoordinates(objPos, objVel, objDir, objUp);
346
   VectorToBASSVector(objPos, position);
347
   VectorToBASSVector(objVel, velocity);
348
   VectorToBASSVector(objDir, fwd);
349
   VectorToBASSVector(objUp, top);
350
   if not BASS_Set3DPosition(position, velocity, fwd, top) then Assert(False);
351
   // update sources
352
   inherited;
353
   {if not }BASS_Apply3D;{ then Assert(False);}
354
end;
355

356
// CPUUsagePercent
357
//
358
function TGLSMBASS.CPUUsagePercent : Single;
359
begin
360
   Result:=BASS_GetCPU*100;
361
end;
362

363
// EAXSupported
364
//
365
function TGLSMBASS.EAXSupported : Boolean;
366
{$IFDEF MSWINDOWS}
367
var
368
   c : Cardinal;
369
   s : Single;
370
begin
371
   Result:=BASS_GetEAXParameters(c, s, s, s);
372
{$ELSE}
373
begin
374
   Result:=false;
375
{$ENDIF}
376
end;
377

378
// GetDefaultFrequency
379
//
380
function TGLSMBASS.GetDefaultFrequency(aSource : TGLBaseSoundSource): integer;
381
var
382
   p : PBASSInfo;
383
   sampleInfo : BASS_Sample;
384
begin
385
   try
386
      p:=PBASSInfo(aSource.ManagerTag);
387
      BASS_SampleGetInfo(p.sample, sampleInfo);
388
      Result:=sampleInfo.freq;
389
   except
390
      Result:=-1;
391
   end;
392
end;
393

394
end.
395

396