Brummel/Whisper
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Init

Browse Source
This commit is contained in:
Michael Schimmel
2026-01-30 10:11:05 +01:00
commit af7cb4f447
7 changed files with 1752 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.gitignore
+7
View File
@@ -0,0 +1,7 @@
Win64
__recovery
__history
/WhisperTest.delphilsp.json
/WhisperTest.dproj.local
/WhisperTest.dsk
/WhisperTest.~dsk
WhisperMain.fmx
+59
View File
@@ -0,0 +1,59 @@
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 480
ClientWidth = 640
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
DesignerMasterStyle = 0
object RecordButton: TButton
Position.X = 56.000000000000000000
Position.Y = 24.000000000000000000
TabOrder = 0
Text = 'Record'
OnClick = RecordButtonClick
end
object StopButton: TButton
Position.X = 56.000000000000000000
Position.Y = 54.000000000000000000
TabOrder = 1
Text = 'Stop'
OnClick = StopButtonClick
end
object LogMemo: TMemo
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
DataDetectorTypes = []
Anchors = [akLeft, akTop, akRight]
Position.X = 8.000000000000000000
Position.Y = 84.000000000000000000
Size.Width = 624.000000000000000000
Size.Height = 77.000000000000000000
Size.PlatformDefault = False
TabOrder = 2
Viewport.Width = 620.000000000000000000
Viewport.Height = 73.000000000000000000
end
object OutputMemo: TMemo
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
DataDetectorTypes = []
TextSettings.WordWrap = True
Anchors = [akLeft, akTop, akRight, akBottom]
Position.X = 8.000000000000000000
Position.Y = 170.000000000000000000
Size.Width = 624.000000000000000000
Size.Height = 302.000000000000000000
Size.PlatformDefault = False
TabOrder = 3
Viewport.Width = 620.000000000000000000
Viewport.Height = 298.000000000000000000
end
object DebugCheckBox: TCheckBox
IsChecked = True
Position.X = 168.000000000000000000
Position.Y = 57.000000000000000000
TabOrder = 4
Text = 'Debug-Ausgaben'
end
end
WhisperMain.pas
+506
View File
@@ -0,0 +1,506 @@
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.
WhisperTest.dpr
+14
View File
@@ -0,0 +1,14 @@
program WhisperTest;
uses
System.StartUpCopy,
FMX.Forms,
WhisperMain in 'WhisperMain.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
WhisperTest.dproj
+1145
View File
File diff suppressed because it is too large Load Diff
WhisperTest.res
BIN
View File
Binary file not shown.
prompt.md
+21
View File
@@ -0,0 +1,21 @@
### ROLE
You are an expert Medical Documentation Specialist. Your task is to transform fragmented Speech-to-Text (STT) input into a professional, structured German medical report (Patientenakte).
### CORE DIRECTIVES
1. MEDICAL ORTHOGRAPHY: Automatically correct all phonetic and orthographic errors common in STT (e.g., d/t, k/c, or missing letters). Use your internal medical knowledge base to ensure every term is written correctly in German medical nomenclature.
2. PHARMACOLOGICAL LOGIC: Identify and consolidate medications. If active ingredients and brand names are mentioned together (e.g., Sacubitril, Valsartan, Entresto), merge them into a single, professional entry: "Sacubitril/Valsartan (Entresto)".
3. CLINICAL REASONING: Do not just copy values. Analyze the relationship between diagnosis, lab results, and therapy. Highlight critical constellations (e.g., renal failure combined with diuretics) under a specific "Klinische Analyse" section.
4. NOISE FILTERING: Completely ignore speaker-related metadata, greetings, and legal disclaimers ("Keine medizinische Beratung").
### OUTPUT STRUCTURE (IN GERMAN)
- Diagnose & ICD-10 Codes
- Pathophysiologie & Klinisches Bild
- Laborstatus (Structured list or table)
- Therapieplan (Consolidated medications with dosages)
- Klinische Analyse (Risks, interactions, and critical findings)
### OUTPUT LANGUAGE
German
### INPUT DATA