WASAPI: added CaptureSST.pas

WASAPI/MainForm.pas

@@ -4,63 +4,11 @@ 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,
+    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.ExtCtrls,
-    System.SyncObjs, System.Math, System.Net.HttpClient, System.Net.HttpClientComponent,
+    System.SyncObjs, System.Math, Vcl.Samples.Spin,
-    System.Net.Mime, System.JSON, System.IOUtils, System.Generics.Collections, Vcl.Samples.Spin;
+    CaptureSTT;
 
 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;
@@ -69,7 +17,7 @@ type
         UpdateButton: TButton;
         SilenceEdit: TSpinEdit;
         OptsMemo: TMemo;
-    LoggingCheckBox: TCheckBox;
+        LoggingCheckBox: TCheckBox;
         procedure FormCreate(Sender: TObject);
         procedure Button1Click(Sender: TObject);
         procedure FormClose(Sender: TObject; var Action: TCloseAction);
@@ -79,423 +27,93 @@ type
         procedure UpdateButtonClick(Sender: TObject);
     private
         fCaptureThread: TAudioCaptureThread;
+        fWorker: TTranscriptionWorker;
         procedure Log(const AMsg: string);
+        procedure HandleTranscriptionResult(const AText: 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
+    // Initialize worker with result callback
+    fWorker := TTranscriptionWorker.Create(HandleTranscriptionResult);
+
+    // Default API options
     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.FormDestroy(Sender: TObject);
+begin
+    if Assigned(fCaptureThread) then
+    begin
+        fCaptureThread.Terminate;
+        fCaptureThread.WaitFor;
+        fCaptureThread.Free;
+    end;
+
+    if Assigned(fWorker) then
+    begin
+        fWorker.Terminate;
+        fWorker.WaitFor;
+        fWorker.Free;
+    end;
+end;
+
+procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+    if Assigned(fCaptureThread) then
+    begin
+        fCaptureThread.Terminate;
+        fCaptureThread.WaitFor;
+    end;
+end;
+
 procedure TForm1.Log(const AMsg: string);
 begin
     if LoggingCheckBox.Checked then
         ResultMemo.Lines.Add(FormatDateTime('hh:nn:ss', Now) + ': ' + AMsg);
 end;
 
+procedure TForm1.HandleTranscriptionResult(const AText: string);
+begin
+    ResultMemo.Lines.Add(AText);
+end;
+
 procedure TForm1.Button1Click(Sender: TObject);
 begin
     if not Assigned(fCaptureThread) then
     begin
-        fCaptureThread := TAudioCaptureThread.Create;
+        fCaptureThread := TAudioCaptureThread.Create(
+            fWorker,
+            'http://minerva.lan:8000/speech-to-text',
+            OptsMemo.Lines,
+            procedure(const Msg: string)
+            begin
+                TThread.Queue(nil, procedure begin Log(Msg); end);
+            end
+        );
+
+        // Apply initial silence settings
+        SilenceEditChange(nil);
+
         fCaptureThread.Start;
         Button1.Caption := 'Stop Recording';
     end
@@ -509,22 +127,6 @@ begin
     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;
@@ -532,23 +134,22 @@ var
 begin
     if Assigned(fCaptureThread) then
     begin
-        rawRms := TInterlocked.CompareExchange(fCaptureThread.fCurrentRms, 0, 0);
+        rawRms := fCaptureThread.CurrentRms;
         if (rawRms > 0) then
         begin
             dbValue := 20 * Log10(rawRms / 32768);
+            // Map -60dB..0dB to 0..100%
             RmsBar.Position := Max(0, Round((dbValue + 60) * (100 / 60)));
         end
-        else RmsBar.Position := 0;
+        else
+            RmsBar.Position := 0;
     end;
 end;
 
 procedure TForm1.SilenceEditChange(Sender: TObject);
 begin
     if Assigned(fCaptureThread) then
-    begin
+        fCaptureThread.RequiredSilencePackets := Max(1, SilenceEdit.Value * 10);
-        // Conversion: SpinEdit Value (seconds) to packets (approx 100ms per packet)
-        fCaptureThread.fRequiredSilencePackets := Max(1, SilenceEdit.Value * 10);
-    end;
 end;
 
 procedure TForm1.UpdateButtonClick(Sender: TObject);
@@ -557,6 +158,4 @@ begin
         fCaptureThread.ForceUpload;
 end;
 
-initialization
-finalization
 end.

WASAPI/WASAPITest.dpr

@@ -2,7 +2,8 @@ program WASAPITest;
 
 uses
   Vcl.Forms,
-  MainForm in 'MainForm.pas' {Form1};
+  MainForm in 'MainForm.pas' {Form1},
+  CaptureSTT in 'CaptureSTT.pas';
 
 {$R *.res}
 

WASAPI/WASAPITest.dproj

@@ -127,6 +127,7 @@
             <Form>Form1</Form>
             <FormType>dfm</FormType>
         </DCCReference>
+        <DCCReference Include="CaptureSTT.pas"/>
         <BuildConfiguration Include="Base">
             <Key>Base</Key>
         </BuildConfiguration>