{$mode objfpc}{$H+}
unit uGroupIcon;

// CC 20260313 group icon create/update/remove helpers

interface

uses
  Graphics, ImgList,
  TGClasses, TGSysUtils, TGPresenters, TGObjects,
  uHCTypeDefs, uHCDefines,
  uCICG4Presenters;

function GetIconIndex(const ASide: uchar; const SSide, UType: string): Integer;

procedure UpdateGroupIconPosition(aLayer: TGlobeLayer; objID: Integer;
  const pCenter: TPointLL);

// CC 20260924 aFaded draws the icon at 50% opacity (per-pixel alpha); used for
//  the group being formation-edited so its position icon isn't taken for a unit
procedure UpdateGroupIconBitmap(aLayer: TGlobeLayer; presID: Integer;
  aIcons: TCustomImageList; const ASide: uchar; const UType: string;
  aFaded: Boolean = False);

procedure RemoveGroupIcon(aLayer: TGlobeLayer; presID, objID: Integer);

implementation

uses
  FPImage, GraphType, IntfGraphics;

const
  // CC 20260924 FPColor alpha for the faded group icon (0..$FFFF): 50%
  FADED_ICON_ALPHA = $7FFF;

function GetIconIndex(const ASide: uchar; const SSide, UType: string): Integer;
var
  lCol: NativeInt;
  lRow: NativeInt;
begin
  // TODO ALE 20220707 this only shows the dark friendly symbols, no NTDS, etc.
  lCol := ASide;

  if UType = Char(MT_SHIP) then lRow := 0
  else if UType = Char(MT_CARRIER) then lRow := 1
  else if UType = Char(MT_SUB) then lRow := 2
  else if UType = Char(MT_AC) then lRow := 3
  else if UType = Char(MT_HELO) then lRow := 4
  else if UType = Char(MT_MISSILE) then lRow := 5
  else if UType = Char(MT_TORP) then lRow := 6
  else if UType = Char(MT_AIRFIELD) then lRow := 7
  else if UType = Char(MT_BASE) then lRow := 8
  else if UType = Char(MT_PORT) then lRow := 9
  else if UType = Char(MT_NUKEAREA) then lRow := 10
  else if UType = Char(MT_REF) then lRow := 11
  else if UType = Char(MT_SAMFIXED) then lRow := 12
  else if UType = Char(MT_SAMMOBILE) then lRow := 13
  else if UType = Char(MT_CONVOY) then lRow := 14
  else if UType = Char(MT_ARMORED) then lRow := 15
  else if UType = Char(MT_CITY) then lRow := 16
  else if UType = Char(MT_SATELLITE) then lRow := 17
  else lRow := 17;

  lCol := lCol * 18; // ALE 20260319 before HCE - 2024.003 - 2024-07-10 added
   // Satellites, use 17 instead of 18

  result := lCol + (lRow + 1) - 1; // ALE 20220707 index into GR_ICONS.BMP
end;

procedure UpdateGroupIconPosition(aLayer: TGlobeLayer; objID: Integer;
  const pCenter: TPointLL);
var
  lObj: TGlobeObject;
begin
  lObj := aLayer.ObjectByID(objID);
  if lObj <> nil then
    TGeoDataObject(lObj).Centroid := pCenter;
end;

// CC 20260924 32-bit copy of aSrc: black (the icon mask colour) fully
//  transparent, everything else at FADED_ICON_ALPHA. LCL's Win32 StretchMaskBlt
//  alpha-blends 32-bit bitmaps that carry alpha.
procedure MakeFadedBitmap(aSrc, aDest: TBitmap);
var
  lSrc, lDst: TLazIntfImage;
  lDesc: TRawImageDescription;
  x, y: Integer;
  c: TFPColor;
begin
  lSrc := aSrc.CreateIntfImage;
  lDst := TLazIntfImage.Create(0, 0);
  try
    lDesc.Init_BPP32_B8G8R8A8_BIO_TTB(aSrc.Width, aSrc.Height);
    lDst.DataDescription := lDesc;
    for y := 0 to aSrc.Height - 1 do
      for x := 0 to aSrc.Width - 1 do
      begin
        c := lSrc.Colors[x, y];
        if (c.Red = 0) and (c.Green = 0) and (c.Blue = 0) then
          c.Alpha := alphaTransparent
        else
          c.Alpha := FADED_ICON_ALPHA;
        lDst.Colors[x, y] := c;
      end;
    aDest.LoadFromIntfImage(lDst);
  finally
    lDst.Free;
    lSrc.Free;
  end;
end;

procedure UpdateGroupIconBitmap(aLayer: TGlobeLayer; presID: Integer;
  aIcons: TCustomImageList; const ASide: uchar; const UType: string;
  aFaded: Boolean);
var
  lPres: TGlobePresenter;
  lTmp: TBitmap;
begin
  lPres := aLayer.Presenters.ByID(presID, False);
  if lPres <> nil then
  begin
    with TCICG4PointPresenter(lPres) do
    begin
      // CC 20260924 draw into a fresh 16x16 so switching between faded (32-bit
      //  alpha) and normal (colour-keyed) never inherits the other's format
      lTmp := TBitmap.Create;
      try
        lTmp.SetSize(Image.Bitmap.Width, Image.Bitmap.Height);
        lTmp.Canvas.Brush.Color := clBlack;
        lTmp.Canvas.FillRect(0, 0, lTmp.Width, lTmp.Height);
        if (aIcons.Count > 0) and
           (GetIconIndex(ASide, '', UType) < aIcons.Count) then
          aIcons.Draw(lTmp.Canvas, 0, 0, GetIconIndex(ASide, '', UType), True);
        if aFaded then
        begin
          MakeFadedBitmap(lTmp, Image.Bitmap);
          Image.Bitmap.Transparent := False;
          ImageTransparent := False;  // the presenter re-applies this every render
        end
        else
        begin
          Image.Bitmap.Assign(lTmp);
          Image.Bitmap.TransparentColor := clBlack;
          Image.Bitmap.Transparent := True;
          ImageTransparent := True;
        end;
      finally
        lTmp.Free;
      end;
    end;
  end;
end;

procedure RemoveGroupIcon(aLayer: TGlobeLayer; presID, objID: Integer);
var
  obj: TGlobeObject;
  pres: TGlobePresenter;
begin
  obj := aLayer.ObjectByID(objID);
  if obj <> nil then
  begin
    aLayer.Objects.Delete(obj);
    obj.Free;
  end;
  pres := aLayer.Presenters.ByID(presID, False);
  if pres <> nil then
  begin
    TPointPresenter(pres).Image.Free;
    aLayer.Presenters.Delete(pres);
    pres.Free;
  end;
end;

end.