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

//{$DEFINE ULTRAFASTMODE}
//{$DEFINE FASTMODE}
//{$DEFINE REPORTTICKTIME}

interface

// XXX should move the socket creation off the constructor path so that the game closes cleanly if
//     it is run while another instance already has the port

uses
   corenetwork, storable, rpc, actors, dynasties, facilities, techtree, gravity;

type
   TGame = class;

   TGameClient = class(TMessageWebSocket, IMessageTarget)
    private
      procedure Login(var Message: TMessage); message 'login';
      procedure CreateDynasty(var Message: TMessage); message 'create';
    protected
      FGame: TGame;
      // FDynasty is inherited. It's assumed we are subscribed to that. Dynasties never go away.
      FSubscriptions: TActorHashTable;
      function GetTarget(ID: TActorID): IMessageTarget; override;
    public
      constructor Create(Listener: TListenerSocket; Game: TGame);
      destructor Destroy(); override;
      function IsSubscribed(Actor: TAbstractActor): Boolean; override;
      procedure Subscribe(Actor: TAbstractActor); override;
      procedure Unsubscribe(Actor: TAbstractActor); override;
   end;

   TGameServer = class(TNetworkServer)
    protected
      FGame: TGame;
      function CreateNetworkSocket(ListenerSocket: TListenerSocket): TNetworkSocket; override;
    public
      constructor Create(Game: TGame);
   end;

   TGame = class(TAbstractGame)
    protected
      FGameID: Cardinal;
      FActors, FActorsNeedingCacheUpdates, FActorsNeedingNotifications, FDeadActors: TActorHashTable;
      FNeedTick, FNeedSave: Boolean;
      FDynasties: TDynastyHashTable;
      FUniverse: TGravitationalSystem;
      // FSun: TChildActor; // for hacky genesis
      FAborted: Boolean;
      FServer: TGameServer;
      FHighestID: TActorID;
      FUniverseFilename: RawByteString;
      FTechnologyTree: TTechnologyTreeManager;
      function GetDynasty(Username, Password: UTF8String): TAbstractDynasty;
      function CreateDynasty(Username, Password: UTF8String): TAbstractDynasty;
      procedure ExecuteBigBang();
      procedure ExecuteGenesis(Dynasty: TAbstractDynasty);
      function GetTarget(ID: TActorID; Dynasty: TAbstractDynasty): IMessageTarget;
      function GetTechnologyTree(): TAbstractTechnologyTreeManager; override;
    public
      constructor Create(UniverseFilename, TechTreeFilename: RawByteString);
      destructor Destroy(); override;
      constructor Read(Stream: TReadStream); override;
      procedure Write(Stream: TWriteStream); override;
      procedure Run();
      procedure Save();
      procedure MarkDirty(Actor: TAbstractActor; DirtyFlags: TDirtyFlags); override;
      procedure ReportChanges();
      procedure ReportDeaths(); // also frees them
      property Aborted: Boolean write FAborted;
      function GetID(): TActorID; override;
      procedure Register(Actor: TAbstractActor); override;
      procedure Unregister(Actor: TAbstractActor); override;
      procedure Kill(Actor: TAbstractActor); override;
      function GetBuildTarget(ID: TActorID; Dynasty: TAbstractDynasty): TAbstractActor; override;
      function GetGameID(): Cardinal; override;
   end;

implementation

uses
   exceptions, sysutils, math, spacemanagers;

constructor TGameClient.Create(Listener: TListenerSocket; Game: TGame);
begin
   inherited Create(Listener);
   FGame := Game;
   FSubscriptions := TActorHashTable.Create();
end;

destructor TGameClient.Destroy();
var
   Actor: TAbstractActor;
begin
   Assert(Assigned(FSubscriptions));
   for Actor in FSubscriptions.Values do
      Actor.Unsubscribe(Self);
   FSubscriptions.Free();
   if (Assigned(FDynasty)) then
      FDynasty.Unsubscribe(Self);
   inherited;
end;

function TGameClient.GetTarget(ID: TActorID): IMessageTarget;
begin
   Assert(Assigned(FGame));
   if (ID = 0) then
   begin
      if (Assigned(FDynasty)) then
         Result := FDynasty
      else
         Result := Self;
   end
   else
   begin
      if (Assigned(FDynasty)) then
         Result := FGame.GetTarget(ID, FDynasty)
      else
         Result := nil;
   end;
