{$MODE OBJFPC} { -*- delphi -*- }
{$INCLUDE settings.inc}
unit rpc;

interface

{$DEFINE DEBUG_NETWORK}

uses
   corewebsocket, stringstream, hashtable, hashset, genericutils, stringutils, hashfunctions, storable, autostorable, tokenutils,
   properties;

const
   kNone = -1; // the "none" in TTechnologyTreeNodeIDOrNone
   kNoDiscovery = -1.0; // return value for GetTimeForBreakthrough()
   kSecondsPerDay = 86400;

type
   TMessageWebSocket = class;
   TAbstractGame = class;
   TAbstractDynasty = class;
   TAbstractActor = class;
   TAbstractFacility = class;

   IMessageTarget = interface
      procedure DispatchStr(var Message);
   end;

   PMessage = ^TMessage;
   TMessage = record
     private
      const
        MaxMessageNameLength = 32;
      var
        FName: String[MaxMessageNameLength]; // only used for dispatch (must be first)
        FConnection: TMessageWebSocket; // only used by Reply() and Subscribe()
        FConversationID: Cardinal; // only used by Reply()
        FStream: TStringStreamReader;
        FDynasty: TAbstractDynasty;
        {$IFOPT C+} FReplyStream: TStringStreamWriter; {$ENDIF} // only used by Reply() and cleanup assertions
      function GetHandled(): Boolean;
     public
      property Dynasty: TAbstractDynasty read FDynasty;
      property Stream: TStringStreamReader read FStream;
      property Handled: Boolean read GetHandled;
      function Reply(const Success: Boolean): TStringStreamWriter;
      procedure AutoSubscribe(Actor: TAbstractActor); inline; // same as Subscribe but uses Actor.AutoSubscribe instead of Actor.Subscribe
      procedure Subscribe(Actor: TAbstractActor); inline;
      procedure Unsubscribe(Actor: TAbstractActor); inline;
   end;

   TErrorString = String[255];

   TTechnologyPoints = type Double;
   TDependencyCount = type Byte;
   TTechnologyTreeNodeID = type 0..High(Integer);
   TTechnologyTreeNodeIDOrNone = type -1..High(Integer);
   TTechnologyTreeNodeKind = (tkNone, tkBreakthrough, tkTopic, tkTechnology);
   TTechnologyTreeNodeKindSet = set of TTechnologyTreeNodeKind;
   TTechnologyTreeFilterProc = procedure (const ID: TTechnologyTreeNodeID; const Name: UTF8String; const Kind: TTechnologyTreeNodeKind) is nested;
   TTechnologyTreeNodeStatus = record
      PendingDependencies: TDependencyCount;
      TimeSinceUnlocked: TDateTime;
      Discovered: Boolean; // for tkBreakthroughs only (the others, just check PendingDependencies=0)
   end;
   TTechnologyTreeNodeStatusArray = array of TTechnologyTreeNodeStatus;
   TResearchTopicList = array of UTF8String;
   TTechnologyTreeNodeArray = array of TTechnologyTreeNodeID;
   PDiscoveryNotificationProc = ^TDiscoveryNotificationProc;
   TDiscoveryNotificationProc = procedure (Actor: TAbstractActor; Kinds: TTechnologyTreeNodeKindSet) of object;

   TAbstractTechnologyTreeManager = class abstract (TStorable)
    public
      function GetFreshTechTreeStatusArray(): TTechnologyTreeNodeStatusArray; virtual; abstract;
      procedure FilterTechTree(Kinds: TTechnologyTreeNodeKindSet; Callback: TTechnologyTreeFilterProc); virtual; abstract;
      function GetIDFor(Name: UTF8String; Kinds: TTechnologyTreeNodeKindSet): TTechnologyTreeNodeIDOrNone; virtual; abstract;
      function GetPointsForBreakthrough(ID: TTechnologyTreeNodeID; const Status: TTechnologyTreeNodeStatusArray; Topic: TTechnologyTreeNodeIDOrNone; TimeStudiedAtStart, Interval: TDateTime; out Lambda: Double): TTechnologyPoints; virtual; abstract;
      function Discover(ID: TTechnologyTreeNodeID; var Status: TTechnologyTreeNodeStatusArray; Dynasty: TAbstractDynasty): TTechnologyTreeNodeKindSet; virtual; abstract;
      procedure DescribeTechnologies(Technologies: TTechnologyTreeNodeArray; Stream: TStringStreamWriter); virtual; abstract;
      function Build(ID: TTechnologyTreeNodeID; Dynasty: TAbstractDynasty): TAbstractActor; virtual; abstract;
   end;

   TAbstractDynasty = class abstract (TStorable, IMessageTarget)
     protected
      function GetName(): UTF8String; virtual; abstract;
     public
      function Authenticate(const Password: UTF8String): Boolean; virtual; abstract;
      procedure Login(var Message: TMessage); virtual; abstract;
      procedure Subscribe(Connection: TMessageWebSocket); virtual; abstract;
      procedure Unsubscribe(Connection: TMessageWebSocket); virtual; abstract;
      procedure SendUpdate(Stream: TStringStreamWriter); virtual; abstract;
      procedure Adopt(Actor: TAbstractActor); virtual; abstract;
      procedure Divorce(Actor: TAbstractActor); virtual; abstract;
      procedure AddNewsItem(Actor: TAbstractActor); virtual; abstract;
      procedure AddDiscoveryWatcher(Watcher: PDiscoveryNotificationProc; Filter: TTechnologyTreeNodeKindSet); virtual; abstract;
      procedure RemoveDiscoveryWatcher(Watcher: PDiscoveryNotificationProc); virtual; abstract;
      function GetResearchTopics(): TResearchTopicList; virtual; abstract;
      function GetDefaultResearchTopic(): UTF8String; virtual; abstract;
      function VerifyResearchTopic(TopicName: UTF8String): Boolean; virtual; abstract;
      procedure Tick(Interval: TDateTime); virtual; abstract;
      procedure DoSomeResearch(Actor: TAbstractActor; Interval: TDateTime; var ResearchPoints: TTechnologyPoints; TopicName: UTF8String; TimeStudied: TDateTime); virtual; abstract; // TimeStudied is only the time studied up to the start of the current interval, so total time studied at the end of the interval we are calculating is Interval+TimeStudied
      property Name: UTF8String read GetName;
   end;

   TAbstractLocation = class end;

   TAbstractTreeNodeClass = class of TAbstractTreeNode;
   TAbstractTreeNode = class abstract (TStorable)
     protected
      function GetParent(): TAbstractTreeNode; virtual; abstract;
      procedure SetParent(const NewParent: TAbstractTreeNode); virtual; abstract;
     public
      procedure RemoveChild(const OldChild: TAbstractTreeNode); virtual; // only use this if child will not have new parent (e.g. it exploded or crashed)
      function AddChild(const OldChild: TAbstractTreeNode; const Location: TAbstractLocation): Boolean; virtual; // implies remove from old parent
      function FindAncestor(const SearchClass: TAbstractTreeNodeClass; out Target, Penultimate: TAbstractTreeNode): Boolean; // values are initialised even if it returned false
      property Parent: TAbstractTreeNode read GetParent write SetParent; // to change this, use AddChild()/RemoveChild() on parent
   end;

   TChangeNotification = procedure (const Child: TAbstractTreeNode) of object;

   TDirtyFlags = set of (dfNeedSave, dfNeedNotifications, dfNeedTick, dfPhysicalPropertiesChanged);

   TActorID = Cardinal;
   TAbstractActor = class abstract (TAbstractTreeNode, IMessageTarget)
     protected
      function GetID(): TActorID; virtual; abstract;
      {$IFDEF DEBUG} function GetName(): UTF8String; virtual; abstract; {$ENDIF}
     public
      constructor Create(Dynasty: TAbstractDynasty; Settings: TAutoStorable); virtual; overload;
      class function ParseSettings(Tokens: TTokenArray; var Index: Cardinal; var ErrorMessage: TErrorString): TAutoStorable; virtual; abstract;
      class function GetImage(Settings: TAutoStorable): UTF8String; virtual; abstract;
      class function GetEnvironment(Settings: TAutoStorable): UTF8String; virtual; abstract;
      procedure AddFacility(Facility: TAbstractFacility); virtual; abstract;
      procedure MarkDirty(DirtyFlags: TDirtyFlags); virtual; abstract;
      procedure AutoSubscribe(Connection: TMessageWebSocket); virtual; abstract; // subscribe and send state (make sure to subscribe connection too)
      procedure Subscribe(Connection: TMessageWebSocket); virtual; abstract; // just subscribe (make sure to subscribe connection too)
      procedure Unsubscribe(Connection: TMessageWebSocket); virtual; abstract;
      procedure UpdatePhysicalProperties(); virtual; abstract;
      procedure ReportChanges(); virtual; abstract;
      procedure ReportDeath(); virtual; abstract;
      procedure KillChildren(); virtual; abstract;
      procedure ReportIdentity(Stream: TStringStreamWriter); virtual; abstract;
      procedure ReportState(Dynasty: TAbstractDynasty; Stream: TStringStreamWriter); virtual; abstract;
      procedure Tick(Interval: TDateTime); virtual; abstract;
      function ParseLocationFromMessage(Stream: TStringStreamReader): TAbstractLocation; virtual; abstract;
      property ID: TActorID read GetID;
      {$IFDEF DEBUG} property Name: UTF8String read GetName; {$ENDIF}
   end;
   TAbstractActorClass = class of TAbstractActor;

   // A facility is an aspect of a TActor (typically a TChildActor) that is present during the entire
   // lifetime of the TActor. It allows us to create variants of TActors without having to define actual
   // classes. Facilities can represent physical things, but they are physical things that are an
   // intrinsic part of the TActor to which they are attached.
   TAbstractFacility = class abstract (TAbstractTreeNode)
     public
      constructor Create(Actor: TAbstractActor; Settings: TAutoStorable); virtual; overload;
      class function ParseSettings(Tokens: TTokenArray; var Index: Cardinal; var ErrorMessage: TErrorString): TAutoStorable; virtual; abstract;
      procedure Tick(Interval: TDateTime); virtual; abstract;
      procedure KillChildren(Game: TAbstractGame); virtual; abstract;
      procedure ApplyPhysicalProperties(Target: PPhysicalProperties); virtual; abstract;
      class function HasPhysicalProperty(): Boolean; virtual; abstract;
   end;
   TAbstractFacilityClass = class of TAbstractFacility;

   TAbstractGame = class abstract (TStorable, IMessageTarget)
     protected
      function GetTechnologyTree(): TAbstractTechnologyTreeManager; virtual; abstract;
     public
      function GetID(): TActorID; virtual; abstract;
      procedure Register(Actor: TAbstractActor); virtual; abstract;
      procedure Unregister(Actor: TAbstractActor); virtual; abstract;
      procedure Kill(Actor: TAbstractActor); virtual; abstract;
      function GetBuildTarget(ID: TActorID; Dynasty: TAbstractDynasty): TAbstractActor; virtual; abstract;
      procedure MarkDirty(Actor: TAbstractActor; DirtyFlags: TDirtyFlags); virtual; abstract;
      property TechnologyTree: TAbstractTechnologyTreeManager read GetTechnologyTree;
      function GetGameID(): Cardinal; virtual; abstract;
   end;

   TMessageWebSocket = class(TWebSocket)
    protected
      FDynasty: TAbstractDynasty;
      function GetTarget(ID: TActorID): IMessageTarget; virtual; abstract;
    public
      procedure HandleMessage(s: UTF8String); override;
      {$IFDEF DEBUG} procedure WriteFrame(const s: UTF8String); override; {$ENDIF}
      {$IFDEF DEBUG} procedure Disconnect(); override; {$ENDIF}
      function IsSubscribed(Actor: TAbstractActor): Boolean; virtual; abstract;
      procedure Subscribe(Actor: TAbstractActor); virtual; abstract;
      procedure Unsubscribe(Actor: TAbstractActor); virtual; abstract;
      procedure ReportChange(Actor: TAbstractActor);
      procedure ReportDeath(Actor: TAbstractActor);
      procedure SendNewsUpdate(Actor: TAbstractActor); 
      procedure SendDynastyUpdate();
      {$IFOPT C+} property Debug_Dynasty: TAbstractDynasty read FDynasty; {$ENDIF}
      {$IFOPT C+} property Debug_Socket: LongInt read FSocketNumber; {$ENDIF}
   end;

