Whisper/WhisperMain.pas

unit WhisperMain;

interface

uses
    Winapi.Windows, Winapi.MMSystem, System.SysUtils, System.Types, System.UITypes,
    System.Classes, System.Variants, System.IOUtils, FMX.Types, FMX.Controls,
    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.URLClient, System.Net.HttpClientComponent,
    IdTCPClient, IdException, IdGlobal, IdComponent;

type
    TWaveHeader = packed record
        RIFF: array[0..3] of AnsiChar;
        FileSize: Cardinal;
        WAVE: array[0..3] of AnsiChar;
        fmt: array[0..3] of AnsiChar;
        FormatLength: Cardinal;
        FormatTag: Word;
        Channels: Word;
        SampleRate: Cardinal;
        BytesPerSecond: Cardinal;
        BlockAlign: Word;
        BitsPerSample: Word;
        Data: array[0..3] of AnsiChar;
        DataLength: Cardinal;
    end;

    TForm1 = class(TForm)
        RecordButton: TButton;
        StopButton: TButton;
        LogMemo: TMemo;
        OutputMemo: TMemo;
        DebugCheckBox: TCheckBox;
        procedure RecordButtonClick(Sender: TObject);
        procedure StopButtonClick(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
    private
        waveHandle: HWAVEIN;
        fileStream: TFileStream;
        waveHeader: TWaveHeader;
        isRecording: Boolean;
        tempAudioPath: string;

        waveCaps: array[0..1] of TWaveHdr;
        waveBuffers: array[0..1] of array[0..4095] of Byte;

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

        // Wyoming / Whisper
        procedure SendToWhisperAsync(const FilePath: string);
        function CreateEvent(const EventType: string; Data: TJSONObject = nil; PayloadLen: Int64 = -1): string;
        function GetAudioMetadata: TJSONObject;

        // LLM / OpenAI API
        procedure QueryLLM(const UserInput: string);

        // Audio Capture
        procedure StartCapture(const FileName: string);
        procedure StopCapture;
        procedure WriteWavHeader;
        procedure UpdateWavHeader;
    public
    end;

var
    Form1: TForm1;

implementation

{$R *.fmx}

procedure waveInProc(hwi: HWAVEIN; uMsg: UINT; dwInstance, dwParam1, dwParam2: DWORD_PTR); stdcall;
var
    header: PWaveHdr;
    form: TForm1;
begin
    if (uMsg = WIM_DATA) then
    begin
        header := PWaveHdr(dwParam1);
        form := TForm1(dwInstance);

        if (form.isRecording) and (header.dwBytesRecorded > 0) then
        begin
            form.fileStream.WriteBuffer(header.lpData^, header.dwBytesRecorded);
            waveInPrepareHeader(hwi, header, sizeof(TWaveHdr));
            waveInAddBuffer(hwi, header, sizeof(TWaveHdr));
        end;
    end;
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;

function TForm1.GetAudioMetadata: TJSONObject;
begin
    Result := TJSONObject.Create;
    Result.AddPair('rate', TJSONNumber.Create(16000));
    Result.AddPair('width', TJSONNumber.Create(2));
    Result.AddPair('channels', TJSONNumber.Create(1));
end;

procedure TForm1.WriteWavHeader;
begin
    FillChar(waveHeader, sizeof(TWaveHeader), 0);
    waveHeader.RIFF := 'RIFF';
    waveHeader.WAVE := 'WAVE';
    waveHeader.fmt := 'fmt ';
    waveHeader.FormatLength := 16;
    waveHeader.FormatTag := WAVE_FORMAT_PCM;
    waveHeader.Channels := 1;
    waveHeader.SampleRate := 16000;
    waveHeader.BitsPerSample := 16;
    waveHeader.BlockAlign := (waveHeader.Channels * waveHeader.BitsPerSample) div 8;
    waveHeader.BytesPerSecond := waveHeader.SampleRate * waveHeader.BlockAlign;
    waveHeader.Data := 'data';
    fileStream.WriteBuffer(waveHeader, sizeof(TWaveHeader));
end;

procedure TForm1.UpdateWavHeader;
var
    pos: Int64;
begin
    pos := fileStream.Position;
    LogDebug(Format('Updating WAV Header. Total File Size: %d', [pos]));
    waveHeader.FileSize := pos - 8;
    waveHeader.DataLength := pos - sizeof(TWaveHeader);
    fileStream.Position := 0;
    fileStream.WriteBuffer(waveHeader, sizeof(TWaveHeader));
end;

procedure TForm1.StartCapture(const FileName: string);
var
    wfx: TWaveFormatEx;
    i: Integer;
    mmRes: MMRESULT;
begin
    if (isRecording) then exit;

    LogDebug('Starting capture to: ' + FileName);
    fileStream := TFileStream.Create(FileName, fmCreate);
    WriteWavHeader;

    wfx.wFormatTag := WAVE_FORMAT_PCM;
    wfx.nChannels := waveHeader.Channels;
    wfx.nSamplesPerSec := waveHeader.SampleRate;
    wfx.nAvgBytesPerSec := waveHeader.BytesPerSecond;
    wfx.nBlockAlign := waveHeader.BlockAlign;
    wfx.wBitsPerSample := waveHeader.BitsPerSample;
    wfx.cbSize := 0;

    LogDebug('Opening WaveIn device...');
    mmRes := waveInOpen(@waveHandle, WAVE_MAPPER, @wfx, DWORD_PTR(@waveInProc), DWORD_PTR(self), CALLBACK_FUNCTION);

    if (mmRes = MMSYSERR_NOERROR) then
    begin
        isRecording := true;
        LogDebug('WaveIn device opened successfully. Preparing buffers...');
        for i := 0 to 1 do
        begin
            FillChar(waveCaps[i], sizeof(TWaveHdr), 0);
            waveCaps[i].lpData := @waveBuffers[i];
            waveCaps[i].dwBufferLength := sizeof(waveBuffers[i]);
            waveInPrepareHeader(waveHandle, @waveCaps[i], sizeof(TWaveHdr));
            waveInAddBuffer(waveHandle, @waveCaps[i], sizeof(TWaveHdr));
        end;
        waveInStart(waveHandle);
        LogDebug('WaveIn started.');
    end
    else
    begin
        Log('Error opening WaveIn device. Error code: ' + IntToStr(mmRes));
    end;
end;

procedure TForm1.StopCapture;
var
    i: Integer;
begin
    if (not isRecording) then exit;

    LogDebug('Stopping capture...');
    isRecording := false;
    waveInStop(waveHandle);
    waveInReset(waveHandle);

    for i := 0 to 1 do
        waveInUnprepareHeader(waveHandle, @waveCaps[i], sizeof(TWaveHdr));

    waveInClose(waveHandle);
    LogDebug('WaveIn closed.');

    UpdateWavHeader;
    if (Assigned(fileStream)) then
        FreeAndNil(fileStream);
end;

procedure TForm1.RecordButtonClick(Sender: TObject);
begin
    tempAudioPath := TPath.Combine(TPath.GetTempPath, 'whisper_capture.wav');
    StartCapture(tempAudioPath);
    RecordButton.Enabled := false;
    StopButton.Enabled := true;
    Log('Recording started...');
end;

procedure TForm1.StopButtonClick(Sender: TObject);
begin
    StopCapture;
    RecordButton.Enabled := true;
    StopButton.Enabled := false;
    if (TFile.Exists(tempAudioPath)) then
        SendToWhisperAsync(tempAudioPath);
end;

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

function TForm1.CreateEvent(const EventType: string; Data: TJSONObject; PayloadLen: Int64): string;
var
    evt: TJSONObject;
begin
    evt := TJSONObject.Create;
    try
        evt.AddPair('type', EventType);
        if (Assigned(Data)) then
            evt.AddPair('data', Data)
        else
            evt.AddPair('data', TJSONObject.Create);

        if (PayloadLen >= 0) then
            evt.AddPair('payload_length', TJSONNumber.Create(PayloadLen));

        Result := evt.ToJSON + #10;
    finally
        evt.Free;
    end;
end;

procedure TForm1.QueryLLM(const UserInput: string);
var
    client: TNetHTTPClient;
    reqJson, msgSystem, msgUser: TJSONObject;
    msgs: TJSONArray;
    resp: IHTTPResponse;
    respJson: TJSONObject;
    choices: TJSONArray;
    firstChoice, messageObj: TJSONObject;
    content: string;

    exePath, promptPath, systemPromptText: string;
begin
    LogDebug('Querying LLM (RAKI)...');

    // Resolve system prompt path
    exePath := ExtractFilePath(ParamStr(0));
    promptPath := TPath.GetFullPath(TPath.Combine(exePath, '..\..\Prompt.md'));

    if TFile.Exists(promptPath) then
    begin
        LogDebug('Loading system prompt from: ' + promptPath);
        systemPromptText := TFile.ReadAllText(promptPath, TEncoding.UTF8);
    end
    else
    begin
        LogDebug('Prompt file not found at: ' + promptPath + '. Using default.');
        systemPromptText := 'You are a helpful assistant.';
    end;

    client := TNetHTTPClient.Create(nil);
    reqJson := TJSONObject.Create;
    try
        try
            // Prepare Request JSON
            reqJson.AddPair('model', 'openai/gpt-oss-20b');
            reqJson.AddPair('temperature', TJSONNumber.Create(0.7));
            reqJson.AddPair('stream', TJSONBool.Create(False));

            msgs := TJSONArray.Create;

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

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

            reqJson.AddPair('messages', msgs);

            client.ContentType := 'application/json';
            client.Accept := 'application/json';

            // Execute Request
            resp := client.Post('http://raki:1234/v1/chat/completions', TStringStream.Create(reqJson.ToJSON, TEncoding.UTF8));

            LogDebug('LLM Status: ' + IntToStr(resp.StatusCode));

            if resp.StatusCode = 200 then
            begin
                respJson := TJSONObject.ParseJSONValue(resp.ContentAsString(TEncoding.UTF8)) as TJSONObject;
                if Assigned(respJson) then
                try
                    // Parse: choices[0].message.content
                    choices := respJson.GetValue('choices') as TJSONArray;
                    if (Assigned(choices)) and (choices.Count > 0) then
                    begin
                        firstChoice := choices.Items[0] as TJSONObject;
                        messageObj := firstChoice.GetValue('message') as TJSONObject;
                        if Assigned(messageObj) then
                        begin
                            content := messageObj.GetValue('content').Value;

                            TThread.Queue(nil,
                                procedure
                                begin
                                    OutputMemo.Lines.Add('');
                                    OutputMemo.Lines.Add('RAKI: ' + content);
                                end);
                        end;
                    end;
                finally
                    respJson.Free;
                end;
            end
            else
            begin
                Log('LLM Error (' + IntToStr(resp.StatusCode) + '): ' + resp.StatusText);
            end;

        except
            on E: Exception do
                Log('LLM Exception: ' + E.Message);
        end;
    finally
        reqJson.Free;
        client.Free;
    end;
end;

procedure TForm1.SendToWhisperAsync(const FilePath: string);
begin
    TThread.CreateAnonymousThread(
        procedure
        var
            client: TIdTCPClient;
            stream: TFileStream;
            jsonResp, jsonData: TJSONObject;
            response, msgType, textValue: string;
            dataSize: Int64;
            isFinished: Boolean;
            payloadLen: Integer;
            debugMsg: string;
        begin
            client := TIdTCPClient.Create(nil);
            isFinished := false;
            try
                try
                    client.Host := '192.168.178.10';
                    client.Port := 10300;
                    client.ReadTimeout := 30000;

                    LogDebug('Connecting to ' + client.Host + ':' + IntToStr(client.Port));

                    if not TFile.Exists(FilePath) then
                    begin
                        LogDebug('File not found: ' + FilePath);
                        exit;
                    end;

                    client.Connect;
                    client.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;

                    stream := TFileStream.Create(FilePath, fmOpenRead or fmShareDenyNone);
                    try
                        dataSize := stream.Size - sizeof(TWaveHeader);
                        LogDebug(Format('Sending audio. PCM Data Size: %d', [dataSize]));

                        // 1. Wyoming protocol sequence
                        debugMsg := CreateEvent('audio-start', self.GetAudioMetadata);
                        LogDebug('Sending: ' + debugMsg.Trim);
                        client.IOHandler.Write(debugMsg);

                        debugMsg := CreateEvent('audio-chunk', self.GetAudioMetadata, dataSize);
                        LogDebug('Sending: ' + debugMsg.Trim);
                        client.IOHandler.Write(debugMsg);

                        stream.Position := sizeof(TWaveHeader);
                        client.IOHandler.Write(stream, dataSize);

                        LogDebug('Audio data sent.');

                        client.IOHandler.Write(CreateEvent('audio-stop'));

                        // 2. Response event loop
                        while (client.Connected) and (not isFinished) do
                        begin
                            response := client.IOHandler.ReadLn();
                            if (response = '') then
                            begin
                                client.IOHandler.CheckForDisconnect(true, true);
                                if not client.Connected then break;
                                TThread.Sleep(10);
                                continue;
                            end;

                            LogDebug('Received: ' + response);

                            jsonResp := TJSONObject.ParseJSONValue(response) as TJSONObject;
                            if Assigned(jsonResp) then
                            try
                                if jsonResp.TryGetValue('type', msgType) then
                                begin
                                    if (msgType = 'transcript') then
                                    begin
                                        textValue := '';
                                        if (jsonResp.TryGetValue('data_length', payloadLen)) and (payloadLen > 0) then
                                        begin
                                            textValue := client.IOHandler.ReadString(payloadLen);
                                            // Handle case where payload is a JSON object itself (e.g. {"text": "..."})
                                            if textValue.Trim.StartsWith('{') then
                                            begin
                                                var nestedJson := TJSONObject.ParseJSONValue(textValue) as TJSONObject;
                                                if Assigned(nestedJson) then
                                                try
                                                    nestedJson.TryGetValue('text', textValue);
                                                finally
                                                    nestedJson.Free;
                                                end;
                                            end;
                                        end
                                        else if jsonResp.TryGetValue('data', jsonData) then
                                            jsonData.TryGetValue('text', textValue);

                                        if (textValue <> '') then
                                        begin
                                            var finalTxt := textValue.Trim;

                                            LogDebug('Transcript payload: ' + finalTxt);

                                            TThread.Queue(nil,
                                                procedure
                                                begin
                                                    OutputMemo.Lines.Add('Me: ' + finalTxt);
                                                end);

                                            // Trigger LLM request (still in background thread context)
                                            QueryLLM(finalTxt);
                                        end;
                                        isFinished := true;
                                    end
                                    else if (msgType = 'error') then
                                    begin
                                        Log('[Thread] Server Error: ' + response);
                                        isFinished := true;
                                    end;
                                end;
                            finally
                                jsonResp.Free;
                            end;
                        end;
                    finally
                        stream.Free;
                    end;
                except
                    on E: Exception do
                    begin
                        var errMsg := E.Message;
                        Log('[Thread] Exception: ' + errMsg);
                    end;
                end;
            finally
                if client.Connected then
                    client.Disconnect;
                client.Free;
            end;
        end).Start;
end;

end.