ttw_fmx_v10/utils/uWebServerGames.pas

unit uWebServerGames;

interface

uses
  System.SysUtils, System.Classes, System.JSON, System.Generics.Collections,
  IdHTTPServer, IdCustomHTTPServer, IdContext, IdComponent, System.NetEncoding, System.IOUtils;

type
  TGameWebServer = class
  private
    FHTTP: TIdHTTPServer;
    FRootDir: string;
    FCurrentGame: string;
    FClients: TList<TIdContext>;
    procedure HTTPCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
      AResponseInfo: TIdHTTPResponseInfo);
    procedure BroadcastJSON(const AJSON: TJSONObject);
    procedure HTTPDisconnect(AContext: TIdContext);
    function ParseControlCommands(const AGameName: string): TArray<string>;
  public
    constructor Create(const ARootDir: string; APort: Integer = 8080);
    destructor Destroy; override;

    procedure Start;
    procedure Stop;

    procedure SetGame(const AFileName: string);
    procedure Input(AParams: TJSONObject);
    function GetControlCommands: TArray<string>;
  end;

implementation

{ TGameWebServer }

function TGameWebServer.ParseControlCommands(const AGameName: string): TArray<string>;
var
  configPath, content, controlSection: string;
  startPos, endPos: Integer;
  lines: TArray<string>;
  line: string;
  commands: TList<string>;