type
   TActorIDUtils = specialize DefaultUtils <TActorID>;
   TActorHashTable = class(specialize THashTable<TActorID, TAbstractActor, TActorIDUtils>)
      constructor Create();
      procedure ReadObjects(Stream: TReadStream);
      procedure ReadReferences(Stream: TReadStream);
      procedure WriteObjects(Stream: TWriteStream);
      procedure WriteReferences(Stream: TWriteStream);
      procedure FreeObjects();
   end;

type
   TDiscoveryWatcherHashTable = class(specialize THashTable<PDiscoveryNotificationProc, TTechnologyTreeNodeKindSet, PointerUtils>)
      constructor Create();
   end;

type
   TDynastyHashTable = class(specialize THashTable<UTF8String, TAbstractDynasty, UTF8StringUtils>)
      constructor Create();
      procedure Read(Stream: TReadStream);
      procedure Write(Stream: TWriteStream);
   end;

type
   TMessageWebSocketHashSet = class(specialize THashSet<TMessageWebSocket, TObjectUtils>)
      constructor Create();
   end;

implementation

uses
   sysutils;

constructor TActorHashTable.Create();
begin
   inherited Create(@Integer32Hash32);
end;

procedure TActorHashTable.ReadObjects(Stream: TReadStream);
var
   NewCount, Index: THashTableSizeInt;
   Actor: TAbstractActor;
