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

interface

uses
   storable, autostorable, stringstream, tokenutils, rpc, actors, facilities;

type
   TSpaceManager = class abstract (TPhysicalActor)
     protected
      procedure UpdatePhysicalPropertiesFromChildren(); virtual; abstract;
     public
      procedure RemoveChild(const OldChild: TAbstractTreeNode); override;
      function AddChild(const NewChild: TAbstractTreeNode; const Location: TAbstractLocation): Boolean; override;
   end;
   TSpaceManagerClass = class of TSpaceManager;

type
   TGridCoordinate = Byte;

   TAbstractGridSettings = class(TActorSettings) // @RegisterStorableClass
    private
      FWidth, FHeight: TGridCoordinate;
    published
      property Width: TGridCoordinate read FWidth write FWidth;
      property Height: TGridCoordinate read FHeight write FHeight;
   end;

   TAbstractGrid = class(TSpaceManager) // @RegisterActorClass
    protected
      type
       PGridCell = ^TGridCell;
       TGridCell = record
         Environment: UTF8String;
         // XXX ... more surface data ...
         Actor: TAbstractActor;
       end;
      var
       FWidth, FHeight: TGridCoordinate;
       FGrid: array of TGridCell;
      function GetRendererClass(): UTF8String; override;
      class function CreateSettings(): TAutoStorable; override;
      procedure SetMetrics(Width, Height: TGridCoordinate);
      procedure Terraform(Settings: TAbstractGridSettings); virtual; abstract;
      function GetRadius(): TGravitationalSystemValue; override;
      function GetMass(): TGravitationalSystemValue; override;
      procedure AddPhysicalProperties(Target: PPhysicalProperties); override;
    public
      constructor Create(Dynasty: TAbstractDynasty; Settings: TAutoStorable); override; overload;
      destructor Destroy(); override;
      constructor Read(Stream: TReadStream); override;
      procedure Write(Stream: TWriteStream); override;
      class function ParseSettings(Tokens: TTokenArray; var Index: Cardinal; var ErrorMessage: TErrorString): TAutoStorable; override;
      procedure ReportState(Dynasty: TAbstractDynasty; Stream: TStringStreamWriter); override;
      procedure Tick(Interval: TDateTime); override;
      function ParseLocationFromMessage(Stream: TStringStreamReader): TAbstractLocation; override;
      procedure RemoveChild(const OldChild: TAbstractTreeNode); override;
      function AddChild(const NewChild: TAbstractTreeNode; const Location: TAbstractLocation): Boolean; override;
      procedure KillChildren(); override;
   end;

   TLandscapeGridSettings = class(TAbstractGridSettings) // @RegisterStorableClass
   end;

   TLandscapeGrid = class(TAbstractGrid) // @RegisterActorClass
    protected
      class function CreateSettings(): TAutoStorable; override;
      procedure Terraform(Settings: TAbstractGridSettings); override;
    public
      class function ParseSettings(Tokens: TTokenArray; var Index: Cardinal; var ErrorMessage: TErrorString): TAutoStorable; override;
   end;

   TUniformGridSettings = class(TAbstractGridSettings) // @RegisterStorableClass
    private
      FEnvironment: UTF8String;
    published
      property Environment: UTF8String read FEnvironment write FEnvironment;
   end;

   TUniformGrid = class(TAbstractGrid) // @RegisterActorClass
    protected
      class function CreateSettings(): TAutoStorable; override;
      procedure Terraform(Settings: TAbstractGridSettings); override;
    public
      constructor Create(Width, Height: TGridCoordinate; AName: UTF8String; Environment: UTF8String); overload; deprecated 'For hacky genesis only';
      class function ParseSettings(Tokens: TTokenArray; var Index: Cardinal; var ErrorMessage: TErrorString): TAutoStorable; override;
   end;

   TSpaceManagerFacilitySettings = class(TAutoStorable) // @RegisterStorableClass
    private
      FSpaceManagerClass: TSpaceManagerClass;
      FSpaceManagerSettings: TAutoStorable;
    public
      destructor Destroy(); override;
    published
      property SpaceManagerClass: TSpaceManagerClass read FSpaceManagerClass write FSpaceManagerClass;
      property SpaceManagerSettings: TAutoStorable read FSpaceManagerSettings write FSpaceManagerSettings;
   end;

   TSpaceManagerFacility = class(TFacility) // @RegisterFacilityClass
     protected
      FContents: TSpaceManager;
      class function GetHasPhysicalProperty(): Boolean; override;
     public
      constructor Create(Actor: TAbstractActor; Contents: TSpaceManager); overload; deprecated 'For hacky genesis only.';
      constructor Create(Actor: TAbstractActor; Settings: TAutoStorable); override; overload;
      constructor Read(Stream: TReadStream); override;
      procedure Write(Stream: TWriteStream); override;
      class function ParseSettings(Tokens: TTokenArray; var Index: Cardinal; var ErrorMessage: TErrorString): TAutoStorable; override;
      procedure Tick(Interval: TDateTime); override;
      // XXX we don't yet support the parent actor's dynasty changing
      procedure KillChildren(Game: TAbstractGame); override;
     published
      property Contents: TSpaceManager read FContents;
   end;

