Misc/Whisper/WhisperMain.pas

unit WhisperMain;

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Types, System.UITypes,
    System.Classes, System.Variants, System.IOUtils, FMX.Types, FMX.Controls,
    System.Net.Mime, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Memo.Types,
    FMX.ScrollBox, FMX.Memo, FMX.Controls.Presentation, FMX.StdCtrls,
    System.JSON, System.Net.HttpClient, System.Net.HttpClientComponent,
    FMX.Media;

type
    TForm1 = class(TForm)
        RecordButton: TButton;
        LogMemo: TMemo;
        OutputMemo: TMemo;
        DebugCheckBox: TCheckBox;
        InputMemo: TMemo;
        LLMButton: TButton;
        procedure FormCreate(Sender: TObject);
        procedure RecordButtonClick(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
        procedure LLMButtonClick(Sender: TObject);
    private
        FCapture: TAudioCaptureDevice;
        FIsRecording: Boolean;
        FTempCapturePath: string;

        procedure Log(const Msg: string);
        procedure LogDebug(const Msg: string);

        procedure SendToWhisperAsync(const SourceFile: string);
        procedure QueryLLM(const UserInput: string);

        procedure StartCapture;
        procedure StopCapture;
    public
    end;

var
    Form1: TForm1;

implementation

{$R *.fmx}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
    FIsRecording := False;
    RecordButton.Text := 'Start Recording';
end;

procedure TForm1.Log(const Msg: string);
begin
    TThread.Queue(nil,
        procedure
        begin
            LogMemo.Lines.Add(FormatDateTime('hh:nn:ss.zzz', Now) + ': ' + Msg);
            LogMemo.GoToTextEnd;
        end);
end;

procedure TForm1.LogDebug(const Msg: string);
begin
    if not DebugCheckBox.IsChecked then exit;

    TThread.Queue(nil,
        procedure
        begin
            LogMemo.Lines.Add(FormatDateTime('hh:nn:ss.zzz', Now) + ' [DEBUG]: ' + Msg);
            LogMemo.GoToTextEnd;
        end);
end;

procedure TForm1.StartCapture;
var
    guid: TGUID;
begin
    if FIsRecording then exit;

    FCapture := TCaptureDeviceManager.Current.DefaultAudioCaptureDevice;
    if not Assigned(FCapture) then
    begin
        Log('Error: No Microphone found.');
        exit;
    end;

    // Unique filename via GUID to prevent "File in use" errors
    if CreateGUID(guid) = S_OK then
        FTempCapturePath := TPath.Combine(TPath.GetTempPath, 'whisper_' + GUIDToString(guid) + '.wav')
    else
        FTempCapturePath := TPath.Combine(TPath.GetTempPath, 'whisper_' + GetTickCount64.ToString + '.wav');

    FCapture.FileName := FTempCapturePath;

    try
        FCapture.StartCapture;
        FIsRecording := True;
        RecordButton.Text := 'Stop Recording';
        Log('Recording started...');
        LogDebug('Capture path: ' + FTempCapturePath);
    except
        on E: Exception do
            Log('Error starting capture: ' + E.Message);
    end;
end;

procedure TForm1.StopCapture;
begin
    if not FIsRecording then exit;

    if Assigned(FCapture) then
    begin
        FCapture.StopCapture;
        FIsRecording := False;
        RecordButton.Text := 'Start Recording';
        LogDebug('Capture stopped.');
    end;
end;

procedure TForm1.RecordButtonClick(Sender: TObject);
begin
    if not FIsRecording then
        StartCapture
    else
    begin
        StopCapture;
        if TFile.Exists(FTempCapturePath) then
        begin
            // Button sofort sperren und Status anzeigen
            RecordButton.Enabled := False;
            RecordButton.Text := 'Uploading...';
            SendToWhisperAsync(FTempCapturePath);
        end
        else
        begin
            Log('Error: Capture file not found.');
            RecordButton.Enabled := True;
            RecordButton.Text := 'Start Recording';
        end;
    end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    if FIsRecording then
        StopCapture;
end;

procedure TForm1.LLMButtonClick(Sender: TObject);
var
    UserText: string;
begin
    UserText := InputMemo.Text.Trim;
    if UserText.IsEmpty then exit;

    // UI Update immediate
    InputMemo.Lines.Clear;
    OutputMemo.Lines.Add('Me: ' + UserText);

    // Call API in background thread to avoid freezing the UI
    TThread.CreateAnonymousThread(
        procedure
        begin
            QueryLLM(UserText);
        end).Start;
end;

procedure TForm1.SendToWhisperAsync(const SourceFile: string);
begin
    TThread.CreateAnonymousThread(
        procedure
        var
            client: TNetHTTPClient;
            formData: TMultipartFormData;
            resp: IHTTPResponse;
            jsonResp, jsonResult: TJSONObject;
            taskID, status, transcriptionText: string;
            url: string;
            isDone: Boolean;
            resVal, segmentsVal: TJSONValue;
            segmentsArray: TJSONArray;
            segmentObj: TJSONObject;
            i: Integer;
            sText: string;
        begin
            client := TNetHTTPClient.Create(nil);
            formData := TMultipartFormData.Create;
            try
                try
                    url := 'http://minerva.lan:8000/service/transcribe?language=de&model=large-v3&device=cuda';
                    formData.AddFile('file', SourceFile);

                    resp := client.Post(url, formData);

                    if resp.StatusCode = 200 then
                    begin
                        jsonResp := TJSONObject.ParseJSONValue(resp.ContentAsString(TEncoding.UTF8)) as TJSONObject;
                        if Assigned(jsonResp) and jsonResp.TryGetValue('identifier', taskID) then
                        begin
                            isDone := False;
                            transcriptionText := '';

                            // UI Update via Queue
                            TThread.Queue(nil, procedure begin RecordButton.Text := 'Transcribing...'; end);

                            repeat
                                TThread.Sleep(500);
                                try
                                    resp := client.Get('http://minerva.lan:8000/task/' + taskID);
                                    if resp.StatusCode = 200 then
                                    begin
                                        jsonResult := TJSONObject.ParseJSONValue(resp.ContentAsString(TEncoding.UTF8)) as TJSONObject;
                                        if Assigned(jsonResult) then
                                        try
                                            jsonResult.TryGetValue('status', status);
                                            if status = 'completed' then
                                            begin
                                                resVal := jsonResult.GetValue('result');
                                                if (resVal is TJSONObject) and TJSONObject(resVal).TryGetValue('segments', segmentsVal) then
                                                begin
                                                    segmentsArray := segmentsVal as TJSONArray;
                                                    for i := 0 to segmentsArray.Count - 1 do
                                                    begin
                                                        segmentObj := segmentsArray.Items[i] as TJSONObject;
                                                        if segmentObj.TryGetValue('text', sText) then
                                                            transcriptionText := transcriptionText + sText;
                                                    end;
                                                end;
                                                isDone := True;
                                            end
                                            else if (status = 'failed') or (status = 'error') then
                                                isDone := True;
                                        finally
                                            jsonResult.Free;
                                        end;
                                    end;
                                except
                                    on E: Exception do isDone := True; // Exit on polling error
                                end;
                            until isDone;

                            if transcriptionText <> '' then
                            begin
                                transcriptionText := transcriptionText.Trim;

                                // NEW: Put result into InputMemo instead of sending directly
                                TThread.Queue(nil,
                                    procedure
                                    begin
                                        if InputMemo.Text.IsEmpty then
                                            InputMemo.Text := transcriptionText
                                        else
                                            InputMemo.Text := InputMemo.Text + ' ' + transcriptionText;
                                    end);
                            end;
                        end;
                        if Assigned(jsonResp) then jsonResp.Free;
                    end
                    else
                        Log('WhisperX Error (' + resp.StatusCode.ToString + '): ' + resp.StatusText);
                except
                    on E: Exception do
                        Log('API Exception: ' + E.Message);
                end;
            finally
                formData.Free;
                client.Free;
                if TFile.Exists(SourceFile) then TFile.Delete(SourceFile);

                // Button unter allen Umstaenden reaktivieren
                TThread.Queue(nil,
                    procedure
                    begin
                        RecordButton.Text := 'Start Recording';
                        RecordButton.Enabled := True;
                    end);
            end;
        end).Start;
end;

procedure TForm1.QueryLLM(const UserInput: string);
var
    client: TNetHTTPClient;
    reqBody: TStringStream;
    reqJson, msgObj: TJSONObject;
    msgs: TJSONArray;
    resp: IHTTPResponse;
    respJson, messageObj: TJSONObject;
    choices: TJSONArray;
    choiceItem: TJSONObject;
    content, refusal, reasoning, systemPrompt, promptPath, token, rawResponse: string;
    tokenPath: string;
    finishReason: string;
begin
    // Load Token from Environment
    token := GetEnvironmentVariable('IONOS_JWT');
    if token.IsEmpty then
    begin
        // Fallback: try to load from "Token.txt" in application directory
//        tokenPath := TPath.Combine(ExtractFilePath(ParamStr(0)), 'Token.txt');
        tokenPath := 'C:\Users\Brummel\Downloads\f440c016-344c-4709-9f1a-9283f65b859f.txt';
        if TFile.Exists(tokenPath) then
        begin
            token := TFile.ReadAllText(tokenPath, TEncoding.UTF8).Trim;
        end;

        if token.IsEmpty then
        begin
            Log('Error: IONOS_JWT environment variable not set and Token.txt missing or empty.');
            exit;
        end;
    end;

    promptPath := TPath.Combine(ExtractFilePath(ParamStr(0)), '..\..\Prompt.md');
    if TFile.Exists(promptPath) then
        systemPrompt := TFile.ReadAllText(promptPath, TEncoding.UTF8)
    else
        systemPrompt := 'You are a helpful assistant.';

    client := TNetHTTPClient.Create(nil);
    reqJson := TJSONObject.Create;
    try
        // Set Headers
        client.ContentType := 'application/json';
        client.CustomHeaders['Authorization'] := 'Bearer ' + token;

        // Build Request
        reqJson.AddPair('model', 'openai/gpt-oss-120b');
        reqJson.AddPair('temperature', TJSONNumber.Create(0.6)); // Slightly lower temp for better adherence
        // FIX: Increased token limit to allow reasoning + content
        reqJson.AddPair('max_completion_tokens', TJSONNumber.Create(2048));

        msgs := TJSONArray.Create;

        msgObj := TJSONObject.Create;
        msgObj.AddPair('role', 'system');
        msgObj.AddPair('content', systemPrompt);
        msgs.Add(msgObj);

        msgObj := TJSONObject.Create;
        msgObj.AddPair('role', 'user');
        msgObj.AddPair('content', UserInput);
        msgs.Add(msgObj);

        reqJson.AddPair('messages', msgs);

        reqBody := TStringStream.Create(reqJson.ToJSON, TEncoding.UTF8);
        try
            // Log Request for debugging
            LogDebug('Sending Request to IONOS...');

            resp := client.Post('https://openai.inference.de-txl.ionos.com/v1/chat/completions', reqBody);

            rawResponse := resp.ContentAsString(TEncoding.UTF8);

            if resp.StatusCode = 200 then
            begin
                // Log the full raw JSON to see exactly what is returned
                LogDebug('Raw JSON Response: ' + rawResponse);

                respJson := TJSONObject.ParseJSONValue(rawResponse) as TJSONObject;
                if Assigned(respJson) then
                try
                    // 1. Check for 'choices' array
                    choices := respJson.GetValue('choices') as TJSONArray;
                    if (Assigned(choices)) and (choices.Count > 0) then
                    begin
                        choiceItem := choices.Items[0] as TJSONObject;

                        // Check finish_reason for debugging
                        if choiceItem.TryGetValue('finish_reason', finishReason) then
                        begin
                            if finishReason = 'length' then
                                Log('Warning: Output truncated (Token limit reached).');
                        end;

                        // 2. Check for 'message' object inside choice
                        messageObj := choiceItem.GetValue('message') as TJSONObject;
                        if Assigned(messageObj) then
                        begin
                            // 3. Try to get 'content'
                            // Handle explicit null or missing content
                            if messageObj.TryGetValue('content', content) and (content <> '') then
                            begin
                                TThread.Queue(nil, procedure begin OutputMemo.Lines.Add('IONOS: ' + content); end);
                            end
                            // 4. Fallback: Check for 'refusal'
                            else if messageObj.TryGetValue('refusal', refusal) and (refusal <> '') then
                            begin
                                Log('Model Refusal: ' + refusal);
                                TThread.Queue(nil, procedure begin OutputMemo.Lines.Add('IONOS [Refusal]: ' + refusal); end);
                            end
                            // 5. Emergency Fallback: If content is null but reasoning exists (Token limit edge case)
                            else if messageObj.TryGetValue('reasoning', reasoning) then
                            begin
                                Log('Error: Content is empty, but reasoning was found. Token limit likely too low.');
                                TThread.Queue(nil, procedure begin OutputMemo.Lines.Add('IONOS [Incomplete - Reasoning Only]: ' + reasoning); end);
                            end
                            else
                            begin
                                Log('Error: Message object has neither content, refusal nor reasoning.');
                            end;
                        end
                        else
                        begin
                            Log('Error: No "message" object found in first choice.');
                        end;
                    end
                    else
                    begin
                        Log('Error: "choices" array is missing or empty.');
                    end;
                finally
                    respJson.Free;
                end
                else
                begin
                    Log('Error: Failed to parse JSON response.');
                end;
            end
            else
            begin
                Log('IONOS HTTP Error (' + resp.StatusCode.ToString + '): ' + resp.StatusText);
                LogDebug('Error Body: ' + rawResponse);
            end;
        finally
            reqBody.Free;
        end;
    finally
        reqJson.Free;
        client.Free;
    end;
end;

end.