{*********************************************}
{  TeeChart Pro - TTagCloudSeries             }
{  Copyright (c) 2011-2020 by Steema Software }
{*********************************************}
unit TeeTagCloud;
{$I TeeDefs.inc}

interface

uses
  {$IFNDEF LINUX}
  {$IFNDEF FMX}
  Windows,
  {$ENDIF}
  {$ENDIF}
  Classes, SysUtils,

  {$IFDEF D17}
  System.UITypes, System.Types,
  {$ENDIF}

  {$IFDEF FMX}
  FMX.Types,

  {$IFDEF D19}
  FMX.Graphics,
  {$ENDIF}

  {$ELSE}
  Graphics,
  {$ENDIF}

  {$IFDEF FMX}
  FMXTee.Canvas, FMXTee.Procs, FMXTee.Engine, FMXTee.Chart,
  FMXTee.Series.Surface
  {$ELSE}
  TeCanvas, TeeProcs, TeEngine, Chart, TeeSurfa
  {$ENDIF}
  ;

type
  TTagCloudSeries=class; // forward

  TDrawTagEvent=procedure(Sender:TTagCloudSeries; ValueIndex:Integer) of object;

  TTagCloudOrder=(toText, toValue, toNone);

  TTagCloudSeries=class(TCustom3DPaletteSeries)
  private
    FFilter     : String;
    FFont       : TTeeFont;
    FSeparation : Integer;

    FOnDrawTag  : TDrawTagEvent;

    function GetGradient:TTeeGradient;
    procedure SetFilter(const Value: String);
    procedure SetFont(const Value: TTeeFont);
    procedure SetGradient(const Value: TTeeGradient);
    procedure SetSeparation(const Value: Integer);
    function ShouldDraw(ValueIndex:Integer):Boolean;
  protected
    Procedure AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False); override;
    procedure AssignFormatting(Source: TChartSeries); override;
    procedure DrawAllValues; override;
    procedure GalleryChanged3D(Is3D: Boolean); override;
    class Function GetEditorClass:String; override;
    Procedure PrepareLegendCanvas( ValueIndex:Integer; var BackColor:TColor;
                                   var BrushStyle:{$IFDEF FMX}TBrushKind{$ELSE}TBrushStyle{$ENDIF}); override;
    Procedure SetParentChart(Const Value:TCustomAxisPanel); override;
  public
    Positions : Array of TRect;

    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    function AddTag(const Text:String; const Value:Double):Integer;
    procedure Assign(Source:TPersistent); override;
    Function CalcXPos(ValueIndex:Integer):Integer; override;
    Function CalcYPos(ValueIndex:Integer):Integer; override;
    function Clicked(X,Y:Integer):Integer; override;
    function GetTagFontSize(ValueIndex:Integer):TCoordinate;
    procedure Sort(SortBy: TTagCloudOrder; Order:TChartListOrder=loAscending);
    function UseAxis:Boolean; override;
  published
    // wish: BaseTextAlign:Boolean property (ie: TextAlign:=TA_BASELINE)

    property Filter:String read FFilter write SetFilter;
    property Font:TTeeFont read FFont write SetFont;
    property Gradient:TTeeGradient read GetGradient write SetGradient;
    property TagSeparation:Integer read FSeparation write SetSeparation default 5;

    { Published declarations }
    property Active;
    property ColorSource;
    property Cursor;
    property HorizAxis;
    property Marks;
    property ParentChart;
    property DataSource;
    property PercentFormat;
    property SeriesColor;
    property ShowInLegend;
    property Title;
    property ValueFormat;
    property VertAxis;
    property XLabelsSource;

    { events }
    property AfterDrawValues;
    property BeforeDrawValues;
    property OnAfterAdd;
    property OnBeforeAdd;
    property OnClearValues;
    property OnClick;
    property OnDblClick;
    property OnGetMarkText;
    property OnMouseEnter;
    property OnMouseLeave;

    // inherited
    property Brush;
    property EndColor;
    property MidColor;
    property LegendEvery;
    property Pen;
    property PaletteMin;
    property PaletteStep;
    property PaletteSteps;
    property PaletteStyle;
    property StartColor;
    property UseColorRange;
    property UsePalette;
    property UsePaletteMin;
    property XValues;
    property YValues;

    // Events
    property OnDrawTag:TDrawTagEvent read FOnDrawTag write FOnDrawTag;
    property OnGetColor;
  end;

