{********************************************}
{     TeeChart Pro Charting Library          }
{           TriSurface Series                }
{ Copyright (c) 1995-2020 by Steema Software }
{         All Rights Reserved                }
{********************************************}
unit TeeTriSurface;
{$I TeeDefs.inc}

// Adapted from Andre Bester's algorithm (anb@iafrica.com)

{ This unit implements the "Tri-Surface" charting series.

  A Tri-Surface is a 3D surface of triangles, automatically
  calculated from all XYZ points.

  All XYZ coordinates can have floating point decimals and
  can be expressed in any range.

  This series inherits all formatting properties like Pen,
  Brush, ColorRange and Palette from its ancestor class.

  Special properties:

    HideTriangles : Boolean ( default True )

      Triangles are ordered by Z position (hidding algorithm).
      When False, display speed might be faster but incorrect.

    CacheTriangles : Boolean ( default True )

      When True, triangles from XYZ data are just recalculated once
      instead of at every redraw.
}

interface

Uses {$IFNDEF LINUX}
     {$IFNDEF FMX}
     Windows, Messages,
     {$ENDIF}
     {$ENDIF}
     Classes,

     {$IFDEF FMX}
     FMX.Types, Types,

     {$IFDEF D19}
     FMX.Graphics,
     {$ENDIF}
     
     {$ELSE}
     Graphics,
     {$IFDEF D9}
     Types,
     {$ENDIF}
     {$ENDIF}

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

     {$IFDEF FMX}
     {$IFDEF D17}
     System.UIConsts,
     {$ENDIF}
     FMXTee.Engine, FMXTee.Canvas, FMXTee.Chart, FMXTee.Procs,
     FMXTee.Series.Surface, FMXTee.Functions.Triangulate
     {$ELSE}
     TeEngine, Chart, TeCanvas, TeeProcs, TeeSurfa, TeeTriangulate
     {$ENDIF}
     ;

type
  PTriangle=^TTriangle;

  TTriangle=packed record
    Index : Integer;
    Color : TColor;
    Next  : PTriangle;
    Prev  : PTriangle;
    P     : TTrianglePoints;
    Z     : Double;
  end;

  ETriSurfaceException=class(ChartException);

  TCustomTriSurfaceSeries=class(TCustom3DPaletteSeries)
  private
    { Private declarations }
    FBorder    : TChartHiddenPen;
    FFastBrush : Boolean;
    FHide      : Boolean;

    IDirtyTriangles : Boolean;
    Triangles  : PTriangle;
    ILastTriangle : PTriangle;
    ITriangulator : TTriangulator;

    ICachedSurface : TTeeCachedObject;

    {$IFNDEF FMX}
    {$IFDEF MSWINDOWS}
    DCBRUSH    : HGDIOBJ;
    CanvasDC   : TTeeCanvasHandle;
    {$ENDIF}
    {$ENDIF}

    Function CalcPointResult(Index:Integer):TPoint3D;
    procedure CalcTriPoints(Index:Integer; out Points:TTrianglePoints3D;
                            out Colors:TTriangleColors3D;
                            out Indexes:TTriangleIndexes);
    Procedure ClearTriangles;
    procedure FreeCached;
    function GetX(Index:Integer):TTriValue;
    function GetZ(Index:Integer):TTriValue;
    Procedure SetBorder(Value:TChartHiddenPen);
    procedure SetFastBrush(const Value: Boolean);
    procedure SetHide(const Value: Boolean);
    procedure SetXYZ(Dest,Source:Integer);
  protected
    Reuse3D,
    Normals : Boolean;

    Procedure AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False); override;
    procedure AssignFormatting(Source: TChartSeries); override;
    procedure CanvasChanged(Sender:TObject); override;
    procedure ChangedAxisScale(const Axis:TChartAxis); override;
    class Procedure CreateSubGallery(AddSubChart:TChartSubGalleryProc); override;
    procedure DoBeforeDrawValues; override;
    procedure DrawAllValues; override;
    Procedure DrawMark(ValueIndex:Integer; Const St:String;
                       APosition:TSeriesMarkPosition); override;
    class Function GetEditorClass:String; override;
    Procedure NotifyValue(ValueEvent:TValueEvent; ValueIndex:Integer); override;
    Procedure PrepareForGallery; override;
    class Procedure SetSubGallery(ASeries:TChartSeries; Index:Integer); override;

  public
    { Public declarations }
    CacheTriangles : Boolean;

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

    Procedure Assign(Source:TPersistent); override;
    Function Clicked(x,y:Integer):Integer; override;
    Function NumSampleValues:Integer; override;

    procedure TrianglePoints(TriangleIndex:Integer; out P:TTrianglePoints3D);

    property Border:TChartHiddenPen read FBorder write SetBorder;
    property Brush;
    property FastBrush:Boolean read FFastBrush write SetFastBrush default False;
    property HideTriangles:Boolean read FHide write SetHide default True;
    property Pen;
    property Transparency;
  end;

  TTriSurfaceSeries=class(TCustomTriSurfaceSeries)
  published
    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;

    property Border;
    property Brush;
    property EndColor;
    property FastBrush;
    property HideTriangles;
    property LegendEvery;
    property MidColor;
    property Pen;
    property PaletteMin;
    property PaletteStep;
    property PaletteSteps;
    property PaletteStyle;
    property StartColor;
    property UseColorRange;
    property UsePalette;
    property UsePaletteMin;
    property TimesZOrder;
    property Transparency;
    property XValues;
    property YValues;
    property ZValues;

    { events }
    property OnGetColor;
  end;

