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

interface

uses
   basenetwork, systems, internals, serverstream, materials, wrappers,
   region, time, systemdynasty, orepile, commonbuses, annotatedpointer;

type
   TMiningFeatureClass = class(TFeatureClass)
   private
      FMaxRate: TMassRate; // kg per second
   strict protected
      function GetFeatureNodeClass(): FeatureNodeReference; override;
   public
      constructor CreateFromTechnologyTree(const Reader: TTechTreeReader); override;
      function InitFeatureNode(ASystem: TSystem): TFeatureNode; override;
   end;

   TMiningFeatureNode = class(TFeatureNode, IMiner, IOrePileSupplier)
   private
      type
         TRegionFlags = (rfSoughtBus, rfHasOre);
         TOrePileFlags = (ofAutoselect, ofBackpressure);
   strict private
      FFeatureClass: TMiningFeatureClass;
      FDisabledReasons: TDisabledReasons;
      FConfiguredRate: TMassRate;
      FTargetRate: TMassRate;
      FActualOreRates: TOreRates;
      FRegion: specialize TAnnotatedPointer<TRegionFeatureNode, TRegionFlags>;
      FOrePile: specialize TAssetOrFeature<TOrePileFeatureNode, TOrePileFeatureClass, TOrePileFlags>;
      FProcessingFractions: TOreQuantityFractions;
   private
      function ResolveOrePile(): TOrePileFeatureNode;
      procedure DisconnectTarget();
      procedure DisconnectEverything();
   protected
      constructor CreateFromJournal(Journal: TJournalReader; AFeatureClass: TFeatureClass; ASystem: TSystem); override;
      procedure Attaching(); override; 
      procedure Detaching(); override;
      procedure HandleChanges(); override;
      procedure Serialize(DynastyIndex: Cardinal; Writer: TServerStreamWriter); override;
   public
      constructor Create(ASystem: TSystem; AFeatureClass: TMiningFeatureClass);
      destructor Destroy(); override;
      procedure UpdateJournal(Journal: TJournalWriter); override;
      procedure ApplyJournal(Journal: TJournalReader); override;
      function HandleCommand(PlayerDynasty: TDynasty; Command: UTF8String; var Message: TMessage): Boolean; override;
   private // IMiner
      function MinerGetRate(): TMassRate; // call MinerChanged _before_ changing this
      procedure MinerSetRates(Rates: TOreRates); // sets everything to zero when the region is empty
      function MinerSync(Duration: TMillisecondsDuration): TOreQuantities; // apply the given TOreRates; return how much was mined
      procedure MinerDisconnectRegion();
   private // IOrePileSupplier
      function OrePileSupplierGetRate(): TMassRate;
      function OrePileSupplierCurrentRates(): TOreRates;
      procedure OrePileSupplierPileReady();
      procedure OrePileSupplierPileFull();
      procedure OrePileSupplierPileDisconnecting();
      procedure OrePileSupplierTriggerSync(); // receiver must propagate back to region (MinerChanged) or to previous pile (TransferOres), which will eventually propagate back to trigger a call to our TransferOres
      procedure WalkUpstream(Callback: TWalkCallback);
      function GetAsset(): TAssetNode;
   end;

implementation

uses
   exceptions, sysutils, isdprotocol, knowledge, messages, typedump, ttparser, isdnumbers;

constructor TMiningFeatureClass.CreateFromTechnologyTree(const Reader: TTechTreeReader);
begin
   inherited Create();
   Reader.Tokens.ReadIdentifier('max');
   Reader.Tokens.ReadIdentifier('throughput');
   FMaxRate := ReadMassPerTime(Reader.Tokens);
end;

function TMiningFeatureClass.GetFeatureNodeClass(): FeatureNodeReference;
begin
   Result := TMiningFeatureNode;
end;

function TMiningFeatureClass.InitFeatureNode(ASystem: TSystem): TFeatureNode;
begin
   Result := TMiningFeatureNode.Create(ASystem, Self);
end;


constructor TMiningFeatureNode.Create(ASystem: TSystem; AFeatureClass: TMiningFeatureClass);
begin
   inherited Create(ASystem);
   FFeatureClass := AFeatureClass;
   FOrePile.SetFlag(ofAutoselect);
end;

constructor TMiningFeatureNode.CreateFromJournal(Journal: TJournalReader; AFeatureClass: TFeatureClass; ASystem: TSystem);
begin
   Assert(Assigned(AFeatureClass));
   FFeatureClass := AFeatureClass as TMiningFeatureClass;
   inherited;
end;

destructor TMiningFeatureNode.Destroy();
begin
   DisconnectEverything();
   inherited;
end;

procedure TMiningFeatureNode.Attaching();
begin
   MarkAsDirty([dkNeedsHandleChanges]);
   Assert(FRegion.IsFlagClear(rfSoughtBus));
