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

interface

uses
   storable, rpc, stringstream, actors;

type
   TDynasty = class(TAbstractDynasty) // @RegisterStorableClass
    private
      FCachedCountOfAvailableTechs: Cardinal;
      procedure ChangePassword(var Message: TMessage); message 'change-password';
      procedure Build(var Message: TMessage); message 'build';
    protected
      FName, FPassword: UTF8String;
      FActors: TActorHashTable;
      FNewsItems: TActorHashTable;
      FHome: TChildActor;
      FTechnologyTreeStatus: TTechnologyTreeNodeStatusArray;
      FUnlockedResearchTopics: TResearchTopicList; // cache
      FUnlockedTechnologies: TTechnologyTreeNodeArray; // cache
      FSubscribers: TMessageWebSocketHashSet;
      FDiscoveryWatchers: TDiscoveryWatcherHashTable;
      function GetName(): UTF8String; override;
      procedure NotifyUnlockWatchers(Actor: TAbstractActor; Kinds: TTechnologyTreeNodeKindSet);
      procedure UpdateUnlockedCaches();
      procedure ReportChanges(); // XXX maybe switch to a 'dirty' system and have the game invoke us
    public
      constructor Create(Username, Password: UTF8String);
      destructor Destroy(); override;
      constructor Read(Stream: TReadStream); override;
      procedure Write(Stream: TWriteStream); override;
      function Authenticate(const Password: UTF8String): Boolean; override;
      procedure Login(var Message: TMessage); override;
      procedure Subscribe(Connection: TMessageWebSocket); override;
      procedure Unsubscribe(Connection: TMessageWebSocket); override;
      procedure SendUpdate(Stream: TStringStreamWriter); override;
      procedure Adopt(Actor: TAbstractActor); override;
      procedure Divorce(Actor: TAbstractActor); override;
      procedure AddNewsItem(Actor: TAbstractActor); override;
      procedure AddDiscoveryWatcher(Watcher: PDiscoveryNotificationProc; Filter: TTechnologyTreeNodeKindSet); override;
      procedure RemoveDiscoveryWatcher(Watcher: PDiscoveryNotificationProc); override;
      function GetResearchTopics(): TResearchTopicList; override;
      function GetDefaultResearchTopic(): UTF8String; override;
      function VerifyResearchTopic(TopicName: UTF8String): Boolean; override;
      procedure DoSomeResearch(Actor: TAbstractActor; Interval: TDateTime; var ResearchPoints: TTechnologyPoints; TopicName: UTF8String; TimeStudied: TDateTime); override;
      procedure Tick(Interval: TDateTime); override;
   end;

implementation

uses
   exceptions, arrayutils;

constructor TDynasty.Create(Username, Password: UTF8String);
begin
   inherited Create();
   FName := Username;
   FPassword := Password;
   FActors := TActorHashTable.Create();
   FNewsItems := TActorHashTable.Create();
   FDiscoveryWatchers := TDiscoveryWatcherHashTable.Create();
   Assert(Assigned(TActor.Game));
   Assert(Assigned(TActor.Game.TechnologyTree));
   FTechnologyTreeStatus := TActor.Game.TechnologyTree.GetFreshTechTreeStatusArray();
   UpdateUnlockedCaches();
end;

destructor TDynasty.Destroy();
begin
   FSubscribers.Free();
   FDiscoveryWatchers.Free();
   FNewsItems.FreeObjects();
   FNewsItems.Free();
   FActors.Free();
   inherited;
end;

constructor TDynasty.Read(Stream: TReadStream);
var
   Index: Cardinal;
