library lazMoveUnits;

{$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,
  uLazMoveUnitsGlobals,
  Windows,
  Forms,
  ShellAPI,
  SysUtils,
  Types,
  Dialogs,
  Interfaces,
  Controls,
  DateUtils;

const
  DLLVERN = 1;
  DLLVERINTN = 21;

var
  frmMain: TfrmMain;

  {*** Recalculate group position based on Main Body units in position ***}
  procedure HCGroupCenterReset(const pGroup: PHCGroup);
  var
    lUnit: PHCUnit;
    lLat, lLon: Int64;
    lCount: NativeInt;
    lGroupIsAir: CBOOL;
  begin
    lLat := 0; lLon := 0; lCount := 0;
    lUnit := pGroup^.Units;

    // ALE 20180418 single unit groups are always centered on the unit
    if (lUnit^.next = nil) then
    begin
      lLat := lUnit^.sLat;
      lLon := lUnit^.sLon;
    end
    else
    begin
      // ALE 20180418 multi-unit groups which may not have any main body units
      lGroupIsAir := HCUTIsAir(pGroup^.gtype);
      while (lUnit <> nil) do
      begin
        if (((lUnit^.rings and MainBodyFlag) = 0)
         and (lUnit^.independent <> FM_REFORMING)) then
        begin
          // ALE 20180418 aircraft don't affect group center in non-air groups
          if ((lGroupIsAir = CFALSE) and (HCUTIsAir(lUnit^.utype) = CFALSE)) then
          begin
          lLat := lLat + lUnit^.sLat;
          lLon := lLon + lUnit^.sLon;
          Inc(lCount);
          end;
        end;
        lUnit := lUnit^.next;
      end;
      if (lCount > 0) then
      begin
        lLat := lLat div lCount;
        lLon := lLon div lCount;
      end
      else
      begin
        // ALE 20180418 there weren't any acceptable main body units so take
        //  the first main body unit, if any
        lUnit := pGroup^.Units;
        while (lUnit <> nil) do
        begin
          if ((lUnit^.rings and MainBodyFlag) = 0) then
          begin
            lLat := lUnit^.sLat;
            lLon := lUnit^.sLon;
            break;
          end;
        end;
        // ALE 20180418 if there weren't any main body units, take the first
        //  unit as the group center
        if (lLat = 0) then
        begin
          lUnit := pGroup^.Units;
          lLat := lUnit^.sLat;
          lLon := lUnit^.sLon;
        end;
      end;
    end;
    pGroup^.sLat := lLat;
    pGroup^.sLon := lLon;
  end;
  {*** end HCGroupCenterCalculate ***}

  {*** 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 MoveUnits DLL by Tony Eischens';
  end;

  {*** Free DLL ***}
  procedure DLLFree(); export; cdecl;
  begin
    // Do any cleanup here, this is the end
    frmMain.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;
    uLazMoveUnitsGlobals.PGEClosing := PGEClosing;
    uLazMoveUnitsGlobals.PDLLBusy := PDLLBusy;

    frmMain := TfrmMain.Create(nil);
    // ALE 20180123 float outside HC frmMain.ParentWindow := hwndHC;
    frmMain.Caption := 'lazarus MoveUnits Export DLL v' + IntToStr(DLLVERN) +
      ', ExportDLL Interface v' + IntToStr(DLLVERINTN);
    frmMain.memDLLInit.Lines.Add('lazarus MoveUnits 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]));

    uLazMoveUnitsGlobals.intVerInterface := DLLVERINTN;
    uLazMoveUnitsGlobals.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 = '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 = 'Effect00') then
        HCEffect00 := 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,
      uLazMoveUnitsGlobals.intVerInterface, uLazMoveUnitsGlobals.intVerSaveGame);
    DatabaseVersionDB := DatabaseVersionDBIn; // ALE 20170923 current database
    ScenData := ScenDataIn; // ALE 20170923 unique identifiers, lineage, etc.
    ScenSaveData := ScenSaveDataIn; // ALE 20170923 save UUIDs and Scenario Orders

  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

    // 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.
  end;

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

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

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

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

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

function Effect00():short;export;cdecl;
var
  intItem: Integer;
  PGroup: PHCGroup;
  PUnit: PHCUnit;
  lRings: ULONGLONG;
  lSectors: ULONGLONG;
  lString: String;
  lGroupLatOld, lGroupLonOld: LongInt;
begin
  // ALE 20130819 skip the effect if CTRUE
  result := CTRUE;

  // ALE 20180416 Move each unit 1 second and group 1 second
  //  the trouble here is figuring out the group movement.
  byte(PDLLBusy^) := CTRUE; // ALE 20130816 don't process other events in GE

  PGroup := PStartGroup;
  while (PGroup <> nil) do
  begin
    lGroupLatOld := PGroup^.sLat;
    lGroupLonOld := PGroup^.sLon;
    PUnit := PGroup^.Units;
    while (PUnit <> nil) do
    begin
      {
      // ALE 20180416 move the non-loitering unit
      if ((HCUTIsAir(PUnit^.utype) = CTRUE) and (PGroup^.Units^.Air^.Throttle = TH_LOITER)) then
      begin

      end
      else
      }
      begin
        HCNewPos(PUnit^.sLon, PUnit^.sLat, PUnit^.course * SLIVER1, (PUnit^.kts * NM1) div 3600, 0);
      end;
      PUnit := PUnit^.next;
    end;
    // ALE 20180416 consider recalculating group center here
    HCGroupCenterReset(PGroup);

    PGroup := PGroup^.toSouth;
  end;

  // ALE 20180418 Help the Weather groups truck along
  PGroup := frmMain.PWeatherGroups;
  while (PGroup <> nil) do
  begin
    lGroupLatOld := PGroup^.sLat;
    lGroupLonOld := PGroup^.sLon;
    PUnit := PGroup^.Units;
    while (PUnit <> nil) do
    begin
      HCNewPos(PUnit^.sLon, PUnit^.sLat, PUnit^.course * SLIVER1, (PUnit^.kts * NM1) div 3600, 0);
      PUnit := PUnit^.next;
    end;
    // ALE 20180416 consider recalculating group center here
    HCGroupCenterReset(PGroup);

    PGroup := PGroup^.toSouth;
  end;

  byte(PDLLBusy^) := CFALSE;
end;

exports
  DLLVer,
  DLLVerInt,
  DLLDesc,
  DLLFree,
  DLLInit,
  ScenLoad,
  GameTime
  ,
  StartGroup // ALE 20130205 Sends updated GroupPtr whenever that changes
  ,
  SonobuoyRegionHead // ALE 20130812 Sends updated pointer to all sonobuoys when it changes
  ,
  WeatherGroups // ALE 20130812 Sends update GroupPtr whenever the top weather group changes
  ,
  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
  ,
  Effect00 // ALE 20180416 override the GE MoveUnits
  ;
end.