end;

procedure TMiningFeatureNode.Detaching();
begin
   DisconnectEverything();
end;

procedure TMiningFeatureNode.DisconnectTarget();
begin
   Assert(FOrePile.Assigned);
   if (FOrePile.Resolved) then
      FOrePile.Unwrap().RemoveSupplier(Self);
   FOrePile.Clear();
   MarkAsDirty([dkNeedsHandleChanges, dkUpdateClients, dkUpdateJournal]);
end;
   
procedure TMiningFeatureNode.DisconnectEverything();
begin
   if (FOrePile.Assigned) then
      DisconnectTarget();
   if (FRegion.Assigned) then
      FRegion.Unwrap().RemoveMiner(Self);
   FRegion.Clear();
   MarkAsDirty([dkNeedsHandleChanges, dkUpdateClients]);
end;

function TMiningFeatureNode.ResolveOrePile(): TOrePileFeatureNode;
var
   Message: TFindOrePilesBusMessage;
   Filter: TOreFilter;
   NoExclusions: TOreFilter;
   Piles: TOrePileArray;
begin
   if (FOrePile.IsFlagSet(ofAutoselect)) then
   begin
      Assert(not FOrePile.Assigned);
      Filter.InitFromRates(FActualOreRates);
      NoExclusions.Clear();
      Message := TFindOrePilesBusMessage.CreateFiltered(Parent.Owner, Filter, NoExclusions);
      InjectBusMessage(Message);
      Result := nil;
      Piles := Message.ExtractPileList();
      if (Length(Piles) > 0) then
         Result := Piles[0];
      FreeAndNil(Message);
      if (not Assigned(Result)) then
      begin
         Message := TFindOrePilesBusMessage.CreateFindEmpty(Parent.Owner);
         InjectBusMessage(Message);
         Piles := Message.ExtractPileList();
         if (Length(Piles) > 0) then
            Result := Piles[0];
         FreeAndNil(Message);
      end;
      if (Assigned(Result)) then
      begin
         FOrePile.AssignFeature(Result); // also clears flags
      end
      else
         FOrePile.Clear();
   end
   else
   if (FOrePile.Assigned) then
   begin
      if (not FOrePile.Resolved) then
         FOrePile.Resolve();
      Result := FOrePile.Unwrap();
   end
   else
      Result := nil;
end;

procedure TMiningFeatureNode.HandleChanges();
var
   DisabledReasons: TDisabledReasons;
   Message: TRegisterMinerBusMessage;
   RateLimit: Double;
   TargetRate: TMassRate;
   OrePile: TOrePileFeatureNode;
begin
   Writeln(DebugName, ' handling changes');
   Writeln('  max rate -> ', FFeatureClass.FMaxRate.ToString());
   DisabledReasons := CheckDisabled(Parent, Self, RateLimit);
   TargetRate := FFeatureClass.FMaxRate * RateLimit;
   Writeln('  rate limited -> ', TargetRate.ToString());
   if (TargetRate > FConfiguredRate) then
   begin
      TargetRate := FConfiguredRate;
      Writeln('  configuration -> ', TargetRate.ToString());
   end;
   if (DisabledReasons <> FDisabledReasons) then
   begin
      FDisabledReasons := DisabledReasons;
      MarkAsDirty([dkUpdateClients]);
   end;
   if (FOrePile.Resolve()) then
      FOrePile.Unwrap().AddSupplier(Self);
   if (FRegion.IsFlagClear(rfSoughtBus)) then
   begin
      Assert(not FRegion.Assigned);
      Message := TRegisterMinerBusMessage.Create(Self);
      InjectBusMessage(Message);
      if (Assigned(Message.Region)) then
         FRegion.Wrap(Message.Region);
      FRegion.ConfigureFlag(rfHasOre, Message.HasOre);
      FRegion.SetFlag(rfSoughtBus);
      FreeAndNil(Message);
      Writeln('  configured region (', FRegion.Assigned, ', ', FRegion.IsFlagSet(rfHasOre), ')');
   end;
   if (FRegion.IsFlagClear(rfHasOre)) then
   begin
      TargetRate := TMassRate.Zero;
      Writeln('  region has no ore -> ', TargetRate.ToString());
   end
   else
      Assert(FRegion.Assigned);
   OrePile := ResolveOrePile();
   if (Assigned(OrePile)) then
   begin
      Assert(OrePile = FOrePile.Unwrap());
      Writeln('  ore pile: ', OrePile.DebugName);
   end
   else
      Assert(not FOrePile.Assigned);
   if (FOrePile.IsFlagSet(ofBackpressure)) then
   begin
      TargetRate := TMassRate.Zero;
      Writeln('  target applied backpressure -> ', TargetRate.ToString());
   end
   else
      Assert(FOrePile.Assigned);
   if (TargetRate <> FTargetRate) then
   begin
      if (FRegion.Assigned) then
      begin
         Writeln('  notifying region...');
         FRegion.Unwrap().MinerChanged(Self); // triggers sync
      end;
      if (Assigned(OrePile)) then
      begin
         Writeln('  notifying ore pile...');
         OrePile.ClientChanged();
      end;
      FTargetRate := TargetRate;
      MarkAsDirty([dkUpdateClients]);
   end;
   Writeln('  target rate: ', FTargetRate.ToString());
   inherited;