begin
   Assert(Count = 0);
   NewCount := Stream.ReadCardinal(); // $R-
   if (NewCount > 0) then
   begin
      PrepareForSize(NewCount);
      for Index := 1 to NewCount do
      begin
         Actor := Stream.ReadObject() as TAbstractActor;
         Add(Actor.ID, Actor);
      end;
   end;
   Stream.VerifySentinel();
end;

procedure TActorHashTable.ReadReferences(Stream: TReadStream);
var
   NewCount, Index, Key: THashTableSizeInt;
   Hash: DWord;
   Entry: PHashTableEntry;
begin
   // This method is way more invasive into the innards of the THashTable class than the other ones
   Assert(Count = 0);
   NewCount := Stream.ReadCardinal(); // $R-
   if (NewCount > 0) then
   begin
      PrepareForSize(NewCount);
      FCount := NewCount;
      for Index := 1 to NewCount do
      begin
         Key := Stream.ReadCardinal(); // $R-
         Hash := FHashFunction(Key) mod Length(FTable); // $R-
         New(Entry);
         Entry^.Key := Key;
         Entry^.Value := nil;
         Stream.ReadReference(@(Pointer(Entry^.Value)));
         Entry^.Next := FTable[Hash];
         FTable[Hash] := Entry;
      end;
   end;
   Stream.VerifySentinel();