implementation

uses
   sysutils, exceptions;

procedure TSpaceManager.RemoveChild(const OldChild: TAbstractTreeNode);
begin
   // subclass is responsible for actually forgetting that OldChild was a child
   // subclass should do this before calling us
   Assert(Assigned(OldChild));
   Assert(Assigned(OldChild.Parent));
   Assert(OldChild.Parent = Self, 'tried to remove a child from an object that wasn''t its parent');
   OldChild.Parent := nil;
   if (OldChild.Independent) then
   begin
      MarkDirty([dfNeedSave, dfNeedNotifications]);
   end
   else
   begin
      MarkDirty([dfNeedSave, dfNeedNotifications, dfPhysicalPropertiesChanged]);
   end;
end;

function TSpaceManager.AddChild(const NewChild: TAbstractTreeNode; const Location: TAbstractLocation): Boolean;
begin
   Assert(Assigned(NewChild));
   if (Assigned(NewChild.Parent)) then
      NewChild.Parent.RemoveChild(NewChild);
   NewChild.Parent := Self;
   if (NewChild.Independent) then
   begin
      MarkDirty([dfNeedSave, dfNeedNotifications]);
   end
   else
   begin
      MarkDirty([dfNeedSave, dfNeedNotifications, dfPhysicalPropertiesChanged]);
   end;
   Result := True;
   // subclass is responsible for actually remembering that NewChild is a child
end;

