unit uWebServerChat;

interface

uses classes, StrUtils, DateUtils, System.JSON, System.Generics.Collections,
  IdBaseComponent, IdComponent, IdCustomTCPServer, IdContext,
  IdCustomHTTPServer, uRecords, System.IOUtils, IdGlobalProtocols,
  IdHTTPServer, System.SysUtils;

type
  TTwitchMessage = record
    Nickname: string;
    Content: string;
    Timestamp: TDateTime;
    TimeMsg: Integer;
  end;

type
  TTTW_Chat = class(TObject)
    msgStyle: TStyleChat;
    fFontsList: tstringlist;
    IdHTTPServer1: TIdHTTPServer;
    procedure IdHTTPServer1CommandGet(AContext: TIdContext;
      ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
  private
  FBColor: string;
    Messages: TThreadList<TTwitchMessage>;
    FDeleteByTime: Boolean; // Режим удаления: по времени (true) или количеству (false)
    FMaxMsgCount: Integer;  // Максимальное количество сообщений
    function GenerateHTML: string;
    function GenerateJSON: string;
    procedure CleanupOldMessages;
  public
    constructor Create(FontList: tstrings; aPort:integer; aColor:string);
    destructor Destroy;
    procedure addMessage(newMsg: TStyleChat);
    procedure ActiveServer(aEn: boolean);
     procedure SetDeleteMode(DeleteByTime: Boolean; MaxMsgCount: Integer); // Установка режима удаления
   procedure changeBackground(aColor:string);
  end;

var
  Timestamp2: string;

implementation

uses uGeneral;

{ TTTW_Chat }

procedure TTTW_Chat.SetDeleteMode(DeleteByTime: Boolean; MaxMsgCount: Integer);
begin
  FDeleteByTime := DeleteByTime;
  FMaxMsgCount := MaxMsgCount;
end;

procedure TTTW_Chat.ActiveServer(aEn: boolean);
begin
  IdHTTPServer1.Active := aEn;
end;

procedure TTTW_Chat.addMessage(newMsg: TStyleChat);
var
  Msg: TTwitchMessage;
begin
  Msg.Nickname := newMsg.Nick;
  Msg.Content := newMsg.Context;
  Msg.Timestamp := now;
  Msg.TimeMsg := newMsg.TimeMsg;
  msgStyle := newMsg;
  with Messages.LockList do
try
      if not FDeleteByTime then
      begin
        // Удаление старых сообщений при превышении лимита
        while Count >= FMaxMsgCount do
          Delete(0);
      end;
      Add(Msg);
    finally
      Messages.UnlockList;
    end;
end;

procedure TTTW_Chat.changeBackground(aColor: string);
begin
FBColor:=aColor;
end;

procedure TTTW_Chat.CleanupOldMessages;
var
  MsgList: TList<TTwitchMessage>;
  I: integer;
  ExpiryTime: TDateTime;
begin
  if not FDeleteByTime then
    Exit; // Выходим, если удаление по времени отключено
 MsgList := Messages.LockList;
  try
    for I := MsgList.Count - 1 downto 0 do
    begin
      ExpiryTime := Now - (MsgList[I].TimeMsg / 86400);  // Используем значение из сообщения
      if MsgList[I].Timestamp < ExpiryTime then
        MsgList.Delete(I);
    end;
  finally
    Messages.UnlockList;
  end;
end;

constructor TTTW_Chat.Create(FontList: tstrings; aPort:integer;AColor:string);
var
  I: integer;
begin
   FBColor := AColor;
  Messages := TThreadList<TTwitchMessage>.Create;
  IdHTTPServer1 := TIdHTTPServer.Create;
  IdHTTPServer1.DefaultPort := aPort;
  IdHTTPServer1.OnCommandGet := IdHTTPServer1CommandGet;
  fFontsList := tstringlist.Create;
  for I := 0 to FontList.Count - 1 do
    fFontsList.Add(FontList[I]);
   FDeleteByTime := True; // По умолчанию удаление по времени
  FMaxMsgCount := 100;   // Значение по умолчанию

end;

destructor TTTW_Chat.Destroy;
begin
  Messages.Free;
  IdHTTPServer1.Active := false;
  IdHTTPServer1.Free;
  fFontsList.Free;
end;


function TTTW_Chat.GenerateHTML: string;
var
  I: integer;
  s, s1: string;
DeleteByTimeJS: string;
begin
  DeleteByTimeJS := LowerCase(BoolToStr(FDeleteByTime)); // Преобразуем булево значение в строку 'true' или 'false'
s := 'body { background: ' + FBColor + '; }' + #13#10;
  for I := 41 to fFontsList.Count - 1 do
  begin
    s1 := StringReplace(fFontsList[I], '.ttf', '', [rfReplaceAll]);
    s := s + '@font-face { font-family: ''' + s1 + '''; src: url(fonts/' + fFontsList[I] + '); }' + #13#10;
  end;

  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">' +
    '<title>Messages</title><style>' + s +
    '.message { margin:5px; border-radius:5px; transition: opacity 1s linear; display: flex; align-items: center; }' +
    '.message-icon { width: 1.5em; height: 1.5em; margin-right: 0.5em; }' + // Стиль для иконки
    '</style><script>' +
    'let existingMessages = new Map(); let fetching = false;' +
    'function fetchMessages() {' +
    '  if (fetching) return; fetching = true;' +
    '  fetch("/messages").then(response => response.json()).then(data => {' +
    '    const container = document.getElementById("messages");' +
    '    const newIds = new Set();' +
    '    data.forEach(msg => {' +
    '      const msgId = "msg-" + msg.timestamp;' +
    '      newIds.add(msgId);' +
    '      if (!existingMessages.has(msgId)) {' +
    '        const div = document.createElement("div");' +
    '        div.className = "message";' +
    '        div.id = msgId;' +
    '        div.style = `background-color:${msg.color}; font-family:${msg.family}; ' +
    '                    padding:${msg.padding}px; border: ${msg.sizeBorder}px solid ${msg.colorBorder}; ' +
    '                    color:${msg.colorText}; font-size:${msg.fontSize}px;`;' +
    '        div.innerHTML = `' +
  // '          <img src="${msg.iconUrl}" class="message-icon">' + // Добавлена иконка
    '          <div><b>${msg.nickname}:</b> ${msg.content}</div>`;' +
    '        div.style.opacity = "1";' +
    '        container.appendChild(div);' +
    '        existingMessages.set(msgId, div);' +
    '        if (deleteByTime) {' + // Устанавливаем таймер только если включено удаление по времени
    '          setTimeout(() => {' +
    '             div.style.opacity = "0";' +
    '             setTimeout(() => { div.remove(); existingMessages.delete(msgId); }, 1000);' +
    '           }, msg.timeMsg * 1000);' +
    '         }' +
    '      }' +
    '    });' +
    '    existingMessages.forEach((div, msgId) => {' +
    '      if (!newIds.has(msgId)) { div.remove(); existingMessages.delete(msgId); }' +
    '    });' +
    '  }).finally(() => { fetching = false; });' +
    '}' +
    'setInterval(fetchMessages, 500); fetchMessages();' +
    '</script></head><body><div id="messages"></div></body></html>';
end;

function TTTW_Chat.GenerateJSON: string;
var
  MsgList: TList<TTwitchMessage>;
  Msg: TTwitchMessage;
  JSONArray: TJSONArray;
  JSONObject: TJSONObject;
begin
  JSONArray := TJSONArray.Create;
  try
    MsgList := Messages.LockList;
    try
      for Msg in MsgList do
      begin
        JSONObject := TJSONObject.Create;
        JSONObject.AddPair('nickname', Msg.Nickname);
        JSONObject.AddPair('content', Msg.Content);
        JSONObject.AddPair('timestamp',
          TJSONNumber.Create(DateTimeToUnix(Msg.Timestamp)));
        JSONObject.AddPair('color', msgStyle.BlockColor); // Оставляем HEX-цвет
        JSONObject.AddPair('bcolor', msgStyle.BColor); // Оставляем HEX-цвет
        JSONObject.AddPair('fontSize', TJSONNumber.Create(msgStyle.FontSize));
        JSONObject.AddPair('colorText', msgStyle.FontColor);

        JSONObject.AddPair('colorBorder', msgStyle.BorderColor);
        JSONObject.AddPair('sizeBorder',
          TJSONNumber.Create(msgStyle.BorderSize));
        JSONObject.AddPair('padding', TJSONNumber.Create(msgStyle.BorderSize));
        JSONObject.AddPair('family', msgStyle.FontFamily);
        JSONObject.AddPair('timeMsg', TJSONNumber.Create(Msg.TimeMsg));  // Добавляем время
        // Управляет только блоком, не текстом
        JSONArray.Add(JSONObject);
      end;
    finally
      Messages.UnlockList;
    end;
    Result := JSONArray.ToString;
  finally
    JSONArray.Free;
  end;
end;

procedure TTTW_Chat.IdHTTPServer1CommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  HtmlContent: string;
  FontFileName: string;
  FontFilePath: string;
  MIMEType: string;
  FS: TFileStream;
begin
  CleanupOldMessages;

  if ARequestInfo.Document = '/messages' then
  begin
    AResponseInfo.ContentType := 'application/json; charset=utf-8';
    AResponseInfo.ContentText := GenerateJSON;
  end
  else if Pos('/fonts/', ARequestInfo.Document) = 1 then
  // Проверяем запрос к шрифтам
  begin
    // Извлекаем имя файла из URL
    FontFileName := TPath.GetFileName(ARequestInfo.Document);

    // Формируем полный путь к файлу (папка fonts должна быть рядом с исполняемым файлом)
    FontFilePath := myConst.fontsPath + FontFileName;

    // Проверяем существование файла
    if FileExists(FontFilePath) then
    begin

      MIMEType := 'font/ttf';

      // Настраиваем ответ
      AResponseInfo.ContentType := MIMEType;
      try
        FS := TFileStream.Create(FontFilePath, fmOpenRead + fmShareDenyWrite);
        AResponseInfo.ContentStream := FS;
        AResponseInfo.ResponseNo := 200;
      except
        FS.Free;
        AResponseInfo.ResponseNo := 500;
      end;
    end;
  end
  else
  begin
    AResponseInfo.CacheControl := 'no-cache, no-store, must-revalidate';
    AResponseInfo.Pragma := 'no-cache';
    AResponseInfo.Expires := 0;
    Timestamp2 := IntToStr(DateTimeToUnix(now));
    AResponseInfo.ContentType := 'text/html; charset=utf-8';
    AResponseInfo.ContentText := GenerateHTML;
  end;
end;


end.
