Gemini Test

2026-01-13 10:25:33 +01:00
parent 1387131f57
commit 3c5d51f6a8
10 changed files with 447 additions and 348 deletions
@@ -8,6 +8,8 @@ uses
    System.UITypes,
    System.Classes,
    System.Variants,
+    System.Generics.Collections,
+    System.SyncObjs,
    FMX.Types,
    FMX.Controls,
    FMX.Forms,
@@ -22,8 +24,11 @@ uses
    FMX.ListBox,
    FMX.TabControl,
    FMX.WebBrowser,
+    Myc.Signals,
+    Myc.Futures,
    Myc.Api.Gemini,
-    Myc.Api.MarkdownStream;
+    Myc.Api.MarkdownStream,
+    FMX.ApplicationEvents;

 type
    TForm1 = class(TForm)
@@ -43,6 +48,9 @@ type
        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);
@@ -52,6 +60,15 @@ type
        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
@@ -64,7 +81,6 @@ var
 implementation

 uses
-    System.Threading,
    Myc.System.Quota;

 {$R *.fmx}
@@ -72,8 +88,17 @@ uses
 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);
@@ -152,79 +177,68 @@ begin
    // Da User Markdown oft erwarten:
    FMarkdown.Append(prompt);

-    TTask.Run(
-        procedure
-        var
-            CurrentChat: IGeminiChat;
-            resultData: TGeminiResult;
-            // State Tracking für den Stream
-            LastWasThought: Boolean;
-            FirstChunk: Boolean;
-        begin
-            CurrentChat := FChat;
-            if CurrentChat = nil then
-                exit;
+    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;
+                LastWasThought := False;
+                FirstChunk := True;

-            // --- STREAMING ---
-            resultData :=
-                CurrentChat.SendMessageStream(
-                    prompt,
-                    procedure(const TextChunk: string; IsThought: Boolean)
-                    begin
-                        TThread.Queue(
-                            nil,
-                            procedure
-                            begin
-                                // Statuswechsel oder allererster Chunk -> Neuer Block
-                                if FirstChunk or (IsThought <> LastWasThought) then
-                                begin
-                                    if IsThought then
+                // --- STREAMING ---
+                Result :=
+                    CurrentChat.SendMessageStream(
+                        prompt,
+                        procedure(const TextChunk: string; IsThought: Boolean)
+                        begin
+                            FResponseLock.Enter;
+                            try
+                                FResponseQueue.Enqueue(
+                                    procedure
                                    begin
-                                        FMarkdown.BeginBlock(btMarkdown, 'Thinking...');
-                                        // Optional: Kursiver Block für Gedanken
-                                        // Wir hängen Gedanken oft als Zitat oder kursiv an
+                                        // 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
-                                    else
-                                    begin
-                                        // Wenn wir aus einem Gedanken kommen oder starten
-                                        FMarkdown.BeginBlock(btMarkdown, 'Gemini');
-                                    end;
+                                );
+                            finally
+                                FResponseLock.Leave;
+                            end;

-                                    LastWasThought := IsThought;
-                                    FirstChunk := False;
-                                end;
+                            FResposeQueueChanged.Notify;
+                        end
+                    );
+            end
+        );

-                                // Inhalt anhängen
-                                if IsThought then
-                                    FMarkdown.Append(TextChunk) // Wird im selben Markdown-Block gerendert
-                                else
-                                    FMarkdown.Append(TextChunk);
-                            end
-                        );
-                    end
-                );
+    FNewResposeReceived := TFlag.CreateObserver(FAsking.Done.Signal);

-            // Abschluss im Main Thread
-            TThread.Queue(
-                nil,
-                procedure
-                begin
-                    if resultData.Text.StartsWith('Error') then
-                    begin
-                        FMarkdown.BeginBlock(btMarkdown, 'Error');
-                        FMarkdown.Append('> ' + resultData.Text);
-                    end;
-
-                    QuotaLabel.Text := Format('Input: %d | Output: %d', [resultData.Usage.PromptTokens, resultData.Usage.CandidatesTokens]);
-                    UpdateQuotaDisplay;
-                    AskButton.Enabled := True;
-                end
-            );
-        end
-    );
 end;

 procedure TForm1.Edit1Exit(Sender: TObject);
@@ -241,46 +255,19 @@ begin
    if apiKey.IsEmpty then
        exit;

-    TTask.Run(
-        procedure
-        var
-            client: IGeminiClient;
-            modelList: TArray<string>;
-        begin
-            client := TGeminiClient.Create(apiKey);
-            modelList := client.ListModels;
+    FModelList :=
+        TFuture<TArray<string>>.Construct(
+            FModelList.Done,
+            function: TArray<string>
+            var
+                client: IGeminiClient;
+            begin
+                client := TGeminiClient.Create(apiKey);
+                Result := client.ListModels;
+            end
+        );

-            TThread.Queue(
-                nil,
-                procedure
-                var
-                    mName: string;
-                begin
-                    if Length(modelList) = 0 then
-                    begin
-                        FMarkdown.Append(sLineBreak + '*System: No models found.*' + sLineBreak);
-                        exit;
-                    end;
-
-                    ModelsComboBox.BeginUpdate;
-                    try
-                        ModelsComboBox.Items.Clear;
-                        for mName in modelList 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
-            );
-        end
-    );
+    FNeedModelListUpdate := TFlag.CreateObserver(FModelList.Done.Signal);
 end;

 procedure TForm1.UploadCacheButtonClick(Sender: TObject);
@@ -309,46 +296,105 @@ begin
    // Hinweis im Browser anzeigen
    FMarkdown.Append(sLineBreak + '*Creating Cache...*' + sLineBreak);

-    TTask.Run(
-        procedure
-        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;
+    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;

-                TThread.Queue(
-                    nil,
-                    procedure
-                    begin
-                        FMarkdown.Append('**Success: Cache created!**' + sLineBreak);
-                        FMarkdown.Append('ID: `' + cacheName + '`' + sLineBreak);
-
-                        InitChat;
-                        UploadCacheButton.Enabled := True;
-                    end
-                );
-            except
-                on E: Exception do
-                begin
-                    errMsg := E.Message;
-                    TThread.Queue(
-                        nil,
+                    Result :=
                        procedure
                        begin
-                            FMarkdown.Append('**Cache Upload Failed:** ' + errMsg + sLineBreak);
-                            UploadCacheButton.Enabled := True;
-                        end
-                    );
+                            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;
-        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.