begin
   inherited;
   FName := Stream.ReadString();
   FPassword := Stream.ReadString();
   FActors := TActorHashTable.Create();
   FActors.ReadReferences(Stream);
   FNewsItems := TActorHashTable.Create();
   FNewsItems.ReadObjects(Stream);
   FDiscoveryWatchers := TDiscoveryWatcherHashTable.Create();
   Stream.ReadReference(@Pointer(FHome));
   SetLength(FTechnologyTreeStatus, Stream.ReadCardinal());
   if (Length(FTechnologyTreeStatus) > 0) then
   begin
      Assert(SizeOf(FTechnologyTreeStatus[0])*Length(FTechnologyTreeStatus) <= High(Cardinal));
      {$WARNINGS OFF} // turn off the type size mismatch warning on the next line
      Stream.ReadByteStream(FTechnologyTreeStatus[0], SizeOf(FTechnologyTreeStatus[0])*Length(FTechnologyTreeStatus));
      {$WARNINGS ON}
   end;
   // XXX rebuild this from the status array:
   SetLength(FUnlockedResearchTopics, Stream.ReadCardinal());
   if (Length(FUnlockedResearchTopics) > 0) then
      for Index := Low(FUnlockedResearchTopics) to High(FUnlockedResearchTopics) do
         FUnlockedResearchTopics[Index] := Stream.ReadString();
   SetLength(FUnlockedTechnologies, Stream.ReadCardinal());
   if (Length(FUnlockedTechnologies) > 0) then
      for Index := Low(FUnlockedTechnologies) to High(FUnlockedTechnologies) do
         FUnlockedTechnologies[Index] := Stream.ReadCardinal();
end;

procedure TDynasty.Write(Stream: TWriteStream);
var
   Index: Cardinal;
begin
   inherited;
   Stream.WriteString(FName);
   Stream.WriteString(FPassword);
   FActors.WriteReferences(Stream);
   FNewsItems.WriteObjects(Stream);
   Stream.WriteReference(FHome);
   Stream.WriteCardinal(Length(FTechnologyTreeStatus));
   if (Length(FTechnologyTreeStatus) > 0) then
   begin
      Assert(SizeOf(FTechnologyTreeStatus[0])*Length(FTechnologyTreeStatus) <= High(Cardinal));
      {$WARNINGS OFF} // turn off the type size mismatch warning on the next line
      Stream.WriteByteStream(FTechnologyTreeStatus[0], SizeOf(FTechnologyTreeStatus[0])*Length(FTechnologyTreeStatus));
      {$WARNINGS ON}
   end;
   // XXX rebuild this from the status array:
   Stream.WriteCardinal(Length(FUnlockedResearchTopics));
   if (Length(FUnlockedResearchTopics) > 0) then
      for Index := Low(FUnlockedResearchTopics) to High(FUnlockedResearchTopics) do
         Stream.WriteString(FUnlockedResearchTopics[Index]);
   Stream.WriteCardinal(Length(FUnlockedTechnologies));
   if (Length(FUnlockedTechnologies) > 0) then
      for Index := Low(FUnlockedTechnologies) to High(FUnlockedTechnologies) do
         Stream.WriteCardinal(FUnlockedTechnologies[Index]);
end;

function TDynasty.GetName(): UTF8String;
begin
   Result := FName;
end;

function TDynasty.Authenticate(const Password: UTF8String): Boolean;
begin
   Result := Password = FPassword;
end;

procedure TDynasty.Login(var Message: TMessage);
var
   Stream: TStringStreamWriter;
begin
   Stream := Message.Reply(True);
   Stream.WriteCardinal(TActor.Game.GetGameID());
   Stream.WriteString(FName);
   Assert(Assigned(FHome));
   Assert(Assigned(FHome.Parent));
   FHome.ReportIdentity(Stream);
   SendUpdate(Stream);
   Stream.Close();
   // the order of the following two statements is important
   // the client doesn't know what the parent is, so when it receives FHome it doesn't know
   // that it is going to receive the Parent already, so it asks for it again if we send
   // it FHome before we send it FHome.Parent.
   Message.AutoSubscribe(FHome.ParentActor);
   Message.AutoSubscribe(FHome);
end;

procedure TDynasty.ChangePassword(var Message: TMessage);
var
   NewPassword: UTF8String;
begin
   NewPassword := Message.Stream.ReadString();
   if (Message.Stream.ReadEnd()) then
   begin
      FPassword := NewPassword;
      Message.Reply(True).Close();
   end;
end;

procedure TDynasty.Build(var Message: TMessage);
var
   ID: TTechnologyTreeNodeIDOrNone;
   NewChild: TAbstractActor;
   NewParent: TAbstractActor;
   NewLocation: TAbstractLocation;
   Reply: TStringStreamWriter;
