library lazFormation;

{$mode delphi}{$H+}

uses
  Classes { you can add units after this },
  Generics.Collections, Generics.Defaults,
  uHCDefines,
  mainform,
  uHCGCI,
  uHCGlobals,
  uHCTypeDefs,
  uHCEventHelpers,
  uHCDateTime,
  uHCAnnexDefs,
  uHCAnnexHelpers, uHCUtils,
  uLazFormationGlobals,
  Windows,
  Forms,
  ShellAPI,
  SysUtils,
  Types,
  Dialogs,
  Interfaces,
  Controls,
  DateUtils,
  ulazformation;

const
  DLLVERN = 1;
  DLLVERINTN = 21;

var
  frmMain: TfrmMain;

  {*** Return DLL internal version, i.e. revision 5 of my DLL ***}
  function DLLVer(): word; export; cdecl;
  begin
    Result := DLLVERN;
  end;

  {*** Return DLL interface version, i.e. revision 1 of my HCE interface spec ***}
  function DLLVerInt(): word; export; cdecl;
  begin
    Result := DLLVERINTN;
  end;

  {*** Return DLL description, 255 characters max ***}
  function DLLDesc(): PAnsiChar; export; cdecl;
  begin
    Result := 'lazarus Formation test DLL by Tony Eischens';
  end;

  {*** Free DLL ***}
  procedure DLLFree(); export; cdecl;
  begin
    // Do any cleanup here, this is the end
    frmMain.Free;
    UnitFormationListClear;
    UnitFormationList.Free;
  end;

  {*** Init DLL ***}
  procedure DLLInit(hwndHC: HWND; pathHC: PAnsiChar; verHC: PAnsiChar;
    verSaveGame: longword; funcRefs: PHCDLL_FUNC_REF; PGEClosing: Pointer;
    PDLLBusy: Pointer; verInterface: longword); export; cdecl;
  var
    funcTmp: PHCDLL_FUNC_REF;
  begin
    // here we initialize globals and such for the life of the DLL
    Application.Initialize;
    // ALE 20120410 Freezes HC Application.Run;
    uLazFormationGlobals.PGEClosing := PGEClosing;
    uLazFormationGlobals.PDLLBusy := PDLLBusy;

    // ALE 20180222 init globals
    UnitFormationList := TDictionary<HCUUID, THCFORMATIONC>.Create;

    frmMain := TfrmMain.Create(nil);
    // ALE 20180123 float outside HC frmMain.ParentWindow := hwndHC;
    frmMain.Caption := 'lazarus Formation Export DLL v' + IntToStr(DLLVERN) +
      ', ExportDLL Interface v' + IntToStr(DLLVERINTN);
    frmMain.memDLLInit.Lines.Add('lazarus GUI Export DLL v' + IntToStr(DLLVERN));
    frmMain.memDLLInit.Lines.Add('ExportDLL Interface v' + IntToStr(DLLVERINTN));
    frmMain.memDLLInit.Lines.Add('hwndHC = 0x' + IntToHex(hwndHC, 8));
    frmMain.memDLLInit.Lines.Add('pathHC = ' + pathHC);
    frmMain.memDLLInit.Lines.Add('verHC = ' + verHC);
    frmMain.memDLLInit.Lines.Add('verSaveGame = 0x' + IntToHex(verSaveGame, 8));
    frmMain.memDLLInit.Lines.Add(Format('funcRefs = 0x%p', [funcRefs]));
    frmMain.memDLLInit.Lines.Add(Format('GE ExportDLL Interface Version = %d',
      [verInterface]));

    uLazFormationGlobals.intVerInterface := DLLVERINTN;
    uLazFormationGlobals.intVerSaveGame := verSaveGame;

    // ALE 20170224 Alert the user that the GE is too old for this ExportDLL
    if (verInterface < 21) then
    begin
      MessageDlg('GE too old', GetModuleName(hInstance) +
        ' is designed for HC2017.011+.  Please ' +
        ' update your GE or disable this ExportDLL.', mtWarning, [mbOK], 0);
    end;

    // ALE 20130908 List the function pointers sent over by the GE
    //  then capture one of them for example usage
    frmMain.memDLLInit.Lines.BeginUpdate;
    funcTmp := funcRefs;
    while (funcTmp <> nil) do
    begin
      frmMain.memDLLInit.Lines.Add(#9 + Format('funcRef: 0x%p %s',
        [funcTmp^.funcPtr, funcTmp^.funcName]));

      if (funcTmp^.funcName = 'NewPtr') then
        frmMain.NewPtr := funcTmp^.funcPtr
      else if (funcTmp^.funcName = 'DispPtr') then
        frmMain.DisposPtr := THCDisposPtr(funcTmp^.funcPtr)
      else if (funcTmp^.funcName = 'QueueHarpoonEvent') then
        frmMain.HCQueueHarpoonEvent := THCQueueHarpoonEvent(funcTmp^.funcPtr)
      else if (funcTmp^.funcName = 'dllCheckLatLonDepth') then
        frmMain.HCdllCheckLatLonDepth := THCdllCheckLatLonDepth(funcTmp^.funcPtr)
      else if (funcTmp^.funcName = 'annex_id_to_disk_id') then
        frmMain.HCannex_id_to_disk_id := THCannex_id_to_disk_id(funcTmp^.funcPtr)
      else if (funcTmp^.funcName = 'disk_id_to_annex_id') then
        frmMain.HCdisk_id_to_annex_id := THCdisk_id_to_annex_id(funcTmp^.funcPtr)
      else if (funcTmp^.funcName = 'MessageLogLine') then
        frmMain.HCMessageLogLine := THCMessageLogLine(funcTmp^.funcPtr)
      else if (funcTmp^.funcName = 'Effect02') then
        HCEffect02 := funcTmp^.funcPtr
      else if (funcTmp^.funcName = 'ResetGroupCenter') then
        HCResetGroupCenter := funcTmp^.funcPtr
      else if (funcTmp^.funcName = 'SetCourseUnit_Raw') then
        HCSetCourseUnit_Raw := funcTmp^.funcPtr
      else if (funcTmp^.funcName = 'SetCourseGroup_Raw') then
        HCSetCourseGroup_Raw := funcTmp^.funcPtr;

      funcTmp := funcTmp^.Next;
    end;
    frmMain.memDLLInit.Lines.EndUpdate;

    frmMain.Show;
  end;

  procedure ScenLoad(strHarpPath: PAnsiChar; intScenNum: smallint;
    strScenFPath: PAnsiChar; intBSNum: shortint; strBSFName: PAnsiChar;
    intSide: byte; intGameTimeIn: Long; intGameTimeLeftIn: Long;
    AnnexDataIn: PHCAnnexes_disk; DatabaseVersionDBIn: PHCDATABASE_VERSION;
    ScenDataIn: PHCSCENARIO_DATA; ScenSaveDataIn: PHCSCENARIO_SAVE_DATA) export; cdecl;
  var
    lLLI: PHCLINEAGE_LIST_ITEM;
    lLineageStr: String;
    lRow: NativeInt;
  begin
    intGameTime := intGameTimeIn;
    // ALE 20150712 Now that we receive the game time here, store it
    intGameTimeLeft := intGameTimeLeftIn;
    // ALE 20150712 Now that we receive the game time left here, store it
    // ALE 20170923 replaced in interface version 21 with ScenData dt_scen_start := dt_scen_start_in; // ALE 20150712 Scenario Starting date and time
    AnnexData := AnnexDataIn; // ALE 20150813 Database/Platform information
    HCAnnexHelper := THCAnnexHelper.Create(AnnexDataIn, frmMain.HCannex_id_to_disk_id,
      uLazFormationGlobals.intVerInterface, uLazFormationGlobals.intVerSaveGame);
    DatabaseVersionDB := DatabaseVersionDBIn; // ALE 20170923 current database
    ScenData := ScenDataIn; // ALE 20170923 unique identifiers, lineage, etc.
    ScenSaveData := ScenSaveDataIn; // ALE 20170923 save UUIDs and Scenario Orders

    // ALE 20180222 clear out globals
    UnitFormationListClear();

    if (frmMain.SLckbEnabled.Checked = True) then
    begin
      frmMain.SLmemMsgLog.Lines.Insert(0,
        Format('ScenLoad HC Path=%s, Scen#=%d, ScenFNP=%s, BattleSet=%d, BattleSet=%s, PlayerSide=%d, GameTime=%d, ScenStart %4.4d-%2.2d-%2.2d, %2.2d:%2.2d:%2.2d',
        [strHarpPath, intScenNum, strScenFPath, intBSNum, strBSFName, intSide,
        intGameTimeIn, ScenData^.dt_scen_start.year, ScenData^.dt_scen_start.month,
        ScenData^.dt_scen_start.day, ScenData^.dt_scen_start.hour,
        ScenData^.dt_scen_start.minute, ScenData^.dt_scen_start.second]));
      if (frmMain.SLmemMsgLog.Lines.Count > frmMain.SLedtLines.Value) then
      begin
        frmMain.SLmemMsgLog.Lines.Delete(frmMain.SLedtLines.Value);
      end;
    end;

    // ALE 20170923 Enumerate the scenario lineage
    if (ScenData^.Lineage.Count > 0) then
    begin
      lRow := 1;
      frmMain.SLsgLineage.RowCount := ScenData^.Lineage.Count + 1;
      frmMain.SLsgLineage.Cells[0, 0] := '';
      frmMain.SLsgLineage.Cells[1, 0] := 'Date & Time Saved';
      frmMain.SLsgLineage.Cells[2, 0] := 'Scen Format Ver';
      frmMain.SLsgLineage.Cells[3, 0] := 'SE version';
      frmMain.SLsgLineage.Cells[4, 0] := 'DB flavor';
      frmMain.SLsgLineage.Cells[5, 0] := 'uuid';
      lLLI := @ScenData^.Lineage.Top;
      while (lLLI <> nil) do
      begin
        frmMain.SLsgLineage.Cells[0, lRow] := IntToStr(lRow);
        frmMain.SLsgLineage.Cells[1, lRow] :=
         FormatDateTime('yyyy-MM-dd hh:nn:ss', UnixToDateTime(lLLI^.dtstamp));
        frmMain.SLsgLineage.Cells[2, lRow] := IntToStr(lLLI^.ScenarioVersion);
        frmMain.SLsgLineage.Cells[3, lRow] := lLLI^.SEVersion;
        frmMain.SLsgLineage.Cells[4, lRow] := lLLI^.DatabaseVersion.RESFile.flavor;
        frmMain.SLsgLineage.Cells[5, lRow] := lLLI^.uuid;

        Inc(lRow);
        lLLI := lLLI^.next;
      end;
    end;
  end;

  procedure TimeFactor(TimeFactor: longint); export; cdecl;
  begin
    if (frmMain.TFckbEnabled.Checked = True) then
    begin
      frmMain.TFmemMsgLog.Lines.Insert(0, Format('%8.8d: TimeFactor=%d',
        [intGameTime, TimeFactor]));
      if (frmMain.TFmemMsgLog.Lines.Count > frmMain.TFedtLines.Value) then
      begin
        frmMain.TFmemMsgLog.Lines.Delete(frmMain.TFedtLines.Value);
      end;
    end;
  end;

  procedure GameTime(GameTime: Long; GameTimeLeft: Long); export; cdecl;
  var
    PEvent: PHCHarpoonEvent;
    PGroup: PHCGroup;
    EventType: uchar;
    strGroupID: string;
    dtNow: THCDateTimeRec;
  begin
    intGameTime := GameTime;
    intGameTimeLeft := GameTimeLeft; // ALE 20150712 store remaining time

    frmMain.GTlblGameTime.Caption :=
      'GameTime: ' + Format('%8.8d', [intGameTime]);
    frmMain.GTlblGameTimeLeft.Caption :=
      'GameTimeLeft: ' + Format('%8.8d', [intGameTimeLeft]);
    dtNow := HCDateTimeInc(ScenData.dt_scen_start, intGameTime);
    frmMain.GTlblGameDateTime.Caption :=
      'GameDateTime: ' + Format('%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d',
      [dtNow.year, dtNow.month, dtNow.day, dtNow.hour, dtNow.minute, dtNow.second]);

    // ALE 20130812 If the user wants to look at data structures
    //  then make sure the GE doesn't keep processing until the
    //  user is done.  You would use this mechanism to manipulate
    //  the data structures so that they maintain a consistent state.
    // ALE 20130816 You don't have to make use of PDLLBusy if you don't
    //  mind the UI freezing during your processing.  Freezing is a fine
    //  approach for things like moving units or firing missiles that
    //  don't require immediate user feedback.
    // ALE 20130816 Note also that GameTime is called at the beginning of the
    //  game second.  Any of the enabled stock GE effects will run after this function
    //  or if using PDLLBusy then once you unbusy any DLLs.
    if (frmMain.GTckbPause.Checked) then
    begin
      byte(PDLLBusy^) := CTRUE; // ALE 20130816 don't process other events in GE
      frmMain.GTbtnResume.Enabled := True;
      frmMain.GTckbPause.Enabled := False;
      frmMain.PageControl1.ActivePageIndex := 21; // GameTime/InvestigateStructures

      // ALE 20130816 this would be a good place to start your thread that does the long processing
      // ALE 20170601 Harpoon Events
      PEvent := frmMain.PHarpEventHead;
      frmMain.GTHEEventList.Items.BeginUpdate;
      frmMain.GTHEEventList.Clear;
      frmMain.GEHEmemDetail.Clear;
      while (PEvent <> nil) do
      begin
        EventType := PEvent^.flag and CommandMask;
        strGroupID := '   ';
        if (PEvent^.ourGroup <> nil) then
          strGroupID := PHCGroup(PEvent^.ourGroup)^.id;
        frmMain.GTHEEventList.Items.Add(Format('%8.5d 0x%p %s %3.3d %3.3d %1.1d %s',
          [PEvent^.Time, PEvent, strGroupID, PEvent^.UnitID, EventType,
          PEvent^.in_scroll_flag, HCEventType2String(EventType)]));
        PEvent := PEvent^.Next;
      end;
      frmMain.GTHEEventList.Items.EndUpdate;
      // ALE 20170601 Groups/Units
      PGroup := PStartGroup;
    end;
  end;

  procedure StartGroup(StartGroup: PHCGroup); export; cdecl;
  var
    PHCGThis: PHCGroup;
  begin
      // ALE 20130317 Fill up the SGlbxGroups
      PStartGroup := StartGroup;
  end;

  procedure HarpoonEventHead(HarpEventHead: PHCHarpoonEvent); export; cdecl;
  begin
    frmMain.PHarpEventHead := HarpEventHead;
  end;

  procedure SonobuoyRegionHead(SonobuoyRegionHead: PHCSonobuoyRegion); export; cdecl;
  begin
    frmMain.PSonobuoyRegionHead := SonobuoyRegionHead;
  end;

  procedure AllDeadUnitsPtr(AllDeadUnitsPtr: PHCDeadListItem); export; cdecl;
  begin
    frmMain.PAllDeadUnitsPtr := AllDeadUnitsPtr;
  end;

  procedure WeatherGroups(WeatherGroups: PHCGroup); export; cdecl;
  begin
    frmMain.PWeatherGroups := WeatherGroups;
  end;

  procedure VictoryConditionsList(VictoryConditionsList: PHCVictoryConditions);
  export; cdecl;
  begin
    frmMain.PVictoryConditionsList := VictoryConditionsList;
  end;

  procedure ActGroupPtr(ActGroup: PHCGroup); export; cdecl;
  begin
    PActGroup := ActGroup;
  end;

  procedure ActUnitPtr(ActUnit: PHCUnit); export; cdecl;
  begin
    PActUnit := ActUnit;
  end;