end;

procedure TActorHashTable.WriteObjects(Stream: TWriteStream);
var
   Item: PHashTableEntry;
   Index: THashTableSizeInt;
begin
   Stream.WriteCardinal(Count);
   if (Count > 0) then
   begin
      for Index := 0 to Length(FTable)-1 do // $R-
      begin
         Item := FTable[Index];
         while (Assigned(Item)) do
         begin
            Assert(Item^.Key = Item^.Value.ID);
            Stream.WriteObject(Item^.Value as TStorable);
            Item := Item^.Next;
         end;
      end;
   end;
   Stream.WriteSentinel();
end;

procedure TActorHashTable.WriteReferences(Stream: TWriteStream);
var
   Item: PHashTableEntry;
   Index: THashTableSizeInt;
begin
   Stream.WriteCardinal(Count);
   if (Count > 0) then
   begin
      for Index := 0 to Length(FTable)-1 do // $R-
      begin
         Item := FTable[Index];
         while (Assigned(Item)) do
         begin
            Assert(Assigned(Item^.Value), 'item with key ' + IntToStr(Item^.Key) + ' has nil value');
            Assert(Item^.Key = Item^.Value.ID, 'writing item key ' + IntToStr(Item^.Key) + ' for actor id ' + IntToStr(Item^.Value.ID));
            Stream.WriteCardinal(Item^.Key);
            Assert(Assigned(Item^.Value));
            Stream.WriteReference(Item^.Value as TStorable);
            Item := Item^.Next;
         end;
      end;
   end;
   Stream.WriteSentinel();