begin
   ID := TActor.Game.TechnologyTree.GetIDFor(Message.Stream.ReadString(), [tkTechnology]);
   NewParent := TActor.Game.GetBuildTarget(Message.Stream.ReadCardinal(), Self);
   if (Assigned(NewParent)) then
   begin
      NewLocation := NewParent.ParseLocationFromMessage(Message.Stream);
      if (Assigned(NewLocation)) then
      begin
         if (Message.Stream.ReadEnd()) then
         begin       
            try
               // XXX check for visibility
               // XXX check for ability to construct at that distance
               if ((ID <> kNone) and (FTechnologyTreeStatus[ID].PendingDependencies = 0)) then
               begin
                  // XXX check that Actor can be built on the same kind of environment as NewParent has
                  begin
                     NewChild := TActor.Game.TechnologyTree.Build(ID, Self);
                     if (Assigned(NewChild)) then
                     begin
                        if (NewParent.AddChild(NewChild, NewLocation)) then
                        begin
                           Reply := Message.Reply(True);
                           NewChild.ReportIdentity(Reply);
                           Reply.Close();
                           Message.AutoSubscribe(NewChild);
                           Exit;
                        end;
                        NewChild.Free();
                     end;
                  end;
               end;
            finally
               NewLocation.Free();
            end;
         end;
      end;
   end;
   // if we get this far, we failed
   Message.Stream.Bail();
   Message.Reply(False).Close();
end;

procedure TDynasty.Adopt(Actor: TAbstractActor);
begin
   Assert(Actor is TOwnableActor);
   Assert(not FActors.Has(Actor.ID));
   FActors[Actor.ID] := Actor;
   if (not Assigned(FHome)) then
      FHome := Actor as TChildActor; // XXX temporary until genesis is figured out and explicitly sets the home
end;

procedure TDynasty.Divorce(Actor: TAbstractActor);
begin
   Assert(Actor is TOwnableActor);
   Assert(FActors.Has(Actor.ID));
   FActors.Remove(Actor.ID);
   if (FHome = Actor) then
   begin
      Writeln('Lost ', Actor.Name, ' (home of ', FName, ')!');
      FHome := nil; // XXX yikes
   end;
end;

procedure TDynasty.AddNewsItem(Actor: TAbstractActor);
var
   Socket: TMessageWebSocket;
begin
   Assert(not FNewsItems.Has(Actor.ID));
   FNewsItems[Actor.ID] := Actor;
   if (Assigned(FSubscribers) and (FSubscribers.Count > 0)) then
   begin
      for Socket in FSubscribers do
         Socket.SendNewsUpdate(Actor);
   end;
   // XXX should track read vs unread news items
   // consider use case:
   //   log in using desktop, leave it logged in
   //   get notifications, which end up unread
   //   log in using laptop - all unread notifications should be rereceived!
end;

procedure TDynasty.Subscribe(Connection: TMessageWebSocket);
begin
   if (not Assigned(FSubscribers)) then
      FSubscribers := TMessageWebSocketHashSet.Create();
   {$IFOPT C+} Assert(Connection.Debug_Dynasty = Self); {$ENDIF}
   Assert(not FSubscribers.Has(Connection));
   FSubscribers.Add(Connection);
end;

procedure TDynasty.Unsubscribe(Connection: TMessageWebSocket);
begin
   Assert(Assigned(FSubscribers));
   FSubscribers.Remove(Connection);
   if (FSubscribers.Count = 0) then
   begin
      FSubscribers.Free();
      FSubscribers := nil;
   end;
end;

procedure TDynasty.ReportChanges();
var
   Socket: TMessageWebSocket;
begin
   if (Assigned(FSubscribers) and (FSubscribers.Count > 0)) then
      for Socket in FSubscribers do
         Socket.SendDynastyUpdate();
end;

procedure TDynasty.SendUpdate(Stream: TStringStreamWriter);
begin
   TActor.Game.TechnologyTree.DescribeTechnologies(FUnlockedTechnologies, Stream);
end;