procedure SaveGame(FileNameIn: PAnsiChar; ScenSaveDataIn: PHCSCENARIO_SAVE_DATA); export; cdecl;
begin
  if (frmMain.SGckbEnabled1.Checked = True) then
  begin

    frmMain.SGmemMsgLog1.Lines.Insert(0, Format('%8.8d: Game Saved: uuid=%s, uuid_prev=%s, file=%s',
      [intGameTime, ScenSaveDataIn.uuid, ScenSaveDataIn.uuid_prev, FileNameIn]));

    if (frmMain.SGmemMsgLog1.Lines.Count > frmMain.SGedtLines1.Value) then
    begin
      frmMain.SGmemMsgLog1.Lines.Delete(frmMain.SGedtLines1.Value);
    end;
  end;
end;

procedure UnitFree(pUnit: PHCUnit); export; cdecl;
var
  lFormation: THCFORMATIONC;
begin
  if (UnitFormationList.TryGetValue(pUnit^.UUID, lFormation)) then
  begin
    lFormation.Free;
    UnitFormationList.Remove(pUnit^.UUID);
  end;
end;

function Effect02():short;export;cdecl;
var
  intItem: Integer;
  PGroup: PHCGroup;
  PUnit: PHCUnit;
  lRings: ULONGLONG;
  lSectors: ULONGLONG;
  lString: String;
  lFormation: THCFORMATIONC;