end;

procedure TGameClient.Login(var Message: TMessage);
var
   Username, Password: UTF8String;
begin
   if (not Assigned(FDynasty)) then
   begin
      Username := Message.Stream.ReadString();
      Password := Message.Stream.ReadString();
      if ((Message.Stream.ReadEnd()) and (Password <> '')) then
      begin
         FDynasty := FGame.GetDynasty(Username, Password);
         if (Assigned(FDynasty)) then
         begin
            FDynasty.Subscribe(Self);
            FDynasty.Login(Message);
            Exit;
         end;
      end;
   end;
   Message.Reply(False).Close();
end;

procedure TGameClient.CreateDynasty(var Message: TMessage);
var
   Username, Password: UTF8String;
begin
   if (not Assigned(FDynasty)) then
   begin
      Username := Message.Stream.ReadString();
      Password := Message.Stream.ReadString();
      if (Message.Stream.ReadEnd()) then
      begin
         FDynasty := FGame.CreateDynasty(Username, Password);
         FGame.ReportChanges(); // This flushes the changes so that we don't get notified of all the changes that our creation involved
         FGame.Save(); // This is an important event, so make sure we save it
         if (Assigned(FDynasty)) then
         begin
            FDynasty.Subscribe(Self);
            FDynasty.Login(Message);
            Exit;
         end;
      end;
   end;
   Message.Reply(False).Close();
end;

function TGameClient.IsSubscribed(Actor: TAbstractActor): Boolean;
begin
   Result := FSubscriptions.Has(Actor.ID);
end;

procedure TGameClient.Subscribe(Actor: TAbstractActor);
begin
   Assert(Assigned(FSubscriptions));
   Assert(not FSubscriptions.Has(Actor.ID));
   FSubscriptions[Actor.ID] := Actor;
end;

procedure TGameClient.Unsubscribe(Actor: TAbstractActor);
begin
   Assert(Assigned(FSubscriptions));
   Assert(FSubscriptions.Has(Actor.ID));
   FSubscriptions.Remove(Actor.ID);
end;



constructor TGameServer.Create(Game: TGame);
begin
   inherited Create(13534);
   FGame := Game;
end;

function TGameServer.CreateNetworkSocket(ListenerSocket: TListenerSocket): TNetworkSocket;
begin
   Result := TGameClient.Create(ListenerSocket, FGame);
end;


constructor TGame.Create(UniverseFilename, TechTreeFilename: RawByteString);
begin
   inherited Create();
   FGameID := Random(High(FGameID));
   Assert(not Assigned(TActor.Game));
   TActor.Game := Self;
   FUniverseFilename := UniverseFilename;
   FTechnologyTree := TTechnologyTreeManager.Create(TechTreeFilename);
   FActors := TActorHashTable.Create();
   FActorsNeedingCacheUpdates := TActorHashTable.Create();
   FActorsNeedingNotifications := TActorHashTable.Create();
   FDeadActors := TActorHashTable.Create();
   FDynasties := TDynastyHashTable.Create();
   ExecuteBigBang();
   FServer := TGameServer.Create(Self);
end;

destructor TGame.Destroy();
var
   Dynasty: TAbstractDynasty;
begin
   FServer.Free();
   FUniverse.Free();
   if (Assigned(FDynasties)) then
      for Dynasty in FDynasties.Values do
         Dynasty.Free();
   FDynasties.Free();
   FActors.Free();
   FActorsNeedingCacheUpdates.Free();
   FActorsNeedingNotifications.Free();
   FDeadActors.Free();
   FTechnologyTree.Free();
   TActor.Game := nil;
   inherited;
end;

constructor TGame.Read(Stream: TReadStream);
begin
   inherited;
   FGameID := Stream.ReadCardinal();
   Assert(not Assigned(TActor.Game));
   TActor.Game := Self;
   FUniverseFilename := Stream.Filename;
   FTechnologyTree := Stream.ReadObject() as TTechnologyTreeManager;
   FHighestID := Stream.ReadCardinal();
   FActors := TActorHashTable.Create();
   FActorsNeedingCacheUpdates := TActorHashTable.Create();
   FActorsNeedingNotifications := TActorHashTable.Create();
   FDeadActors := TActorHashTable.Create();
   FDynasties := TDynastyHashTable.Create();
   FDynasties.Read(Stream);
   FUniverse := Stream.ReadObject() as TGravitationalSystem;
   FServer := TGameServer.Create(Self);