procedure TDynasty.UpdateUnlockedCaches();
var
   ActualTopicCount, ActualTechnologyCount: Cardinal;

   procedure AddNode(const ID: TTechnologyTreeNodeID; const Name: UTF8String; const Kind: TTechnologyTreeNodeKind);
   begin
      if (FTechnologyTreeStatus[ID].PendingDependencies = 0) then
      begin
         if (Kind = tkTopic) then
         begin
            Assert(ActualTopicCount <= Length(FUnlockedResearchTopics));
            if (ActualTopicCount = Length(FUnlockedResearchTopics)) then
               SetLength(FUnlockedResearchTopics, Length(FUnlockedResearchTopics)+1);
            FUnlockedResearchTopics[ActualTopicCount] := Name;
            Inc(ActualTopicCount);
         end
         else
         if (Kind = tkTechnology) then
         begin
            Assert(ActualTechnologyCount <= Length(FUnlockedTechnologies));
            if (ActualTechnologyCount = Length(FUnlockedTechnologies)) then
               SetLength(FUnlockedTechnologies, Length(FUnlockedTechnologies)+1);
            FUnlockedTechnologies[ActualTechnologyCount] := ID;
            Inc(ActualTechnologyCount);
         end
         else
            Assert(False);
      end;
   end;

begin
   ActualTopicCount := 0;
   ActualTechnologyCount := 0;
   TActor.Game.TechnologyTree.FilterTechTree([tkTopic, tkTechnology], @AddNode);
   SetLength(FUnlockedResearchTopics, ActualTopicCount);
   SetLength(FUnlockedTechnologies, ActualTechnologyCount);
end;

function TDynasty.GetResearchTopics(): TResearchTopicList;
begin
   Result := FUnlockedResearchTopics;
end;

function TDynasty.GetDefaultResearchTopic(): UTF8String;
begin
   Assert(Length(FUnlockedResearchTopics) > 0); // should really test for this in the techtree parser
   Result := FUnlockedResearchTopics[0];
end;

function TDynasty.VerifyResearchTopic(TopicName: UTF8String): Boolean;
var
   Index: TTechnologyTreeNodeIDOrNone;
begin
   Index := TActor.Game.TechnologyTree.GetIDFor(TopicName, [tkTopic]);
   Result := (Index <> kNone) and (FTechnologyTreeStatus[Index].PendingDependencies = 0);
end;

procedure TDynasty.DoSomeResearch(Actor: TAbstractActor; Interval: TDateTime; var ResearchPoints: TTechnologyPoints; TopicName: UTF8String; TimeStudied: TDateTime);
const
   // this nonsense is so that we can ensure that when we start a tick, all the research stations know everything that
   // is going to get unlocked this tick, so that the game doesn't change if the ticks get slower or faster
   MinimumTimeUnlockedBeforeBreakthroughInSeconds = 48 * 60 * 60; // two in-game days
   MinimumTimeUnlockedBeforeBreakthroughInDays = MinimumTimeUnlockedBeforeBreakthroughInSeconds / kSecondsPerDay;

type
   TAvailableTechData = record
      ID: TTechnologyTreeNodeID;
      PointsNeeded, Lambda: Double;
   end;

var
   Topic: TTechnologyTreeNodeIDOrNone;
   AvailableTechnologies: array of TAvailableTechData;
   ActualCountOfAvailableTechnologies: Cardinal;

   procedure ConsiderResearching(const ID: TTechnologyTreeNodeID; const Name: UTF8String; const Kind: TTechnologyTreeNodeKind);
   var
      PointsNeeded: TTechnologyPoints;
      Lambda: Double;
   begin
      if ((FTechnologyTreeStatus[ID].PendingDependencies = 0) and 
          (not FTechnologyTreeStatus[ID].Discovered) and 
          (FTechnologyTreeStatus[ID].TimeSinceUnlocked > MinimumTimeUnlockedBeforeBreakthroughInDays)) then
      begin
         PointsNeeded := TActor.Game.TechnologyTree.GetPointsForBreakthrough(ID, FTechnologyTreeStatus, Topic, TimeStudied, Interval, Lambda);
         if (ResearchPoints >= PointsNeeded) then
         begin
            Inc(ActualCountOfAvailableTechnologies);
            if (ActualCountOfAvailableTechnologies > Length(AvailableTechnologies)) then
               SetLength(AvailableTechnologies, Length(AvailableTechnologies)*2+1); // +1 is so that it still works if we had 0 before
            AvailableTechnologies[ActualCountOfAvailableTechnologies-1].ID := ID;
            AvailableTechnologies[ActualCountOfAvailableTechnologies-1].PointsNeeded := PointsNeeded;
            AvailableTechnologies[ActualCountOfAvailableTechnologies-1].Lambda := Lambda;
         end;
      end;
   end;