begin
  SetLength(Result, 0);

  configPath := TPath.Combine(FRootDir, 'games\' + AGameName + '\config.cfg');

  if not FileExists(configPath) then
    Exit;

  content := TFile.ReadAllText(configPath, TEncoding.UTF8).ToLower;

  startPos := content.IndexOf('<control>');
  endPos := content.IndexOf('</control>');

  if (startPos = -1) or (endPos = -1) or (endPos <= startPos) then
    Exit;

  startPos := startPos + Length('<control>');
  controlSection := content.Substring(startPos, endPos - startPos).Trim;

  commands := TList<string>.Create;
  try
    lines := controlSection.Split([#10, #13], TStringSplitOptions.ExcludeEmpty);
    for line in lines do
    begin
      // Èñïðàâëåíèå: èñïîëüçóåì âðåìåííóþ ïåðåìåííóþ âìåñòî èçìåíåíèÿ loop variable
      var trimmedLine := line.Trim;
      if not trimmedLine.IsEmpty then
        commands.Add(trimmedLine);
    end;
    Result := commands.ToArray;
  finally
    commands.Free;
  end;
end;

function TGameWebServer.GetControlCommands: TArray<string>;
begin
  if FCurrentGame.IsEmpty then
    SetLength(Result, 0)
  else
    Result := ParseControlCommands(FCurrentGame);
end;

constructor TGameWebServer.Create(const ARootDir: string; APort: Integer);
begin
  FRootDir := ARootDir;
  FCurrentGame := '';
  FClients := TList<TIdContext>.Create;

  FHTTP := TIdHTTPServer.Create(nil);
  FHTTP.DefaultPort := APort;
  FHTTP.OnDisconnect := HTTPDisconnect;
  FHTTP.OnCommandGet := HTTPCommandGet;
  FHTTP.Bindings.Add.Port := APort;
end;

destructor TGameWebServer.Destroy;
begin
  Stop;
  FHTTP.Free;
  FClients.Free;
  inherited;
end;

procedure TGameWebServer.Start;
begin
  FHTTP.Active := True;
end;

procedure TGameWebServer.Stop;
begin
  FHTTP.Active := False;
end;

procedure TGameWebServer.HTTPDisconnect(AContext: TIdContext);
begin
  FClients.Remove(AContext);
  AContext.Connection.Disconnect;
end;

procedure TGameWebServer.SetGame(const AFileName: string);
begin
  if not TDirectory.Exists(TPath.Combine(FRootDir, 'games\' + AFileName)) then
    raise Exception.CreateFmt('Game "%s" not found', [AFileName]);
  FCurrentGame := AFileName;

  var obj := TJSONObject.Create;
  try
    obj.AddPair('type','setGame');
    obj.AddPair('payload', TJSONObject.Create.AddPair('currentGame', FCurrentGame));
    BroadcastJSON(obj);
  finally
    obj.Free;
  end;
end;

procedure TGameWebServer.Input(AParams: TJSONObject);
var
  evt: TJSONObject;
begin
  evt := TJSONObject.Create;
  try
    evt.AddPair('type', 'input');
    evt.AddPair('payload', AParams.Clone as TJSONValue);
    BroadcastJSON(evt);
  finally
    evt.Free;
  end;
end;

procedure TGameWebServer.BroadcastJSON(const AJSON: TJSONObject);
var
  s: string;
  ctx: TIdContext;
  toRemove: TList<TIdContext>;
begin
  s := 'data: ' + AJSON.ToJSON + #13#10#13#10; // CRLF x2 â êîíöå
  toRemove := TList<TIdContext>.Create;
  try
    for ctx in FClients do
    begin
      try
        if ctx.Connection.Connected then
        begin
          ctx.Connection.IOHandler.Write(s);
        end
        else
        begin
          toRemove.Add(ctx);
        end;
      except
        toRemove.Add(ctx);
      end;
    end;

    // Óäàëÿåì îòêëþ÷åííûõ êëèåíòîâ
    for ctx in toRemove do
    begin
      FClients.Remove(ctx);
    end;
  finally
    toRemove.Free;
  end;
end;

procedure TGameWebServer.HTTPCommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  gamePath, doc, filePath: string;
  HeartbeatThread: TThread;
begin
  // Äîáàâëÿåì CORS çàãîëîâêè äëÿ âñåõ îòâåòîâ
  AResponseInfo.CustomHeaders.Add('Access-Control-Allow-Origin: *');
  AResponseInfo.CustomHeaders.Add('Access-Control-Allow-Methods: GET, OPTIONS');
  AResponseInfo.CustomHeaders.Add('Access-Control-Allow-Headers: *');

  // Îáðàáîòêà CORS preflight çàïðîñîâ
  if ARequestInfo.Command = 'OPTIONS' then
  begin
    AResponseInfo.ResponseNo := 204; // No Content
    AResponseInfo.ContentText := '';
    Exit;
  end;

    // ÊÐÈÒÈ×ÅÑÊÈ ÂÀÆÍÎ: ïðåäîòâðàùàåì çàêðûòèå ñîåäèíåíèÿ
    AResponseInfo.CloseConnection := False;

  // Îáðàáîòêà SSE
  if SameText(ARequestInfo.URI, '/events') then
  begin
    AContext.Connection.IOHandler.WriteLn('HTTP/1.1 200 OK');
    AContext.Connection.IOHandler.WriteLn('Content-Type: text/event-stream');
    AContext.Connection.IOHandler.WriteLn('Cache-Control: no-cache');
    AContext.Connection.IOHandler.WriteLn('Connection: keep-alive');
    AContext.Connection.IOHandler.WriteLn('Access-Control-Allow-Origin: *');
    AContext.Connection.IOHandler.WriteLn; // Ïóñòàÿ ñòðîêà - êîíåö çàãîëîâêîâ

    // Äîáàâëÿåì êëèåíòà â ñïèñîê
    FClients.Add(AContext);

    // Çàïóñêàåì heartbeat â îòäåëüíîì ïîòîêå
    HeartbeatThread := TThread.CreateAnonymousThread(
      procedure
      begin
        try
          while not TThread.CheckTerminated and AContext.Connection.Connected do
          begin
            TThread.Sleep(15000); // Êàæäûå 15 ñåêóíä

            // Ïðîâåðÿåì ñîåäèíåíèå ïåðåä îòïðàâêîé
            if AContext.Connection.Connected then
            begin
              AContext.Connection.IOHandler.Write(': heartbeat' + #13#10#13#10);
            end;
          end;
        finally
          FClients.Remove(AContext);
        end;
      end
    );
    HeartbeatThread.FreeOnTerminate := True;
    HeartbeatThread.Start;

    // Îòïðàâëÿåì íà÷àëüíîå ñîîáùåíèå
    try
      AContext.Connection.IOHandler.Write('data: {"type":"ready","message":"Connection established"}'#13#10#13#10);
    except
      FClients.Remove(AContext);
    end;

    Exit;
  end;

  // 3. Îáðàáîòêà êîðíåâîãî ïóòè
  if SameText(ARequestInfo.Document, '/') then
  begin
    doc := 'index.html';
  end
  else
  begin
    doc := ARequestInfo.Document.Trim(['/']);
  end;

  // 4. Îáðàáîòêà ôàéëîâ èãðû
  if FCurrentGame = '' then
  begin
    AResponseInfo.ResponseNo := 404;
    AResponseInfo.ContentText := 'Game not selected';
    Exit;
  end;

  gamePath := IncludeTrailingPathDelimiter(FRootDir) + 'games' + PathDelim + FCurrentGame;
  filePath := TPath.Combine(gamePath, doc);

  if FileExists(filePath) then
  begin
    AResponseInfo.ContentStream := TFileStream.Create(filePath, fmOpenRead or fmShareDenyWrite);
    try
      if filePath.EndsWith('.html') then
        AResponseInfo.ContentType := 'text/html; charset=utf-8'
      else if filePath.EndsWith('.js') then
        AResponseInfo.ContentType := 'application/javascript; charset=utf-8'
      else if filePath.EndsWith('.css') then
        AResponseInfo.ContentType := 'text/css; charset=utf-8'
      else if filePath.EndsWith('.png') then
        AResponseInfo.ContentType := 'image/png'
      else if filePath.EndsWith('.jpg') or filePath.EndsWith('.jpeg') then
        AResponseInfo.ContentType := 'image/jpeg'
      else if filePath.EndsWith('.gif') or filePath.EndsWith('.gif') then
        AResponseInfo.ContentType := 'image/gif'
      else
        AResponseInfo.ContentType := 'application/octet-stream';
    except
      AResponseInfo.ContentStream.Free;
      raise;
    end;
  end
  else
  begin
    AResponseInfo.ResponseNo := 404;
    AResponseInfo.ContentText := 'Not Found: ' + doc;
    AResponseInfo.ContentType := 'text/plain; charset=utf-8';
  end;
end;

end.