Michael Schimmel
401 lines
12 KiB
ObjectPascal
401 lines
12 KiB
ObjectPascal
unit MainUnit;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Types,
|
|
System.UITypes,
|
|
System.Classes,
|
|
System.Variants,
|
|
System.Generics.Collections,
|
|
System.SyncObjs,
|
|
FMX.Types,
|
|
FMX.Controls,
|
|
FMX.Forms,
|
|
FMX.Graphics,
|
|
FMX.Dialogs,
|
|
FMX.Memo.Types,
|
|
FMX.ScrollBox,
|
|
FMX.Memo,
|
|
FMX.Controls.Presentation,
|
|
FMX.StdCtrls,
|
|
FMX.Edit,
|
|
FMX.ListBox,
|
|
FMX.TabControl,
|
|
FMX.WebBrowser,
|
|
Myc.Signals,
|
|
Myc.Futures,
|
|
Myc.Api.Gemini,
|
|
Myc.Api.MarkdownStream,
|
|
FMX.ApplicationEvents;
|
|
|
|
type
|
|
TForm1 = class(TForm)
|
|
AskButton: TButton;
|
|
Edit1: TEdit;
|
|
ModelsComboBox: TComboBox;
|
|
QuotaLabel: TLabel;
|
|
AskMemo: TMemo;
|
|
ResetChatButton: TButton;
|
|
TabControl1: TTabControl;
|
|
CacheTabItem: TTabItem;
|
|
SysInstrTabItem: TTabItem;
|
|
CacheMemo: TMemo;
|
|
SystemInstructionMemo: TMemo;
|
|
UploadCacheButton: TButton;
|
|
ThinkingCheckBox: TCheckBox;
|
|
GlobalQuoteLabel: TLabel;
|
|
ChatTabItem: TTabItem;
|
|
ChatBrowser: TWebBrowser;
|
|
ApplicationEvents: TApplicationEvents;
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure AskButtonClick(Sender: TObject);
|
|
procedure Edit1Exit(Sender: TObject);
|
|
procedure ResetChatButtonClick(Sender: TObject);
|
|
procedure UploadCacheButtonClick(Sender: TObject);
|
|
private
|
|
FChat: IGeminiChat;
|
|
FCachedClient: IGeminiClient;
|
|
FMarkdown: IMarkdownStream;
|
|
FAsking: TFuture<TGeminiResult>;
|
|
FResponseLock: TCriticalSection;
|
|
FResponseQueue: TQueue<TProc>;
|
|
FModelList: TFuture<TArray<string>>;
|
|
FUploadCache: TFuture<TProc>;
|
|
FNeedModelListUpdate: TFlag;
|
|
FResposeQueueChanged: TFlag;
|
|
FNewResposeReceived: TFlag;
|
|
FCacheUploaded: TFlag;
|
|
procedure InitChat;
|
|
procedure UpdateQuotaDisplay;
|
|
public
|
|
procedure GetAvailableModels;
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Myc.System.Quota;
|
|
|
|
{$R *.fmx}
|
|
|
|
const
|
|
FallbackModel = 'gemini-2.5-flash-lite';
|
|
|
|
procedure TForm1.FormDestroy(Sender: TObject);
|
|
begin
|
|
FResponseQueue.Free;
|
|
FResponseLock.Free;
|
|
end;
|
|
|
|
procedure TForm1.FormCreate(Sender: TObject);
|
|
begin
|
|
FResponseQueue := TQueue<TProc>.Create;
|
|
FResponseLock := TCriticalSection.Create;
|
|
|
|
// 1. Markdown Stream initialisieren und mit Browser verbinden
|
|
FMarkdown := TMarkdownStream.Create;
|
|
FMarkdown.InitializeBrowser(ChatBrowser);
|
|
|
|
// Load default instructions if file exists
|
|
if FileExists('T:\Myc\KI\gemini.md') then
|
|
SystemInstructionMemo.Lines.LoadFromFile('T:\Myc\KI\gemini.md', TEncoding.UTF8);
|
|
|
|
UpdateQuotaDisplay;
|
|
GetAvailableModels;
|
|
InitChat;
|
|
end;
|
|
|
|
procedure TForm1.InitChat;
|
|
begin
|
|
// Browser komplett leeren
|
|
if Assigned(FMarkdown) then
|
|
FMarkdown.Clear;
|
|
|
|
FMarkdown.BeginBlock(btMarkdown);
|
|
if Assigned(FCachedClient) then
|
|
begin
|
|
FChat := FCachedClient.StartChat;
|
|
FMarkdown.Append('*--- New Chat Session ---* (Cached Content Active)');
|
|
end
|
|
else
|
|
begin
|
|
FMarkdown.Append('*--- New Chat Session ---*');
|
|
FChat := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.ResetChatButtonClick(Sender: TObject);
|
|
begin
|
|
InitChat;
|
|
end;
|
|
|
|
procedure TForm1.UpdateQuotaDisplay;
|
|
begin
|
|
GlobalQuoteLabel.Text := 'Total: ' + TGlobalQuota.GetTotal.ToString + ', Today: ' + TGlobalQuota.GetDailyTotal.ToString;
|
|
end;
|
|
|
|
procedure TForm1.AskButtonClick(Sender: TObject);
|
|
var
|
|
apiKey: string;
|
|
modelName: string;
|
|
prompt: string;
|
|
begin
|
|
apiKey := Edit1.Text;
|
|
prompt := AskMemo.Text;
|
|
|
|
if ModelsComboBox.ItemIndex > -1 then
|
|
modelName := ModelsComboBox.Items[ModelsComboBox.ItemIndex]
|
|
else
|
|
modelName := FallbackModel;
|
|
|
|
// --- LAZY INIT ---
|
|
if FChat = nil then
|
|
begin
|
|
var client: IGeminiClient := TGeminiClient.Create(apiKey, modelName);
|
|
|
|
if not SystemInstructionMemo.Text.Trim.IsEmpty then
|
|
client.SystemInstruction := SystemInstructionMemo.Text;
|
|
|
|
client.EnableThinking := ThinkingCheckBox.IsChecked;
|
|
FChat := client.StartChat;
|
|
end;
|
|
|
|
AskButton.Enabled := False;
|
|
AskMemo.Text := '';
|
|
|
|
// --- USER BLOCK ---
|
|
FMarkdown.BeginBlock(btRawText, 'Prompt');
|
|
// Hier nutzen wir RawText für den Prompt selbst, um Markdown-Injection des Users zu verhindern,
|
|
// oder wir bleiben im Markdown Block für schöneres Rendering (Code-Blöcke des Users).
|
|
// Da User Markdown oft erwarten:
|
|
FMarkdown.Append(prompt);
|
|
|
|
FAsking :=
|
|
TFuture<TGeminiResult>.Construct(
|
|
FAsking.Done,
|
|
function: TGeminiResult
|
|
var
|
|
CurrentChat: IGeminiChat;
|
|
// State Tracking für den Stream
|
|
LastWasThought: Boolean;
|
|
FirstChunk: Boolean;
|
|
begin
|
|
CurrentChat := FChat;
|
|
if CurrentChat = nil then
|
|
exit;
|
|
|
|
LastWasThought := False;
|
|
FirstChunk := True;
|
|
|
|
// --- STREAMING ---
|
|
Result :=
|
|
CurrentChat.SendMessageStream(
|
|
prompt,
|
|
procedure(const TextChunk: string; IsThought: Boolean)
|
|
begin
|
|
FResponseLock.Enter;
|
|
try
|
|
FResponseQueue.Enqueue(
|
|
procedure
|
|
begin
|
|
// Statuswechsel oder allererster Chunk -> Neuer Block
|
|
if FirstChunk or (IsThought <> LastWasThought) then
|
|
begin
|
|
if IsThought then
|
|
begin
|
|
FMarkdown.BeginBlock(btMarkdown, 'Thinking...');
|
|
// Optional: Kursiver Block für Gedanken
|
|
// Wir hängen Gedanken oft als Zitat oder kursiv an
|
|
end
|
|
else
|
|
begin
|
|
// Wenn wir aus einem Gedanken kommen oder starten
|
|
FMarkdown.BeginBlock(btMarkdown, 'Gemini');
|
|
end;
|
|
|
|
LastWasThought := IsThought;
|
|
FirstChunk := False;
|
|
end;
|
|
|
|
FMarkdown.Append(TextChunk);
|
|
end
|
|
);
|
|
finally
|
|
FResponseLock.Leave;
|
|
end;
|
|
|
|
FResposeQueueChanged.Notify;
|
|
end
|
|
);
|
|
end
|
|
);
|
|
|
|
FNewResposeReceived := TFlag.CreateObserver(FAsking.Done.Signal);
|
|
|
|
end;
|
|
|
|
procedure TForm1.Edit1Exit(Sender: TObject);
|
|
begin
|
|
if ModelsComboBox.ItemIndex < 0 then
|
|
GetAvailableModels;
|
|
end;
|
|
|
|
procedure TForm1.GetAvailableModels;
|
|
var
|
|
apiKey: string;
|
|
begin
|
|
apiKey := Edit1.Text.Trim;
|
|
if apiKey.IsEmpty then
|
|
exit;
|
|
|
|
FModelList :=
|
|
TFuture<TArray<string>>.Construct(
|
|
FModelList.Done,
|
|
function: TArray<string>
|
|
var
|
|
client: IGeminiClient;
|
|
begin
|
|
client := TGeminiClient.Create(apiKey);
|
|
Result := client.ListModels;
|
|
end
|
|
);
|
|
|
|
FNeedModelListUpdate := TFlag.CreateObserver(FModelList.Done.Signal);
|
|
end;
|
|
|
|
procedure TForm1.UploadCacheButtonClick(Sender: TObject);
|
|
var
|
|
apiKey: string;
|
|
content: string;
|
|
sysInstr: string;
|
|
modelName: string;
|
|
begin
|
|
apiKey := Edit1.Text;
|
|
content := CacheMemo.Text;
|
|
sysInstr := SystemInstructionMemo.Text;
|
|
|
|
if content.Trim.IsEmpty then
|
|
begin
|
|
FMarkdown.Append(sLineBreak + '**Error:** Cache content is empty.' + sLineBreak);
|
|
exit;
|
|
end;
|
|
|
|
if ModelsComboBox.ItemIndex > -1 then
|
|
modelName := ModelsComboBox.Items[ModelsComboBox.ItemIndex].Split([' '])[0]
|
|
else
|
|
modelName := FallbackModel;
|
|
|
|
UploadCacheButton.Enabled := False;
|
|
// Hinweis im Browser anzeigen
|
|
FMarkdown.Append(sLineBreak + '*Creating Cache...*' + sLineBreak);
|
|
|
|
FUploadCache :=
|
|
TFuture<TProc>.Construct(
|
|
FUploadCache.Done,
|
|
function: TProc
|
|
var
|
|
client: IGeminiClient;
|
|
cacheName: string;
|
|
errMsg: string;
|
|
begin
|
|
try
|
|
client := TGeminiClient.Create(apiKey, modelName);
|
|
cacheName := client.CreateCache(content, sysInstr, 300);
|
|
client.ActiveCacheName := cacheName;
|
|
FCachedClient := client;
|
|
|
|
Result :=
|
|
procedure
|
|
begin
|
|
FMarkdown.Append('**Success: Cache created!**' + sLineBreak);
|
|
FMarkdown.Append('ID: `' + cacheName + '`' + sLineBreak);
|
|
|
|
InitChat;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
errMsg := E.Message;
|
|
Result := procedure begin FMarkdown.Append('**Cache Upload Failed:** ' + errMsg + sLineBreak); end;
|
|
end;
|
|
end;
|
|
end
|
|
);
|
|
|
|
FCacheUploaded := TFlag.CreateObserver(FUploadCache.Done.Signal);
|
|
end;
|
|
|
|
procedure TForm1.ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
|
|
begin
|
|
if FNeedModelListUpdate.Reset then
|
|
begin
|
|
ModelsComboBox.BeginUpdate;
|
|
try
|
|
ModelsComboBox.Items.Clear;
|
|
|
|
var models := FModelList.Value;
|
|
|
|
if Length(models) = 0 then
|
|
begin
|
|
FMarkdown.Append(sLineBreak + '*System: No models found.*' + sLineBreak);
|
|
exit;
|
|
end;
|
|
|
|
for var mName in models do
|
|
ModelsComboBox.Items.Add(mName);
|
|
|
|
if ModelsComboBox.Items.Count > 0 then
|
|
begin
|
|
ModelsComboBox.ItemIndex := ModelsComboBox.Items.IndexOf(FallbackModel);
|
|
if ModelsComboBox.ItemIndex < 0 then
|
|
ModelsComboBox.ItemIndex := 0;
|
|
end;
|
|
finally
|
|
ModelsComboBox.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
if FCacheUploaded.Reset then
|
|
begin
|
|
if Assigned(FUploadCache.Value) then
|
|
FUploadCache.Value();
|
|
UploadCacheButton.Enabled := True;
|
|
end;
|
|
|
|
if FResposeQueueChanged.Reset then
|
|
begin
|
|
FResponseLock.Enter;
|
|
try
|
|
while FResponseQueue.Count > 0 do
|
|
(FResponseQueue.Dequeue)();
|
|
finally
|
|
FResponseLock.Leave;
|
|
end;
|
|
end;
|
|
|
|
if FNewResposeReceived.Reset then
|
|
begin
|
|
var res := FAsking.Value;
|
|
|
|
if res.Text.StartsWith('Error') then
|
|
begin
|
|
FMarkdown.BeginBlock(btMarkdown, 'Error');
|
|
FMarkdown.Append('> ' + Res.Text);
|
|
end;
|
|
|
|
QuotaLabel.Text := Format('Input: %d | Output: %d', [res.Usage.PromptTokens, res.Usage.CandidatesTokens]);
|
|
|
|
UpdateQuotaDisplay;
|
|
AskButton.Enabled := True;
|
|
end;
|
|
end;
|
|
|
|
end.
|