implementation

uses
  Math, SysUtils,
  {$IFDEF FMX}
  FMXTee.Constants, FMXTee.ProConstants
  {$ELSE}
  TeeConst, TeeProCo
  {$ENDIF};

{ TCustomTriSurfaceSeries }

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

  CacheTriangles:=True;
  IDirtyTriangles:=True;
  
  FBorder:=TChartHiddenPen.Create(CanvasChanged);
  FBorder.Color:={$IFDEF FMX}claWhite{$ELSE}clWhite{$ENDIF};
  FHide:=True;

  ITriangulator:=TTriangulator.Create;

  with ITriangulator do
  begin
    GetX:=Self.GetX;
    GetZ:=Self.GetZ;
    SetXYZ:=Self.SetXYZ;

    ImprovedTriangles:=True;
  end;
end;

Destructor TCustomTriSurfaceSeries.Destroy;
begin
  FBorder.Free;
  ITriangulator.Free;
  ClearTriangles;
  FreeCached;
  inherited;
end;

function TCustomTriSurfaceSeries.GetX(Index:Integer):TTriValue;
begin
  result:=XValues.Value[Index];
end;

function TCustomTriSurfaceSeries.GetZ(Index:Integer):TTriValue;
begin
  result:=ZValues.Value[Index];
end;

procedure TCustomTriSurfaceSeries.SetXYZ(Dest,Source:Integer);
begin
  XValues.Value[Dest]:=XValues.Value[Source];
  YValues.Value[Dest]:=YValues.Value[Source];
  ZValues.Value[Dest]:=ZValues.Value[Source];
end;

Procedure TCustomTriSurfaceSeries.ClearTriangles;
var Triangle : PTriangle;
    tmpTriangle : PTriangle;
begin
  Triangle:=Triangles;

  while Assigned(Triangle) do
  begin
    { free triangle memory }
    tmpTriangle:=Triangle;
    Triangle:=Triangle.Next;
    Dispose(tmpTriangle);
  end;

  Triangles:=nil;
end;

Function TCustomTriSurfaceSeries.Clicked(x,y:Integer):Integer;
var t   : Integer;
    tmp : TPoint;
    Triangle : PTriangle;
    P   : TTrianglePoints;
    P3D : TTrianglePoints3D;
begin
  result:=TeeNoPointClicked;
  tmp:=TeePoint(x,y);

  // If "hide triangles" mode, then use the list of calculated
  // triangles, from Last to First.
  if Assigned(ILastTriangle) then
  begin
    Triangle:=ILastTriangle;
    while Assigned(Triangle) do
    begin
      if PointInPolygon(tmp,Triangle.P) then
      begin
        result:=Triangle.Index;
        break;
      end;

      Triangle:=Triangle.Prev;
    end;
  end
  else
  // Search across 3D non-Z sorted list of triangles...
  begin
    for t:=1 to ITriangulator.NumTriangles do
    begin
      TrianglePoints(t,P3D);
      ParentChart.Canvas.TrianglePointsTo2D(P3D,P);

      if PointInPolygon(tmp,P) then
      begin
        result:=t;
        break;
      end;
    end;
  end;