end;

procedure TGame.Write(Stream: TWriteStream);
begin
   inherited;
   Stream.WriteCardinal(FGameID);
   Stream.WriteObject(FTechnologyTree);
   Stream.WriteCardinal(FHighestID);
   FDynasties.Write(Stream);
   Stream.WriteObject(FUniverse);
   // It is an intentional decision to not remember the time we last ticked
   // The universe is paused while the server is not running
end;

function TGame.GetTechnologyTree(): TAbstractTechnologyTreeManager;
begin
   Result := FTechnologyTree;
end;

procedure TGame.Run();
const
   ScaleFactor = {$IFDEF ULTRAFASTMODE} 365.25*24.0*20.0 // year per three minutes (will almost certainly peg the CPU)
               {$ELSE}{$IFDEF FASTMODE} 365.25*24.0*2.0 // year per half-hour
                                {$ELSE} 365.25*24.0 {$ENDIF}{$ENDIF}; // year per hour
   MinimumIntervalInSeconds = 10.0*60.0; // don't bother simulating less than 10 game-minutes at once
   MinimumIntervalInMilliseconds = MinimumIntervalInSeconds * 1000.0;
   MinimumIntervalInDays = MinimumIntervalInSeconds / kSecondsPerDay;
   MaximumIntervalInSeconds = 500.0*60.0; // simulate (and send updates to clients) at least once every 500 game-minutes
   MaximumIntervalInMilliseconds = MaximumIntervalInSeconds * 1000.0;
   MaximumIntervalInDays = MaximumIntervalInSeconds / kSecondsPerDay;
   SelectTimeout = Trunc(MaximumIntervalInMilliseconds/ScaleFactor);
var
   LastTime, ThisTime, NewTime, BeforeTick, AfterTick, TickLength, Interval, TotalTimeSimulated: TDateTime;
   Rate: Double;
   Dynasty: TAbstractDynasty;
