1 unit SoundTouchDLL;
2
3 //////////////////////////////////////////////////////////////////////////////
4 //
5 // SoundTouch.dll wrapper for accessing SoundTouch routines from Delphi/Pascal
6 //
7 // Module Author : Christian Budde
8 //
9 // 2014-01-12 fixes by Sandro Cumerlato <sandro.cumerlato 'at' gmail.com>
10 //
11 ////////////////////////////////////////////////////////////////////////////////
12 //
13 // License :
14 //
15 // SoundTouch audio processing library
16 // Copyright (c) Olli Parviainen
17 //
18 // This library is free software; you can redistribute it and/or
19 // modify it under the terms of the GNU Lesser General Public
20 // License as published by the Free Software Foundation; either
21 // version 2.1 of the License, or (at your option) any later version.
22 //
23 // This library is distributed in the hope that it will be useful,
24 // but WITHOUT ANY WARRANTY; without even the implied warranty of
25 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
26 // Lesser General Public License for more details.
27 //
28 // You should have received a copy of the GNU Lesser General Public
29 // License along with this library; if not, write to the Free Software
30 // Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
31 //
32 ////////////////////////////////////////////////////////////////////////////////
33
34 interface
35
36 uses
37 Windows;
38
39 type
40 TSoundTouchHandle = THandle;
41
42 // Create a new instance of SoundTouch processor.
43 TSoundTouchCreateInstance = function : TSoundTouchHandle; cdecl;
44
45 // Destroys a SoundTouch processor instance.
46 TSoundTouchDestroyInstance = procedure (Handle: TSoundTouchHandle); cdecl;
47
48 // Get SoundTouch library version string
49 TSoundTouchGetVersionString = function : PAnsiChar; cdecl;
50
51 // Get SoundTouch library version string 2
52 TSoundTouchGetVersionString2 = procedure(VersionString : PAnsiChar; BufferSize : Integer); cdecl;
53
54 // Get SoundTouch library version Id
55 TSoundTouchGetVersionId = function : Cardinal; cdecl;
56
57 // Sets new rate control value. Normal rate = 1.0, smaller values
58 // represent slower rate, larger faster rates.
59 TSoundTouchSetRate = procedure (Handle: TSoundTouchHandle; NewRate: Single); cdecl;
60
61 // Sets new tempo control value. Normal tempo = 1.0, smaller values
62 // represent slower tempo, larger faster tempo.
63 TSoundTouchSetTempo = procedure (Handle: TSoundTouchHandle; NewTempo: Single); cdecl;
64
65 // Sets new rate control value as a difference in percents compared
66 // to the original rate (-50 .. +100 %);
67 TSoundTouchSetRateChange = procedure (Handle: TSoundTouchHandle; NewRate: Single); cdecl;
68
69 // Sets new tempo control value as a difference in percents compared
70 // to the original tempo (-50 .. +100 %);
71 TSoundTouchSetTempoChange = procedure (Handle: TSoundTouchHandle; NewTempo: Single); cdecl;
72
73 // Sets new pitch control value. Original pitch = 1.0, smaller values
74 // represent lower pitches, larger values higher pitch.
75 TSoundTouchSetPitch = procedure (Handle: TSoundTouchHandle; NewPitch: Single); cdecl;
76
77 // Sets pitch change in octaves compared to the original pitch
78 // (-1.00 .. +1.00);
79 TSoundTouchSetPitchOctaves = procedure (Handle: TSoundTouchHandle; NewPitch: Single); cdecl;
80
81 // Sets pitch change in semi-tones compared to the original pitch
82 // (-12 .. +12);
83 TSoundTouchSetPitchSemiTones = procedure (Handle: TSoundTouchHandle; NewPitch: Single); cdecl;
84
85 // Sets the number of channels, 1 = mono, 2 = stereo
86 TSoundTouchSetChannels = procedure (Handle: TSoundTouchHandle; NumChannels: Cardinal); cdecl;
87
88 // Sets sample rate.
89 TSoundTouchSetSampleRate = procedure (Handle: TSoundTouchHandle; SampleRate: Cardinal); cdecl;
90
91 // Flushes the last samples from the processing pipeline to the output.
92 // Clears also the internal processing buffers.
93 //
isnull94 // Note: This function is meant for extracting the last samples of a sound
95 // stream. This function may introduce additional blank samples in the end
96 // of the sound stream, and thus it
97 // in the middle of a sound stream.
98 TSoundTouchFlush = procedure (Handle: TSoundTouchHandle); cdecl;
99
100 // Adds 'numSamples' pcs of samples from the 'samples' memory position into
101 // the input of the object. Notice that sample rate _has_to_ be set before
otherwisenull102 // calling this function, otherwise throws a runtime_error exception.
103 TSoundTouchPutSamples = procedure (Handle: TSoundTouchHandle;
104 const Samples: PSingle; //< Pointer to sample buffer.
105 NumSamples: Cardinal //< Number of samples in buffer. Notice
106 //< that in case of stereo-sound a single sample
107 //< contains data for both channels.
108 ); cdecl;
109
110 // Clears all the samples in the object's output and internal processing
111 // buffers.
112 TSoundTouchClear = procedure (Handle: TSoundTouchHandle); cdecl;
113
114 // Changes a setting controlling the processing system behaviour. See the
115 // 'SETTING_...' defines for available setting ID's.
116 //
117 // \return 'TRUE' if the setting was successfully changed
118 TSoundTouchSetSetting = function (Handle: TSoundTouchHandle;
119 SettingId: Integer; //< Setting ID number. see SETTING_... defines.
120 Value: Integer //< New setting value.
121 ): Boolean; cdecl;
122
123 // Reads a setting controlling the processing system behaviour. See the
124 // 'SETTING_...' defines for available setting ID's.
125 //
126 // \return the setting value.
127 TSoundTouchGetSetting = function (Handle: TSoundTouchHandle;
128 SettingId: Integer //< Setting ID number, see SETTING_... defines.
129 ): Integer; cdecl;
130
131 // Returns number of samples currently unprocessed.
132 TSoundTouchNumUnprocessedSamples = function (Handle: TSoundTouchHandle): Cardinal; cdecl;
133
134 // Adjusts book-keeping so that given number of samples are removed from beginning of the
135 // sample buffer without copying them anywhere.
136 //
137 // Used to reduce the number of samples in the buffer when accessing the sample buffer directly
138 // with 'ptrBegin' function.
139 TSoundTouchReceiveSamples = function (Handle: TSoundTouchHandle;
140 OutBuffer: PSingle; //< Buffer where to copy output samples.
141 MaxSamples: Integer //< How many samples to receive at max.
142 ): Cardinal; cdecl;
143
144 // Returns number of samples currently available.
145 TSoundTouchNumSamples = function (Handle: TSoundTouchHandle): Cardinal; cdecl;
146
147 // Returns nonzero if there aren't any samples available for outputting.
148 TSoundTouchIsEmpty = function (Handle: TSoundTouchHandle): Integer; cdecl;
149
150 var
151 SoundTouchCreateInstance : TSoundTouchCreateInstance;
152 SoundTouchDestroyInstance : TSoundTouchDestroyInstance;
153 SoundTouchGetVersionString : TSoundTouchGetVersionString;
154 SoundTouchGetVersionString2 : TSoundTouchGetVersionString2;
155 SoundTouchGetVersionId : TSoundTouchGetVersionId;
156 SoundTouchSetRate : TSoundTouchSetRate;
157 SoundTouchSetTempo : TSoundTouchSetTempo;
158 SoundTouchSetRateChange : TSoundTouchSetRateChange;
159 SoundTouchSetTempoChange : TSoundTouchSetTempoChange;
160 SoundTouchSetPitch : TSoundTouchSetPitch;
161 SoundTouchSetPitchOctaves : TSoundTouchSetPitchOctaves;
162 SoundTouchSetPitchSemiTones : TSoundTouchSetPitchSemiTones;
163 SoundTouchSetChannels : TSoundTouchSetChannels;
164 SoundTouchSetSampleRate : TSoundTouchSetSampleRate;
165 SoundTouchFlush : TSoundTouchFlush;
166 SoundTouchPutSamples : TSoundTouchPutSamples;
167 SoundTouchPutSamplesI16 : TSoundTouchPutSamplesI16;
168 SoundTouchClear : TSoundTouchClear;
169 SoundTouchSetSetting : TSoundTouchSetSetting;
170 SoundTouchGetSetting : TSoundTouchGetSetting;
171 SoundTouchNumUnprocessedSamples : TSoundTouchNumUnprocessedSamples;
172 SoundTouchReceiveSamples : TSoundTouchReceiveSamples;
173 SoundTouchNumSamples : TSoundTouchNumSamples;
174 SoundTouchIsEmpty : TSoundTouchIsEmpty;
175
176 type
177 TSoundTouch = class
178 private
179 FHandle : TSoundTouchHandle;
180 FRate : Single;
181 FPitch : Single;
182 FTempo : Single;
183 FSampleRate : Single;
184 FChannels : Cardinal;
GetNumSamplesnull185 function GetNumSamples: Cardinal;
GetNumUnprocessedSamplesnull186 function GetNumUnprocessedSamples: Cardinal;
GetIsEmptynull187 function GetIsEmpty: Integer;
GetPitchChangenull188 function GetPitchChange: Single;
GetRateChangenull189 function GetRateChange: Single;
GetTempoChangenull190 function GetTempoChange: Single;
191 procedure SetRate(const Value: Single);
192 procedure SetPitch(const Value: Single);
193 procedure SetTempo(const Value: Single);
194 procedure SetPitchChange(const Value: Single);
195 procedure SetRateChange(const Value: Single);
196 procedure SetTempoChange(const Value: Single);
197 procedure SetChannels(const Value: Cardinal);
198 procedure SetSampleRate(const Value: Single);
199 protected
200 procedure SamplerateChanged; virtual;
201 procedure ChannelsChanged; virtual;
202 procedure PitchChanged; virtual;
203 procedure TempoChanged; virtual;
204 procedure RateChanged; virtual;
205 public
GetVersionStringnull206 class function GetVersionString: string;
GetVersionIdnull207 class function GetVersionId: Cardinal;
208 constructor Create; virtual;
209 destructor Destroy; override;
210 procedure Flush; virtual;
211 procedure Clear; virtual;
212
213 procedure PutSamples(const Samples: PSingle; const NumSamples: Cardinal);
ReceiveSamplesnull214 function ReceiveSamples(const OutBuffer: PSingle; const MaxSamples: Integer): Cardinal;
215
SetSettingnull216 function SetSetting(const SettingId: Integer; const Value: Integer): Boolean;
GetSettingnull217 function GetSetting(const SettingId: Integer): Integer;
218
219 property VersionString: string read GetVersionString;
220 property VersionID: Cardinal read GetVersionId;
221 property Channels: Cardinal read FChannels write SetChannels;
222 property Rate: Single read FRate write SetRate;
223 property RateChange: Single read GetRateChange write SetRateChange;
224 property Tempo: Single read FTempo write SetTempo;
225 property TempoChange: Single read GetTempoChange write SetTempoChange;
226 property Pitch: Single read FPitch write SetPitch;
227 property PitchChange: Single read GetPitchChange write SetPitchChange;
228 property SampleRate: Single read FSampleRate write SetSampleRate;
229
230 property NumSamples: Cardinal read GetNumSamples;
231 property NumUnprocessedSamples: Cardinal read GetNumUnprocessedSamples;
232 property IsEmpty: Integer read GetIsEmpty;
233 end;
234
235 implementation
236
237 { TSoundTouch }
238
239 constructor TSoundTouch.Create;
240 begin
241 inherited;
242 FHandle := SoundTouchCreateInstance();
243 FRate := 1;
244 FTempo := 1;
245 FPitch := 1;
246 FChannels := 1;
247 FSampleRate := 44100;
248 SamplerateChanged;
249 ChannelsChanged;
250 end;
251
252 destructor TSoundTouch.Destroy;
253 begin
254 SoundTouchDestroyInstance(FHandle);
255 inherited;
256 end;
257
258 procedure TSoundTouch.Flush;
259 begin
260 SoundTouchFlush(FHandle);
261 end;
262
263 procedure TSoundTouch.Clear;
264 begin
265 SoundTouchClear(FHandle);
266 end;
267
TSoundTouch.GetIsEmptynull268 function TSoundTouch.GetIsEmpty: Integer;
269 begin
270 result := SoundTouchIsEmpty(FHandle);
271 end;
272
GetNumSamplesnull273 function TSoundTouch.GetNumSamples: Cardinal;
274 begin
275 result := SoundTouchNumSamples(FHandle);
276 end;
277
GetNumUnprocessedSamplesnull278 function TSoundTouch.GetNumUnprocessedSamples: Cardinal;
279 begin
280 result := SoundTouchNumUnprocessedSamples(FHandle);
281 end;
282
TSoundTouch.GetPitchChangenull283 function TSoundTouch.GetPitchChange: Single;
284 begin
285 result := 100 * (FPitch - 1.0);
286 end;
287
TSoundTouch.GetRateChangenull288 function TSoundTouch.GetRateChange: Single;
289 begin
290 result := 100 * (FRate - 1.0);
291 end;
292
TSoundTouch.GetTempoChangenull293 function TSoundTouch.GetTempoChange: Single;
294 begin
295 result := 100 * (FTempo - 1.0);
296 end;
297
TSoundTouch.GetVersionIdnull298 class function TSoundTouch.GetVersionId: Cardinal;
299 begin
300 result := SoundTouchGetVersionId();
301 end;
302
TSoundTouch.GetVersionStringnull303 class function TSoundTouch.GetVersionString: string;
304 begin
305 result := StrPas(SoundTouchGetVersionString());
306 end;
307
308 procedure TSoundTouch.SetChannels(const Value: Cardinal);
309 begin
310 if FChannels <> Value then
311 begin
312 FChannels := Value;
313 ChannelsChanged;
314 end;
315 end;
316
317 procedure TSoundTouch.ChannelsChanged;
318 begin
319 assert(FChannels in [1, 2]);
320 SoundTouchSetChannels(FHandle, FChannels);
321 end;
322
323 procedure TSoundTouch.SetPitch(const Value: Single);
324 begin
325 if FPitch <> Value then
326 begin
327 FPitch := Value;
328 PitchChanged;
329 end;
330 end;
331
332 procedure TSoundTouch.PitchChanged;
333 begin
334 SoundTouchSetPitch(FHandle, FPitch);
335 end;
336
337 procedure TSoundTouch.putSamples(const Samples: PSingle;
338 const NumSamples: Cardinal);
339 begin
340 SoundTouchPutSamples(FHandle, Samples, NumSamples);
341 end;
342
343 procedure TSoundTouch.RateChanged;
344 begin
345 SoundTouchSetRate(FHandle, FRate);
346 end;
347
TSoundTouch.ReceiveSamplesnull348 function TSoundTouch.ReceiveSamples(const OutBuffer: PSingle;
349 const MaxSamples: Integer): Cardinal;
350 begin
351 result := SoundTouchReceiveSamples(FHandle, OutBuffer, MaxSamples);
352 end;
353
354 procedure TSoundTouch.SetPitchChange(const Value: Single);
355 begin
356 Pitch := 1.0 + 0.01 * Value;
357 end;
358
359 procedure TSoundTouch.SetRate(const Value: Single);
360 begin
361 if FRate <> Value then
362 begin
363 FRate := Value;
364 RateChanged;
365 end;
366 end;
367
368 procedure TSoundTouch.SetRateChange(const Value: Single);
369 begin
370 Rate := 1.0 + 0.01 * Value;
371 end;
372
373 procedure TSoundTouch.SetSampleRate(const Value: Single);
374 begin
375 if FSampleRate <> Value then
376 begin
377 FSampleRate := Value;
378 SamplerateChanged;
379 end;
380 end;
381
382 procedure TSoundTouch.SamplerateChanged;
383 begin
384 assert(FSampleRate > 0);
385 SoundTouchsetSampleRate(FHandle, round(FSampleRate));
386 end;
387
388 procedure TSoundTouch.SetTempo(const Value: Single);
389 begin
390 if FTempo <> Value then
391 begin
392 FTempo := Value;
393 TempoChanged;
394 end;
395 end;
396
397 procedure TSoundTouch.SetTempoChange(const Value: Single);
398 begin
399 Tempo := 1.0 + 0.01 * Value;
400 end;
401
TSoundTouch.GetSettingnull402 function TSoundTouch.GetSetting(const SettingId: Integer): Integer;
403 begin
404 result := SoundTouchGetSetting(FHandle, SettingId);
405 end;
406
TSoundTouch.SetSettingnull407 function TSoundTouch.SetSetting(const SettingId: Integer;
408 const Value: Integer): Boolean;
409 begin
410 result := SoundTouchSetSetting(FHandle, SettingId, Value);
411 end;
412
413 procedure TSoundTouch.TempoChanged;
414 begin
415 SoundTouchsetTempo(FHandle, FTempo);
416 end;
417
418 var
419 SoundTouchLibHandle: HINST;
420 SoundTouchDLLFile: PAnsiChar = 'SoundTouch.dll';
421
422 // bpm detect functions. untested -- if these don't work then remove:
423 bpm_createInstance: function(chan: CInt32; sampleRate : CInt32): THandle; cdecl;
424 bpm_destroyInstance: procedure(h: THandle); cdecl;
425 bpm_getBpm: function(h: THandle): cfloat; cdecl;
426 bpm_putSamples: procedure(h: THandle; const samples: pcfloat;
427 numSamples: cardinal); cdecl;
428
429 procedure InitDLL;
430 begin
431 SoundTouchLibHandle := LoadLibrary(SoundTouchDLLFile);
432 if SoundTouchLibHandle <> 0 then
433 try
434 Pointer(SoundTouchCreateInstance) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_createInstance');
435 Pointer(SoundTouchDestroyInstance) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_destroyInstance');
436 Pointer(SoundTouchGetVersionString) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_getVersionString');
437 Pointer(SoundTouchGetVersionString2) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_getVersionString2');
438 Pointer(SoundTouchGetVersionId) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_getVersionId');
439 Pointer(SoundTouchSetRate) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setRate');
440 Pointer(SoundTouchSetTempo) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setTempo');
441 Pointer(SoundTouchSetRateChange) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setRateChange');
442 Pointer(SoundTouchSetTempoChange) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setTempoChange');
443 Pointer(SoundTouchSetPitch) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setPitch');
444 Pointer(SoundTouchSetPitchOctaves) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setPitchOctaves');
445 Pointer(SoundTouchSetPitchSemiTones) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setPitchSemiTones');
446 Pointer(SoundTouchSetChannels) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setChannels');
447 Pointer(SoundTouchSetSampleRate) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setSampleRate');
448 Pointer(SoundTouchFlush) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_flush');
449 Pointer(SoundTouchPutSamples) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_putSamples');
450 Pointer(SoundTouchPutSamplesI16) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_putSamples_i16');
451 Pointer(SoundTouchClear) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_clear');
452 Pointer(SoundTouchSetSetting) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_SetSetting');
453 Pointer(SoundTouchGetSetting) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setSetting');
454 Pointer(SoundTouchNumUnprocessedSamples) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_numUnprocessedSamples');
455 Pointer(SoundTouchReceiveSamples) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_receiveSamples');
456 Pointer(SoundTouchReceiveSamplesI16) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_receiveSamples_i16');
457 Pointer(SoundTouchNumSamples) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_numSamples');
458 Pointer(SoundTouchIsEmpty) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_isEmpty');
459
460 Pointer(bpm_createInstance) :=GetProcAddress(SoundTouchLibHandle, 'bpm_createInstance');
461 Pointer(bpm_destroyInstance) :=GetProcAddress(SoundTouchLibHandle, 'bpm_destroyInstance');
462 Pointer(bpm_getBpm) :=GetProcAddress(SoundTouchLibHandle, 'bpm_getBpm');
463 Pointer(bpm_putSamples) :=GetProcAddress(SoundTouchLibHandle, 'bpm_putSamples');
464
465 except
466 FreeLibrary(SoundTouchLibHandle);
467 SoundTouchLibHandle := 0;
468 end;
469 end;
470
471 procedure FreeDLL;
472 begin
473 if SoundTouchLibHandle <> 0 then FreeLibrary(SoundTouchLibHandle);
474 end;
475
476 initialization
477 InitDLL;
478
479 finalization
480 FreeDLL;
481
482 end.
483