{$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, rfLastSyncParity);
         TOrePileFlags = (ofAutoselect, ofBackpressure);
   strict private
      FFeatureClass: TMiningFeatureClass;
      FDisabledReasons: TDisabledReasons;
      FConfiguredRate: TVolumeRate;
      FTargetRate, FActualRate: TVolumeRate;
      FRegion: specialize TAnnotatedPointer<TRegionFeatureNode, TRegionFlags>;
      FOrePile: specialize TAssetOrFeature<TOrePileFeatureNode, TOrePileFeatureClass, TOrePileFlags>;
      FProcessingFraction: Fraction32;
      FLastSyncOres: POreQuantities;
      {$IFOPT C+} FLastSyncDuration: TMillisecondsDuration; {$ENDIF}
   private
      procedure AutoselectOrePile();
      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(): TVolumeRate; // call MinerChanged _before_ changing this
      procedure MinerDisconnectRegion();
   private // IOrePileSupplier
      function OrePileSupplierGetRate(): TVolumeRate;
      procedure OrePileSupplierPileReady();
      procedure OrePileSupplierPileFull();
      procedure OrePileSupplierPileDisconnecting();
      procedure WalkUpstream(Callback: TWalkCallback);
      procedure OreSync(Parity: Boolean);
      procedure ResetSyncParity();
      function ComputeOreTransfer(Parity: Boolean; Duration: TMillisecondsDuration): TOreQuantities;
   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
   Writeln(DebugName, ' :: Destroy');
   Assert(not Assigned(FLastSyncOres));
   DisconnectEverything();
   Assert(not Assigned(FLastSyncOres));
   if (Assigned(FLastSyncOres)) then
      Dispose(FLastSyncOres);
   inherited;
end;

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

procedure TMiningFeatureNode.Detaching();
begin
   Writeln(DebugName, ' detaching');
   DisconnectEverything();
end;

procedure TMiningFeatureNode.DisconnectTarget();
begin
   Assert(FOrePile.Assigned);
   Writeln(DebugName, ' removing self as supplier of ', FOrePile.Unwrap().DebugName);
   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
   begin
      Writeln(DebugName, ' removing self from region ', FRegion.Unwrap().DebugName);
      FRegion.Unwrap().RemoveMiner(Self);
   end;
   FRegion.Clear();
   MarkAsDirty([dkNeedsHandleChanges, dkUpdateClients]);
end;

procedure TMiningFeatureNode.AutoselectOrePile();
var
   Message: TFindOrePilesBusMessage;
   Filter: TOreFilter;
   NoExclusions: TOreFilter;
   Piles: TOrePileArray;
   OrePile: TOrePileFeatureNode;
begin
   Assert(not FOrePile.Assigned);
   Filter.InitFromRates(FActualOreRates);
   NoExclusions.Clear();
   Message := TFindOrePilesBusMessage.CreateForProfile(Parent.Owner, FRegion.Unwrap().OreProfile);
   InjectBusMessage(Message);
   OrePile := nil;
   Piles := Message.ExtractPileList();
   if (Length(Piles) > 0) then
      OrePile := Piles[0];
   FreeAndNil(Message);
   if (not Assigned(OrePile)) then
   begin
      Message := TFindOrePilesBusMessage.CreateFindEmpty(Parent.Owner);
      InjectBusMessage(Message);
      Piles := Message.ExtractPileList();
      if (Length(Piles) > 0) then
         OrePile := Piles[0];
      FreeAndNil(Message);
   end;
   if (Assigned(OrePile)) then
   begin
      FOrePile.AssignFeature(OrePile); // also clears flags
      OrePile.AddSupplier(Self);
   end
   else
      FOrePile.Clear();
end;

procedure TMiningFeatureNode.HandleChanges();
var
   DisabledReasons: TDisabledReasons;
   Message: TRegisterMinerBusMessage;
   RateLimit: Double;
   TargetRate: TVolumeRate;
