library TestGroupIds;

{$mode delphi}{$H+}

uses
  Classes { you can add units after this },
  uHCDefines,
  mainform, uTestGroupIdsGlobals,
  uHCGCI,
  uHCGlobals,
  uHCTypeDefs,
  uHCEventHelpers,
  uHCDateTime,
  uHCAnnexDefs,
  uHCAnnexHelpers,
  Windows,
  Forms,
  ShellAPI,
  SysUtils,
  Types,
  Dialogs,
  Interfaces,
  Controls,
  DateUtils;

const
  DLLVERN = 2;
  DLLVERINTN = 34;

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 Testbed for creating and auditing group ids 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;
    uTestGroupIdsGlobals.PGEClosing := PGEClosing;
    uTestGroupIdsGlobals.PDLLBusy := PDLLBusy;
    frmMain := TfrmMain.Create(nil);
    // ALE 2020-08-14 let it float free frmMain.ParentWindow := hwndHC;
    frmMain.Caption := 'lazarus TestGroupIds Export DLL v' + IntToStr(DLLVERN) +
      ', ExportDLL Interface v' + IntToStr(DLLVERINTN);
    frmMain.memDLLInit.Lines.Add('lazarus TestGroupIds 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]));

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

    // ALE 20170224 Alert the user that the GE is too old for this ExportDLL
    if (verInterface < 30) then
    begin
      MessageDlg('GE too old', GetModuleName(hInstance) +
        ' is designed for HC2022.003+.  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
    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 = '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 = 'assign_group_id') then
        frmMain.HCassign_group_id := THCassign_group_id(funcTmp^.funcPtr)
      else if (funcTmp^.funcName = 'CreateGroup') then
        frmMain.HCCreateGroup := THCdllCreateGroup(funcTmp^.funcPtr);

      funcTmp := funcTmp^.Next;
    end;

    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;
  lSide: NativeInt;
begin
  // ALE 20200814 no group selected for potential turncoating
  // ALE 20200814 Deselect all of the Unit stuff
  frmMain.PSelectedUnit:=nil;
  frmMain.SGlblUnitIDName.Caption:='';

  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,
    uTestGroupIdsGlobals.intVerInterface, uTestGroupIdsGlobals.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 20200523 populate the sides dropdown
  frmMain.lbxSides.Items.Clear;
  for lSide := 0 to MAX_SIDE_NAMES - 1 do
  begin
    frmMain.lbxSides.Items.Add(AnnexData^.PBSStrings^.SideName[lSide]);
  end;
  frmMain.lbxSides.ItemIndex:=BLUESIDE;

end;

procedure MsgLog(MsgLine: PAnsiChar); export; cdecl;
begin
  if (frmMain.MLckbEnabled.Checked = True) then
  begin
    //ShowMessage(BoolToStr(frmMain.MLedtMessageToPost.Enabled, True));
    frmMain.MLmemMsgLog.Lines.Insert(0, Format('%8.8d: %s', [intGameTime, MsgLine]));
    if (frmMain.MLmemMsgLog.Lines.Count > frmMain.MLedtLines.Value) then
    begin
      frmMain.MLmemMsgLog.Lines.Delete(frmMain.MLedtLines.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

  dtNow := HCDateTimeInc(ScenData.dt_scen_start, intGameTime);

  // ALE 20220202 Calculate group statistics
  //if frmMain <> nil then
  //begin
  //  frmMain.CountGroups();
  //end;

  // 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;
var
  PHCGThis: PHCGroup;
begin
    // ALE 20130317 Fill up the SGlbxGroups
  frmMain.PStartGroup := StartGroup; // ALE 20211231 update before we re-list installations
  frmMain.PopulateGroupList(frmMain.SGlbxGroups);
end;

exports
  DLLVer,
  DLLVerInt,
  DLLDesc,
  DLLFree,
  DLLInit,
  ScenLoad,
  MsgLog,
  GameTime
  ,
  StartGroup // ALE 20130205 Sends updated GroupPtr whenever that changes
  ;
end.