228 lines
7.2 KiB
Plaintext
228 lines
7.2 KiB
Plaintext
unit uWebServerKandinsky;
|
||
|
||
interface
|
||
|
||
uses
|
||
System.SysUtils, System.Types, System.UITypes, System.Classes,
|
||
System.Variants, System.NetEncoding,IdContext, IdCustomHTTPServer, IdHTTPServer, IdGlobal,
|
||
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Edit,
|
||
FMX.Controls.Presentation, FMX.StdCtrls, uKandinskyAPI, FMX.Memo.Types, System.json,
|
||
FMX.ScrollBox, FMX.Memo, System.IOUtils, System.SyncObjs,System.DateUtils;
|
||
|
||
type
|
||
TKandinsky_Web = class(TObject)
|
||
|
||
IdHTTPServer1: TIdHTTPServer;
|
||
procedure IdHTTPServer1CommandGet(AContext: TIdContext;
|
||
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
|
||
private
|
||
FCriticalSection: TCriticalSection;
|
||
FCurrentImage: string;
|
||
FImageTime: TDateTime;
|
||
FCurrentText: string;
|
||
ka:TFusionBrainAPI;
|
||
function GenerateHTML: string;
|
||
function GenerateJSON: string;
|
||
procedure CleanupOldMessages;
|
||
procedure GenerationDone(Sender: TObject; const FileName: string);
|
||
procedure GenerationError(Sender: TObject; const ErrorMessage: string);
|
||
procedure GenerationUpdate(Sender: TObject; const Message: string);
|
||
public
|
||
constructor Create(aKey:string; aSecret:string; aPort:integer);
|
||
destructor Destroy;
|
||
procedure generate(prompt:string; aNick:string);
|
||
procedure ActiveServer(aEn: boolean);
|
||
end;
|
||
|
||
implementation
|
||
|
||
{ TKandinsky_Web }
|
||
|
||
procedure TKandinsky_Web.ActiveServer(aEn: boolean);
|
||
begin
|
||
IdHTTPServer1.Active :=aEn;
|
||
end;
|
||
|
||
procedure TKandinsky_Web.CleanupOldMessages;
|
||
begin
|
||
if FileExists(FCurrentImage) then
|
||
begin
|
||
DeleteFile(FCurrentImage);
|
||
end;
|
||
end;
|
||
|
||
constructor TKandinsky_Web.Create(aKey:string; aSecret:string; aPort:integer);
|
||
begin
|
||
IdHTTPServer1 := TIdHTTPServer.Create;
|
||
IdHTTPServer1.DefaultPort := aPort;
|
||
IdHTTPServer1.OnCommandGet := IdHTTPServer1CommandGet;
|
||
ka:=TFusionBrainAPI.Create(nil,aKey, aSecret);
|
||
ka.OnGenerationDone := GenerationDone;
|
||
ka.OnStatusUpdate:=GenerationUpdate;
|
||
ka.OnError:=GenerationError;
|
||
FCriticalSection:=TCriticalSection.Create;
|
||
//flog.toLog(0,'uWebServerKandinsky','Create','<27><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
||
end;
|
||
|
||
destructor TKandinsky_Web.Destroy;
|
||
begin
|
||
IdHTTPServer1.Active := False;
|
||
FreeAndNil(FCriticalSection);
|
||
CleanupOldMessages;
|
||
end;
|
||
|
||
procedure TKandinsky_Web.generate(prompt: string; aNick:string);
|
||
begin
|
||
//flog.toLog(0,'uWebServerKandinsky','generate','<27><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
||
FCriticalSection.Enter;
|
||
try
|
||
FCurrentText := aNick;
|
||
finally
|
||
FCriticalSection.Leave;
|
||
end;
|
||
ka.StartGeneration(prompt);
|
||
//flog.toLog(0,'uWebServerKandinsky','generate','<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
||
end;
|
||
|
||
function TKandinsky_Web.GenerateHTML: string;
|
||
begin
|
||
Result := '<!DOCTYPE html>' +
|
||
'<html><head>' +
|
||
'<meta http-equiv="Cache-Control" content="no-cache, no-store, must-revalidate">' +
|
||
'<meta http-equiv="Pragma" content="no-cache">' +
|
||
'<meta http-equiv="Expires" content="0">' +
|
||
'<style>' +
|
||
'body { background: #00ff00; }' +
|
||
'#current-image { max-width: 100%; max-height: 90vh; margin: 5vh auto; display: block; }' +
|
||
'#image-text { text-align: center; font-size: 24px; margin: 10px; color: black; }' +
|
||
'.hidden { display: none !important; }' + // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> hidden
|
||
'</style></head>' +
|
||
'<body>' +
|
||
'<div id="image-container">' +
|
||
' <img id="current-image" class="hidden" src="" />' + // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> hidden
|
||
' <div id="image-text" class="hidden"></div>' + // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> hidden
|
||
'</div>' +
|
||
'<script>' +
|
||
'function updateImage() {' +
|
||
' fetch("/image-data")' +
|
||
' .then(response => response.json())' +
|
||
' .then(data => {' +
|
||
' const img = document.getElementById("current-image");' +
|
||
' const textDiv = document.getElementById("image-text");' +
|
||
' ' +
|
||
' if (data.imageUrl && data.text) {' +
|
||
' if (img.src !== data.imageUrl) {' +
|
||
' img.src = data.imageUrl;' +
|
||
' textDiv.textContent = data.text;' +
|
||
' }' +
|
||
' img.classList.remove("hidden");' +
|
||
' textDiv.classList.remove("hidden");' +
|
||
' } else {' + // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
' img.classList.add("hidden");' +
|
||
' textDiv.classList.add("hidden");' +
|
||
' img.src = "";' + // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> src
|
||
' textDiv.textContent = "";' +
|
||
' }' +
|
||
' })' +
|
||
' .catch(error => console.error("Error:", error));' +
|
||
'}' +
|
||
'setInterval(updateImage, 1000);' +
|
||
'updateImage();' +
|
||
'</script>' +
|
||
'</body></html>';
|
||
end;
|
||
|
||
function TKandinsky_Web.GenerateJSON: string;
|
||
var
|
||
JSONObject: TJSONObject;
|
||
begin
|
||
JSONObject := TJSONObject.Create;
|
||
try
|
||
FCriticalSection.Enter;
|
||
try
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if FileExists(FCurrentImage) and (SecondsBetween(Now, FImageTime) <= 5) then
|
||
begin
|
||
JSONObject.AddPair('imageUrl', '/image?' + IntToStr(DateTimeToUnix(FImageTime))); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
JSONObject.AddPair('text', FCurrentText)
|
||
end
|
||
else
|
||
begin
|
||
JSONObject.AddPair('imageUrl', '');
|
||
JSONObject.AddPair('text', '');
|
||
end;
|
||
finally
|
||
FCriticalSection.Leave;
|
||
end;
|
||
Result := JSONObject.ToString;
|
||
finally
|
||
JSONObject.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TKandinsky_Web.GenerationDone(Sender: TObject;
|
||
const FileName: string);
|
||
begin
|
||
TThread.Queue(nil, procedure
|
||
begin
|
||
FCriticalSection.Enter;
|
||
try
|
||
CleanupOldMessages;
|
||
FCurrentImage := FileName;
|
||
FImageTime := Now;
|
||
//flog.toLog(0,'uWebServerKandinsky','GenerationDone','<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
||
finally
|
||
FCriticalSection.Leave;
|
||
end;
|
||
end);
|
||
end;
|
||
|
||
procedure TKandinsky_Web.GenerationError(Sender: TObject;
|
||
const ErrorMessage: string);
|
||
begin
|
||
//flog.toLog(2,'uWebServerKandinsky','GenerationError',ErrorMessage);
|
||
end;
|
||
|
||
procedure TKandinsky_Web.GenerationUpdate(Sender: TObject;
|
||
const Message: string);
|
||
begin
|
||
// flog.toLog(0,'uWebServerKandinsky','GenerationUpdate',Message);
|
||
end;
|
||
|
||
procedure TKandinsky_Web.IdHTTPServer1CommandGet(AContext: TIdContext;
|
||
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
|
||
var
|
||
FilePath: string;
|
||
begin
|
||
FCriticalSection.Enter;
|
||
try
|
||
if ARequestInfo.Document = '/' then
|
||
begin
|
||
AResponseInfo.ContentType := 'text/html';
|
||
AResponseInfo.ContentText := GenerateHTML;
|
||
end
|
||
else if ARequestInfo.Document = '/image' then
|
||
begin
|
||
if FileExists(FCurrentImage) and (SecondsBetween(Now, FImageTime) <= 5) then
|
||
begin
|
||
AResponseInfo.ContentType := 'image/jpeg';
|
||
AResponseInfo.ContentStream := TFileStream.Create(FCurrentImage, fmOpenRead);
|
||
end
|
||
else
|
||
AResponseInfo.ResponseNo := 404;
|
||
end
|
||
else if ARequestInfo.Document = '/image-data' then
|
||
begin
|
||
AResponseInfo.ContentType := 'application/json';
|
||
AResponseInfo.ContentText := GenerateJSON;
|
||
end
|
||
else
|
||
AResponseInfo.ResponseNo := 404;
|
||
finally
|
||
FCriticalSection.Leave;
|
||
end;
|
||
end;
|
||
|
||
|
||
end.
|