end;

Function TCustomTriSurfaceSeries.NumSampleValues:Integer;
begin
  result:=15;
end;

Procedure TCustomTriSurfaceSeries.AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False);
Const Factor = 10;
      tmpRandom = 1000;

var t    : Integer;
    x,y,z,
    x2,z2,
    xx,zz : Single;
begin
  NumValues:=Max(NumValues,3);

  for t:=1 to NumValues do
  begin

    X:=RandomValue(tmpRandom)-(tmpRandom div 2);
    Z:=RandomValue(tmpRandom)-(tmpRandom div 2);

    x2:=x*0.01;
    z2:=z*0.01;

    xx:=x2*x2;
    zz:=z2*z2;

    y:= 3*Sqr(1-x2)*Exp(-xx - Sqr(z2+1))
             - Factor * (x2*0.2 - Power(x2,3) - Power(z2,5))*exp(-xx-zz)
             - (1/3) * exp(-Sqr(x2+1) - zz);

    (*
    // Sample:
    x:=X-0.5;
    x2:=x*x*0.1;
    z:=Z-0.5;
    z2:=z*z*0.1;
    xz:=Sqrt(x2*z2);

    if xz=0 then y:=0
            else y:=Sin(xz)/xz;

    // Another sample:
    y:=Sqr(Exp(tmpZ))*Cos(tmpX*tmpZ);
    *)

    AddXYZ(X,y,Z);
  end;
end;

class Function TCustomTriSurfaceSeries.GetEditorClass:String;
begin
  result:='TTriSurfaceSeriesEditor'; { <-- dont translate ! }
end;

Procedure TCustomTriSurfaceSeries.SetBorder(Value:TChartHiddenPen);
begin
  FBorder.Assign(Value);
end;

procedure TCustomTriSurfaceSeries.DoBeforeDrawValues;
begin
  inherited;

  if Count<3 then
     ITriangulator.NumTriangles:=0
  else
  if (not CacheTriangles) or IDirtyTriangles then
  begin
    FreeCached;

    Inc(IUpdating);
    AddXYZ(XValues[0],YValues[0],ZValues[0]);

    try
      if ITriangulator.CreateTriangles(Count) then
         IDirtyTriangles:=False
      else
      begin
        Visible:=False;

        raise ETriSurfaceException.Create(TeeMsg_TriSurfaceSimilar);
      end;
    finally
      Delete(Count-1);
      Dec(IUpdating);

      // Set this here again to False, because the above "Delete" will
      // trigger NotifyValue:
      IDirtyTriangles:=False
    end;
  end
  else
  if AxisRectChanged then
     FreeCached;
end;

Function TCustomTriSurfaceSeries.CalcPointResult(Index:Integer):TPoint3D;
begin
  with result do
  begin
    X:=CalcXPos(Index);
    Y:=CalcYPos(Index);
    Z:=CalcZPos(Index);
  end;
end;

procedure TCustomTriSurfaceSeries.TrianglePoints(TriangleIndex:Integer;
                                                 out P:TTrianglePoints3D);

  Procedure CalcPoint(APoint,Index:Integer);
  begin
    With P[APoint] do
    begin
      X:=CalcXPos(Index);
      Y:=CalcYPos(Index);
      Z:=CalcZPos(Index);
    end;
  end;

var tmp : Integer;
begin
  tmp:=3*TriangleIndex;

  {$R-}
  CalcPoint(0,ITriangulator.IPT[tmp-2]);
  CalcPoint(1,ITriangulator.IPT[tmp-1]);
  CalcPoint(2,ITriangulator.IPT[tmp]);
end;

procedure TCustomTriSurfaceSeries.CalcTriPoints(Index:Integer; out Points:TTrianglePoints3D;
                                                out Colors:TTriangleColors3D;
                                                out Indexes:TTriangleIndexes);
var tmp : Integer;
begin
  TrianglePoints(Index,Points);

  tmp:=3*Index;

  with Indexes do
  begin
    Point0:=ITriangulator.IPT[tmp-2];
    Colors[0]:=ValueColor[Point0];

    Point1:=ITriangulator.IPT[tmp-1];
    Colors[1]:=ValueColor[Point1];

    Point2:=ITriangulator.IPT[tmp];
    Colors[2]:=ValueColor[Point2];
  end;