begin
   Assert(MinimumIntervalInSeconds < MaximumIntervalInSeconds);
   {$IFNDEF ULTRAFASTMODE} Assert(Trunc(MaximumIntervalInMilliseconds/ScaleFactor) > 0, 'ScaleFactor is so big that we''d peg the CPU even just trying to do the maximum interval each tick'); {$ENDIF}
   Writeln('Server active. Game ID: ', FGameID, '. Attempting to tick at least every ', SelectTimeout, 'ms, and at most once per ', MinimumIntervalInMilliSeconds:0, 'ms, for a speed of ', ScaleFactor, ' in-game seconds per real-world second.');
   FNeedTick := True;
   TotalTimeSimulated := 0.0;
   LastTime := Now;
   repeat
      FServer.Select(SelectTimeout);
      ThisTime := Now;
      Interval := (ThisTime - LastTime) * ScaleFactor;
      if ((FNeedTick and (Interval > MinimumIntervalInDays)) or (Interval > MaximumIntervalInDays)) then
      begin
         FNeedTick := False;
         BeforeTick := Now;
         FUniverse.Tick(Interval);
         if (Assigned(FDynasties)) then
            for Dynasty in FDynasties.Values do
               Dynasty.Tick(Interval);
         TotalTimeSimulated := TotalTimeSimulated + Interval;
         AfterTick := Now;
         TickLength := AfterTick-BeforeTick;
         if (TickLength > 0) then
         begin
            Rate := Interval/TickLength;
         end
         else
         begin
            Rate := NaN;
         end;
         {$IFDEF REPORTTICKTIME} Writeln('Tick took ', (TickLength)*24*60*60*1000:8:0, 'ms wall-clock time to compute ', Interval*24*60:5:0, ' minutes game time ', {(total time simulated: ', (TotalTimeSimulated/365.25):2:3, ' years)', } ' -- computing at ', Rate:0:2, ' game time per wall-clock time'); {$ENDIF}
         Assert(not FNeedTick);
         NewTime := Now;
         if ((NewTime - ThisTime) > Interval) then
         begin
            Writeln('ALERT! Ticker took longer to tick than the time it processed. Pausing game for ', ((NewTime - ThisTime)*kSecondsPerDay/60.0):3:1, ' minutes.');
            LastTime := NewTime;
         end
         else
         begin
            LastTime := ThisTime;
         end;
      end;
      if (FActorsNeedingCacheUpdates.Count > 0) then
      begin
         BeforeTick := Now;
         UpdatePhysicalProperties();
         AfterTick := Now;
         {$IFDEF REPORTTICKTIME} Writeln('Updating caches took ', (AfterTick-BeforeTick)*24*60*60*1000:5:0, 'ms wall-clock time'); {$ENDIF}
         Assert(FActorsNeedingCacheUpdates.Count = 0);
      end;
      if (FActorsNeedingNotifications.Count > 0) then
      begin
         BeforeTick := Now;
         ReportChanges();
         AfterTick := Now;
         {$IFDEF REPORTTICKTIME} Writeln('Reporting changes took ', (AfterTick-BeforeTick)*24*60*60*1000:5:0, 'ms wall-clock time'); {$ENDIF}
         Assert(FActorsNeedingNotifications.Count = 0);
      end;
      if (FDeadActors.Count > 0) then
      begin
         BeforeTick := Now;
         ReportDeaths();
         AfterTick := Now;
         {$IFDEF REPORTTICKTIME} Writeln('Reporting deaths took ', (AfterTick-BeforeTick)*24*60*60*1000:5:0, 'ms wall-clock time'); {$ENDIF}
         Assert(FDeadActors.Count = 0);
      end;
      if (FNeedSave) then
      begin
         FNeedSave := False;
         BeforeTick := Now;
         Save();
         AfterTick := Now;
         {$IFDEF REPORTTICKTIME} Writeln('Saving universe took ', (AfterTick-BeforeTick)*24*60*60*1000:5:0, 'ms wall-clock time'); {$ENDIF}
         Assert(not FNeedSave);
      end;
   until FAborted;
   Writeln('Server aborted.');
end;

procedure TGame.Save();
begin
   StoreObjectToFile(FUniverseFilename, Self, 1);
end;

procedure TGame.MarkDirty(Actor: TAbstractActor; DirtyFlags: TDirtyFlags);
begin
   if (dfNeedTick in DirtyFlags) then
      FNeedTick := True;
   if (dfPhysicalPropertiesChanged in DirtyFlags) then
   begin
      // it's possible for Actor to already be in the list
      // e.g. if two different children invalidate their parents' cache in the same tick
      FActorsNeedingCacheUpdates[Actor.ID] := Actor;
   end;
   if (dfNeedNotifications in DirtyFlags) then
   begin
      // it's possible for Actor to already be in the list
      // e.g. if the player changes the settings of the actor on the same turn as the actor ticks in a meaningful way
      FActorsNeedingNotifications[Actor.ID] := Actor;
   end;
   if (dfNeedSave in DirtyFlags) then
      FNeedSave := True;
end;

procedure TGame.UpdatePhysicalProperties();
var
   Actor: TAbstractActor;
begin
   for Actor in FActorsNeedingCacheUpdates.Values do
      Actor.UpdatePhysicalProperties();
   FActorsNeedingCacheUpdates.Empty();
end;

procedure TGame.ReportChanges();
var
   Actor: TAbstractActor;
begin
   for Actor in FActorsNeedingNotifications.Values do
      Actor.ReportChanges();
   FActorsNeedingNotifications.Empty();
end;

procedure TGame.ReportDeaths();
var
   Actor: TAbstractActor;
   {$IFOPT C+} Ancestor: TAbstractTreeNode; {$ENDIF}   
   DeathRow: array of TAbstractActor;
   DeathRowCount, Index: Cardinal;
begin
   Assert(FDeadActors.Count > 0);
   SetLength(DeathRow, FDeadActors.Count);
   DeathRowCount := 0;
   for Actor in FDeadActors.Values do
   begin
      {$IFOPT C+}
      // Make sure this guy's subtree is disconnected
      Ancestor := Actor;
      while (Assigned(Ancestor.Parent)) do
         Ancestor := Ancestor.Parent;
      Assert(Ancestor <> FUniverse);
      {$ENDIF}
      Actor.ReportDeath();
      Unregister(Actor);
      // Remove actors that don't need to be freed
      if (not Assigned(Actor.Parent)) then
      begin
         DeathRow[DeathRowCount] := Actor;
         Inc(DeathRowCount);
      end;
   end;
   Assert(DeathRowCount > 0);
   FDeadActors.Empty();
   for Index := 0 to DeathRowCount-1 do
      DeathRow[Index].Free();
end;

function TGame.GetDynasty(Username, Password: UTF8String): TAbstractDynasty;
var
   Candidate: TAbstractDynasty;
begin
   Candidate := FDynasties[Username];
   if (Assigned(Candidate) and Candidate.Authenticate(Password)) then
      Result := Candidate
   else
      Result := nil;
end;

function TGame.CreateDynasty(Username, Password: UTF8String): TAbstractDynasty;
var
   Candidate: TAbstractDynasty;
begin
   Candidate := FDynasties[Username];
   if (not Assigned(Candidate)) then
   begin
      Result := TDynasty.Create(Username, Password);
      Assert(Result.Authenticate(Password));
      FDynasties[Username] := Result;
      ExecuteGenesis(Result);
   end
   else
   begin
      Result := nil;
   end;
end;

procedure TGame.ExecuteBigBang();
begin
   Assert(not Assigned(FUniverse));
   FUniverse := TGravitationalSystem.Create('The Galaxy');
end;

const
   AU = 149597871.0E3; // m

function GetRandomStar(Name: UTF8String): TMassiveActor;
type
   TStarClass = (O, A, B, F, G, K, M);
   TRange = record
      Min, Max: TGravitationalSystemValue;
   end;
const
   SolarMass = 1.9891E30; // kg
   SolarRadius = 6.96342E8; // m
   StarMassRanges: array[TStarClass] of TRange = (
      (Min: 15*SolarMass; Max: 90*SolarMass),
      (Min: 1.4*SolarMass; Max: 2.1*SolarMass),
      (Min: 2.1*SolarMass; Max: 16*SolarMass),
      (Min: 1.04*SolarMass; Max: 1.4*SolarMass),
      (Min: 0.8*SolarMass; Max: 1.04*SolarMass),
      (Min: 0.45*SolarMass; Max: 0.8*SolarMass),
      (Min: 0.075*SolarMass; Max: 0.45*SolarMass)
   );
   StarRadiusRanges: array[TStarClass] of TRange = (
      (Min: 6.6*SolarRadius; Max: 100*SolarRadius), // 100 is a guess
      (Min: 1.4*SolarRadius; Max: 1.8*SolarRadius),
      (Min: 1.8*SolarRadius; Max: 6.6*SolarRadius),
      (Min: 1.15*SolarRadius; Max: 1.4*SolarRadius),
      (Min: 0.96*SolarRadius; Max: 1.15*SolarRadius),
      (Min: 0.7*SolarRadius; Max: 0.96*SolarRadius),
      (Min: 0.08*SolarRadius; Max: 0.7*SolarRadius)
   );
var
   StarClass: TStarClass;
   Radius, Mass, Density: TGravitationalSystemValue;
begin
   case Random(1000) of
           0: StarClass := A; // (0.125% => 0.1%)
      1..  6: StarClass := B; // (0.625% => 0.6%)
      7.. 40: StarClass := F; // (3.03% => 3.3%)
     41..116: StarClass := G; // (7.5%)
    117..237: StarClass := K; // (12%)
    238..999: StarClass := M; // (76% => 76.1%)
    else
       Assert(False);
       StarClass := O; // (0.00003% => 0%)
   end;
   Radius := Random() * (StarRadiusRanges[StarClass].Max-StarRadiusRanges[StarClass].Min) + StarRadiusRanges[StarClass].Min;
   Mass := Random() * (StarMassRanges[StarClass].Max-StarMassRanges[StarClass].Min) + StarMassRanges[StarClass].Min;
   Density := 1.0/(4.0/3.0 * Pi * Radius * Radius * Radius / Mass);
   Result := TMassiveActor.Create(Name, '../images/sun-2.png', Radius, Density);
end;

procedure TGame.ExecuteGenesis(Dynasty: TAbstractDynasty);

   function PlaceStarSystem(SolarSystem: TGravitationalSystem; Name: UTF8String; DistanceFromStar: TGravitationalSystemValue; OtherStar: TMassiveActor; MaxPlanets: Cardinal): TMassiveActor;
   const
      MinStep = 1.4;
      MaxStep = 2.8;
      FurthestPlanetDistance = 80.0 * AU;
      MaxMoons = 5;
   var
      Distance, Radius: TGravitationalSystemValue;
      Star, Planet, Moon: TMassiveActor;
      PlanetCount, MoonCount: Cardinal;
      Clockwise, PlanetClockwiseOverride, MoonClockwiseOverride: Boolean;
   begin
      Star := GetRandomStar(Name);
      Clockwise := Random() > 0.5;
      SolarSystem.TeleportToOrbit(Star, DistanceFromStar, Clockwise, OtherStar);
      Distance := Star.Radius + 0.1 * AU + Random() * 0.4 * AU;
      PlanetCount := 0;
      while ((Distance < FurthestPlanetDistance) and (PlanetCount < MaxPlanets)) do
      begin
         if (Random() < 1.0 / Sqrt(PlanetCount+1)) then
         begin
            Inc(PlanetCount);
            Radius := Random() * 70E6;
            Planet := TOwnableActor.Create(Star.Name + ' ' + IntToStr(PlanetCount), '../images/planet-' + IntToStr(RandomRange(1,4)) + '.png', Radius, 1000+Random()*3000, Dynasty);
            Planet.AddFacility(TSpaceManagerFacility.Create(Planet, TUniformGrid.Create(Trunc(Log10(Radius)/3)+1, RandomRange(1, 5), Planet.Name + ' Surface', 'land')));
            PlanetClockwiseOverride := (Random() < 0.1);
            SolarSystem.TeleportToOrbit(Planet, Distance, Clockwise xor PlanetClockwiseOverride, Star);
            MoonCount := 0;
            while ((Random() < 0.5) and (MoonCount < MaxMoons)) do
            begin
               Inc(MoonCount);
               Moon := TOwnableActor.Create('Moon ' + IntToStr(MoonCount) + ' of ' + Star.Name + ' ' + IntToStr(PlanetCount), '../images/moon-1.png', Random() * 0.25 * Radius, 1000+Random()*3000, Dynasty);
               if (Random() < 0.1) then
                  Moon.AddFacility(TSpaceManagerFacility.Create(Moon, TUniformGrid.Create(RandomRange(1, 2), RandomRange(1, 2), Moon.Name + ' Surface', 'land')));
               MoonClockwiseOverride := (Random() < 0.1) xor PlanetClockwiseOverride;
               SolarSystem.TeleportToOrbit(Moon, Radius * (1.5 + Random() * 300), Clockwise xor MoonClockwiseOverride, Planet);
            end;
         end;
         Distance := Distance * (MinStep + Random() * (MaxStep-MinStep));
      end;
      Result := Star;
   end;

const
   SepMin = 1.0 * AU;
   SepMax = 100.0 * AU;
   GreekLetters: array[0..5] of UTF8String = ('Alpha', 'Beta', 'Gamma', 'Delta', 'Epsilon', 'Zeta'); // ...
var
   SolarSystem: TMassiveActor;
   SolarSystemInside: TGravitationalSystem;
   Star: TMassiveActor;
   HaveMore: Boolean;
   StarCount: Cardinal;
begin
   // Pick some random stars
   SolarSystemInside := TGravitationalSystem.Create(Dynasty.Name + ' Home System');
   // HaveMore := Random() < 0.333; // approximately 1/3 of the star systems in the Milky Way are binary or multiple
   HaveMore := False; // Home systems can't be multiple until I've made that work better
   if (not HaveMore) then
      Star := PlaceStarSystem(SolarSystemInside, Dynasty.Name, 0, nil, 12)
   else
      Star := PlaceStarSystem(SolarSystemInside, GreekLetters[0] + ' ' + Dynasty.Name, 0, nil, 4);
   if (HaveMore) then
   begin
      PlaceStarSystem(SolarSystemInside, GreekLetters[1] + ' ' + Dynasty.Name, Random()*(SepMax-SepMin)+SepMin, Star, 4);
      StarCount := 2;
      while ((Random() < 0.1) and (StarCount < Length(GreekLetters))) do
      begin
         PlaceStarSystem(SolarSystemInside, GreekLetters[StarCount] + ' ' + Dynasty.Name, Random()*(SepMax-SepMin)+SepMin, Star, 3);
         Inc(StarCount);
      end;
   end;
   SolarSystem := TMassiveActor.Create(SolarSystemInside.Name, '../images/sun-2.png', 1, 1); // XXX mass and density are bogus - eventually this should just work without us being explicit
   SolarSystem.AddFacility(TSpaceManagerFacility.Create(SolarSystem, SolarSystemInside));
   FUniverse.TeleportToOrbit(SolarSystem, 1E20, True, nil); // XXX should place them sanely somehow
end;

{
   SolarRadius = 6.96342E8; // m
   PhobosRadius = 11.1E3; // m
   JupiterRadius = 69.911E6; // m
   VenusRadius = 6.052E6; // m
   EarthRadius = 6.378E6; // m
   MoonRadius = 1.73710E6; // m
   MarsRadius = 3.397E6; // m
   SolarDensity = 1408; // kg/m^3
   PhobosDensity = 1876; // kg/m^3
   VenusDensity = 5243; // kg/m^3
   EarthDensity = 5520; // kg/m^3
   MoonDensity = 3346.4; // kg/m^3
   MarsDensity = 3933.5; // kg/m^3
   JupiterDensity = 1326; // kg/m^3
   SolarDistance = 0;
   PhobosDistance = 0.0000626827104*AU; // from Mars
   VenusDistance = 0.7*AU;
   EarthDistance = 1*AU;
   MoonDistance = 0.00257*AU; // from Earth
   MarsDistance = 1.5*AU;
   JupiterDistance = 779E9; // km

type
   TPlanetNameKind = (pnOpolis, pnCityOf);
const
   kLetters = ['a' .. 'z', 'A' .. 'Z'];
   kVowels = ['a', 'e', 'i', 'o', 'u', 'y', 'A', 'E', 'I', 'O', 'U', 'Y'];
   kConsonants = kLetters - kVowels;
var
   Name, ShortName: UTF8String;
   Index: Cardinal;
   NameKind: TPlanetNameKind;
begin
   Assert(Length(Dynasty.Name) > 0);
   if (Length(Dynasty.Name) > 1) then
      Name := AnsiUppercase(Dynasty.Name[1]) + Copy(Dynasty.Name, 2, Length(Dynasty.Name)-1)
   else
      Name := AnsiUppercase(Dynasty.Name);
   NameKind := pnCityOf;
   Index := Length(Name);
   while ((Index > 0) and (Name[Index] in kConsonants)) do
      Dec(Index);
   while ((Index > 0) and (Name[Index] in kVowels)) do
      Dec(Index);
   if (Index > 0) then
   begin
      ShortName := Name;
      SetLength(ShortName, Index);
      while ((Index > 0) and (Name[Index] in kLetters)) do
         Dec(Index);
      if (Index = 0) then
         NameKind := pnOpolis;
   end;
   case NameKind of
     pnOpolis: Name := ShortName + 'opolis';
     else Name := 'City of ' + Name;
   end;
end;


   FSun := TOwnableActor.Create('Sun', '../images/sun-2.png', SolarRadius, SolarDensity, nil);
   (FUniverse as TGravitationalSystem).TeleportToOrbit(FSun, 0, nil);

   // Earth
   Planet := TOwnableActor.Create(Name, '../images/planet-2.png', EarthRadius, EarthDensity, Dynasty);
   (FUniverse as TGravitationalSystem).TeleportToOrbit(Planet, EarthDistance, FSun);

   // Moon
   Moon := TOwnableActor.Create('Moon', '../images/moon-1.png', MoonRadius, MoonDensity, Dynasty);
   (FUniverse as TGravitationalSystem).TeleportToOrbit(Moon, MoonDistance, Planet);

   // Comms Satellite
   Moon := TOwnableActor.Create('Comms', '../images/rocket-isd.png', 5, 300 / 125, Dynasty); // 5m cube = 125m^3; 300kg
   (FUniverse as TGravitationalSystem).TeleportToOrbit(Moon, 42164e3, Planet);

   // Venus
   Planet := TOwnableActor.Create('Venus', '../images/planet-3.png', VenusRadius, VenusDensity, Dynasty);
   (FUniverse as TGravitationalSystem).TeleportToOrbit(Planet, VenusDistance, FSun);

   // Mars
   Planet := TOwnableActor.Create('Mars', '../images/planet-3.png', MarsRadius, MarsDensity, Dynasty);
   (FUniverse as TGravitationalSystem).TeleportToOrbit(Planet, MarsDistance, FSun);

   // Mars Moon
   Moon := TOwnableActor.Create('Phobos', '../images/moon-1.png', PhobosRadius, PhobosDensity, Dynasty);
   (FUniverse as TGravitationalSystem).TeleportToOrbit(Moon, PhobosDistance, Planet);

   // Jupiter
   Planet := TOwnableActor.Create('Jupiter', '../images/planet-1.png', JupiterRadius, JupiterDensity, Dynasty);
   (FUniverse as TGravitationalSystem).TeleportToOrbit(Planet, JupiterDistance, FSun);

//   Planet.AddFacility(TResearchFacility.Create(Planet, Dynasty));

}

function TGame.GetTarget(ID: TActorID; Dynasty: TAbstractDynasty): IMessageTarget;
var
   Actor: TAbstractActor;
begin
   if (not FActors.Has(ID)) then
   begin
      Result := nil;
      Exit;
   end;
   Actor := FActors[ID];
   // XXX check if they're allowed to know the actor exists in the first place
   Result := Actor;
end;

function TGame.GetID(): TActorID;
begin
   Inc(FHighestID);
   Result := FHighestID;
end;

function TGame.GetBuildTarget(ID: TActorID; Dynasty: TAbstractDynasty): TAbstractActor;
var
   Actor: TAbstractActor;
begin
   if (not FActors.Has(ID)) then
   begin
      Result := nil;
      Exit;
   end;
   Actor := FActors[ID];
   // XXX check if they're allowed to know the actor exists in the first place
   Result := Actor;
end;

function TGame.GetGameID(): Cardinal;
begin
   Result := FGameID;
end;

procedure TGame.Register(Actor: TAbstractActor);
begin
   Assert(not FActors.Has(Actor.ID));
   Assert(Actor.ID <= FHighestID);
   FActors[Actor.ID] := Actor;
   Writeln('Registering ', Actor.ID, ' (', Actor.ClassName, ' with name: "', Actor.Name, '")');
end;

procedure TGame.Unregister(Actor: TAbstractActor);
{$IFOPT C+}
var
   Ancestor: TAbstractTreeNode;
{$ENDIF}   
begin
   Assert(FActors.Has(Actor.ID));
   Assert(FActors[Actor.ID] = Actor);
   {$IFOPT C+}
   // Make sure this guy's subtree is disconnected
   Ancestor := Actor;
   while (Assigned(Ancestor.Parent)) do
      Ancestor := Ancestor.Parent;
   Assert(Ancestor <> FUniverse);
   {$ENDIF}
   FActors.Remove(Actor.ID);
   Writeln('Unregistering ', Actor.ID, ' (name: "', Actor.Name, '")');
end;

procedure TGame.Kill(Actor: TAbstractActor);
{$IFOPT C+}
var
   Ancestor: TAbstractTreeNode;
{$ENDIF}   
begin
   {$IFOPT C+}
   // Make sure this guy's subtree is disconnected
   Ancestor := Actor;
   while (Assigned(Ancestor.Parent)) do
      Ancestor := Ancestor.Parent;
   Assert(Ancestor <> FUniverse);
   if (Ancestor <> Actor) then
   begin
      Assert(Ancestor is TAbstractActor);
      Assert(FDeadActors.Has((Ancestor as TAbstractActor).ID))
   end
   else
   begin
      Assert(not FDeadActors.Has(Actor.ID));
   end;
   {$ENDIF}
   FDeadActors[Actor.ID] := Actor;
   Actor.KillChildren();
end;

initialization
   RegisterStorableClass(TGame);
end.