end;

procedure TMiningFeatureNode.Serialize(DynastyIndex: Cardinal; Writer: TServerStreamWriter);
var
   Visibility: TVisibility;
   DisabledReasons: TDisabledReasons;
   OrePile: TOrePileFeatureNode;
   OrePileAsset: TAssetNode;
begin
   Visibility := Parent.ReadVisibilityFor(DynastyIndex);
   if ((dmDetectable * Visibility <> []) and (dmClassKnown in Visibility)) then
   begin
      Writer.WriteCardinal(fcMining);
      Writer.WriteDouble(FFeatureClass.FMaxRate.AsDouble);
      Writer.WriteDouble(FConfiguredRate.AsDouble);
      DisabledReasons := FDisabledReasons;
      if (FRegion.IsFlagSet(rfSoughtBus) and not FRegion.Assigned) then
         Include(DisabledReasons, drNoBus);
      if (FRegion.IsFlagClear(rfHasOre) and FRegion.Assigned) then
         Include(DisabledReasons, drCannotGuaranteeInput);
      if (FOrePile.IsFlagSet(ofBackpressure)) then
         Include(DisabledReasons, drCannotStoreOutput);
      if (FConfiguredRate < FFeatureClass.FMaxRate) then
         Include(DisabledReasons, drConfiguration);
      Writer.WriteCardinal(Cardinal(DisabledReasons));
      Writer.WriteDouble(FTargetRate.AsDouble);
      OrePile := ResolveOrePile();
      if (Assigned(OrePile)) then
      begin
         OrePileAsset := OrePile.Parent;
         Writer.WriteCardinal(OrePileAsset.ID(DynastyIndex));
      end
      else
      begin
         Writer.WriteCardinal(0);
      end;
   end;
end;

procedure TMiningFeatureNode.UpdateJournal(Journal: TJournalWriter);
var
   OrePile: TOrePileFeatureNode;
   OrePileAsset: TAssetNode;
   Ore: TOres;
begin
   Journal.WriteDouble(FConfiguredRate.AsDouble);
   OrePile := ResolveOrePile();
   if (Assigned(OrePile)) then
      OrePileAsset := OrePile.Parent
   else
      OrePileAsset := nil;
   Journal.WriteAssetNodeReference(OrePileAsset);
   Journal.WriteBoolean(FOrePile.IsFlagSet(ofBackpressure));
   for Ore in TOres do
      Journal.WriteCardinal(FProcessingFractions[Ore].AsCardinal);
end;

procedure TMiningFeatureNode.ApplyJournal(Journal: TJournalReader);
var
   Ore: TOres;
   Asset: TAssetNode;
begin
   FConfiguredRate := TMassRate.FromPerMillisecond(Journal.ReadDouble());
   Asset := Journal.ReadAssetNodeReference(System);
   if (Assigned(Asset)) then
      FOrePile.AssignAsset(Asset)
   else
      FOrePile.Clear();
   FOrePile.ConfigureFlag(ofBackpressure, Journal.ReadBoolean());
   for Ore in TOres do
      FProcessingFractions[Ore] := Fraction32.FromCardinal(Journal.ReadCardinal());
end;

function TMiningFeatureNode.HandleCommand(PlayerDynasty: TDynasty; Command: UTF8String; var Message: TMessage): Boolean;
var
   RequestedValue: Double;
   NewRate: TMassRate;
   DynastyIndex: Cardinal;
   FindMessage: TFindOrePilesBusMessage;
   OrePile, OldOrePile: TOrePileFeatureNode;
   ID: TAssetID;
   Piles: TOrePileArray;
