Init WASAPI
This commit is contained in:
Michael Schimmel
+84
@@ -0,0 +1,84 @@
|
|||||||
|
# ---> Delphi
|
||||||
|
# Uncomment these types if you want even more clean repository. But be careful.
|
||||||
|
# It can make harm to an existing project source. Read explanations below.
|
||||||
|
#
|
||||||
|
# Resource files are binaries containing manifest, project icon and version info.
|
||||||
|
# They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files.
|
||||||
|
#*.res
|
||||||
|
#
|
||||||
|
# Type library file (binary). In old Delphi versions it should be stored.
|
||||||
|
# Since Delphi 2009 it is produced from .ridl file and can safely be ignored.
|
||||||
|
#*.tlb
|
||||||
|
#
|
||||||
|
# Diagram Portfolio file. Used by the diagram editor up to Delphi 7.
|
||||||
|
# Uncomment this if you are not using diagrams or use newer Delphi version.
|
||||||
|
#*.ddp
|
||||||
|
#
|
||||||
|
# Visual LiveBindings file. Added in Delphi XE2.
|
||||||
|
# Uncomment this if you are not using LiveBindings Designer.
|
||||||
|
#*.vlb
|
||||||
|
#
|
||||||
|
# Deployment Manager configuration file for your project. Added in Delphi XE2.
|
||||||
|
# Uncomment this if it is not mobile development and you do not use remote debug feature.
|
||||||
|
#*.deployproj
|
||||||
|
#
|
||||||
|
# C++ object files produced when C/C++ Output file generation is configured.
|
||||||
|
# Uncomment this if you are not using external objects (zlib library for example).
|
||||||
|
#*.obj
|
||||||
|
#
|
||||||
|
|
||||||
|
# Default Delphi compiler directories
|
||||||
|
# Content of this directories are generated with each Compile/Construct of a project.
|
||||||
|
# Most of the time, files here have not there place in a code repository.
|
||||||
|
Win32/
|
||||||
|
Win64/
|
||||||
|
OSX64/
|
||||||
|
OSXARM64/
|
||||||
|
Android/
|
||||||
|
Android64/
|
||||||
|
iOSDevice64/
|
||||||
|
Linux64/
|
||||||
|
|
||||||
|
# Delphi compiler-generated binaries (safe to delete)
|
||||||
|
*.exe
|
||||||
|
*.dll
|
||||||
|
*.bpl
|
||||||
|
*.bpi
|
||||||
|
*.dcp
|
||||||
|
*.so
|
||||||
|
*.apk
|
||||||
|
*.drc
|
||||||
|
*.map
|
||||||
|
*.dres
|
||||||
|
*.rsm
|
||||||
|
*.tds
|
||||||
|
*.dcu
|
||||||
|
*.lib
|
||||||
|
*.a
|
||||||
|
*.o
|
||||||
|
*.ocx
|
||||||
|
|
||||||
|
# Delphi autogenerated files (duplicated info)
|
||||||
|
*.cfg
|
||||||
|
*.hpp
|
||||||
|
*Resource.rc
|
||||||
|
|
||||||
|
# Delphi local files (user-specific info)
|
||||||
|
*.local
|
||||||
|
*.identcache
|
||||||
|
*.projdata
|
||||||
|
*.tvsconfig
|
||||||
|
*.dsk
|
||||||
|
|
||||||
|
# Delphi history and backups
|
||||||
|
__history/
|
||||||
|
__recovery/
|
||||||
|
*.~*
|
||||||
|
|
||||||
|
# Castalia statistics file (since XE7 Castalia is distributed with Delphi)
|
||||||
|
*.stat
|
||||||
|
|
||||||
|
# Boss dependency manager vendor folder https://github.com/HashLoad/boss
|
||||||
|
modules/
|
||||||
|
|
||||||
|
.vscode
|
||||||
@@ -0,0 +1,92 @@
|
|||||||
|
object Form1: TForm1
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Caption = 'Form1'
|
||||||
|
ClientHeight = 815
|
||||||
|
ClientWidth = 677
|
||||||
|
Color = clBtnFace
|
||||||
|
Font.Charset = DEFAULT_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -12
|
||||||
|
Font.Name = 'Segoe UI'
|
||||||
|
Font.Style = []
|
||||||
|
OnClose = FormClose
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDestroy = FormDestroy
|
||||||
|
DesignSize = (
|
||||||
|
677
|
||||||
|
815)
|
||||||
|
TextHeight = 15
|
||||||
|
object Button1: TButton
|
||||||
|
Left = 16
|
||||||
|
Top = 8
|
||||||
|
Width = 137
|
||||||
|
Height = 25
|
||||||
|
Caption = 'Button1'
|
||||||
|
TabOrder = 0
|
||||||
|
OnClick = Button1Click
|
||||||
|
end
|
||||||
|
object ResultMemo: TMemo
|
||||||
|
Left = 16
|
||||||
|
Top = 168
|
||||||
|
Width = 638
|
||||||
|
Height = 591
|
||||||
|
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||||
|
TabOrder = 1
|
||||||
|
ExplicitWidth = 585
|
||||||
|
ExplicitHeight = 217
|
||||||
|
end
|
||||||
|
object RmsBar: TProgressBar
|
||||||
|
Left = 16
|
||||||
|
Top = 781
|
||||||
|
Width = 638
|
||||||
|
Height = 17
|
||||||
|
Anchors = [akLeft, akRight, akBottom]
|
||||||
|
TabOrder = 2
|
||||||
|
ExplicitTop = 407
|
||||||
|
ExplicitWidth = 585
|
||||||
|
end
|
||||||
|
object UpdateButton: TButton
|
||||||
|
Left = 16
|
||||||
|
Top = 39
|
||||||
|
Width = 137
|
||||||
|
Height = 25
|
||||||
|
Caption = 'Update'
|
||||||
|
TabOrder = 3
|
||||||
|
OnClick = UpdateButtonClick
|
||||||
|
end
|
||||||
|
object SilenceEdit: TSpinEdit
|
||||||
|
Left = 184
|
||||||
|
Top = 8
|
||||||
|
Width = 49
|
||||||
|
Height = 24
|
||||||
|
MaxValue = 20
|
||||||
|
MinValue = 1
|
||||||
|
TabOrder = 4
|
||||||
|
Value = 3
|
||||||
|
OnChange = SilenceEditChange
|
||||||
|
end
|
||||||
|
object OptsMemo: TMemo
|
||||||
|
Left = 296
|
||||||
|
Top = 8
|
||||||
|
Width = 358
|
||||||
|
Height = 154
|
||||||
|
Anchors = [akLeft, akTop, akRight]
|
||||||
|
TabOrder = 5
|
||||||
|
ExplicitWidth = 305
|
||||||
|
end
|
||||||
|
object LoggingCheckBox: TCheckBox
|
||||||
|
Left = 16
|
||||||
|
Top = 80
|
||||||
|
Width = 97
|
||||||
|
Height = 17
|
||||||
|
Caption = 'Logging'
|
||||||
|
TabOrder = 6
|
||||||
|
end
|
||||||
|
object RmsTimer: TTimer
|
||||||
|
Interval = 100
|
||||||
|
OnTimer = RmsTimerTimer
|
||||||
|
Left = 192
|
||||||
|
Top = 40
|
||||||
|
end
|
||||||
|
end
|
||||||
@@ -0,0 +1,562 @@
|
|||||||
|
unit MainForm;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
||||||
|
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Winapi.MMSystem, Vcl.ComCtrls, Vcl.ExtCtrls,
|
||||||
|
System.SyncObjs, System.Math, System.Net.HttpClient, System.Net.HttpClientComponent,
|
||||||
|
System.Net.Mime, System.JSON, System.IOUtils, System.Generics.Collections, Vcl.Samples.Spin;
|
||||||
|
|
||||||
|
type
|
||||||
|
TTranscriptionTask = record
|
||||||
|
TaskID: string;
|
||||||
|
SequenceIndex: Int64;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(* Polling worker for async API tasks *)
|
||||||
|
TTranscriptionWorker = class(TThread)
|
||||||
|
strict private
|
||||||
|
fQueue: TThreadedQueue<TTranscriptionTask>;
|
||||||
|
fClient: TNetHTTPClient;
|
||||||
|
procedure ProcessTask(const ATask: TTranscriptionTask);
|
||||||
|
protected
|
||||||
|
procedure Execute; override;
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure Enqueue(const ATaskID: string; AIndex: Int64);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TAudioCaptureThread = class(TThread)
|
||||||
|
private
|
||||||
|
FWaveIn: HWAVEIN;
|
||||||
|
FHeaders: array[0..1] of TWaveHdr;
|
||||||
|
FBuffers: array[0..1] of array of Byte;
|
||||||
|
FEvent: THandle;
|
||||||
|
fCurrentRms: Integer;
|
||||||
|
|
||||||
|
fIsSilent: Boolean;
|
||||||
|
fDbThreshold: Double;
|
||||||
|
fSilenceCounter: Integer;
|
||||||
|
fRequiredSilencePackets: Integer;
|
||||||
|
fActiveFragment: TMemoryStream;
|
||||||
|
fTotalSegmentsSent: Int64;
|
||||||
|
fForceUploadFlag: Integer; // Atomic flag
|
||||||
|
|
||||||
|
procedure PrepareBuffers;
|
||||||
|
procedure UnprepareBuffers;
|
||||||
|
function CalculateRms(ABuffer: PByte; ALength: Cardinal): Integer;
|
||||||
|
procedure ProcessSilence(ARms: Integer; ABuffer: PByte; ALength: Cardinal);
|
||||||
|
procedure WriteWavHeader(AStream: TStream; ADataSize: Cardinal);
|
||||||
|
procedure TrimSilentStart(AOffset: Int64);
|
||||||
|
procedure SyncUploadAndEnqueue(AStream: TMemoryStream);
|
||||||
|
procedure PerformUpload(AStream: TMemoryStream);
|
||||||
|
protected
|
||||||
|
procedure Execute; override;
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure ForceUpload;
|
||||||
|
property CurrentRms: Integer read fCurrentRms;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TForm1 = class(TForm)
|
||||||
|
Button1: TButton;
|
||||||
|
ResultMemo: TMemo;
|
||||||
|
RmsBar: TProgressBar;
|
||||||
|
RmsTimer: TTimer;
|
||||||
|
UpdateButton: TButton;
|
||||||
|
SilenceEdit: TSpinEdit;
|
||||||
|
OptsMemo: TMemo;
|
||||||
|
LoggingCheckBox: TCheckBox;
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure Button1Click(Sender: TObject);
|
||||||
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||||||
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
procedure RmsTimerTimer(Sender: TObject);
|
||||||
|
procedure SilenceEditChange(Sender: TObject);
|
||||||
|
procedure UpdateButtonClick(Sender: TObject);
|
||||||
|
private
|
||||||
|
fCaptureThread: TAudioCaptureThread;
|
||||||
|
procedure Log(const AMsg: string);
|
||||||
|
public
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Form1: TForm1;
|
||||||
|
GlobalTranscriptionWorker: TTranscriptionWorker;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R *.dfm}
|
||||||
|
|
||||||
|
{ TTranscriptionWorker }
|
||||||
|
|
||||||
|
constructor TTranscriptionWorker.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(False);
|
||||||
|
fQueue := TThreadedQueue<TTranscriptionTask>.Create(100, 1000, 100);
|
||||||
|
fClient := TNetHTTPClient.Create(nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TTranscriptionWorker.Destroy;
|
||||||
|
begin
|
||||||
|
Terminate;
|
||||||
|
fQueue.DoShutDown;
|
||||||
|
fClient.Free;
|
||||||
|
fQueue.Free;
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTranscriptionWorker.Enqueue(const ATaskID: string; AIndex: Int64);
|
||||||
|
var
|
||||||
|
task: TTranscriptionTask;
|
||||||
|
begin
|
||||||
|
task.TaskID := ATaskID;
|
||||||
|
task.SequenceIndex := AIndex;
|
||||||
|
fQueue.PushItem(task);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTranscriptionWorker.Execute;
|
||||||
|
var
|
||||||
|
task: TTranscriptionTask;
|
||||||
|
begin
|
||||||
|
while not Terminated do
|
||||||
|
begin
|
||||||
|
if (fQueue.PopItem(task) = TWaitResult.wrSignaled) and (not Terminated) then
|
||||||
|
ProcessTask(task);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTranscriptionWorker.ProcessTask(const ATask: TTranscriptionTask);
|
||||||
|
var
|
||||||
|
resp: IHTTPResponse;
|
||||||
|
jsonResult: TJSONObject;
|
||||||
|
status, transcriptionText, sText: string;
|
||||||
|
resVal, segmentsVal: TJSONValue;
|
||||||
|
segmentsArray: TJSONArray;
|
||||||
|
i: Integer;
|
||||||
|
isDone: Boolean;
|
||||||
|
begin
|
||||||
|
isDone := False;
|
||||||
|
repeat
|
||||||
|
if Terminated then exit;
|
||||||
|
try
|
||||||
|
resp := fClient.Get('http://minerva.lan:8000/task/' + ATask.TaskID);
|
||||||
|
if (resp.StatusCode = 200) then
|
||||||
|
begin
|
||||||
|
jsonResult := TJSONObject.ParseJSONValue(resp.ContentAsString(TEncoding.UTF8)) as TJSONObject;
|
||||||
|
if Assigned(jsonResult) then
|
||||||
|
try
|
||||||
|
if jsonResult.TryGetValue('status', status) then
|
||||||
|
begin
|
||||||
|
if (status = 'completed') then
|
||||||
|
begin
|
||||||
|
if jsonResult.TryGetValue('result', resVal) and (resVal is TJSONObject) and
|
||||||
|
TJSONObject(resVal).TryGetValue('segments', segmentsVal) then
|
||||||
|
begin
|
||||||
|
segmentsArray := segmentsVal as TJSONArray;
|
||||||
|
transcriptionText := '';
|
||||||
|
for i := 0 to segmentsArray.Count - 1 do
|
||||||
|
if (segmentsArray.Items[i] as TJSONObject).TryGetValue('text', sText) then
|
||||||
|
transcriptionText := transcriptionText + sText;
|
||||||
|
|
||||||
|
sText := transcriptionText.Trim;
|
||||||
|
TThread.Queue(nil, procedure begin
|
||||||
|
Form1.ResultMemo.Lines.Add(sText);
|
||||||
|
end);
|
||||||
|
isDone := True;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else if (status = 'failed') or (status = 'error') then
|
||||||
|
isDone := True;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
jsonResult.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
on E: Exception do isDone := True;
|
||||||
|
end;
|
||||||
|
if not isDone then Sleep(500);
|
||||||
|
until isDone;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TAudioCaptureThread }
|
||||||
|
|
||||||
|
constructor TAudioCaptureThread.Create;
|
||||||
|
var
|
||||||
|
format: TWaveFormatEx;
|
||||||
|
begin
|
||||||
|
inherited Create(True);
|
||||||
|
FEvent := CreateEvent(nil, False, False, nil);
|
||||||
|
fActiveFragment := TMemoryStream.Create;
|
||||||
|
fDbThreshold := -35.0;
|
||||||
|
fRequiredSilencePackets := 30;
|
||||||
|
fIsSilent := True;
|
||||||
|
fTotalSegmentsSent := 0;
|
||||||
|
fForceUploadFlag := 0;
|
||||||
|
|
||||||
|
FillChar(format, sizeof(format), 0);
|
||||||
|
format.wFormatTag := WAVE_FORMAT_PCM;
|
||||||
|
format.nChannels := 1;
|
||||||
|
format.nSamplesPerSec := 16000;
|
||||||
|
format.wBitsPerSample := 16;
|
||||||
|
format.nBlockAlign := 2;
|
||||||
|
format.nAvgBytesPerSec := 32000;
|
||||||
|
|
||||||
|
if waveInOpen(@FWaveIn, WAVE_MAPPER, @format, FEvent, 0, CALLBACK_EVENT) <> MMSYSERR_NOERROR then
|
||||||
|
raise Exception.Create('waveInOpen failed');
|
||||||
|
|
||||||
|
PrepareBuffers;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TAudioCaptureThread.Destroy;
|
||||||
|
begin
|
||||||
|
waveInStop(FWaveIn);
|
||||||
|
UnprepareBuffers;
|
||||||
|
waveInClose(FWaveIn);
|
||||||
|
CloseHandle(FEvent);
|
||||||
|
fActiveFragment.Free;
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAudioCaptureThread.ForceUpload;
|
||||||
|
begin
|
||||||
|
TInterlocked.Exchange(fForceUploadFlag, 1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAudioCaptureThread.SyncUploadAndEnqueue(AStream: TMemoryStream);
|
||||||
|
var
|
||||||
|
client: TNetHTTPClient;
|
||||||
|
formData: TMultipartFormData;
|
||||||
|
resp: IHTTPResponse;
|
||||||
|
jsonResp: TJSONObject;
|
||||||
|
taskID: string;
|
||||||
|
urlParams: string;
|
||||||
|
begin
|
||||||
|
client := TNetHTTPClient.Create(nil);
|
||||||
|
formData := TMultipartFormData.Create;
|
||||||
|
try
|
||||||
|
AStream.Position := 0;
|
||||||
|
formData.AddStream('file', AStream, False, 'fragment.wav', 'audio/wav');
|
||||||
|
|
||||||
|
// Build query string from OptsMemo settings
|
||||||
|
urlParams := '';
|
||||||
|
TThread.Synchronize(nil, procedure
|
||||||
|
begin
|
||||||
|
for var i := 0 to Form1.OptsMemo.Lines.Count - 1 do
|
||||||
|
begin
|
||||||
|
if (urlParams <> '') then
|
||||||
|
urlParams := urlParams + '&';
|
||||||
|
urlParams := urlParams + Form1.OptsMemo.Lines[i];
|
||||||
|
end;
|
||||||
|
end);
|
||||||
|
|
||||||
|
resp := client.Post(
|
||||||
|
'http://minerva.lan:8000/speech-to-text?' + urlParams,
|
||||||
|
formData
|
||||||
|
);
|
||||||
|
|
||||||
|
if (resp.StatusCode = 200) then
|
||||||
|
begin
|
||||||
|
jsonResp := TJSONObject.ParseJSONValue(resp.ContentAsString(TEncoding.UTF8)) as TJSONObject;
|
||||||
|
try
|
||||||
|
if Assigned(jsonResp) and jsonResp.TryGetValue('identifier', taskID) then
|
||||||
|
GlobalTranscriptionWorker.Enqueue(taskID, fTotalSegmentsSent);
|
||||||
|
finally
|
||||||
|
jsonResp.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
formData.Free;
|
||||||
|
client.Free;
|
||||||
|
AStream.Free; // Stream is freed here as it was passed to this method
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAudioCaptureThread.PerformUpload(AStream: TMemoryStream);
|
||||||
|
begin
|
||||||
|
inc(fTotalSegmentsSent);
|
||||||
|
SyncUploadAndEnqueue(AStream);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAudioCaptureThread.WriteWavHeader(AStream: TStream; ADataSize: Cardinal);
|
||||||
|
type
|
||||||
|
TWavHeader = packed record
|
||||||
|
RIFF: array[0..3] of AnsiChar;
|
||||||
|
FileSize: Cardinal;
|
||||||
|
WAVE: array[0..3] of AnsiChar;
|
||||||
|
fmt: array[0..3] of AnsiChar;
|
||||||
|
FormatSize: Cardinal;
|
||||||
|
FormatTag: Word;
|
||||||
|
Channels: Word;
|
||||||
|
SamplesPerSec: Cardinal;
|
||||||
|
AvgBytesPerSec: Cardinal;
|
||||||
|
BlockAlign: Word;
|
||||||
|
BitsPerSample: Word;
|
||||||
|
DataMark: array[0..3] of AnsiChar;
|
||||||
|
DataSize: Cardinal;
|
||||||
|
end;
|
||||||
|
var
|
||||||
|
header: TWavHeader;
|
||||||
|
begin
|
||||||
|
header.RIFF := 'RIFF';
|
||||||
|
header.FileSize := ADataSize + sizeof(TWavHeader) - 8;
|
||||||
|
header.WAVE := 'WAVE';
|
||||||
|
header.fmt := 'fmt ';
|
||||||
|
header.FormatSize := 16;
|
||||||
|
header.FormatTag := 1;
|
||||||
|
header.Channels := 1;
|
||||||
|
header.SamplesPerSec := 16000;
|
||||||
|
header.BitsPerSample := 16;
|
||||||
|
header.BlockAlign := 2;
|
||||||
|
header.AvgBytesPerSec := 32000;
|
||||||
|
header.DataMark := 'data';
|
||||||
|
header.DataSize := ADataSize;
|
||||||
|
AStream.WriteBuffer(header, sizeof(TWavHeader));
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAudioCaptureThread.CalculateRms(ABuffer: PByte; ALength: Cardinal): Integer;
|
||||||
|
var
|
||||||
|
i, count: Integer;
|
||||||
|
pSamples: PSmallInt;
|
||||||
|
sum, sampleVal: Double;
|
||||||
|
begin
|
||||||
|
sum := 0;
|
||||||
|
pSamples := PSmallInt(ABuffer);
|
||||||
|
count := ALength div 2;
|
||||||
|
for i := 0 to count - 1 do
|
||||||
|
begin
|
||||||
|
sampleVal := pSamples^;
|
||||||
|
sum := sum + (sampleVal * sampleVal);
|
||||||
|
inc(pSamples);
|
||||||
|
end;
|
||||||
|
if (count > 0) then Result := Round(Sqrt(sum / count)) else Result := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAudioCaptureThread.TrimSilentStart(AOffset: Int64);
|
||||||
|
var
|
||||||
|
newSize: Int64;
|
||||||
|
begin
|
||||||
|
newSize := fActiveFragment.Size - AOffset;
|
||||||
|
if (newSize > 0) then
|
||||||
|
Move(PByte(fActiveFragment.Memory)[AOffset], fActiveFragment.Memory^, newSize);
|
||||||
|
fActiveFragment.Size := newSize;
|
||||||
|
fActiveFragment.Position := newSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAudioCaptureThread.ProcessSilence(ARms: Integer; ABuffer: PByte; ALength: Cardinal);
|
||||||
|
var
|
||||||
|
uploadStream: TMemoryStream;
|
||||||
|
currentDb: Double;
|
||||||
|
maxIdleSize, keepSize, sendSize: Int64;
|
||||||
|
forceRequested: Boolean;
|
||||||
|
begin
|
||||||
|
forceRequested := TInterlocked.CompareExchange(fForceUploadFlag, 0, 1) = 1;
|
||||||
|
fActiveFragment.WriteBuffer(ABuffer^, ALength);
|
||||||
|
if (ARms > 0) then currentDb := 20 * Log10(ARms / 32768) else currentDb := -100.0;
|
||||||
|
|
||||||
|
if (currentDb > fDbThreshold) then
|
||||||
|
begin
|
||||||
|
if fIsSilent then
|
||||||
|
begin
|
||||||
|
fIsSilent := False;
|
||||||
|
TThread.Queue(nil, procedure begin Form1.Log('Activity detected...'); end);
|
||||||
|
end;
|
||||||
|
fSilenceCounter := 0;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
inc(fSilenceCounter);
|
||||||
|
if fIsSilent then
|
||||||
|
begin
|
||||||
|
maxIdleSize := Int64(fRequiredSilencePackets) * ALength;
|
||||||
|
if (fActiveFragment.Size > maxIdleSize) then
|
||||||
|
TrimSilentStart(fActiveFragment.Size - maxIdleSize);
|
||||||
|
end
|
||||||
|
else if (fSilenceCounter >= fRequiredSilencePackets) or forceRequested then
|
||||||
|
begin
|
||||||
|
fIsSilent := True;
|
||||||
|
keepSize := (Int64(fRequiredSilencePackets) div 2) * ALength;
|
||||||
|
|
||||||
|
if forceRequested then keepSize := 0;
|
||||||
|
|
||||||
|
sendSize := fActiveFragment.Size - keepSize;
|
||||||
|
if (sendSize > 0) then
|
||||||
|
begin
|
||||||
|
uploadStream := TMemoryStream.Create;
|
||||||
|
WriteWavHeader(uploadStream, sendSize);
|
||||||
|
fActiveFragment.Position := 0;
|
||||||
|
uploadStream.CopyFrom(fActiveFragment, sendSize);
|
||||||
|
PerformUpload(uploadStream);
|
||||||
|
TrimSilentStart(sendSize);
|
||||||
|
end;
|
||||||
|
fSilenceCounter := 0;
|
||||||
|
TThread.Queue(nil, procedure begin Form1.Log('Fragment uploaded.'); end);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAudioCaptureThread.PrepareBuffers;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
bufferSize: Cardinal;
|
||||||
|
begin
|
||||||
|
bufferSize := 3200;
|
||||||
|
for i := 0 to High(FBuffers) do
|
||||||
|
begin
|
||||||
|
SetLength(FBuffers[i], bufferSize);
|
||||||
|
FHeaders[i].lpData := PAnsiChar(@FBuffers[i][0]);
|
||||||
|
FHeaders[i].dwBufferLength := bufferSize;
|
||||||
|
FHeaders[i].dwFlags := 0;
|
||||||
|
waveInPrepareHeader(FWaveIn, @FHeaders[i], sizeof(TWaveHdr));
|
||||||
|
waveInAddBuffer(FWaveIn, @FHeaders[i], sizeof(TWaveHdr));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAudioCaptureThread.UnprepareBuffers;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
waveInReset(FWaveIn);
|
||||||
|
for i := 0 to High(FHeaders) do
|
||||||
|
waveInUnprepareHeader(FWaveIn, @FHeaders[i], sizeof(TWaveHdr));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAudioCaptureThread.Execute;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
rmsValue: Integer;
|
||||||
|
begin
|
||||||
|
waveInStart(FWaveIn);
|
||||||
|
while (not Terminated) do
|
||||||
|
begin
|
||||||
|
if (WaitForSingleObject(FEvent, 100) = WAIT_OBJECT_0) then
|
||||||
|
begin
|
||||||
|
for i := 0 to High(FHeaders) do
|
||||||
|
begin
|
||||||
|
if (not Terminated) and ((FHeaders[i].dwFlags and WHDR_DONE) <> 0) then
|
||||||
|
begin
|
||||||
|
rmsValue := CalculateRms(PByte(FHeaders[i].lpData), FHeaders[i].dwBytesRecorded);
|
||||||
|
TInterlocked.Exchange(fCurrentRms, rmsValue);
|
||||||
|
ProcessSilence(rmsValue, PByte(FHeaders[i].lpData), FHeaders[i].dwBytesRecorded);
|
||||||
|
FHeaders[i].dwFlags := FHeaders[i].dwFlags and not WHDR_DONE;
|
||||||
|
waveInAddBuffer(FWaveIn, @FHeaders[i], sizeof(TWaveHdr));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TForm1 }
|
||||||
|
|
||||||
|
procedure TForm1.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
RmsBar.Min := 0;
|
||||||
|
RmsBar.Max := 100;
|
||||||
|
GlobalTranscriptionWorker := TTranscriptionWorker.Create;
|
||||||
|
|
||||||
|
// List settings for the Post on FormCreate in OptsMemo
|
||||||
|
OptsMemo.Lines.Clear;
|
||||||
|
OptsMemo.Lines.Add('language=de');
|
||||||
|
OptsMemo.Lines.Add('task=transcribe');
|
||||||
|
OptsMemo.Lines.Add('model=large-v3');
|
||||||
|
OptsMemo.Lines.Add('device=cuda');
|
||||||
|
OptsMemo.Lines.Add('device_index=0');
|
||||||
|
OptsMemo.Lines.Add('threads=0');
|
||||||
|
OptsMemo.Lines.Add('batch_size=8');
|
||||||
|
OptsMemo.Lines.Add('chunk_size=20');
|
||||||
|
OptsMemo.Lines.Add('compute_type=float16');
|
||||||
|
OptsMemo.Lines.Add('beam_size=5');
|
||||||
|
OptsMemo.Lines.Add('best_of=5');
|
||||||
|
OptsMemo.Lines.Add('patience=1');
|
||||||
|
OptsMemo.Lines.Add('length_penalty=1');
|
||||||
|
OptsMemo.Lines.Add('temperatures=0');
|
||||||
|
OptsMemo.Lines.Add('compression_ratio_threshold=2.4');
|
||||||
|
OptsMemo.Lines.Add('log_prob_threshold=-1');
|
||||||
|
OptsMemo.Lines.Add('no_speech_threshold=0.6');
|
||||||
|
OptsMemo.Lines.Add('initial_prompt=null');
|
||||||
|
OptsMemo.Lines.Add('suppress_tokens=-1');
|
||||||
|
OptsMemo.Lines.Add('suppress_numerals=false');
|
||||||
|
OptsMemo.Lines.Add('hotwords=Absatz');
|
||||||
|
OptsMemo.Lines.Add('vad_onset=0.5');
|
||||||
|
OptsMemo.Lines.Add('vad_offset=0.363');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.Log(const AMsg: string);
|
||||||
|
begin
|
||||||
|
if LoggingCheckBox.Checked then
|
||||||
|
ResultMemo.Lines.Add(FormatDateTime('hh:nn:ss', Now) + ': ' + AMsg);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.Button1Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if not Assigned(fCaptureThread) then
|
||||||
|
begin
|
||||||
|
fCaptureThread := TAudioCaptureThread.Create;
|
||||||
|
fCaptureThread.Start;
|
||||||
|
Button1.Caption := 'Stop Recording';
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
fCaptureThread.Terminate;
|
||||||
|
fCaptureThread.WaitFor;
|
||||||
|
FreeAndNil(fCaptureThread);
|
||||||
|
Button1.Caption := 'Start Recording';
|
||||||
|
RmsBar.Position := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
|
||||||
|
begin
|
||||||
|
if Assigned(fCaptureThread) then begin fCaptureThread.Terminate; fCaptureThread.WaitFor; end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.FormDestroy(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if Assigned(fCaptureThread) then fCaptureThread.Free;
|
||||||
|
if Assigned(GlobalTranscriptionWorker) then
|
||||||
|
begin
|
||||||
|
GlobalTranscriptionWorker.Terminate;
|
||||||
|
GlobalTranscriptionWorker.WaitFor;
|
||||||
|
GlobalTranscriptionWorker.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.RmsTimerTimer(Sender: TObject);
|
||||||
|
var
|
||||||
|
rawRms: Integer;
|
||||||
|
dbValue: Double;
|
||||||
|
begin
|
||||||
|
if Assigned(fCaptureThread) then
|
||||||
|
begin
|
||||||
|
rawRms := TInterlocked.CompareExchange(fCaptureThread.fCurrentRms, 0, 0);
|
||||||
|
if (rawRms > 0) then
|
||||||
|
begin
|
||||||
|
dbValue := 20 * Log10(rawRms / 32768);
|
||||||
|
RmsBar.Position := Max(0, Round((dbValue + 60) * (100 / 60)));
|
||||||
|
end
|
||||||
|
else RmsBar.Position := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.SilenceEditChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if Assigned(fCaptureThread) then
|
||||||
|
begin
|
||||||
|
// Conversion: SpinEdit Value (seconds) to packets (approx 100ms per packet)
|
||||||
|
fCaptureThread.fRequiredSilencePackets := Max(1, SilenceEdit.Value * 10);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.UpdateButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if Assigned(fCaptureThread) then
|
||||||
|
fCaptureThread.ForceUpload;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
finalization
|
||||||
|
end.
|
||||||
@@ -0,0 +1,25 @@
|
|||||||
|
[RmsTimer]
|
||||||
|
Coordinates=61,77,74,36
|
||||||
|
|
||||||
|
[Button1]
|
||||||
|
Coordinates=10,78,59,58
|
||||||
|
|
||||||
|
[ResultMemo]
|
||||||
|
Coordinates=276,10,86,58
|
||||||
|
|
||||||
|
[RmsBar]
|
||||||
|
Coordinates=79,78,61,58
|
||||||
|
|
||||||
|
[UpdateButton]
|
||||||
|
Coordinates=173,10,93,58
|
||||||
|
|
||||||
|
[SilenceEdit]
|
||||||
|
Coordinates=84,10,79,58
|
||||||
|
|
||||||
|
[]
|
||||||
|
Coordinates=289,78,91,36
|
||||||
|
|
||||||
|
[OptsMemo]
|
||||||
|
Coordinates=10,10,64,58
|
||||||
|
Visible=True
|
||||||
|
|
||||||
File diff suppressed because one or more lines are too long
@@ -0,0 +1,14 @@
|
|||||||
|
program WASAPITest;
|
||||||
|
|
||||||
|
uses
|
||||||
|
Vcl.Forms,
|
||||||
|
MainForm in 'MainForm.pas' {Form1};
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.MainFormOnTaskbar := True;
|
||||||
|
Application.CreateForm(TForm1, Form1);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Reference in New Issue
Block a user