LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Basic sound manager based on WinMM 
6

7
	 History :  
8
       17/11/09 - DaStr - Improved Unix compatibility
9
                             (thanks Predator) (BugtrackerID = 2893580)
10
       25/07/09 - DaStr - Added $I GLScene.inc
11
       30/05/09 - DanB - Fixes for AV when sound finishes, and was repeating the same code more than necessary.
12
       24/04/09 - DanB - Creation, split from GLSound.pas, to remove windows dependency
13
	 
14
}
15
unit GLSMWaveOut;
16

17
interface
18

19
{$I GLScene.inc}
20
{$IFDEF UNIX}{$Message Error 'Unit not supported'}{$ENDIF}
21

22
uses Classes, GLSound, MMSystem, GLSoundFileObjects;
23

24
type
25

26
	// TGLSMWaveOut
27
	//
28
   { Basic sound manager based on WinMM <i>waveOut</i> function.
29
      This manager has NO 3D miximing capacity, this is merely a default manager
30
      that should work on any windows based system, and help showcasing/testing
31
      basic GLSS core functionality.
32
      Apart from 3D, mute, pause, priority and volume are ignored too, and only
33
      sampling conversions supported by the windows ACM driver are supported
34
      (ie. no 4bits samples playback etc.). }
35
	TGLSMWaveOut = class (TGLSoundManager)
36
	   private
37
	       
38

39
	   protected
40
	       
41
	      function DoActivate : Boolean; override;
42
	      procedure DoDeActivate; override;
43

44
         procedure KillSource(aSource : TGLBaseSoundSource); override;
45

46
      public
47
	       
48
	      constructor Create(AOwner : TComponent); override;
49
	      destructor Destroy; override;
50

51
        procedure UpdateSources; override;
52
      published
53
	       
54
         property MaxChannels default 4;
55
	end;
56

57
procedure PlayOnWaveOut(pcmData : Pointer; lengthInBytes : Integer;
58
                        sampling : TGLSoundSampling); overload;
59
function PlayOnWaveOut(pcmData : Pointer; lengthInBytes : Integer;
60
                        waveFormat : TWaveFormatEx) : HWaveOut; overload;
61

62
implementation
63

64
uses SysUtils;
65

66
type
67
  TSoundState = (ssPlaying, ssFinished);
68

69
  TWaveOutPlayingRec = record
70
    CurrentState: TSoundState;
71
    WaveOutDevice: hwaveout;
72
    WaveHeader: wavehdr;
73
  end;
74
  PWaveOutPlayingRec = ^TWaveOutPlayingRec;
75

76
procedure _waveOutCallBack2(hwo : HWAVEOUT; uMsg : Cardinal;
77
                           dwInstance, dwParam1, dwParam2 : Integer); stdcall;
78
begin
79
   if uMsg=WOM_DONE then
80
      waveOutClose(hwo);
81
end;
82

83
// PlayOnWaveOut (waveformat)
84
//
85
function PlayOnWaveOut(pcmData : Pointer; lengthInBytes : Integer;
86
                       waveFormat : TWaveFormatEx) : HWaveOut;
87
var
88
   hwo : hwaveout;
89
   wh : wavehdr;
90
   mmres : MMRESULT;
91
begin
92
   mmres:=waveOutOpen(@hwo, WAVE_MAPPER, @waveFormat, Cardinal(@_waveOutCallBack2),
93
                      0, CALLBACK_FUNCTION);
94
   Assert(mmres=MMSYSERR_NOERROR, IntToStr(mmres));
95
   wh.dwBufferLength:=lengthInBytes;
96
   wh.lpData:=pcmData;
97
   wh.dwFlags:=0;
98
   wh.dwLoops:=1;
99
   wh.lpNext:=nil;
100
   mmres:=waveOutPrepareHeader(hwo, @wh, SizeOf(wavehdr));
101
   Assert(mmres=MMSYSERR_NOERROR, IntToStr(mmres));
102
   mmres:=waveOutWrite(hwo, @wh, SizeOf(wavehdr));
103
   Assert(mmres=MMSYSERR_NOERROR, IntToStr(mmres));
104
   Result:=hwo;
105
end;
106

107
// PlayOnWaveOut (sampling)
108
//
109
procedure PlayOnWaveOut(pcmData : Pointer; lengthInBytes : Integer;
110
                        sampling : TGLSoundSampling);
111
var
112
   wfx : TWaveFormatEx;
113
begin
114
   wfx:=sampling.WaveFormat;
115
   PlayOnWaveOut(pcmData, lengthInBytes, wfx);
116
end;
117

118
// ------------------
119
// ------------------ TGLSMWaveOut ------------------
120
// ------------------
121

122
// Create
123
//
124
constructor TGLSMWaveOut.Create(AOwner : TComponent);
125
begin
126
	inherited Create(AOwner);
127
   MaxChannels:=4;
128
end;
129

130
// Destroy
131
//
132
destructor TGLSMWaveOut.Destroy;
133
begin
134
	inherited Destroy;
