library GroupIdManager;

{$mode delphi}{$H+}

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

const
  DLLVERN = 9;
  DLLVERINTN = 34;
  AVAIL = 0;
  USED = 1;
  C1CNT: array[0..SIDES - 1] of NativeInt = (26, 26, 10);
  C2CNT = 62;
  C1: array[0..SIDES - 1, 0..26 - 1] of AnsiChar = (
   ('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K',
   'L', 'M', 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm'),
   ('Z', 'Y', 'X', 'W', 'V', 'U', 'T', 'S', 'R', 'Q', 'P',
   'O', 'N', 'z', 'y', 'x', 'w', 'v', 'u', 't', 's', 'r', 'q', 'p', 'o', 'n'),
   ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
   ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ')
   );
  C2: array[0..C2CNT - 1] of AnsiChar = ('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K',
   'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
   'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p',
   'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z', '0', '1', '2', '3', '4', '5',
   '6', '7', '8', '9');

var
  gPGEClosing: Pointer;
  gPDLLBusy: Pointer;
  intGameTime: Long;
  intGameTimeLeft: Long;
  AnnexData: PHCAnnexes_disk;
  DatabaseVersionDB: PHCDATABASE_VERSION;
  ScenData: PHCSCENARIO_DATA;
  ScenSaveData: PHCSCENARIO_SAVE_DATA;
  HCAnnexHelper: IHCAnnexHelper;
  intVerInterface: NativeInt;
  intVerSaveGame: NativeInt;
  gPStartGroup: PHCGroup;
  gFullyLoaded: Boolean;
  // ALE 20130908 pointers to functions exported by the GE
  HCQueueHarpoonEvent: THCQueueHarpoonEvent;
  NewPtr: THCNewPtr;
  DisposPtr: THCDisposPtr;
  HCdllCheckLatLonDepth: THCdllCheckLatLonDepth;
  HCannex_id_to_disk_id: THCannex_id_to_disk_id;
  HCdisk_id_to_annex_id: THCdisk_id_to_annex_id;
  HCMessageLogLine: THCMessageLogLine;
  HCassign_group_id: THCassign_group_id;
  // ALE 20220204 lists of group ids
  gIds: array[0..SIDES-1, 0..1] of TStringList;

  {*** 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;
  var
    lSide, lAU: NativeInt;
  begin
    // Do any cleanup here, this is the end
    // ALE 20220204 Clean up the lists of Ids
    for lSide := BLUESIDE to GREENSIDE do
    begin
      for lAU := AVAIL to USED do
      begin
        FreeAndNil(gIds[lSide][lAU]);
      end;
    end;
  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;
    lSide, lAU: NativeInt;
  begin
    // here we initialize globals and such for the life of the DLL
    // ALE 20120410 Freezes HC Application.Run;
    gPGEClosing := PGEClosing;
    gPDLLBusy := PDLLBusy;


    // 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
      if (funcTmp^.funcName = 'NewPtr') then
        NewPtr := funcTmp^.funcPtr
      else if (funcTmp^.funcName = 'DispPtr') then
        DisposPtr := THCDisposPtr(funcTmp^.funcPtr)
      else if (funcTmp^.funcName = 'annex_id_to_disk_id') then
        HCannex_id_to_disk_id := THCannex_id_to_disk_id(funcTmp^.funcPtr)
      else if (funcTmp^.funcName = 'disk_id_to_annex_id') then
        HCdisk_id_to_annex_id := THCdisk_id_to_annex_id(funcTmp^.funcPtr)
      else if (funcTmp^.funcName = 'MessageLogLine') then
        HCMessageLogLine := THCMessageLogLine(funcTmp^.funcPtr)
      else if (funcTmp^.funcName = 'assign_group_id') then
        HCassign_group_id := THCassign_group_id(funcTmp^.funcPtr);

      funcTmp := funcTmp^.Next;
    end;

    // ALE 20170224 Alert the user that the GE is too old for this ExportDLL
    if (verInterface < 30) then
    begin
      HCMessageLogLine(PChar('GE too old; ' + GetModuleName(hInstance) +
        ' is designed for HC2022.003+.  Please ' +
        ' update your GE or disable this ExportDLL.'));
    end;

    // ALE 20220204 Allocate the lists of Ids
    for lSide := BLUESIDE to GREENSIDE do
    begin
      for lAU := AVAIL to USED do
      begin
        gIds[lSide][lAU] := TStringList.Create;
        gIds[lSide][lAU].CaseSensitive:=True;
      end;
    end;

  end;

function GetGroupIdCorrectSide(const pGroup: PHCGroup): NativeInt;
var
  lIdS: String;
  lC: AnsiChar;
  lSide: NativeInt;
begin
  // ALE 20220204 logic for group ids
  // Blue AA -> Mz, aa -> mz
  // Red ZZ -> Na, zz -> na
  // Green 0A -> 9Z
  lIdS := Copy(pGroup^.id, 1, 2);
  for lSide := BLUESIDE to GREENSIDE do
  begin
    for lC in C1[lSide] do
    begin
      if lIdS[1] = lC then
      begin
        Result := lSide;
        Exit;
      end;
    end;
  end;
  Result := INVALID_SIDE;
end;

function CountGroups(const pSide: NativeInt): NativeInt;
var
  lPGroup: PHCGroup;
  lGroups, lGroupsBlueRed, lGroupsBlue, lGroupsRed, lGroupsGreen: NativeInt;
begin
  byte(gPDLLBusy^) := CTRUE;
  lPGroup := gPStartGroup;
  if (lPGroup <> nil) then
  begin
    lGroups := 0;

    while (lPGroup <> nil) do
    begin
      if lPGroup^.side = pSide then
        Inc(lGroups);
      lPGroup := lPGroup^.toSouth;
    end;
  end
  else
  begin
    lGroups := -1;
  end;
  Result := lGroups;

  byte(gPDLLBusy^) := CFALSE;
end;

procedure RecalcUsedGroupIds;
var
  lIdS: String;
  lGroup: PHCGroup;
  //lSide: NativeInt;
  lSideCorrect: NativeInt;
  lIdI: NativeInt;
begin
  // ALE 20220406 this procedure removes the used group ids, no matter if
  //  they are meant for a particular side from the list of available group
  //  ids for that side and adds them to the list of used group ids for the
  //  side.
  lGroup := gPStartGroup;
  while (lGroup <> nil) do
  begin
    lIdS := Copy(lGroup^.id, 1, 2);
    lSideCorrect := GetGroupIdCorrectSide(lGroup);

    lIdI := gIds[lGroup^.side][USED].IndexOf(lIdS);
    if lIdI = -1 then
      gIds[lGroup^.side][USED].Add(lIds); // ALE 20220406 Id allocated
    lIdI := gIds[lSideCorrect][AVAIL].IndexOf(lIdS);
    if lIdI <> -1 then
      gIds[lSideCorrect][AVAIL].Delete(lIdI);
    {
    for lSide := BLUESIDE to GREENSIDE do
    begin
       lIdI := gIds[lSide][AVAIL].IndexOf(lIdS) ;
       if lIdI <> -1 then
       begin
         gIds[lSide][AVAIL].Delete(lIdI);
       end;
    end;
    }
    lGroup := lGroup^.toSouth;
  end;
  //debug gIds[BLUESIDE][USED].SaveToFile('C:\Games\HC\GroupIdsBlue.txt');
  //debug gIds[REDSIDE][USED].SaveToFile('C:\Games\HC\GroupIdsRed.txt');
  //debug gIds[GREENSIDE][USED].SaveToFile('C:\Games\HC\GroupIdsGreen.txt');
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;
  lIdI: NativeInt;
  lSide, lAU: NativeInt;
  lIdC1, lIdC2: NativeInt;
  lC1, lC2: NativeInt;
  lGroup: PHCGroup;
  lIdS: String;
begin
  gFullyLoaded := False;
  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, HCannex_id_to_disk_id,
    intVerInterface, 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 20220204 Clean up the lists of Ids
  for lSide := BLUESIDE to GREENSIDE do
  begin
    for lAU := AVAIL to USED do
    begin
      gIds[lSide][lAU].Clear;
    end;
  end;
  // ALE 20220205 populate Ids available
  for lSide := BLUESIDE to GREENSIDE do
  begin
    for lIdC1 := 0 to C1CNT[lSide] - 1 do
    begin
      for lIdC2 := 0 to C2CNT - 1 do
      begin
        gIds[lSide][AVAIL].Add(C1[lSide][lIdC1] + C2[lIdC2]);
      end;
    end;
  end;
  // ALE 20220205 Finally we need to look at any Group Ids already in the
  //  scenario we just loaded and rationalize them by putting them into the
  //  used bucket.  Keep in mind, an already used Blue or Red group id
  //  could fall into either the new Blue or Red bucket
  RecalcUsedGroupIds();
end;

procedure ScenLoaded(intWhichRound: Long) export; cdecl;
var
  lAU: NativeInt;
  lIdC1, lIdC2: NativeInt;
  lC1, lC2: NativeInt;
begin
  // ALE 20220327 once we hit SCENLOADED_EXPORTDLLS_DONE, we can stop
  //  checking for existing group id assignment each time we have a new group
  RecalcUsedGroupIds();
  if intWhichRound = SCENLOADED_INTERNAL_DONE then
  begin
    // ALE 20220205 Finally we need to look at any Group Ids already in the
    //  scenario we just loaded and rationalize them by putting them into the
    //  used bucket.  Keep in mind, an already used Blue or Red group id
    //  could fall into either the new Blue or Red bucket
  end
  else // SCENLOADED_EXPORTDLLS_DONE
  begin
    // ALE 20220216 The scenario is really beginning now
    //  it is a notification message only, don't modify the HC
    //  game state here, it should ahve been done in SCENLOADED_INTERNAL_DONE
    gFullyLoaded := True;
    //HCMessageLogLine(PChar('GroupIdMgr ScenLoaded Blue Ids Used: '
    //+ IntToStr(gIds[BLUESIDE][USED].Count) + ' Red Ids Used: '
    //+ IntToStr(gIds[REDSIDE][USED].Count) + ' Green Ids Used: '
    //+ IntToStr(gIds[GREENSIDE][USED].Count)));
  end;
end;

procedure GameTime(GameTime: Long; GameTimeLeft: Long); export; cdecl;
var
  PEvent: PHCHarpoonEvent;
  PGroup: PHCGroup;
  EventType: uchar;
  strGroupID: string;
  dtNow: THCDateTimeRec;
  lGroupCount: array[0..SIDES-1] of NativeInt;
  lSide: NativeInt;
begin
  intGameTime := GameTime;
  intGameTimeLeft := GameTimeLeft; // ALE 20150712 store remaining time

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

  // ALE 20220406 report stats each game second
  for lSide := BLUESIDE to GREENSIDE do
  begin
    lGroupCount[lSide] := CountGroups(lSide);
  end;
  {
  HCMessageLogLine(PChar('GroupIdMgr Blue Ids Used: '
  + IntToStr(gIds[BLUESIDE][USED].Count) + ' Red Ids Used: '
  + IntToStr(gIds[REDSIDE][USED].Count) + ' Green Ids Used: '
  + IntToStr(gIds[GREENSIDE][USED].Count)
  + ' Blue Ids Available: '
  + IntToStr(gIds[BLUESIDE][AVAIL].Count) + ' Red Ids Available: '
  + IntToStr(gIds[REDSIDE][AVAIL].Count) + ' Green Ids Available: '
  + IntToStr(gIds[GREENSIDE][AVAIL].Count)
  + ' Blue Group Count: '
  + IntToStr(lGroupCount[BLUESIDE]) + ' Red Group Count: '
  + IntToStr(lGroupCount[REDSIDE]) + ' Green Group Count: '
  + IntToStr(lGroupCount[GREENSIDE])));
  }
  // 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
  gPStartGroup := StartGroup; // ALE 20211231 update before we re-list installations
end;

procedure AssignGroupId(pGroup: PHCGroup); export; cdecl;
var
  lGroup: PHCGroup;
  lC1, lC2: AnsiChar;
  lIdS: String;
  lIdI: NativeInt;
begin
  // ALE 20220204 logic for group ids
  // Blue AA -> Mz, aa -> mz
  // Red ZZ -> Na, zz -> na
  // Green 0A -> 9Z
  // We shall populate a list of all group ids
  //  Index, Group Id, Used by side
  //
  byte(gPDLLBusy^) := CTRUE;
  if (NOT gFullyLoaded) then
  begin
    RecalcUsedGroupIds();
  end;
  if (gIds[pGroup^.side][AVAIL].Count > 0) then
  begin
    lIds := gIds[pGroup^.side][AVAIL][0];
    // ALE 20220205 now move the Id to the used list
    gIds[pGroup^.side][USED].Add(lIds);
    gIds[pGroup^.side][AVAIL].Delete(0);
    // ALE 20220205 and do the assignment
    pGroup^.id[0] := lIds[1];
    pGroup^.id[1] := lIds[2];
  end
  else
  begin
    // ALE 20220205 no more Ids available
    HCMessageLogLine(PChar('!!!Couldn''t assign ' + AnnexData.PBSStrings^.SideName[pGroup^.side] + ' Group ID, all used up!!!'));
  end;
  byte(gPDLLBusy^) := CFALSE;
end;

function GroupFree(pGroup: PHCGroup): CBOOL; export; cdecl;
var
  lIdS: String;
  lIdI: NativeInt;
  lSide: NativeInt;
  lSideCorrect: NativeInt;
begin
  byte(gPDLLBusy^) := CTRUE;
  lIdS := Copy(pGroup^.id, 1, 2);
  lSide := pGroup^.side;
  lSideCorrect := GetGroupIdCorrectSide(pGroup);
  lIdI := gIds[lSide][USED].IndexOf(lIdS) ;

  // ALE 20220222 remove from USED list :)
  if lIdI <> -1 then
  begin
    gIds[lSide][USED].Delete(lIdI);
  end;
  // ALE 20220222 Get us ready to re-assign the Id
  //  We do have situations at scenario load where we could
  //   free a group that isn't in the 'used' bucket but is in the
  //   available bucket.
  // ALE 20220406 from <> to = in the next line, add to available
  //  if it isn't already there...
  if gIds[lSideCorrect][AVAIL].IndexOf(lIds) = -1 then
  begin
    // ALE 20220406 we should only add Ids valid for a side
    //  back into the affected side's pool of available Ids.  Similarly
    //  add a freed Id back into the correct pool
    gIds[lSideCorrect][AVAIL].Add(lIds);
  end;
  byte(gPDLLBusy^) := CFALSE;

  result := CFALSE; // ALE 20220206 we didn't free the group
end;

exports
  DLLVer,
  DLLVerInt,
  DLLDesc,
  DLLFree,
  DLLInit,
  ScenLoad,
  GameTime
  ,
  StartGroup // ALE 20130205 Sends updated GroupPtr whenever that changes
  ,
  AssignGroupId // ALE 20220203 Lets us assign a Group Id
  ,
  GroupFree // ALE 20220206 So we can recycle freed up Group Ids
  ,
  ScenLoaded // ALE 20220216 So we can synch list of Group Ids
  ;
end.