mirror of
https://github.com/RPCS3/soundtouch.git
synced 2024-11-12 13:52:56 +01:00
483 lines
18 KiB
ObjectPascal
483 lines
18 KiB
ObjectPascal
unit SoundTouchDLL;
|
|
|
|
//////////////////////////////////////////////////////////////////////////////
|
|
//
|
|
// SoundTouch.dll wrapper for accessing SoundTouch routines from Delphi/Pascal
|
|
//
|
|
// Module Author : Christian Budde
|
|
//
|
|
// 2014-01-12 fixes by Sandro Cumerlato <sandro.cumerlato 'at' gmail.com>
|
|
//
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
//
|
|
// License :
|
|
//
|
|
// SoundTouch audio processing library
|
|
// Copyright (c) Olli Parviainen
|
|
//
|
|
// This library is free software; you can redistribute it and/or
|
|
// modify it under the terms of the GNU Lesser General Public
|
|
// License as published by the Free Software Foundation; either
|
|
// version 2.1 of the License, or (at your option) any later version.
|
|
//
|
|
// This library is distributed in the hope that it will be useful,
|
|
// but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
// Lesser General Public License for more details.
|
|
//
|
|
// You should have received a copy of the GNU Lesser General Public
|
|
// License along with this library; if not, write to the Free Software
|
|
// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
//
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows;
|
|
|
|
type
|
|
TSoundTouchHandle = THandle;
|
|
|
|
// Create a new instance of SoundTouch processor.
|
|
TSoundTouchCreateInstance = function : TSoundTouchHandle; cdecl;
|
|
|
|
// Destroys a SoundTouch processor instance.
|
|
TSoundTouchDestroyInstance = procedure (Handle: TSoundTouchHandle); cdecl;
|
|
|
|
// Get SoundTouch library version string
|
|
TSoundTouchGetVersionString = function : PAnsiChar; cdecl;
|
|
|
|
// Get SoundTouch library version string 2
|
|
TSoundTouchGetVersionString2 = procedure(VersionString : PAnsiChar; BufferSize : Integer); cdecl;
|
|
|
|
// Get SoundTouch library version Id
|
|
TSoundTouchGetVersionId = function : Cardinal; cdecl;
|
|
|
|
// Sets new rate control value. Normal rate = 1.0, smaller values
|
|
// represent slower rate, larger faster rates.
|
|
TSoundTouchSetRate = procedure (Handle: TSoundTouchHandle; NewRate: Single); cdecl;
|
|
|
|
// Sets new tempo control value. Normal tempo = 1.0, smaller values
|
|
// represent slower tempo, larger faster tempo.
|
|
TSoundTouchSetTempo = procedure (Handle: TSoundTouchHandle; NewTempo: Single); cdecl;
|
|
|
|
// Sets new rate control value as a difference in percents compared
|
|
// to the original rate (-50 .. +100 %);
|
|
TSoundTouchSetRateChange = procedure (Handle: TSoundTouchHandle; NewRate: Single); cdecl;
|
|
|
|
// Sets new tempo control value as a difference in percents compared
|
|
// to the original tempo (-50 .. +100 %);
|
|
TSoundTouchSetTempoChange = procedure (Handle: TSoundTouchHandle; NewTempo: Single); cdecl;
|
|
|
|
// Sets new pitch control value. Original pitch = 1.0, smaller values
|
|
// represent lower pitches, larger values higher pitch.
|
|
TSoundTouchSetPitch = procedure (Handle: TSoundTouchHandle; NewPitch: Single); cdecl;
|
|
|
|
// Sets pitch change in octaves compared to the original pitch
|
|
// (-1.00 .. +1.00);
|
|
TSoundTouchSetPitchOctaves = procedure (Handle: TSoundTouchHandle; NewPitch: Single); cdecl;
|
|
|
|
// Sets pitch change in semi-tones compared to the original pitch
|
|
// (-12 .. +12);
|
|
TSoundTouchSetPitchSemiTones = procedure (Handle: TSoundTouchHandle; NewPitch: Single); cdecl;
|
|
|
|
// Sets the number of channels, 1 = mono, 2 = stereo
|
|
TSoundTouchSetChannels = procedure (Handle: TSoundTouchHandle; NumChannels: Cardinal); cdecl;
|
|
|
|
// Sets sample rate.
|
|
TSoundTouchSetSampleRate = procedure (Handle: TSoundTouchHandle; SampleRate: Cardinal); cdecl;
|
|
|
|
// Flushes the last samples from the processing pipeline to the output.
|
|
// Clears also the internal processing buffers.
|
|
//
|
|
// Note: This function is meant for extracting the last samples of a sound
|
|
// stream. This function may introduce additional blank samples in the end
|
|
// of the sound stream, and thus it
|
|
// in the middle of a sound stream.
|
|
TSoundTouchFlush = procedure (Handle: TSoundTouchHandle); cdecl;
|
|
|
|
// Adds 'numSamples' pcs of samples from the 'samples' memory position into
|
|
// the input of the object. Notice that sample rate _has_to_ be set before
|
|
// calling this function, otherwise throws a runtime_error exception.
|
|
TSoundTouchPutSamples = procedure (Handle: TSoundTouchHandle;
|
|
const Samples: PSingle; //< Pointer to sample buffer.
|
|
NumSamples: Cardinal //< Number of samples in buffer. Notice
|
|
//< that in case of stereo-sound a single sample
|
|
//< contains data for both channels.
|
|
); cdecl;
|
|
|
|
// Clears all the samples in the object's output and internal processing
|
|
// buffers.
|
|
TSoundTouchClear = procedure (Handle: TSoundTouchHandle); cdecl;
|
|
|
|
// Changes a setting controlling the processing system behaviour. See the
|
|
// 'SETTING_...' defines for available setting ID's.
|
|
//
|
|
// \return 'TRUE' if the setting was successfully changed
|
|
TSoundTouchSetSetting = function (Handle: TSoundTouchHandle;
|
|
SettingId: Integer; //< Setting ID number. see SETTING_... defines.
|
|
Value: Integer //< New setting value.
|
|
): Boolean; cdecl;
|
|
|
|
// Reads a setting controlling the processing system behaviour. See the
|
|
// 'SETTING_...' defines for available setting ID's.
|
|
//
|
|
// \return the setting value.
|
|
TSoundTouchGetSetting = function (Handle: TSoundTouchHandle;
|
|
SettingId: Integer //< Setting ID number, see SETTING_... defines.
|
|
): Integer; cdecl;
|
|
|
|
// Returns number of samples currently unprocessed.
|
|
TSoundTouchNumUnprocessedSamples = function (Handle: TSoundTouchHandle): Cardinal; cdecl;
|
|
|
|
// Adjusts book-keeping so that given number of samples are removed from beginning of the
|
|
// sample buffer without copying them anywhere.
|
|
//
|
|
// Used to reduce the number of samples in the buffer when accessing the sample buffer directly
|
|
// with 'ptrBegin' function.
|
|
TSoundTouchReceiveSamples = function (Handle: TSoundTouchHandle;
|
|
OutBuffer: PSingle; //< Buffer where to copy output samples.
|
|
MaxSamples: Integer //< How many samples to receive at max.
|
|
): Cardinal; cdecl;
|
|
|
|
// Returns number of samples currently available.
|
|
TSoundTouchNumSamples = function (Handle: TSoundTouchHandle): Cardinal; cdecl;
|
|
|
|
// Returns nonzero if there aren't any samples available for outputting.
|
|
TSoundTouchIsEmpty = function (Handle: TSoundTouchHandle): Integer; cdecl;
|
|
|
|
var
|
|
SoundTouchCreateInstance : TSoundTouchCreateInstance;
|
|
SoundTouchDestroyInstance : TSoundTouchDestroyInstance;
|
|
SoundTouchGetVersionString : TSoundTouchGetVersionString;
|
|
SoundTouchGetVersionString2 : TSoundTouchGetVersionString2;
|
|
SoundTouchGetVersionId : TSoundTouchGetVersionId;
|
|
SoundTouchSetRate : TSoundTouchSetRate;
|
|
SoundTouchSetTempo : TSoundTouchSetTempo;
|
|
SoundTouchSetRateChange : TSoundTouchSetRateChange;
|
|
SoundTouchSetTempoChange : TSoundTouchSetTempoChange;
|
|
SoundTouchSetPitch : TSoundTouchSetPitch;
|
|
SoundTouchSetPitchOctaves : TSoundTouchSetPitchOctaves;
|
|
SoundTouchSetPitchSemiTones : TSoundTouchSetPitchSemiTones;
|
|
SoundTouchSetChannels : TSoundTouchSetChannels;
|
|
SoundTouchSetSampleRate : TSoundTouchSetSampleRate;
|
|
SoundTouchFlush : TSoundTouchFlush;
|
|
SoundTouchPutSamples : TSoundTouchPutSamples;
|
|
SoundTouchPutSamplesI16 : TSoundTouchPutSamplesI16;
|
|
SoundTouchClear : TSoundTouchClear;
|
|
SoundTouchSetSetting : TSoundTouchSetSetting;
|
|
SoundTouchGetSetting : TSoundTouchGetSetting;
|
|
SoundTouchNumUnprocessedSamples : TSoundTouchNumUnprocessedSamples;
|
|
SoundTouchReceiveSamples : TSoundTouchReceiveSamples;
|
|
SoundTouchNumSamples : TSoundTouchNumSamples;
|
|
SoundTouchIsEmpty : TSoundTouchIsEmpty;
|
|
|
|
type
|
|
TSoundTouch = class
|
|
private
|
|
FHandle : TSoundTouchHandle;
|
|
FRate : Single;
|
|
FPitch : Single;
|
|
FTempo : Single;
|
|
FSampleRate : Single;
|
|
FChannels : Cardinal;
|
|
function GetNumSamples: Cardinal;
|
|
function GetNumUnprocessedSamples: Cardinal;
|
|
function GetIsEmpty: Integer;
|
|
function GetPitchChange: Single;
|
|
function GetRateChange: Single;
|
|
function GetTempoChange: Single;
|
|
procedure SetRate(const Value: Single);
|
|
procedure SetPitch(const Value: Single);
|
|
procedure SetTempo(const Value: Single);
|
|
procedure SetPitchChange(const Value: Single);
|
|
procedure SetRateChange(const Value: Single);
|
|
procedure SetTempoChange(const Value: Single);
|
|
procedure SetChannels(const Value: Cardinal);
|
|
procedure SetSampleRate(const Value: Single);
|
|
protected
|
|
procedure SamplerateChanged; virtual;
|
|
procedure ChannelsChanged; virtual;
|
|
procedure PitchChanged; virtual;
|
|
procedure TempoChanged; virtual;
|
|
procedure RateChanged; virtual;
|
|
public
|
|
class function GetVersionString: string;
|
|
class function GetVersionId: Cardinal;
|
|
constructor Create; virtual;
|
|
destructor Destroy; override;
|
|
procedure Flush; virtual;
|
|
procedure Clear; virtual;
|
|
|
|
procedure PutSamples(const Samples: PSingle; const NumSamples: Cardinal);
|
|
function ReceiveSamples(const OutBuffer: PSingle; const MaxSamples: Integer): Cardinal;
|
|
|
|
function SetSetting(const SettingId: Integer; const Value: Integer): Boolean;
|
|
function GetSetting(const SettingId: Integer): Integer;
|
|
|
|
property VersionString: string read GetVersionString;
|
|
property VersionID: Cardinal read GetVersionId;
|
|
property Channels: Cardinal read FChannels write SetChannels;
|
|
property Rate: Single read FRate write SetRate;
|
|
property RateChange: Single read GetRateChange write SetRateChange;
|
|
property Tempo: Single read FTempo write SetTempo;
|
|
property TempoChange: Single read GetTempoChange write SetTempoChange;
|
|
property Pitch: Single read FPitch write SetPitch;
|
|
property PitchChange: Single read GetPitchChange write SetPitchChange;
|
|
property SampleRate: Single read FSampleRate write SetSampleRate;
|
|
|
|
property NumSamples: Cardinal read GetNumSamples;
|
|
property NumUnprocessedSamples: Cardinal read GetNumUnprocessedSamples;
|
|
property IsEmpty: Integer read GetIsEmpty;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TSoundTouch }
|
|
|
|
constructor TSoundTouch.Create;
|
|
begin
|
|
inherited;
|
|
FHandle := SoundTouchCreateInstance();
|
|
FRate := 1;
|
|
FTempo := 1;
|
|
FPitch := 1;
|
|
FChannels := 1;
|
|
FSampleRate := 44100;
|
|
SamplerateChanged;
|
|
ChannelsChanged;
|
|
end;
|
|
|
|
destructor TSoundTouch.Destroy;
|
|
begin
|
|
SoundTouchDestroyInstance(FHandle);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TSoundTouch.Flush;
|
|
begin
|
|
SoundTouchFlush(FHandle);
|
|
end;
|
|
|
|
procedure TSoundTouch.Clear;
|
|
begin
|
|
SoundTouchClear(FHandle);
|
|
end;
|
|
|
|
function TSoundTouch.GetIsEmpty: Integer;
|
|
begin
|
|
result := SoundTouchIsEmpty(FHandle);
|
|
end;
|
|
|
|
function TSoundTouch.GetNumSamples: Cardinal;
|
|
begin
|
|
result := SoundTouchNumSamples(FHandle);
|
|
end;
|
|
|
|
function TSoundTouch.GetNumUnprocessedSamples: Cardinal;
|
|
begin
|
|
result := SoundTouchNumUnprocessedSamples(FHandle);
|
|
end;
|
|
|
|
function TSoundTouch.GetPitchChange: Single;
|
|
begin
|
|
result := 100 * (FPitch - 1.0);
|
|
end;
|
|
|
|
function TSoundTouch.GetRateChange: Single;
|
|
begin
|
|
result := 100 * (FRate - 1.0);
|
|
end;
|
|
|
|
function TSoundTouch.GetTempoChange: Single;
|
|
begin
|
|
result := 100 * (FTempo - 1.0);
|
|
end;
|
|
|
|
class function TSoundTouch.GetVersionId: Cardinal;
|
|
begin
|
|
result := SoundTouchGetVersionId();
|
|
end;
|
|
|
|
class function TSoundTouch.GetVersionString: string;
|
|
begin
|
|
result := StrPas(SoundTouchGetVersionString());
|
|
end;
|
|
|
|
procedure TSoundTouch.SetChannels(const Value: Cardinal);
|
|
begin
|
|
if FChannels <> Value then
|
|
begin
|
|
FChannels := Value;
|
|
ChannelsChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TSoundTouch.ChannelsChanged;
|
|
begin
|
|
assert(FChannels in [1, 2]);
|
|
SoundTouchSetChannels(FHandle, FChannels);
|
|
end;
|
|
|
|
procedure TSoundTouch.SetPitch(const Value: Single);
|
|
begin
|
|
if FPitch <> Value then
|
|
begin
|
|
FPitch := Value;
|
|
PitchChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TSoundTouch.PitchChanged;
|
|
begin
|
|
SoundTouchSetPitch(FHandle, FPitch);
|
|
end;
|
|
|
|
procedure TSoundTouch.putSamples(const Samples: PSingle;
|
|
const NumSamples: Cardinal);
|
|
begin
|
|
SoundTouchPutSamples(FHandle, Samples, NumSamples);
|
|
end;
|
|
|
|
procedure TSoundTouch.RateChanged;
|
|
begin
|
|
SoundTouchSetRate(FHandle, FRate);
|
|
end;
|
|
|
|
function TSoundTouch.ReceiveSamples(const OutBuffer: PSingle;
|
|
const MaxSamples: Integer): Cardinal;
|
|
begin
|
|
result := SoundTouchReceiveSamples(FHandle, OutBuffer, MaxSamples);
|
|
end;
|
|
|
|
procedure TSoundTouch.SetPitchChange(const Value: Single);
|
|
begin
|
|
Pitch := 1.0 + 0.01 * Value;
|
|
end;
|
|
|
|
procedure TSoundTouch.SetRate(const Value: Single);
|
|
begin
|
|
if FRate <> Value then
|
|
begin
|
|
FRate := Value;
|
|
RateChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TSoundTouch.SetRateChange(const Value: Single);
|
|
begin
|
|
Rate := 1.0 + 0.01 * Value;
|
|
end;
|
|
|
|
procedure TSoundTouch.SetSampleRate(const Value: Single);
|
|
begin
|
|
if FSampleRate <> Value then
|
|
begin
|
|
FSampleRate := Value;
|
|
SamplerateChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TSoundTouch.SamplerateChanged;
|
|
begin
|
|
assert(FSampleRate > 0);
|
|
SoundTouchsetSampleRate(FHandle, round(FSampleRate));
|
|
end;
|
|
|
|
procedure TSoundTouch.SetTempo(const Value: Single);
|
|
begin
|
|
if FTempo <> Value then
|
|
begin
|
|
FTempo := Value;
|
|
TempoChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TSoundTouch.SetTempoChange(const Value: Single);
|
|
begin
|
|
Tempo := 1.0 + 0.01 * Value;
|
|
end;
|
|
|
|
function TSoundTouch.GetSetting(const SettingId: Integer): Integer;
|
|
begin
|
|
result := SoundTouchGetSetting(FHandle, SettingId);
|
|
end;
|
|
|
|
function TSoundTouch.SetSetting(const SettingId: Integer;
|
|
const Value: Integer): Boolean;
|
|
begin
|
|
result := SoundTouchSetSetting(FHandle, SettingId, Value);
|
|
end;
|
|
|
|
procedure TSoundTouch.TempoChanged;
|
|
begin
|
|
SoundTouchsetTempo(FHandle, FTempo);
|
|
end;
|
|
|
|
var
|
|
SoundTouchLibHandle: HINST;
|
|
SoundTouchDLLFile: PAnsiChar = 'SoundTouch.dll';
|
|
|
|
// bpm detect functions. untested -- if these don't work then remove:
|
|
bpm_createInstance: function(chan: CInt32; sampleRate : CInt32): THandle; cdecl;
|
|
bpm_destroyInstance: procedure(h: THandle); cdecl;
|
|
bpm_getBpm: function(h: THandle): cfloat; cdecl;
|
|
bpm_putSamples: procedure(h: THandle; const samples: pcfloat;
|
|
numSamples: cardinal); cdecl;
|
|
|
|
procedure InitDLL;
|
|
begin
|
|
SoundTouchLibHandle := LoadLibrary(SoundTouchDLLFile);
|
|
if SoundTouchLibHandle <> 0 then
|
|
try
|
|
Pointer(SoundTouchCreateInstance) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_createInstance');
|
|
Pointer(SoundTouchDestroyInstance) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_destroyInstance');
|
|
Pointer(SoundTouchGetVersionString) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_getVersionString');
|
|
Pointer(SoundTouchGetVersionString2) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_getVersionString2');
|
|
Pointer(SoundTouchGetVersionId) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_getVersionId');
|
|
Pointer(SoundTouchSetRate) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setRate');
|
|
Pointer(SoundTouchSetTempo) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setTempo');
|
|
Pointer(SoundTouchSetRateChange) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setRateChange');
|
|
Pointer(SoundTouchSetTempoChange) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setTempoChange');
|
|
Pointer(SoundTouchSetPitch) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setPitch');
|
|
Pointer(SoundTouchSetPitchOctaves) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setPitchOctaves');
|
|
Pointer(SoundTouchSetPitchSemiTones) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setPitchSemiTones');
|
|
Pointer(SoundTouchSetChannels) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setChannels');
|
|
Pointer(SoundTouchSetSampleRate) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setSampleRate');
|
|
Pointer(SoundTouchFlush) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_flush');
|
|
Pointer(SoundTouchPutSamples) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_putSamples');
|
|
Pointer(SoundTouchPutSamplesI16) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_putSamples_i16');
|
|
Pointer(SoundTouchClear) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_clear');
|
|
Pointer(SoundTouchSetSetting) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_SetSetting');
|
|
Pointer(SoundTouchGetSetting) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_setSetting');
|
|
Pointer(SoundTouchNumUnprocessedSamples) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_numUnprocessedSamples');
|
|
Pointer(SoundTouchReceiveSamples) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_receiveSamples');
|
|
Pointer(SoundTouchReceiveSamplesI16) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_receiveSamples_i16');
|
|
Pointer(SoundTouchNumSamples) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_numSamples');
|
|
Pointer(SoundTouchIsEmpty) := GetProcAddress(SoundTouchLibHandle, 'soundtouch_isEmpty');
|
|
|
|
Pointer(bpm_createInstance) :=GetProcAddress(SoundTouchLibHandle, 'bpm_createInstance');
|
|
Pointer(bpm_destroyInstance) :=GetProcAddress(SoundTouchLibHandle, 'bpm_destroyInstance');
|
|
Pointer(bpm_getBpm) :=GetProcAddress(SoundTouchLibHandle, 'bpm_getBpm');
|
|
Pointer(bpm_putSamples) :=GetProcAddress(SoundTouchLibHandle, 'bpm_putSamples');
|
|
|
|
except
|
|
FreeLibrary(SoundTouchLibHandle);
|
|
SoundTouchLibHandle := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure FreeDLL;
|
|
begin
|
|
if SoundTouchLibHandle <> 0 then FreeLibrary(SoundTouchLibHandle);
|
|
end;
|
|
|
|
initialization
|
|
InitDLL;
|
|
|
|
finalization
|
|
FreeDLL;
|
|
|
|
end.
|