begin
  {
  begin  // ALE 20130819 call HC stock from the DLL
    if (@HCEffect02 <> nil) then
      HCEffect02();
    result := CTRUE;
  end
  }
  begin  // ALE 20130819 skip the effect if CTRUE
    result := CTRUE;
  end;
  // ALE 20180123 undertake patrolling & placekeeping activities
  // 1. Look at each unit's position in the formation
  // 2. Calculate the ideal position of the unit in the formation
  //   a. Sprint/Drift
  //   b. Hold position
  //   c. Center of sector
  //   d. Main body
  //   e. Hustle back into sector
  byte(PDLLBusy^) := CTRUE; // ALE 20130816 don't process other events in GE

  PGroup := PStartGroup;
  while (PGroup <> nil) do
  begin
    PUnit := PGroup^.Units;
    while (PUnit <> nil) do
    begin
      lRings := PUnit^.rings;
      lSectors := PUnit^.sectors;

      GroupOffsetCalculate(PUnit);
      //GroupOffsetCalculateGoal(PUnit);

      // ALE 20180206 do we want to recalculate group center and
      //  unit offsets here before we get started? (ExportDLL lazMoveUnits is doing this)
      // ALE 20180206 we should also store the unit offsets as range & bearing
      //  which seems to make more sense than x & y offsets
      // TODO ALE 20180206 need a calculation to look forward a second and see
      //  if the unit will be closer to its target formation position or now
      // TODO ALE 20180206 need a calculation to look forward a second and see
      //  how much closer unit will be to target formation position if it were
      //  headed straight there.
      // TODO ALE 20180206 Determine if Unit needs to make a change

      // ALE 20180222 Populate our list of formation info
      if (not UnitFormationList.TryGetValue(PUnit^.UUID, lFormation)) then
      begin
        // ALE 20180222 this unit doesn't have formation entries yet, make em
        lFormation := THCFORMATIONC.Create;
        lFormation.UUID := PUnit^.UUID;
        lFormation.Activity:=0;
        lFormation.PositionNow.Bearing:=-1;
        lFormation.PositionNow.Range:=-1;
        lFormation.PositionGoal.Bearing:=-1;
        lFormation.PositionGoal.Range:=-1;
        lFormation.PositionGoal.xOff:=-1;
        lFormation.PositionGoal.yOff:=-1;
        if (PGroup^.Units^.next = nil) then
        begin
          // ALE 20180418 if this is the only unit, then it is at the group center
          PUnit^.xOff := 0;
          PUnit^.yOff := 0;
          PUnit^.rings := MainBodyFlag;
        end;
        if ((PUnit^.rings and MainBodyFlag) > 0) then
        begin
          // ALE 20180418 Directly use the xOff and yOff if in Main Body
          lFormation.PositionGoal.xOff:=PUnit^.xOff;
          lFormation.PositionGoal.yOff:=PUnit^.yOff;
        end;
        UnitFormationList.AddOrSetValue(PUnit^.UUID, lFormation);
      end
      else
      begin
        // ALE 20180222 we have existing entries
        lFormation.UUID := PUnit^.UUID;
      end;

      // ALE 20180222 point the unit towards its formation position
      FormationUnitTurn(PUnit);

      if (PActUnit = PUnit) then
      begin
        // ALE 20180123 write a message about our formation position and action
        lString := PGroup^.id + ' ' + PUnit^.name
         + ' xOff=' + IntToStr(PUnit^.xOff) + ', yOff=' + IntToStr(PUnit^.yOff);
        lString := lString + ', Rings=' + HCFormationRings2String(lRings);
        lString := lString + ', Sectors=' + HCFormationSectors2String(lSectors);
        lString := lString + ', Now=' + Format('%0.2f@%3.0f', [lFormation.PositionNow.Range, lFormation.PositionNow.Bearing]);
        lString := lString + ', Goal=' + Format('%0.2f@%3.0f', [lFormation.PositionGoal.Range, lFormation.PositionGoal.Bearing]);
        frmMain.memForm.Lines.BeginUpdate;
        frmMain.memForm.Lines.Insert(0, lString);

        if (frmMain.memForm.Lines.Count > 1024) then
        begin
          frmMain.memForm.Lines.Delete(1024);
          frmMain.memForm.SelStart:=0;
          frmMain.memForm.SelLength:=0;
          frmMain.memForm.SetFocus;
        end;
        frmMain.memForm.Lines.EndUpdate;
      end;

      PUnit := PUnit^.next;
    end;

    PGroup := PGroup^.toSouth;
  end;

  byte(PDLLBusy^) := CFALSE;

  {
  else
  begin  // ALE 20130819 use HC stock
    result := CFALSE;
  end;
  }