end;

type
  TCanvasAccess=class(TTeeCanvas);

procedure TCustomTriSurfaceSeries.DrawAllValues;

  procedure AddSortedTriangles;
  var tmpForward : Boolean;

    { sort triangles by Z (draw first triangles with bigger depth) }
    Procedure AddByZ(ATriangle:PTriangle);
    var tmp  : PTriangle;
        Last : PTriangle;
    begin
      Last:=nil;
      tmp:=Triangles;

      while Assigned(tmp) do
      begin
        if (tmpForward and (ATriangle.Z>tmp.Z)) or
           ((not tmpForward) and (tmp.Z>ATriangle.Z)) then
        begin
          if Assigned(tmp.Prev) then
          begin
            ATriangle.Prev:=tmp.Prev;
            tmp.Prev.Next:=ATriangle;
          end
          else Triangles:=ATriangle;

          tmp.Prev:=ATriangle;
          ATriangle.Next:=tmp;
          Exit;
        end;

        Last:=tmp;
        tmp:=tmp.Next;
      end;

      if Assigned(Last) then
      begin
        Last.Next:=ATriangle;
        ATriangle.Prev:=Last;
      end
      else Triangles:=ATriangle;
    end;

  var t           : Integer;
      tmp         : Integer;
      tmpTriangle : PTriangle;
      tmpPoints   : TTrianglePoints3D;
  begin
    { create a list of triangles sorted by Z }
    tmpForward:=not ParentChart.DepthAxis.Inverted;

    if ParentChart.View3D and ParentChart.View3DOptions.BackFaced then
       tmpForward:=not tmpForward;

    for t:=1 to ITriangulator.NumTriangles do
    begin
      TrianglePoints(t,tmpPoints);

      New(tmpTriangle);

      with tmpTriangle^ do
      begin
        Next:=nil;
        Prev:=nil;
        Index:=t;

        // Aproximate Z to the greatest of 3 triangle corners
        tmp:=3*t;

        Z:=Math.Max(ZValues.Value[ITriangulator.IPT[tmp]],
           Math.Max(ZValues.Value[ITriangulator.IPT[tmp-1]],
                    ZValues.Value[ITriangulator.IPT[tmp-2]]));

        // Calculate XY screen positions of corners
        ParentChart.Canvas.TrianglePointsTo2D(tmpPoints,P);

        //Color
        Color:=ValueColor[ITriangulator.IPT[tmp-2]];
      end;

      AddByZ(tmpTriangle);
    end;
  end;

var
  tmpBlend  : TTeeBlend;

  procedure DrawAllSorted;
  var Triangle : PTriangle;
  begin
    {$IFNDEF FMX}
    {$IFDEF MSWINDOWS}
    if FastBrush then
    begin
      CanvasDC:=ParentChart.Canvas.Handle;
      SelectObject(CanvasDC,DCBRUSH);
    end;
    {$ENDIF}
    {$ENDIF}

    TCanvasAccess(ParentChart.Canvas).SetAntiAlias(False);

    { draw all triangles }
    Triangle:=Triangles;

    while Assigned(Triangle) do
    begin
      {$IFNDEF FMX}
      {$IFDEF MSWINDOWS}
      if FastBrush then
         TeeSetDCBrushColor(CanvasDC,Triangle.Color)
      else
      {$ENDIF}
      {$ENDIF}
        ParentChart.Canvas.Brush.Color:=Triangle.Color;

      if Assigned(tmpBlend) then
         tmpBlend.SetRectangle(RectFromPolygon(Triangle.P,3));

      ParentChart.Canvas.Polygon(Triangle.P);

      if Transparency>0 then
         if Assigned(tmpBlend) then
            tmpBlend.DoBlend(Transparency);

      ILastTriangle:=Triangle;
      Triangle:=Triangle.Next;
    end;

    TCanvasAccess(ParentChart.Canvas).SetAntiAlias(True);
  end;

