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.