end;

exports
  DLLVer,
  DLLVerInt,
  DLLDesc,
  DLLFree,
  DLLInit,
  ScenLoad,
  TimeFactor,
  GameTime
  ,
  StartGroup // ALE 20130205 Sends updated GroupPtr whenever that changes
  ,
  HarpoonEventHead // ALE 20130805 Sends updated soonest HarpoonEvent pointer whenever it changes
  ,
  SonobuoyRegionHead // ALE 20130812 Sends updated pointer to all sonobuoys when it changes
  ,
  AllDeadUnitsPtr // ALE 20130812 Sends updated pointer to the list of killed units used for victory condition evaluation
  ,
  WeatherGroups // ALE 20130812 Sends update GroupPtr whenever the top weather group changes
  ,
  VictoryConditionsList // ALE 20130812 Sends a pointer to the list of victory conditions when a scenario is loaded
  ,
  ActGroupPtr // ALE 20160305 Sends pointer to the Group the player just selected or NULL
  ,
  ActUnitPtr // ALE 20160305 Sends pointer to the Unit the player just selected or NULL
  ,
  SaveGame // ALE 20170923 UUIDs to associate any data with the right saved game file
  ,
  Effect02 // ALE 20180123 override the GE Patrolling & Placekeeping
  ,
  UnitFree // ALE 20180222 so we can delete items from formation dictionary
  ;
end.