begin
   if (Command = ccListPiles) then
   begin
      Result := True;
      if (Message.CloseInput()) then
      begin
         Message.Reply();
         FindMessage := TFindOrePilesBusMessage.Create(PlayerDynasty);
         InjectBusMessage(FindMessage);
         DynastyIndex := System.DynastyIndex[PlayerDynasty];
         Piles := FindMessage.ExtractPileList();
         for OrePile in Piles do
            Message.Output.WriteCardinal(OrePile.Parent.ID(DynastyIndex));
         FreeAndNil(FindMessage);
         Message.CloseOutput();
      end;
   end
   else

   if (Command = ccSetTarget) then
   begin
      Result := True;
      ID := Message.Input.ReadCardinal();
      if (Message.CloseInput()) then
      begin
         Message.Reply();
         if (ID = 0) then
         begin
            OldOrePile := ResolveOrePile();
            if (Assigned(OldOrePile)) then
            begin
               DisconnectTarget();
               MarkAsDirty([dkUpdateJournal, dkNeedsHandleChanges]);
            end;
         end
         else
         begin
            FindMessage := TFindOrePilesBusMessage.CreateFindByID(System.DynastyIndex[PlayerDynasty], ID);
            InjectBusMessage(FindMessage);
            Piles := FindMessage.ExtractPileList();
            if (Length(Piles) = 0) then
            begin
               Message.Error(ieNotFound);
            end
            else
            begin
               OrePile := Piles[0];
               OldOrePile := ResolveOrePile();
               if (OldOrePile <> OrePile) then
               begin
                  if (Assigned(OldOrePile)) then
                     DisconnectTarget();
                  FOrePile.AssignFeature(OrePile);
                  FOrePile.ConfigureFlag(ofBackpressure, not OrePile.HasRoom);
                  MarkAsDirty([dkUpdateJournal, dkNeedsHandleChanges]);
               end;
            end;
            FreeAndNil(FindMessage);
         end;
      end;
   end
   else

   if (Command = ccSetRate) then
   begin
      Result := True;
      RequestedValue := Message.Input.ReadDouble();
      if (Message.CloseInput()) then
      begin
         Message.Reply();
         if ((RequestedValue > FFeatureClass.FMaxRate.AsDouble) or
             (RequestedValue < 0.0)) then
         begin
            Message.Error(ieRangeError);
         end
         else
         begin
            NewRate := TMassRate.FromPerMillisecond(RequestedValue);
            if (NewRate <> FConfiguredRate) then
            begin
               FConfiguredRate := NewRate;
               MarkAsDirty([dkUpdateJournal, dkNeedsHandleChanges]);
            end;
            if (FOrePile.Assigned) then
            begin
               FOrePile.ConfigureFlag(ofBackpressure, not FOrePile.Unwrap().HasRoom);
               MarkAsDirty([dkUpdateJournal, dkNeedsHandleChanges]);
            end;
            Message.CloseOutput();
         end;
      end;
   end
   else
      Result := False;
end;

function TMiningFeatureNode.MinerGetRate(): TMassRate; // call MinerChanged _before_ changing this
begin
   Result := FTargetRate;
end;

procedure TMiningFeatureNode.MinerSetRates(Rates: TOreRates); // sets everything to zero when the region is empty
begin
   Assert(FRegion.IsFlagSet(rfSoughtBus));
   Assert(FRegion.IsFlagSet(rfHasOre));
   Assert(FRegion.Assigned);
   Assert(FOrePile.Assigned);
   FActualOreRates := Rates;
   FOrePile.Unwrap().ClientChanged();
end;

function TMiningFeatureNode.MinerSync(Duration: TMillisecondsDuration): TOreQuantities;
var
   Ore: TOres;
begin
   Assert(FOrePile.Assigned);
   for Ore in TOres do
      Result[Ore] := ApplyIncrementallyRoundDown(FActualOreRates[Ore], Duration, FProcessingFractions[Ore]);
   FOrePile.Unwrap().TransferOres(Result);
end;

procedure TMiningFeatureNode.MinerDisconnectRegion();
begin
   FRegion.Clear();
   MarkAsDirty([dkNeedsHandleChanges]); // will notify ore pile
end;

function TMiningFeatureNode.OrePileSupplierGetRate(): TMassRate;
begin
   Result := FTargetRate;
end;

function TMiningFeatureNode.OrePileSupplierCurrentRates(): TOreRates;
begin
   Result := FActualOreRates;
end;

procedure TMiningFeatureNode.OrePileSupplierPileReady();
begin
   MarkAsDirty([dkNeedsHandleChanges]);
end;

procedure TMiningFeatureNode.OrePileSupplierPileFull();
begin
   FOrePile.SetFlag(ofBackpressure);
   MarkAsDirty([dkUpdateJournal, dkNeedsHandleChanges]);
end;

procedure TMiningFeatureNode.OrePileSupplierPileDisconnecting();
begin
   FOrePile.Clear();
   MarkAsDirty([dkNeedsHandleChanges]);
end;

procedure TMiningFeatureNode.OrePileSupplierTriggerSync();
begin
   FRegion.Unwrap().Sync();
end;

procedure TMiningFeatureNode.WalkUpstream(Callback: TWalkCallback);
begin
   // there are no upstream piles
end;

function TMiningFeatureNode.GetAsset(): TAssetNode;
begin
   Result := Parent;
end;

initialization
   RegisterFeatureClass(TMiningFeatureClass);
end.