var
   Index: Cardinal;
   DieRoll, Probability: Double;
   UnlockedKinds: TTechnologyTreeNodeKindSet;
begin
   if (Interval > MinimumTimeUnlockedBeforeBreakthroughInDays) then
      Writeln('Warning: Tick interval (', (Interval*kSecondsPerDay):0:1, ' seconds) is greater than the minimum time that a tech has to be unlocked before it can be discovered (', MinimumTimeUnlockedBeforeBreakthroughInSeconds, ' seconds), which means that technology discovery may become slower than intended.');
   Topic := TActor.Game.TechnologyTree.GetIDFor(TopicName, [tkTopic]);
   Assert((TopicName = '') = (Topic = kNone));
   ActualCountOfAvailableTechnologies := 0;
   SetLength(AvailableTechnologies, FCachedCountOfAvailableTechs);
   TActor.Game.TechnologyTree.FilterTechTree([tkBreakthrough], @ConsiderResearching); // this fill the list
   if (ActualCountOfAvailableTechnologies > 0) then
   begin
      FisherYatesShuffle(AvailableTechnologies[0], ActualCountOfAvailableTechnologies, SizeOf(AvailableTechnologies[0]));
      UnlockedKinds := [];
      for Index := 0 to ActualCountOfAvailableTechnologies-1 do
      begin
         if (AvailableTechnologies[Index].PointsNeeded <= ResearchPoints) then
         begin
            DieRoll := Random();
            // http://en.wikipedia.org/wiki/Exponential_distribution
            Probability := 1-(Exp(-AvailableTechnologies[Index].Lambda*Interval));
            if (DieRoll <= Probability) then
            begin
               UnlockedKinds := UnlockedKinds + TActor.Game.TechnologyTree.Discover(AvailableTechnologies[Index].ID, FTechnologyTreeStatus, Self);
               ResearchPoints := ResearchPoints - AvailableTechnologies[Index].PointsNeeded;
            end;
         end;
      end;
      if (UnlockedKinds <> []) then
      begin
         if ((tkTopic in UnlockedKinds) or (tkTechnology in UnlockedKinds)) then
            UpdateUnlockedCaches();
         NotifyUnlockWatchers(Actor, UnlockedKinds);
         if (tkTechnology in UnlockedKinds) then
            ReportChanges();
      end;
   end;
   FCachedCountOfAvailableTechs := Length(AvailableTechnologies);
end;

procedure TDynasty.Tick(Interval: TDateTime);
var
   Index: Cardinal;
begin
   for Index := Low(FTechnologyTreeStatus) to High(FTechnologyTreeStatus) do
   begin
      if (FTechnologyTreeStatus[Index].PendingDependencies = 0) then
         FTechnologyTreeStatus[Index].TimeSinceUnlocked := FTechnologyTreeStatus[Index].TimeSinceUnlocked + Interval;
   end;
end;

procedure TDynasty.AddDiscoveryWatcher(Watcher: PDiscoveryNotificationProc; Filter: TTechnologyTreeNodeKindSet);
begin
   Assert(Assigned(Watcher^));
   Assert(not FDiscoveryWatchers.Has(Watcher));
   FDiscoveryWatchers[Watcher] := Filter;
   Assert(FDiscoveryWatchers.Has(Watcher));
end;

procedure TDynasty.RemoveDiscoveryWatcher(Watcher: PDiscoveryNotificationProc);
begin
   Assert(Assigned(Watcher^));
   Assert(FDiscoveryWatchers.Has(Watcher));
   FDiscoveryWatchers.Remove(Watcher);
end;

procedure TDynasty.NotifyUnlockWatchers(Actor: TAbstractActor; Kinds: TTechnologyTreeNodeKindSet);
var
   Watcher: PDiscoveryNotificationProc;
begin
   for Watcher in FDiscoveryWatchers do
      if (FDiscoveryWatchers[Watcher] * Kinds <> []) then
      begin
         Assert(Assigned(Watcher^));
         Watcher^(Actor, Kinds);
      end;
end;

initialization
{$INCLUDE registrations/dynasties.inc}
end.