end;

procedure TActorHashTable.FreeObjects();
var
   Item: PHashTableEntry;
   Index: THashTableSizeInt;
begin
   if (Count > 0) then
   begin
      for Index := 0 to Length(FTable)-1 do // $R-
      begin
         Item := FTable[Index];
         while (Assigned(Item)) do
         begin
            Assert(Item^.Key = Item^.Value.ID);
            Item^.Value.Free();
            Item^.Value := nil;
            Item := Item^.Next;
         end;
      end;
      Empty();
   end;
end;


constructor TDiscoveryWatcherHashTable.Create();
begin
   inherited Create(THashFunction(@PointerHash32));
end;


constructor TDynastyHashTable.Create();
begin
   inherited Create(@UTF8StringHash32);
end;

procedure TDynastyHashTable.Read(Stream: TReadStream);
var
   NewCount, Index: THashTableSizeInt;
   Dynasty: TAbstractDynasty;
begin
   Assert(Count = 0);
   NewCount := Stream.ReadCardinal(); // $R-
   if (NewCount > 0) then
   begin
      PrepareForSize(NewCount);
      for Index := 1 to NewCount do
      begin
         Dynasty := Stream.ReadObject() as TAbstractDynasty;
         Add(Dynasty.Name, Dynasty);
      end;
   end;
   Stream.VerifySentinel();
end;

procedure TDynastyHashTable.Write(Stream: TWriteStream);
var
   Item: PHashTableEntry;
   Index: THashTableSizeInt;
begin
   Stream.WriteCardinal(Count);
   if (Count > 0) then
   begin
      for Index := 0 to Length(FTable)-1 do // $R-
      begin
         Item := FTable[Index];
         while (Assigned(Item)) do
         begin
            Assert(Item^.Key = Item^.Value.Name);
            Stream.WriteObject(Item^.Value as TStorable);
            Item := Item^.Next;
         end;
      end;
   end;
   Stream.WriteSentinel();
end;


function TAbstractTreeNode.FindAncestor(const SearchClass: TAbstractTreeNodeClass; out Target, Penultimate: TAbstractTreeNode): Boolean;
begin
   if (not Assigned(Parent)) then
   begin
      Target := nil;
      Penultimate := nil;
      Result := False;
   end
   else
   if (Parent is SearchClass) then
   begin
      Target := Parent;
      Penultimate := Self;
      Result := True;
   end
   else
   begin
      Result := Parent.FindAncestor(SearchClass, Target, Penultimate);
   end;
end;

procedure TAbstractTreeNode.RemoveChild(const OldChild: TAbstractTreeNode);
begin
   Assert(False, 'Tried to remove child from ' + ClassName + ' which doesn''t support removing children (or, called inherited RemoveChild() incorrectly)');