135
end;
136

137
// DoActivate
138
//
139
function TGLSMWaveOut.DoActivate : Boolean;
140
begin
141
   Result:=True;
142
end;
143

144
// DoDeActivate
145
//
146
procedure TGLSMWaveOut.DoDeActivate;
147
var
148
   i : Integer;
149
begin
150
   for i:=Sources.Count-1 downto 0 do
151
      KillSource(Sources[i]);
152
end;
153

154
// KillSource
155
//
156
procedure TGLSMWaveOut.KillSource(aSource : TGLBaseSoundSource);
157
var
158
  pRec: PWaveOutPlayingRec;
159
begin
160
   if aSource.ManagerTag<>0 then begin
161
      pRec := PWaveOutPlayingRec(aSource.ManagerTag);
162
      if pRec.CurrentState=ssPlaying then
163
        waveOutReset(pRec.WaveOutDevice);
164
      waveOutUnprepareHeader(pRec.WaveOutDevice, @pRec.WaveHeader, sizeof(wavehdr));
165
      waveOutClose(pRec.WaveOutDevice);
166
      Dispose(pRec);
167
      aSource.ManagerTag:=0;
168
   end;
169
end;
170

171
// Note: This callback function is called from another thread, from MSDN docs:
172
// "Applications should not call any system-defined functions from inside a
173
// callback function, except for EnterCriticalSection, LeaveCriticalSection,
174
// midiOutLongMsg, midiOutShortMsg, OutputDebugString, PostMessage,
175
// PostThreadMessage, SetEvent, timeGetSystemTime, timeGetTime, timeKillEvent,
176
// and timeSetEvent. Calling other wave functions will cause deadlock."
177
procedure _waveOutCallBack(hwo : HWAVEOUT; uMsg : Cardinal;
178
                           dwInstance, dwParam1, dwParam2 : Integer); stdcall;
179
begin
180
   if uMsg=WOM_DONE then begin
181
      PWaveOutPlayingRec(TGLSoundSource(dwInstance).ManagerTag).CurrentState:=ssFinished;
182
   end;
183
end;
184

185
// UpdateSource
186
//
187
procedure TGLSMWaveOut.UpdateSources;
188
var
189
   i, n : Integer;
190
   wfx : TWaveFormatEx;
191
   smp : TGLSoundSample;
192
   wh : wavehdr;
193
   mmres : MMRESULT;
194
   hwo : hwaveout;
195
   pRec: PWaveOutPlayingRec;
196
begin
197
   // count nb of playing sources and delete done ones
198
   n:=0;
199
   for i:=Sources.Count-1 downto 0 do
200
     if Sources[i].ManagerTag<>0 then
201
       if PWaveOutPlayingRec(Sources[i].ManagerTag).currentState=ssPlaying then
202
         Inc(n)
203
       else
204
         Sources.Delete(i);
205
	// start sources if some capacity remains, and forget the others
206
   for i:=Sources.Count-1 downto 0 do if Sources[i].ManagerTag=0 then begin
207
      if n<MaxChannels then begin
208
         smp:=Sources[i].Sample;
209
         if Assigned(smp) and (smp.Data<>nil) then begin
210
            wfx:=smp.Data.Sampling.WaveFormat;
211
            mmres:=waveOutOpen(@hwo, WAVE_MAPPER, @wfx,
212
                               Cardinal(@_waveOutCallBack), Integer(Sources[i]),
213
                               CALLBACK_FUNCTION);
214
            Assert(mmres=MMSYSERR_NOERROR, IntToStr(mmres));
215

216
            FillChar(wh,sizeof(wh),0);
217
            wh.dwBufferLength:=smp.LengthInBytes;
218
            wh.lpData:=smp.Data.PCMData;
219
            wh.dwLoops:=Sources[i].NbLoops;
220
            if wh.dwLoops>1 then
221
               wh.dwFlags:=WHDR_BEGINLOOP+WHDR_ENDLOOP
222
            else wh.dwFlags:=0;
223
            wh.lpNext:=nil;
224

225
            new(pRec);
226
            pRec.waveoutdevice:=hwo;
227
            pRec.waveheader:=wh;
228
            pRec.CurrentState:=ssPlaying;
229

230
            mmres:=waveOutPrepareHeader(hwo, @pRec.waveheader, SizeOf(wavehdr));
231
            Assert(mmres=MMSYSERR_NOERROR, IntToStr(mmres));
232
            Sources[i].ManagerTag:=Integer(prec);
233
            mmres:=waveOutWrite(hwo, @pRec.waveheader, SizeOf(wavehdr));
234
            Assert(mmres=MMSYSERR_NOERROR, IntToStr(mmres));
235

236
            Inc(n);
237
			end else
238
				Sources.Delete(i);
239
		end else
240
			Sources.Delete(i);
241
	end;
242
end;
243

244
initialization
245

246
  RegisterClasses([TGLSMWaveOut]);
247

248
end.
249