implementation

uses
  Math,
  {$IFDEF FMX}
  FMXTee.ProConstants
  {$ELSE}

  {$IFDEF LCL}
  LCLType,
  {$ENDIF}

  TeeProCo
  {$ENDIF};

var
  TagCloudEndColor:TColor=0;

{ TTagCloudSeries }

function TTagCloudSeries.AddTag(const Text: String;
  const Value: Double): Integer;
begin
  result:=AddXYZ(0,Value,0,Text,clTeeColor);
end;

procedure TTagCloudSeries.AssignFormatting(Source: TChartSeries);
begin
  if Source is TTagCloudSeries then
  with TTagCloudSeries(Source) do
  begin
    Self.Font:=FFont;
    Self.Gradient:=Gradient;
    Self.FSeparation:=FSeparation;
  end;

  inherited;
end;

procedure TTagCloudSeries.Assign(Source: TPersistent);
begin
  if Source is TTagCloudSeries then
  with TTagCloudSeries(Source) do
       Self.FFilter:=FFilter;

  inherited;
end;

function TTagCloudSeries.CalcXPos(ValueIndex: Integer): Integer;
begin
  if Length(Positions)<=ValueIndex then
     result:=0
  else
  with Positions[ValueIndex]{$IFDEF FMX}.Round{$ENDIF} do
       result:=(Left+Right) div 2;
end;

function TTagCloudSeries.CalcYPos(ValueIndex: Integer): Integer;
begin
  if Length(Positions)<=ValueIndex then
     result:=0
  else
  with Positions[ValueIndex]{$IFDEF FMX}.Round{$ENDIF} do
       result:=(Top+Bottom) div 2;
end;

function TTagCloudSeries.Clicked(X, Y: Integer): Integer;
var t : Integer;
    P : TPoint;
begin
  result:=TeeNoPointClicked;

  P:=TeePoint(X,Y);

  for t:=0 to Length(Positions)-1 do
  if PointInRect(Positions[t],P) then
  begin
    result:=t;
    break;
  end;
end;

type
  TPenAccess=class(TChartPen);

Constructor TTagCloudSeries.Create(AOwner: TComponent);
begin
  inherited;

  FFont:=TTeeFont.Create(CanvasChanged);
  FFont.Size:=32;

  FSeparation:=5;

  Brush.Style:=bsClear;

  Pen.Visible:=False;
  TPenAccess(Pen).DefaultVisible:=False;

  EndColor:=TagCloudEndColor;
end;

Destructor TTagCloudSeries.Destroy;
begin
  FFont.Free;
  Positions:=nil;
  inherited;
end;

function TTagCloudSeries.ShouldDraw(ValueIndex:Integer):Boolean;
begin
  result:=(FFilter='') or
          (Pos(UpperCase(FFilter),UpperCase(XLabel[ValueIndex]))>0);
end;

procedure TTagCloudSeries.DrawAllValues;

  function TagSpacing:Integer;
  begin
    result:=Round(FSeparation*5*ParentChart.Canvas.TextWidth(TeeCharForHeight)*0.01);
  end;

var t : Integer;
    tt: Integer;
    tmpX : Integer;
    tmpY : Integer;
    tmpH : Integer;
    tmpW : Integer;
    tmpFirst : Integer;
    tmpW2 : Integer;
    tmpSt : String;
    tmpR  : TRect;
    tmp   : TCoordinate;
    tmpBlend : TTeeBlend;