end;

function TAbstractTreeNode.AddChild(const OldChild: TAbstractTreeNode; const Location: TAbstractLocation): Boolean;
begin
   Result := False;
end;


function TMessageWebSocketHash32(const Key: TMessageWebSocket): DWord; inline;
begin
   Result := PointerHash32(Pointer(Key));
end;

constructor TMessageWebSocketHashSet.Create();
begin
   inherited Create(@TMessageWebSocketHash32);
end;


type
   TStringStreamWebSocketWriter = class(TStringStreamWriter)
     private
      FWebSocket: TMessageWebSocket;
      FDone: Boolean;
     protected
      procedure ProcessValue(const Value: UTF8String); override;
     public
      constructor Create(WebSocket: TMessageWebSocket);
   end;

function TMessage.Reply(const Success: Boolean): TStringStreamWriter;
begin
   {$IFOPT C+} Assert(not Assigned(FReplyStream)); {$ENDIF}
   Result := TStringStreamWebSocketWriter.Create(FConnection);
   Result.WriteString('reply');
   Result.WriteCardinal(FConversationID);
   Result.WriteBoolean(Success);
   {$IFOPT C+} FReplyStream := Result; {$ENDIF}
end;

procedure TMessage.AutoSubscribe(Actor: TAbstractActor);
begin
   if (not FConnection.IsSubscribed(Actor)) then
   begin
      Actor.AutoSubscribe(FConnection);
      FConnection.Subscribe(Actor);
   end
   else
      Writeln('Tried to subscribe to ', Actor.ID, ' again');
end;

procedure TMessage.Subscribe(Actor: TAbstractActor);
begin
   if (not FConnection.IsSubscribed(Actor)) then
   begin
      Actor.Subscribe(FConnection);
      FConnection.Subscribe(Actor);
   end
   else
      Writeln('Tried to subscribe to ', Actor.ID, ' again');
end;

procedure TMessage.Unsubscribe(Actor: TAbstractActor);
begin
   if (FConnection.IsSubscribed(Actor)) then
   begin
      Actor.Unsubscribe(FConnection);
      FConnection.Unsubscribe(Actor);
   end
   else
      Writeln('Tried to unsubscribe from ', Actor.ID, ' without being subscribed');
end;

function TMessage.GetHandled(): Boolean;
begin
   Result := FStream.Ended;
end;


constructor TAbstractActor.Create(Dynasty: TAbstractDynasty; Settings: TAutoStorable);
begin
   inherited Create();
end;


constructor TAbstractFacility.Create(Actor: TAbstractActor; Settings: TAutoStorable);
begin
   inherited Create();
   Assert(Assigned(Actor));
end;


constructor TStringStreamWebSocketWriter.Create(WebSocket: TMessageWebSocket);
begin
   inherited Create();
   FWebSocket := WebSocket;
end;

procedure TStringStreamWebSocketWriter.ProcessValue(const Value: UTF8String);
begin
   Assert(not FDone);
   FWebSocket.WriteFrame(Value);
   {$IFOPT C+} FDone := True; {$ENDIF}
end;


procedure TMessageWebSocket.HandleMessage(s: UTF8String);
var
   ConversationID, TargetID: Cardinal;
   MessageName: UTF8String;
   Message: TMessage;
   Target: IMessageTarget;
   Error: TStringStreamWriter;
