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

// CC 20260921 jamming indicator (lightning bolt) create/update/remove helpers

interface

uses
  Classes, Types, Graphics,
  TGClasses, Globe4, TGSysUtils, GlobeUtils, TGPresenters, TGObjects,
  uCICG4Presenters;

const
  // CC 20260921 ppImage always stretch-draws centred on the point and the
  //  presenter has no offset property, so the bitmap is twice the size of the
  //  glyph and the bolt is drawn into the upper-right quadrant. That puts the
  //  bolt up and to the right of the group icon instead of on top of it.
  JAM_BITMAP_SIZE = 32;
  JAM_QUADRANT    = JAM_BITMAP_SIZE div 2;

  JAM_BOLT_COLOR = TColor($0000FFFF); // yellow (BGR)
  JAM_EDGE_COLOR = TColor($00202020); // near-black outline; clBlack is the mask

procedure CreateJamBolt(aGlobe: TGlobe4; aLayer: TGlobeLayer;
  const pCenter: TPointLL; var ioNextID: Integer;
  out presID: Integer; out objID: Integer);

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

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

implementation

// CC 20260921 paint a lightning bolt into the upper-right quadrant of aBitmap;
//  the rest of the bitmap stays clBlack so it masks out as transparent
procedure DrawBolt(aBitmap: TBitmap);
var
  lPts: array[0..6] of TPoint;
  lOX: Integer;
begin
  // CC 20260921 qualify: TGClasses also exports a bsSolid (TGlobeBrushStyle)
  aBitmap.Canvas.Brush.Style := Graphics.bsSolid;
  aBitmap.Canvas.Brush.Color := clBlack;
  aBitmap.Canvas.FillRect(Rect(0, 0, aBitmap.Width, aBitmap.Height));

  lOX := JAM_QUADRANT;  // left edge of the upper-right quadrant

  // 7-point zigzag inside a 16x16 box, bolt tip pointing down-left
  lPts[0] := Point(lOX + 10, 0);
  lPts[1] := Point(lOX +  3, 9);
  lPts[2] := Point(lOX +  7, 9);
  lPts[3] := Point(lOX +  5, 16);
  lPts[4] := Point(lOX + 13, 6);
  lPts[5] := Point(lOX +  9, 6);
  lPts[6] := Point(lOX + 13, 0);

  aBitmap.Canvas.Brush.Color := JAM_BOLT_COLOR;
  aBitmap.Canvas.Pen.Color   := JAM_EDGE_COLOR;
  aBitmap.Canvas.Pen.Width   := 1;
  aBitmap.Canvas.Polygon(lPts);
end;

procedure CreateJamBolt(aGlobe: TGlobe4; aLayer: TGlobeLayer;
  const pCenter: TPointLL; var ioNextID: Integer;
  out presID: Integer; out objID: Integer);
var
  lPres: TCICG4PointPresenter;
  lDataObj: TGeoDataObject;
begin
  lPres := TCICG4PointPresenter.Create(aGlobe, 0);
  aLayer.Presenters.Add(lPres);
  with lPres do
  begin
    PointType := ppImage;
    PointUnit := Pixel;
    Image := TPicture.Create;
    Image.Bitmap.Width  := JAM_BITMAP_SIZE;
    Image.Bitmap.Height := JAM_BITMAP_SIZE;
    DrawBolt(Image.Bitmap);
    // CC 20260921 clBlack is the mask colour, same convention as the group icons
    Image.Bitmap.TransparentColor := clBlack;
    Image.Bitmap.Transparent := True;
    PointSize := JAM_BITMAP_SIZE;
    MaxPointSize := JAM_BITMAP_SIZE;
  end;
  presID := lPres.PresenterID;

  lDataObj := TGeoDataObject.Create(aLayer.Objects);
  lDataObj.Centroid := pCenter;
  lDataObj.PresenterID := lPres.PresenterID;
  lDataObj.ID := ioNextID;
  objID := ioNextID;
  Inc(ioNextID);
end;

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

procedure RemoveJamBolt(aLayer: TGlobeLayer; presID, objID: Integer);
var
  lObj: TGlobeObject;
  lPres: TGlobePresenter;
begin
  lObj := aLayer.ObjectByID(objID);
  if lObj <> nil then
  begin
    aLayer.Objects.Delete(lObj);
    lObj.Free;
  end;
  lPres := aLayer.Presenters.ByID(presID, False);
  if lPres <> nil then
  begin
    // ALE 20220822 the presenter owns the bitmap; free it or the handle leaks
    TPointPresenter(lPres).Image.Free;
    aLayer.Presenters.Delete(lPres);
    lPres.Free;
  end;
end;

end.