begin
  inherited;

  ParentChart.Canvas.AssignVisiblePen(Pen);

  if Pen.Visible or Gradient.Visible or (Brush.Style<>bsClear) then
  begin
    ParentChart.Canvas.Gradient.Assign(Gradient);

    if Gradient.Visible then
       ParentChart.Canvas.Brush.Style:=bsSolid
    else
       ParentChart.Canvas.AssignBrush(Brush);

    ParentChart.Canvas.Rectangle(ParentChart.ChartRect);
  end;

  tmpR:=ParentChart.ChartRect;

  if ParentChart.ClipPoints then
  begin
    if Pen.Visible then
       tmp:=1+(Pen.Width {$IFDEF FMX}*0.5{$ELSE} div 2{$ENDIF})
    else
       tmp:=0;

    tmpR.Right:=tmpR.Right-tmp;
    tmpR.Bottom:=tmpR.Bottom-tmp;

    ParentChart.Canvas.ClipRectangle(tmpR);
  end;

  with ParentChart.Canvas do
  begin
    Brush.Style:=bsClear;
    BackMode:=cbmTransparent;
    Gradient.Visible:=False;
  end;

  if Transparency>0 then
     tmpBlend:=ParentChart.Canvas.BeginBlending(tmpR,Transparency)
  else
     tmpBlend:=nil;

  // Initialize Positions array
  SetLength(Positions,Count);
  for t:=0 to Count-1 do
      Positions[t]:=TeeZeroRect;

  ParentChart.PrepareFont3D(Font);
  ParentChart.Canvas.TextAlign:=TA_LEFT;

  tmpY:={$IFDEF FMX}Round{$ENDIF}(ParentChart.ChartRect.Top);
  tmpFirst:=0;
  t:=0;

  repeat
    tmpH:=0;
    tmpW:=0;

    while t<Count do
    begin
      if ShouldDraw(t) then
      begin
        if Assigned(FOnDrawTag) then
           ParentChart.PrepareFont3D(Font);  // reset font

        ParentChart.Canvas.Font.Size:=GetTagFontSize(t);

        if Assigned(FOnDrawTag) then
           FOnDrawTag(Self,t);

        tmpW2:=ParentChart.Canvas.TextWidth(XLabel[t]);

        if tmpW>0 then
           Inc(tmpW2,TagSpacing);

        if tmpW+tmpW2 > (ParentChart.ChartRect.Right-ParentChart.ChartRect.Left) then
        begin
          // special case, just one tag, longer than total width
          if tmpW=0 then
          begin
            tmpH:=Math.Max(tmpH,ParentChart.Canvas.TextHeight(XLabel[t]));
            Inc(t);
          end;

          break;
        end
        else
        begin
          Inc(tmpW,tmpW2);
          tmpH:=Math.Max(tmpH,ParentChart.Canvas.TextHeight(XLabel[t]));
          Inc(t);
        end;
      end
      else Inc(t);
    end;

    tmpX:={$IFDEF FMX}Round{$ENDIF}(ParentChart.ChartRect.Left);

    with ParentChart.Canvas do
    for tt:=tmpFirst to t-1 do
    if ShouldDraw(tt) then
    begin
      if Assigned(FOnDrawTag) then
         ParentChart.PrepareFont3D(Self.Font);  // reset font

      Font.Size:=GetTagFontSize(tt);
      {$IFDEF FMX}Brush{$ELSE}Font{$ENDIF}.Color:=GetValueColor(tt);

      if Assigned(FOnDrawTag) then
         FOnDrawTag(Self,tt);

      tmpSt:=XLabel[tt];

      with Positions[tt] do
      begin
        Left:=tmpX;
        Bottom:=tmpY+tmpH;
        Top:=Bottom;

        // Allow TextAlign TA_BASELINE or TA_TOP
        if TextAlign<TA_BOTTOM then
           Top:=Top-TextHeight(tmpSt);

        Right:=Left+TextWidth(tmpSt);
      end;

      if ParentChart.View3D then
         TextOut3D({$IFDEF FMX}Round{$ENDIF}(Positions[tt].Left),
                   {$IFDEF FMX}Round{$ENDIF}(Positions[tt].Top),0,tmpSt)
      else
         TextOut(Positions[tt].Left,Positions[tt].Top,tmpSt);

      if PrepareHoverPen(tt) then
      begin
        ParentChart.Canvas.Brush.Style:=bsClear;
        ParentChart.Canvas.Rectangle(Positions[tt]);
      end;

      Inc(tmpX, TagSpacing + {$IFDEF FMX}Round{$ENDIF}(Positions[tt].Right-Positions[tt].Left));
    end;

    tmpFirst:=t;
    Inc(tmpY,tmpH);

    if tmpY > ParentChart.ChartRect.Bottom then
       break;

  until tmpFirst>=Count;

  FFirstVisibleIndex:=0;
  FLastVisibleIndex:=t;

  if ParentChart.ClipPoints then
     ParentChart.Canvas.UnClipRectangle;

  if Transparency>0 then
     ParentChart.Canvas.EndBlending(tmpBlend);
