library HCMQTTLink;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  System.SysUtils,
  System.Classes,
  System.UITypes,
  System.IniFiles,
  ShellAPI,
  Winapi.Windows,
  Winapi.Messages,
  uHCDefines,
  uHCGCI,
  uHCGlobals,
  uHCTypeDefs,
  uHCEventHelpers,
  uHCDateTime,
  uHCAnnexDefs,
  uHCAnnexHelpers,
  uLazHarpoonEventsMQTTGlobals
  ;

const
  DLLVERN = 4;
  DLLVERINTN = 25;

var
  gSendMessageMsg: DWORD = 0;
  gReceiverHandle: THandle;

procedure SendData(var copyDataStruct: TCopyDataStruct); forward;
procedure SendString(const pStrMsg: String); forward;
procedure SendRecord(const pTopic, pMessage: String); forward;


{$R *.res}

function ShowDllPath:String; stdcall;
var
  TheFileName : array[0..MAX_PATH] of char;
begin
 FillChar(TheFileName, sizeof(TheFileName), #0);
 GetModuleFileName(hInstance, TheFileName, sizeof(TheFileName));
 Result := TheFileName;
end;

  {*** 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 Harpoon Event pub via MQTT DLL by Tony Eischens';
  end;

  {*** Free DLL ***}
  procedure DLLFree(); export; cdecl;
  begin
    // Do any cleanup here, this is the end
    // ALE 20200919 close the MQTT Sender
    // ALE 20200928 SendMessage waits for receiver to process
    //  but in exchange we can free the data
    SendMessage(gReceiverHandle, WM_CLOSE, WPARAM(0), LPARAM(0));
    {
    frmMain.Free;
    }
    //MQTTClient.FMQTTClient.Free;
    //MQTTClient.Free;

  end;

  {*** Init DLL ***}
  procedure DLLInit(hwndHC: HWND; pathHC: PAnsiChar; verHC: PAnsiChar;
    verSaveGame: longword; funcRefs: PHCDLL_FUNC_REF; PGEClosing: Pointer;
    PDLLBusy: Pointer; verInterface: longword; srandSeed: ulong; harpoon_uuid_session: HCUUID); export; cdecl;
  var
    funcTmp: PHCDLL_FUNC_REF;
    lIniHC: TIniFile;
    lGUID: TGUID;
  begin
    gSendMessageMsg := RegisterWindowMessage('HCMQTTMessage');
    // here we initialize globals and such for the life of the DLL
    //Application.Initialize;
    // ALE 20120410 Freezes HC Application.Run;
    ulazHarpoonEventsMQTTGlobals.PGEClosing := PGEClosing;
    ulazHarpoonEventsMQTTGlobals.PDLLBusy := PDLLBusy;

    gHarpPath := pathHC;
    gGUIDSession := harpoon_uuid_session;
    {
    frmMain := TfrmMain.Create(nil);
    frmMain.tmrMQTTConnect.Enabled:=True;
    frmMain.ParentWindow := hwndHC;
    frmMain.Caption := 'lazarus GUI Export DLL v' + IntToStr(DLLVERN) +
      ', ExportDLL Interface v' + IntToStr(DLLVERINTN);
    frmMain.memDLLInit.Lines.Add('lazarus Harpoon Event pub via MQTT 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]));
    }
    // ALE 20200826 Read or Create the Harpoon installation UUID
    // ALE 20200120 we need a GUID, try to load it from main game dir
    lIniHC := TIniFile.Create(ExtractFilePath(ShowDLLPath) + '..\' + HCINIFILENAME);
    gGUID := LowerCase(lIniHC.ReadString('MAIN', 'InstallUUID', ''));
    if (gGUID = '') then
    begin
      CreateGUID(lGUID);
      gGUID := Copy(LowerCase(GUIDToString(lGUID)), 2, 36);
      lIniHC.WriteString('MAIN', 'InstallUUID', gGUID);
    end;
    gTopicBase := Format('TGP/HC/%s/%s/', [gGUID, LowerCase(gGUIDSession)]);

    {
    frmMain.memDLLInit.Lines.Add('InstallUUID = ' + gGUID);

    frmMain.edtUsername.Text:=lIniHC.ReadString('ExportDLL_lazHarpoonEventsMQTT', 'MQTT_Username', '');
    frmMain.edtPassword.Text:=frmMain.DecodeString(lIniHC.ReadString('ExportDLL_lazHarpoonEventsMQTT', 'MQTT_Password', ''));
    if ((frmMain.edtUsername.Text <> '') AND (frmMain.edtPassword.Text <> '')) then
      frmMain.ckbCredentials.Checked:=True;
    }
    //InitMQTT(MQTTClient);
    //FakeMainThread:= TFakeMainThread.Create(False);
    //MQTTClientThread := TCICMQTTThread.Create(False);
    lIniHC.Free;

    ulazHarpoonEventsMQTTGlobals.intVerInterface := DLLVERINTN;
    ulazHarpoonEventsMQTTGlobals.intVerSaveGame := verSaveGame;
    {
    // ALE 20170224 Alert the user that the GE is too old for this ExportDLL
    if (verInterface < 23) then
    begin
      MessageDlg('GE too old', GetModuleName(hInstance) +
        ' is designed for HC2020.009+.  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
        NewPtr := funcTmp^.funcPtr
      else if (funcTmp^.funcName = 'DispPtr') then
        DisposPtr := THCDisposPtr(funcTmp^.funcPtr)
      else if (funcTmp^.funcName = 'QueueHarpoonEvent') then
        HCQueueHarpoonEvent := THCQueueHarpoonEvent(funcTmp^.funcPtr)
      else if (funcTmp^.funcName = 'dllCheckLatLonDepth') then
        HCdllCheckLatLonDepth := THCdllCheckLatLonDepth(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
      begin
        HCMessageLogLine:=THCMessageLogLine(funcTmp^.funcPtr);
      end;

      funcTmp := funcTmp^.Next;
    end;

    SendRecord(gTopicBase + 'GameSession', Format('{"InstallUUID": "%s", "SessionUUID": "%s", "srandSeed": %d, "verHC": "%s"}',
     [gGUID, gGUIDSession, srandSeed, verHC]));
    //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;
    lScenarioUUID, lSaveUUID: String;
  begin
    // ALE 20201014 done in DLLInit gHarpPath := strHarpPath;
    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,
      ulazHarpoonEventsMQTTGlobals.intVerInterface, ulazHarpoonEventsMQTTGlobals.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 20201001 build up JSON for Scenario/Save Load
    lScenarioUUID := '';
    lSaveUUID := '';
    if ScenSaveDataIn <> nil then
    begin
      lSaveUUID := ScenSaveDataIn^.uuid;
    end;
    if ScenDataIn <> nil then
    begin
      lScenarioUUID := ScenDataIn^.Lineage.Bottom^.uuid;
    end;
    SendRecord(gTopicBase + 'ScenLoad',
     Format('{"ScenarioUUID": "%s", "SaveUUID": "%s", "GameTime": %d'
      + ', "ScenarioFileName": "%s", "ScenarioNumber": %d, "BattleSetNumber": %d}',
     [lScenarioUUID, lSaveUUID, intGameTimeIn, ExtractFileName(strScenFPath), intScenNum, intBSNum]));
  end;

  procedure TimeFactor(TimeFactor: longint); export; cdecl;
  begin
  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 20200827 publish even if not connected as they queue up
  SendRecord(gTopicBase + 'GameTime', Format('{"GameTime": %d}', [intGameTime]));
  //HCMessageLogLine(PChar(lPubMsg));
end;

procedure HarpoonEventQueued(HarpEvent: PHCHarpoonEvent); export; cdecl;
begin
  if (HarpEvent <> nil) then
  begin
    SendRecord(gTopicBase + 'HarpoonEvents', HCEventToJSON(intGameTime, HarpEvent));
  end;
  //frmMain.PHarpEvent := HarpEvent;
end;

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

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

procedure SaveGame(FileNameIn: PAnsiChar; ScenSaveDataIn: PHCSCENARIO_SAVE_DATA); export; cdecl;
begin
end;

procedure UnitSink(UnitID: byte; GroupID: PAnsiChar; UUID: HCUUID; AnnexID: ID); export; cdecl;
begin
  SendRecord(gTopicBase + 'UnitSink', Format('{"UUID": "%s", "GroupId": "%s", "UnitId": %d, "AnnexId": %d}', [UUID, GroupID, UnitID, AnnexID]));
end;

procedure UnitFree(UnitID: byte; GroupID: PAnsiChar; UUID: HCUUID; AnnexID: ID); export; cdecl;
begin
  SendRecord(gTopicBase + 'UnitFree', Format('{"UUID": "%s", "GroupId": "%s", "UnitId": %d, "AnnexId": %d}', [UUID, GroupID, UnitID, AnnexID]));
end;

procedure UnitNew(UnitID: byte; GroupID: PAnsiChar; utype: shortint;
  side: byte; annexID: ID; Name: PAnsiChar; UUID: HCUUID); export; cdecl;
begin
  SendRecord(gTopicBase + 'UnitNew', Format('{"UUID": "%s", "GroupId": "%s", "UnitId": %d, "AnnexId": %d, "Side": %d, "Name": "%s"}', [UUID, GroupID, UnitID, AnnexID, side, Name]));
end;



procedure SendData(var copyDataStruct: TCopyDataStruct);
var
  res:integer;
  lIter: NativeUInt;
  //lRes: LongBool;
  lShellExec: TShellExecuteInfo;
begin
  gReceiverHandle := FindWindow(PChar('TfrmHCMQTTSender'),PChar('HCMQTTSender'));
  if gReceiverHandle <> 0 then
  begin
    // ALE 20200928 SendMessage waits for receiver to process
    //  but in exchange we can free the data
    res := SendMessage(gReceiverHandle, WM_COPYDATA, WPARAM(gReceiverHandle), LPARAM(@copyDataStruct));
    //HCMessageLogLine(PAnsiChar(AnsiString(Format('SendMessage Result: %d', [res]))));
    // ALE 20200928 PostMessage does not wait for the message to be
    //  processed, so the receiver has to process it.
    //lRes := PostMessage(gReceiverHandle, WM_COPYDATA, WPARAM(gReceiverHandle), LPARAM(@copyDataStruct));

    // ALE 20200924 free the copyDataStruct and contents
    FreeMem(copyDataStruct.lpData);
  end
  else
  begin
    //ShowMessage('CopyData Receiver NOT found!');
    // ALE 20200918 fire up MQTT Application
    ZeroMemory(@lShellExec, SizeOf(lShellExec));
    lShellExec.cbSize := SizeOf(lShellExec);
    lShellExec.fMask := SEE_MASK_WAITFORINPUTIDLE;
    lShellExec.Wnd := 0;
    lShellExec.lpVerb := 'open';
    lShellExec.lpFile := PChar(gHarpPath + '\ExportDLLs\HCMQTT\HCMQTTSender.exe');
    lShellExec.nShow := SW_SHOWNORMAL;
    if NOT ShellExecuteEx(@lShellExec) then
    begin
      // ALE 20200918 failed to start sender
    end
    else
    begin
      for lIter := 0 to 50 do
      begin
        // ALE 20201014 SEE_MASK_WAITFORINPUTIDLE doesn't really mean the
        //  target application is ready to process messages, only that a thread
        //  has started so we sit around and wait...
        gReceiverHandle := FindWindow(PChar('TfrmHCMQTTSender'),PChar('HCMQTTSender'));
        if (gReceiverHandle <> 0) then
        begin
          Break;
        end;
        Sleep(100);
      end;

      if gReceiverHandle <> 0 then
      begin
        SendData(copyDataStruct);
      end
      else
      begin
        // ALE 20200918 couldn't find window
      end;
    end;
  end;
end;

procedure SendString(const pStrMsg: String);
var
  stringToSend:String;
  copyDataStruct:TCopyDataStruct;
begin
//stringToSend := 'About Delphi Programming';
stringToSend := pStrMsg;
copyDataStruct.dwData := 0; //use it to identify the message contents
copyDataStruct.cbData := 1 + ByteLength(stringToSend);
copyDataStruct.lpData := PChar(stringToSend);
SendData(copyDataStruct);
end;

procedure SendRecord(const pTopic, pMessage: String);
var
  copyDataStruct:TCopyDataStruct;
  lMessage: THCMessage;
  lMessageMS: TMemoryStream;
begin
  if SmallInt(ulazHarpoonEventsMQTTGlobals.PGEClosing^) = CFALSE then
  begin
  // ALE 20200918 start the record with the sizes,
  //  then stream all of the
  //  data into a memorystream, send that, decode
  //  on the receiving side
  lMessage.topic := pTopic;
  lMessage.msg := pMessage;
  lMessage.topicLen := Length(lMessage.topic);
  lMessage.msgLen := Length(lMessage.msg);
  // ALE 20200918 copy to memory stream
  lMessageMS := TMemoryStream.Create;
  lMessageMS.Write(lMessage.topicLen, SizeOf(lMessage.topicLen));
  lMessageMS.Write(lMessage.msgLen, SizeOf(lMessage.msgLen));
  lMessageMS.Write(TEncoding.Unicode.GetBytes(lMessage.topic), lMessage.topicLen * SizeOf(Char));
  lMessageMS.Write(TEncoding.Unicode.GetBytes(lMessage.msg), lMessage.msgLen * SizeOf(Char));

  copyDataStruct.dwData := gSendMessageMsg; //use it to identify the message contents
  copyDataStruct.cbData := lMessageMS.Size;
  copyDataStruct.lpData := lMessageMS.Memory;
  SendData(copyDataStruct);
  end;
end;

exports
  DLLVer,
  DLLVerInt,
  DLLDesc,
  DLLFree,
  DLLInit,
  ScenLoad,
  TimeFactor,
  GameTime,
  HarpoonEventQueued // ALE 20200825 Sends HarpoonEvent pointer when an event is added
  ,
  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
  ,
  UnitSink // ALE 20201015 Capture sinkings
  ,
  UnitFree // ALE 20201015 When units are actually freed whether destroyed or landed or...
  ,
  UnitNew // ALE 20201015 For when new units show up, AC launching, etc.
  ;
end.