begin
   DisabledReasons := CheckDisabled(Parent, Self, RateLimit);
   TargetRate := FFeatureClass.FMaxRate * RateLimit;
   if (TargetRate > FConfiguredRate) then
   begin
      TargetRate := FConfiguredRate;
   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);
   end;
   if (FRegion.IsFlagClear(rfHasOre)) then
   begin
      TargetRate := TVolumeRate.Zero;
   end
   else
      Assert(FRegion.Assigned);
   if (FOrePile.IsFlagSet(ofAutoselect)) then
      AutoselectOrePile();
   if (FOrePile.IsFlagSet(ofBackpressure) or not FOrePile.Assigned) then
   begin
      TargetRate := TVolumeRate.Zero;
   end;
   if (TargetRate <> FTargetRate) then
   begin
      if (FRegion.Assigned) then
      begin
         FRegion.Unwrap().MinerChanged(Self); // triggers sync
      end;
      if (FOrePile.Assigned) then
      begin
         FOrePile.Unwrap().ClientChanged();
      end;
      FTargetRate := TargetRate;
      MarkAsDirty([dkUpdateClients]);
   end;
   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) or not FOrePile.Assigned) then
         Include(DisabledReasons, drCannotStoreOutput);
      if (FConfiguredRate < FFeatureClass.FMaxRate) then
         Include(DisabledReasons, drConfiguration);
      Writer.WriteCardinal(Cardinal(DisabledReasons));
      Writer.WriteDouble(FActualRate.AsDouble);
      OrePile := FOrePile.Unwrap();
      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 := FOrePile.Unwrap();
   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 := TVolumeRate.FromPerMillisecond(Journal.ReadDouble());
   Asset := Journal.ReadAssetNodeReference();
   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: TVolumeRate;
   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 := FOrePile.Unwrap();
            if (Assigned(OldOrePile)) then
            begin
               DisconnectTarget();
               MarkAsDirty([dkUpdateJournal, dkNeedsHandleChanges]);
            end;
            Message.CloseOutput();
         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 := FOrePile.Unwrap();
               if (OldOrePile <> OrePile) then
               begin
                  if (Assigned(OldOrePile)) then
                     DisconnectTarget();
                  FOrePile.AssignFeature(OrePile);
                  OrePile.AddSupplier(Self);
                  FOrePile.ConfigureFlag(ofBackpressure, not OrePile.HasRoom);
                  MarkAsDirty([dkUpdateJournal, dkNeedsHandleChanges]);
               end;
               Message.CloseOutput();
            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 := TVolumeRate.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(): TVolumeRate; // call MinerChanged _before_ changing this
begin
   Result := FTargetRate;
end;

procedure TMiningFeatureNode.MinerSetRates(Rates: TOreRates; HasOre: Boolean); // sets everything to zero when the region is empty
var
   ActualRateSum: TVolumeRateSum;
   Ore: TOres;
begin
   Writeln(DebugName, ' :: MinerSetRates (HasOre=', HasOre, ')');
   // this gets called during region handle changes
   Assert(FRegion.IsFlagSet(rfSoughtBus));
   Assert(FRegion.Assigned);
   FRegion.ConfigureFlag(rfHasOre, HasOre);
   FActualOreRates := Rates;
   ActualRateSum.Reset();
   for Ore in TOres do
   begin
      Writeln('  ', System.Encyclopedia.Materials[Ore].Name, ': ', Rates[Ore].ToString(), ' = ', (Rates[Ore] * System.Encyclopedia.Materials[Ore].MassPerUnit).ToString());
      ActualRateSum.Inc(Rates[Ore] * System.Encyclopedia.Materials[Ore].MassPerUnit);
   end;
   FActualRate := ActualRateSum.Flatten();
   Assert(FOrePile.Assigned or FActualRate.IsExactZero);
   if (FOrePile.Assigned) then
      FOrePile.Unwrap().ClientChanged();
   MarkAsDirty([dkUpdateJournal, dkNeedsHandleChanges]);
end;

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

function TMiningFeatureNode.OrePileSupplierGetRate(): TVolumeRate;
begin
   Result := FActualRate;
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.WalkUpstream(Callback: TWalkCallback);
begin
   // there are no upstream piles
end;

procedure TMiningFeatureNode.OreSync(Parity: Boolean);
begin
   Writeln(DebugName, ' OreSync(', Parity, ')');
   if (Parity <> FRegion.IsFlagSet(rfLastSyncParity)) then
   begin
      FRegion.ConfigureFlag(rfLastSyncParity, Parity);
      if (FRegion.Assigned) then
         FRegion.Unwrap().OreSync(Parity);
      if (FOrePile.Assigned) then
         FOrePile.Unwrap().OreSync(Parity);
   end;
end;

procedure TMiningFeatureNode.ResetSyncParity();
begin
   Writeln(DebugName, ' ResetSyncParity');
   if (FRegion.IsFlagSet(rfLastSyncParity)) then
   begin
      FRegion.ClearFlag(rfLastSyncParity);
      if (FRegion.Assigned) then
         FRegion.Unwrap().ResetSyncParity();
      if (FOrePile.Assigned) then
         FOrePile.Unwrap().ResetSyncParity();
   end;
end;

function TMiningFeatureNode.ComputeOreTransfer(Parity: Boolean; Duration: TMillisecondsDuration): TOreQuantities;
var
   Ore: TOres;
begin
   Writeln(DebugName, ' ComputeOreTransfer(', Parity, ', ', Duration.ToString(), ')');
   Assert(Parity = FRegion.IsFlagSet(rfLastSyncParity));
   if (Assigned(FLastSyncOres)) then
   begin
      {$IFOPT C+} Assert(Duration = FLastSyncDuration); {$ENDIF}
      Result := FLastSyncOres^;
      Dispose(FLastSyncOres);
      FLastSyncOres := nil;
   end
   else
   begin
      for Ore in TOres do
         Result[Ore] := ApplyIncrementallyRoundDown(FActualOreRates[Ore], Duration, FProcessingFractions[Ore]);
      New(FLastSyncOres);
      FLastSyncOres^ := Result;
      {$IFOPT C+} FLastSyncDuration := Duration; {$ENDIF}
      MarkAsDirty([dkUpdateJournal]);
   end;
end;

initialization
   RegisterFeatureClass(TMiningFeatureClass);
end.