end;

// TODO: Improve calculation using only the items that are
// valid when Filter is not empty. (See ShoulDraw function)
function TTagCloudSeries.GetTagFontSize(ValueIndex: Integer): TCoordinate;
var tmp : Double;
begin
  result:=FFont.Size;

  tmp:=MandatoryValueList.MaxValue-MandatoryValueList.Value[ValueIndex];
  if tmp>0 then
     result:=result -
       {$IFNDEF FMX}Round{$ENDIF}(0.75*tmp*FFont.Size/MandatoryValueList.Range);

  if result<1 then result:=1;
end;

function TTagCloudSeries.GetGradient:TTeeGradient;
begin
  result:=Brush.Gradient;
end;

procedure TTagCloudSeries.SetFilter(const Value: String);
begin
  SetStringProperty(FFilter,Value);
end;

procedure TTagCloudSeries.SetFont(const Value: TTeeFont);
begin
  FFont.Assign(Value);
end;

function TTagCloudSeries.UseAxis: Boolean;
begin
  result:=False;
end;

// Sort tags alphabetically or by value
procedure TTagCloudSeries.Sort(SortBy: TTagCloudOrder;
                               Order:TChartListOrder=loAscending);
begin
  case SortBy of
     toText: SortByLabels(Order);

    toValue: begin
               YValues.Order:=Order;
               YValues.Sort;
             end;
  else
    Exit;
  end;

  Repaint;
end;

// Just an example, adds random names of series styles
// with random values.
procedure TTagCloudSeries.AddSampleValues(NumValues: Integer;
  OnlyMandatory: Boolean);
var t : Integer;
    s : TSeriesRandomBounds;
begin
  s:=RandomBounds(NumValues);

  for t:=1 to NumValues do
      AddTag(TeeSeriesTypes[RandomValue(TeeSeriesTypes.Count)].Caption,
             s.tmpY+s.DifY*RandomValue(1000));

  Sort(toText);
end;

class function TTagCloudSeries.GetEditorClass: String;
begin
  result:='TTagCloudEditor';
end;

procedure TTagCloudSeries.SetGradient(const Value: TTeeGradient);
begin
  Gradient.Assign(Value);
end;

procedure TTagCloudSeries.SetParentChart(const Value: TCustomAxisPanel);
begin
  inherited;

  // Switch chart to 2D mode, first time this series is dropped
  // at design-time into a Form.

  if Assigned(Value) and
     (csDesigning in ComponentState) and
     (not (csLoading in Owner.ComponentState)) then
          ParentChart.View3D:=False;
end;

procedure TTagCloudSeries.SetSeparation(const Value: Integer);
begin
  SetIntegerProperty(FSeparation,Value);
end;

procedure TTagCloudSeries.GalleryChanged3D(Is3D: Boolean);
begin
  inherited;
  ParentChart.View3D:=False;
end;

procedure TTagCloudSeries.PrepareLegendCanvas(ValueIndex: Integer;
  var BackColor: TColor; var BrushStyle: {$IFDEF FMX}TBrushKind{$ELSE}TBrushStyle{$ENDIF});
begin
  inherited;
  BrushStyle:=bsSolid;
end;

initialization
  TagCloudEndColor:=OperaPalette[2];
  RegisterTeeSeries(TTagCloudSeries, @TeeMsg_GalleryTagCloud,
                                     @TeeMsg_GallerySamples,1);
finalization
  UnRegisterTeeSeries([TTagCloudSeries]);
end.