var t : Integer;
begin
  // DO NOT CALL inherited HERE

  ILastTriangle:=nil;  // for Clicked method

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

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

    if HideTriangles and (not ParentChart.Canvas.SupportsFullRotation) and
      (Brush.Style=bsSolid) then
    begin
      ClearTriangles;
      AddSortedTriangles;
      DrawAllSorted;
    end
    else
    begin
      if not Reuse3D then
         FreeCached;

      ParentChart.Canvas.TriSurface(ITriangulator.NumTriangles,
                 Reuse3D,Normals,tmpBlend,Transparency,CalcTriPoints,
                 ICachedSurface);
    end;

    if Transparency>0 then
    begin
      if Assigned(tmpBlend) then
         tmpBlend.Free  // Do not call EndBlending here...
      else
         ParentChart.Canvas.EndBlending(nil);
    end;

    { draw border }
    if FBorder.Visible then
    begin
      ParentChart.Canvas.AssignVisiblePen(FBorder);

      with ParentChart.Canvas do
      for t:=1 to ITriangulator.NumLines do
      begin
        MoveTo3D(CalcPointResult(ITriangulator.IPL[3*t-2]));
        LineTo3D(CalcPointResult(ITriangulator.IPL[3*t-1]));
      end;
    end;

    SaveChartRect;
  end;
end;

procedure TCustomTriSurfaceSeries.SetFastBrush(const Value: Boolean);
begin
  {$IFNDEF FMX}
  {$IFDEF MSWINDOWS}
  if Assigned(@TeeSetDCBrushColor) then
  begin
    FFastBrush:=Value;
    DCBRUSH:=GetStockObject(DC_BRUSH);
  end;
  {$ENDIF}
  {$ENDIF}
end;

Procedure TCustomTriSurfaceSeries.DrawMark( ValueIndex:Integer; Const St:String;
                                            APosition:TSeriesMarkPosition);
begin
  Marks.ZPosition:=CalcZPos(ValueIndex);
  Marks.ApplyArrowLength(APosition);
  inherited;
end;

procedure TCustomTriSurfaceSeries.AssignFormatting(Source: TChartSeries);
begin
  if Source is TCustomTriSurfaceSeries then
  with TCustomTriSurfaceSeries(Source) do
  begin
    Self.Border:=Border;
  end;

  inherited;
end;

procedure TCustomTriSurfaceSeries.Assign(Source: TPersistent);
begin
  if Source is TCustomTriSurfaceSeries then
  with TCustomTriSurfaceSeries(Source) do
  begin
    Self.ITriangulator.ImprovedTriangles:=ITriangulator.ImprovedTriangles;
    Self.FHide:=HideTriangles;
  end;

  inherited;
end;

class procedure TCustomTriSurfaceSeries.CreateSubGallery(
  AddSubChart: TChartSubGalleryProc);
begin
  inherited;
  AddSubChart(TeeMsg_WireFrame);
  AddSubChart(TeeMsg_NoLine);
  AddSubChart(TeeMsg_Border);
end;

Procedure TCustomTriSurfaceSeries.PrepareForGallery;
begin
  inherited;
  FillSampleValues;
end;

class procedure TCustomTriSurfaceSeries.SetSubGallery(
  ASeries: TChartSeries; Index: Integer);
begin
  With TCustomTriSurfaceSeries(ASeries) do
  Case Index of
    2: Brush.Style:=bsClear;
    3: Pen.Hide;
    4: Border.Show;
  else inherited;
  end;
end;

procedure TCustomTriSurfaceSeries.CanvasChanged(Sender:TObject);
begin
  inherited;
  FreeCached;
end;

procedure TCustomTriSurfaceSeries.FreeCached;
begin
  FreeAndNil(ICachedSurface);
end;

Procedure TCustomTriSurfaceSeries.NotifyValue(ValueEvent:TValueEvent; ValueIndex:Integer);
begin
  inherited;
  IDirtyTriangles:=True;
end;

procedure TCustomTriSurfaceSeries.ChangedAxisScale(const Axis:TChartAxis);
begin
  inherited;
  FreeCached;
end;

procedure TCustomTriSurfaceSeries.SetHide(const Value: Boolean);
begin
  SetBooleanProperty(FHide,Value);
end;

initialization
  RegisterTeeSeries( TTriSurfaceSeries, @TeeMsg_GalleryTriSurface,
                                        @TeeMsg_Gallery3D,1);
finalization
  UnRegisterTeeSeries([TTriSurfaceSeries]);
end.