procedure TSpaceManager.UpdatePhysicalProperties();
begin
   if (
end;


constructor TAbstractGrid.Create(Dynasty: TAbstractDynasty; Settings: TAutoStorable);
begin
   inherited;
   Assert(Settings is TAbstractGridSettings);
   SetMetrics((Settings as TAbstractGridSettings).Width, (Settings as TAbstractGridSettings).Height);
   Terraform(Settings as TAbstractGridSettings);
end;

destructor TAbstractGrid.Destroy();
var
   Index: Cardinal;
begin
   if (Length(FGrid) > 0) then
      for Index := Low(FGrid) to High(FGrid) do
         if (Assigned(FGrid[Index].Actor)) then
            FGrid[Index].Actor.Free();
   inherited;
end;

constructor TAbstractGrid.Read(Stream: TReadStream);
var
   X, Y: TGridCoordinate;
begin
   inherited;
   SetMetrics(Stream.ReadCardinal() { Width }, Stream.ReadCardinal() { Height });
   Assert(FHeight > 0);
   Assert(FWidth > 0);
   for Y := 0 to FHeight-1 do
      for X := 0 to FWidth-1 do
      begin
         FGrid[Y*FWidth+X].Environment := Stream.ReadString();
         // XXX ... more surface data ...
         FGrid[Y*FWidth+X].Actor := Stream.ReadObject() as TChildActor;
      end;
end;

procedure TAbstractGrid.Write(Stream: TWriteStream);
var
   X, Y: TGridCoordinate;
begin
   inherited;
   Stream.WriteCardinal(FWidth);
   Stream.WriteCardinal(FHeight);
   Assert(FHeight > 0);
   Assert(FWidth > 0);
   for Y := 0 to FHeight-1 do
      for X := 0 to FWidth-1 do
      begin
         Stream.WriteString(FGrid[Y*FWidth+X].Environment);
         // XXX ... more surface data ...
         Stream.WriteObject(FGrid[Y*FWidth+X].Actor);
      end;
end;

class function TAbstractGrid.CreateSettings(): TAutoStorable;
begin
   Result := TAbstractGridSettings.Create();
end;

class function TAbstractGrid.ParseSettings(Tokens: TTokenArray; var Index: Cardinal; var ErrorMessage: TErrorString): TAutoStorable;

   function GetDim(SettingName: UTF8String): TGridCoordinate;
   var
      Value: Integer;
   begin
      Result := 0;
      if (Index >= Length(Tokens)) then
      begin
         ErrorMessage := 'Missing ' + SettingName + ' setting';
      end
      else
      if (Tokens[Index].TokenType <> ttInteger) then
      begin
         ErrorMessage := 'Non-numeric ' + SettingName + ' setting';
      end
      else
      begin
         Value := Tokens[Index].IntegerValue;
         Inc(Index);
         if (Value < Low(TGridCoordinate)) then
            ErrorMessage := 'Setting ' + SettingName + ' is too low; minimum is ' + IntToStr(Low(TGridCoordinate))
         else
         if (Value > High(TGridCoordinate)) then
            ErrorMessage := 'Setting ' + SettingName + ' is too high; maximum is ' + IntToStr(High(TGridCoordinate))
         else
            Result := Value;
      end;
   end;

begin
   Result := inherited;
   if (Assigned(Result)) then
   begin
      Assert(ErrorMessage = '');
      Assert(Result is TAbstractGridSettings);
      (Result as TAbstractGridSettings).Width := GetDim('width');
      if (ErrorMessage = '') then
         (Result as TAbstractGridSettings).Height := GetDim('height');
      if (ErrorMessage <> '') then
      begin
         Result.Free();
         Result := nil;
      end;
   end
   else
      Assert(ErrorMessage <> '');
end;

procedure TAbstractGrid.SetMetrics(Width, Height: TGridCoordinate);
begin
   FWidth := Width;
   FHeight := Height;
   SetLength(FGrid, FWidth*FHeight);
end;

function TAbstractGrid.GetRadius(): TGravitationalSystemValue;
begin
   Result := 0; // XXX
end;

function TAbstractGrid.GetMass(): TGravitationalSystemValue;
begin
   Result := 0; // XXX
end;

procedure TAbstractGrid.Tick(Interval: TDateTime);
var
   X, Y: TGridCoordinate;
begin
   inherited;
   Assert(FHeight > 0);
   Assert(FWidth > 0);
   for Y := 0 to FHeight-1 do
      for X := 0 to FWidth-1 do
      begin
         if (Assigned(FGrid[Y*FWidth+X].Actor)) then
            FGrid[Y*FWidth+X].Actor.Tick(Interval);
      end;
end;

procedure TAbstractGrid.ReportState(Dynasty: TAbstractDynasty; Stream: TStringStreamWriter);
var
   X, Y: TGridCoordinate;
   GridCell: PGridCell;
begin
   inherited;
   Stream.WriteCardinal(FWidth);
   Stream.WriteCardinal(FHeight);
   for Y := 0 to FHeight-1 do
      for X := 0 to FWidth-1 do
      begin
         GridCell := @FGrid[Y*FWidth+X];
         // XXX check for visibiliy, then:
         begin
            Stream.WriteString(GridCell^.Environment);
            // XXX ... more surface data ...
            if (Assigned(GridCell^.Actor)) then
            begin
               Stream.WriteBoolean(True);
               GridCell^.Actor.ReportIdentity(Stream);
            end
            else
            begin
               Stream.WriteBoolean(False);
            end;
         end;
      end;
end;

type
   TGridLocation = class(TAbstractLocation)
    private
     X, Y: TGridCoordinate;
   end;

function TAbstractGrid.ParseLocationFromMessage(Stream: TStringStreamReader): TAbstractLocation;
var
   X, Y: Cardinal;
begin
   X := Stream.ReadCardinal();
   if (X >= FWidth) then
      X := 0;
   Y := Stream.ReadCardinal();
   if (Y >= FHeight) then
      Y := 0;
   Result := TGridLocation.Create();
   (Result as TGridLocation).X := X;
   (Result as TGridLocation).Y := Y;
end;

procedure TAbstractGrid.RemoveChild(const OldChild: TAbstractTreeNode);
var
   X, Y: Cardinal;
   GridCell: PGridCell;
begin
   for Y := 0 to FHeight-1 do
      for X := 0 to FWidth-1 do
      begin
         GridCell := @FGrid[Y*FWidth+X];
         if (GridCell^.Actor = OldChild) then
         begin
            GridCell^.Actor := nil;
            inherited;
            Exit;
         end;
      end;
   Assert(False, 'tried to remove actor that wasn''t child');
end;

function TAbstractGrid.AddChild(const NewChild: TAbstractTreeNode; const Location: TAbstractLocation): Boolean;
var
   RealLocation: TGridLocation;
begin
   Assert(Location is TGridLocation);
   RealLocation := Location as TGridLocation;
   if (Assigned(NewChild) and (not Assigned(FGrid[RealLocation.Y*FWidth+RealLocation.X].Actor)) and (NewChild is TChildActor)) then
   begin
      FGrid[RealLocation.Y*FWidth+RealLocation.X].Actor := NewChild as TChildActor;
      Result := inherited AddChild(NewChild, Location);
   end
   else
      Result := False;
end;

function TAbstractGrid.GetRendererClass(): UTF8String;
begin
   Result := 'grid';
end;

procedure TAbstractGrid.KillChildren();
var
   X, Y: Cardinal;
   GridCell: PGridCell;
begin
   inherited;
   Assert(FHeight > 0);
   Assert(FWidth > 0);
   for Y := 0 to FHeight-1 do
      for X := 0 to FWidth-1 do
      begin
         GridCell := @FGrid[Y*FWidth+X];
         if (Assigned(GridCell^.Actor)) then
            Game.Kill(GridCell^.Actor);
      end;
end;

procedure TAbstractGrid.AddPhysicalProperties(Target: PPhysicalProperties);
begin
   inherited;
   if (Length(FGrid) > 0) then
      for Index := Low(FGrid) to High(FGrid) do
         if (Assigned(FGrid[Index].Actor) and not FGrid[Index].Actor.Independent) then
            FGrid[Index].Actor.ApplyPhysicalProperties(Target);
end;


class function TLandscapeGrid.CreateSettings(): TAutoStorable;
begin
   Result := TLandscapeGridSettings.Create();
end;

procedure TLandscapeGrid.Terraform(Settings: TAbstractGridSettings);
begin
   XXX;
end;

class function TLandscapeGrid.ParseSettings(Tokens: TTokenArray; var Index: Cardinal; var ErrorMessage: TErrorString): TAutoStorable;
begin
   Result := inherited;
   XXX;
end;


constructor TUniformGrid.Create(Width, Height: TGridCoordinate; AName: UTF8String; Environment: UTF8String);
var
   X, Y: TGridCoordinate;
begin
   inherited Create(AName);
   SetMetrics(Width, Height);
   Assert(FHeight > 0);
   Assert(FWidth > 0);
   for Y := 0 to FHeight-1 do
      for X := 0 to FWidth-1 do
      begin
         FGrid[Y*FWidth+X].Environment := Environment;
         // XXX ... more surface data ...
      end;
end;

class function TUniformGrid.CreateSettings(): TAutoStorable;
begin
   Result := TUniformGridSettings.Create();
end;

procedure TUniformGrid.Terraform(Settings: TAbstractGridSettings);
var
   X, Y: TGridCoordinate;
   Environment: UTF8String;
begin
   Environment := (Settings as TUniformGridSettings).Environment;
   Assert(FHeight > 0);
   Assert(FWidth > 0);
   for Y := 0 to FHeight-1 do
      for X := 0 to FWidth-1 do
      begin
         FGrid[Y*FWidth+X].Environment := Environment;
         // XXX ... more surface data ...
      end;
end;

class function TUniformGrid.ParseSettings(Tokens: TTokenArray; var Index: Cardinal; var ErrorMessage: TErrorString): TAutoStorable;
begin
   Result := inherited;
   if (Assigned(Result)) then
   begin
      Assert(ErrorMessage = '');
      Assert(Result is TUniformGridSettings);
      if (Index >= Length(Tokens)) then
      begin
         ErrorMessage := 'Cell kind setting missing';
      end
      else
      if (Tokens[Index].TokenType <> ttString) then
      begin
         ErrorMessage := 'Cell kind setting needs to be a string like "land" or some such';
      end
      else
      begin
         (Result as TUniformGridSettings).Environment := Tokens[Index].StringValue^;
      end;
      Inc(Index);
      if (ErrorMessage <> '') then
      begin
         Result.Free();
         Result := nil;
      end;
   end
   else
      Assert(ErrorMessage <> '');
end;


destructor TSpaceManagerFacilitySettings.Destroy();
begin
   SpaceManagerSettings.Free();
   inherited;
end;


constructor TSpaceManagerFacility.Create(Actor: TAbstractActor; Contents: TSpaceManager);
begin
   inherited Create(Actor);
   FContents := Contents;
   AddChild(FContents, nil);
end;

constructor TSpaceManagerFacility.Create(Actor: TAbstractActor; Settings: TAutoStorable);
var
   Dynasty: TAbstractDynasty;
begin
   inherited Create(Actor);
   Assert(Settings is TSpaceManagerFacilitySettings);
   if (Actor is TOwnableActor) then
      Dynasty := (Actor as TOwnableActor).CurrentOwnerDynasty
   else
      Dynasty := nil;
   FContents := (Settings as TSpaceManagerFacilitySettings).SpaceManagerClass.Create(Dynasty, (Settings as TSpaceManagerFacilitySettings).SpaceManagerSettings);
   AddChild(FContents, nil);
end;

constructor TSpaceManagerFacility.Read(Stream: TReadStream);
begin
   inherited;
   FContents := Stream.ReadObject() as TSpaceManager;
end;

procedure TSpaceManagerFacility.Write(Stream: TWriteStream);
begin
   inherited;
   Stream.WriteObject(FContents);
end;

class function TSpaceManagerFacility.ParseSettings(Tokens: TTokenArray; var Index: Cardinal; var ErrorMessage: TErrorString): TAutoStorable;
var
   SpaceManagerClass: TClass;
   SpaceManagerSettings: TAutoStorable;
begin
   Result := nil;
   if (Index >= Length(Tokens)) then
   begin
      ErrorMessage := 'Missing TSpaceManager class name';
      Exit;
   end;
   if (Tokens[Index].TokenType <> ttString) then
   begin
      ErrorMessage := 'Unexpected token in place of TSpaceManager class name';
      Exit;
   end;
   SpaceManagerClass := GetActorClass(Tokens[Index].StringValue^);
   if (not Assigned(SpaceManagerClass)) then
   begin
      ErrorMessage := 'Class name ' + Tokens[Index].StringValue^ + ' not known';
      Exit;
   end;
   if (not SpaceManagerClass.InheritsFrom(TSpaceManager)) then
   begin
      ErrorMessage := 'Class ' + Tokens[Index].StringValue^ + ' is not a TSpaceManager';
      Exit;
   end;
   Inc(Index);
   SpaceManagerSettings := TSpaceManagerClass(SpaceManagerClass).ParseSettings(Tokens, Index, ErrorMessage);
   if (ErrorMessage <> '') then
   begin
      Assert(not Assigned(SpaceManagerSettings));
      // add info to ErrorMessage here if necessary
      Exit;
   end;
   Result := TSpaceManagerFacilitySettings.Create();
   (Result as TSpaceManagerFacilitySettings).SpaceManagerClass := TSpaceManagerClass(SpaceManagerClass);
   (Result as TSpaceManagerFacilitySettings).SpaceManagerSettings := SpaceManagerSettings;
end;

procedure TSpaceManagerFacility.Tick(Interval: TDateTime);
begin
   inherited;
   Assert(Assigned(FContents));
   FContents.Tick(Interval);
end;

procedure TSpaceManagerFacility.KillChildren(Game: TAbstractGame);
begin
   inherited;
   Game.Kill(FContents);
end;

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