begin
   {$IFDEF DEBUG_NETWORK}
   Writeln();
   Writeln('Receiving on ', FSocketNumber, ': ', s);
   {$ENDIF}
   // read the message header
   Message.FStream := TStringStreamReader.Create(s);
   ConversationID := Message.Stream.ReadCardinal();
   TargetID := TActorID(Message.Stream.ReadCardinal());
   MessageName := Message.Stream.ReadString(TMessage.MaxMessageNameLength);
   // compile the message record
   Message.FName := MessageName;
   Message.FConversationID := ConversationID;
   Message.FConnection := Self;
   Message.FDynasty := FDynasty;
   {$IFOPT C+} Message.FReplyStream := nil; {$ENDIF}
   {$IFDEF DEBUG_NETWORK} Writeln('Interpreted as ', MessageName, ' message for actor ID ', TargetID, ' using conversation ID ', ConversationID); {$ENDIF}
   // dispatch the message
   Target := GetTarget(TargetID);
   if (Assigned(Target)) then
      Target.DispatchStr(Message)
   {$IFDEF DEBUG_NETWORK}
   else
      Writeln('Received message "', MessageName, '" for actor ', TargetID, ' from dynasty "', FDynasty.Name, '", but they can''t target messages to that actor');
   {$ELSE} ; {$ENDIF}
   if (not Message.Handled) then
   begin
      {$IFDEF DEBUG_NETWORK} Writeln('Didn''t properly handle message "', MessageName, '" to actor ', TargetID, '; or client sent bogus data'); {$ENDIF}
      Error := TStringStreamWebSocketWriter.Create(Self);
      Error.WriteString('error');
      Error.WriteCardinal(Message.FConversationID);
      Error.Close();
      Error.Free();
   end;
   {$IFOPT C+} Assert((not Assigned(Message.FReplyStream)) or ((Message.FReplyStream as TStringStreamWebSocketWriter).FDone)); {$ENDIF}
   {$IFOPT C+}
   if (Assigned(Message.FReplyStream)) then
      Message.FReplyStream.Free();
   {$ENDIF}
   Message.FStream.Free();
   {$IFDEF DEBUG_NETWORK} Writeln('Finished processing message...'); {$ENDIF}
end;

procedure TMessageWebSocket.ReportChange(Actor: TAbstractActor);
var
   Stream: TStringStreamWriter;
begin
   Stream := TStringStreamWebSocketWriter.Create(Self);
   Stream.WriteString('change');
   Stream.WriteCardinal(Actor.ID);
   Actor.ReportState(FDynasty, Stream);
   Stream.Close();
   Stream.Free();
end;

procedure TMessageWebSocket.ReportDeath(Actor: TAbstractActor);
var
   Stream: TStringStreamWriter;
begin
   Stream := TStringStreamWebSocketWriter.Create(Self);
   Stream.WriteString('death');
   Stream.WriteCardinal(Actor.ID);
   Stream.Close();
   Stream.Free();
end;

procedure TMessageWebSocket.SendNewsUpdate(Actor: TAbstractActor);
var
   Stream: TStringStreamWriter;
begin
   Actor.AutoSubscribe(Self);
   Subscribe(Actor);
   Stream := TStringStreamWebSocketWriter.Create(Self);
   Stream.WriteString('news');
   Actor.ReportIdentity(Stream);
   Stream.Close();
   Stream.Free();
end;

procedure TMessageWebSocket.SendDynastyUpdate();
var
   Stream: TStringStreamWriter;
begin
   Stream := TStringStreamWebSocketWriter.Create(Self);
   Stream.WriteString('dynasty');
   FDynasty.SendUpdate(Stream);
   Stream.Close();
   Stream.Free();
end;

{$IFDEF DEBUG}
procedure TMessageWebSocket.WriteFrame(const s: UTF8String);
begin
   {$IFDEF DEBUG_NETWORK} Writeln('Sending on ', FSocketNumber, ':', s); {$ENDIF}
   Sleep(100); // this is to simulate bad network conditions
   inherited;
end;

procedure TMessageWebSocket.Disconnect();
begin
   {$IFDEF DEBUG_NETWORK} Writeln('Disconnected ', FSocketNumber); {$ENDIF}
   inherited;
end;
{$ENDIF}

initialization
   Assert((Low(Cardinal) <= Low(THashTableSizeInt)) and (High(Cardinal) >= High(THashTableSizeInt)), 'THashTableSizeInt cannot be stored using Cardinal.'); {BOGUS Warning: Comparison might be always false due to range of constant and expression}
end.