{**********************************************}
{      TeeChart Pro OpenGL Component           }
{   Copyright (c) 1998-2020 by Steema Software }
{         All Rights Reserved                  }
{**********************************************}
unit TeeOpenGL;
{$I TeeDefs.inc}

interface

uses
  Classes, Graphics, StdCtrls, ExtCtrls,
  TeeProcs, TeCanvas, TeeGLCanvas;

type
  TTeeOpenGL=class;

  TGLPosition=class(TPointXYZFloat);

  TGLLight=class(TPersistent)
  private
    FColor    : TColor;
    FDiffuse  : TColor;
    FSpecular : TColor;
    FVisible  : Boolean;

    IOwner   : TTeeOpenGL;
  protected
    Procedure SetColor(const Value:TColor);
    Procedure SetDiffuse(const Value:TColor);
    Procedure SetSpecular(const Value:TColor);
    procedure SetVisible(Value:Boolean);
  public
    Constructor Create(AOwner:TTeeOpenGL);
    Procedure Assign(Source:TPersistent); override;
    Procedure GLColor(AColor:TColor; out Value:GLMat);
  published
    property Color:TColor read FColor write SetColor default clSilver;
    property Diffuse:TColor read FDiffuse write SetDiffuse default clWhite;
    property Specular:TColor read FSpecular write SetSpecular default clWhite;
    property Visible:Boolean read FVisible write SetVisible;
  end;

  TGLLightSource=class(TGLLight)
  private
    FDirection    : TGLPosition;
    FFixedPos     : Boolean;
    FPosition     : TGLPosition;
    FSpotDegrees  : Double;
    FSpotExp      : Integer;
    FUseDirection : Boolean;

    procedure SetFixed(const Value: Boolean);
    Procedure SetSpotDegrees(const Value:Double);
    Procedure SetSpotExp(const Value:Integer);
    Procedure SetUseDirection(const Value:Boolean);
  protected
    Procedure SetDirection(const Value:TGLPosition);
    Procedure SetPosition(const Value:TGLPosition);
  public
    Constructor Create(AOwner:TTeeOpenGL);
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;
  published
    property Direction:TGLPosition read FDirection write SetDirection;
    property FixedPosition:Boolean read FFixedPos write SetFixed default True;
    property Position:TGLPosition read FPosition write SetPosition;
    property SpotDegrees:Double read FSpotDegrees write SetSpotDegrees;
    property SpotExponent:Integer read FSpotExp write SetSpotExp default 0;
    property UseDirection:Boolean read FUseDirection write SetUseDirection default False;
  end;

  TGLLights=class
  private
    FItems: Array of TGLLightSource;
    IOwner : TTeeOpenGL;

    function Get(Index:Integer):TGLLightSource;
  public
    Destructor Destroy; override;

    function Add:TGLLightSource;
    function Count:Integer;
    procedure Delete(Index:Integer);

    property Items[Index:Integer]:TGLLightSource read Get; default;
  end;

  {$IFDEF D16}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
  {$ENDIF}
  TTeeOpenGL = class(TComponent)
  private
    { Private declarations }
    FActive       : Boolean;
    FAmbientLight : Integer;
    FAntialias    : Boolean;
    FDrawStyle    : TTeeCanvasSurfaceStyle;
    FFontExtrusion: Double;
    FFontStyle    : TTeeFontStyle;
    FLightHelpers : Boolean;
    FLights       : TGLLights;
    FShadeQuality : Boolean;
    FShininess    : Double;
    FTeePanel     : TCustomTeePanel;
    FTexQuality   : Boolean;

    FOnInit       : TNotifyEvent;
    FOnRepaint    : TNotifyEvent;

    IOldCanvas    : TCanvas3DClass;

    Procedure Activate;
    procedure Changed(Sender:TObject);
    Function GetCanvas:TGLCanvas;
    function GetFontOutlines:Boolean;
    function GetLight0:TGLLightSource;
    function GetLight1:TGLLightSource;
    function GetLight2:TGLLightSource;
    function GetWireframe: Boolean;
    Procedure OnCanvasInit(Sender:TObject);
    Procedure OnCanvasFinish(Sender:TObject);
    procedure ResetOldCanvas;
    Procedure SetActive(Value:Boolean);
    Procedure SetAmbientLight(Value:Integer);
    Procedure SetAntialias(Value:Boolean);
    Procedure SetDoubleProperty(Var Variable:Double; Const Value:Double);
    procedure SetDrawStyle(const Value: TTeeCanvasSurfaceStyle);
    Procedure SetFontExtrusion(const Value:Double);
    Procedure SetFontOutlines(Value:Boolean);
    procedure SetFontStyle(const Value:TTeeFontStyle);
    Procedure SetLightHelpers(const Value:Boolean);
    Procedure SetLightSource0(const Value:TGLLightSource);
    Procedure SetLightSource1(const Value:TGLLightSource);
    Procedure SetLightSource2(const Value:TGLLightSource);
    Procedure SetShadeQuality(Value:Boolean);
    Procedure SetShininess(const Value:Double);
    Procedure SetTeePanel(const Value:TCustomTeePanel);
    procedure SetTexQuality(const Value: Boolean);
    procedure SetWireframe(const Value: Boolean);
  protected
    { Protected declarations }
    IAlwaysActive : Boolean;

    procedure Notification( AComponent: TComponent;
                            Operation: TOperation); override;
    Procedure Repaint;
  public
    { Public declarations }

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

    procedure DrawLamps;

    property Canvas:TGLCanvas read GetCanvas;
    property Light0:TGLLightSource read GetLight0;
    property Lights:TGLLights read FLights;
    property Wireframe:Boolean read GetWireframe write SetWireframe;
  published
    { Published declarations }
    property Active:Boolean read FActive write SetActive default False;
    property AmbientLight:Integer read FAmbientLight write SetAmbientLight;
    property Antialias:Boolean read FAntialias write SetAntialias default True;
    property DrawStyle:TTeeCanvasSurfaceStyle read FDrawStyle
                                              write SetDrawStyle default tcsSolid;
    property FontExtrusion:Double read FFontExtrusion write SetFontExtrusion;
    property FontOutlines:Boolean read GetFontOutlines write SetFontOutlines default False;
    property FontStyle:TTeeFontStyle read FFontStyle write SetFontStyle default fsNormal;
    property LightHelpers:Boolean read FLightHelpers write SetLightHelpers default False;
    property Light:TGLLightSource read GetLight0 write SetLightSource0;
    property Light1:TGLLightSource read GetLight1 write SetLightSource1;
    property Light2:TGLLightSource read GetLight2 write SetLightSource2;
    property ShadeQuality:Boolean read FShadeQuality write SetShadeQuality default True;
    property Shininess:Double read FShininess write SetShininess;
    property TeePanel:TCustomTeePanel read FTeePanel write SetTeePanel;
    property TextureQuality:Boolean read FTexQuality write SetTexQuality default True;

    property OnInit:TNotifyEvent read FOnInit write FOnInit;
    property OnRepaint:TNotifyEvent read FOnRepaint write FOnRepaint;
  end;

implementation

{$R TeeGLIcon.res}

Uses Controls,

     {$IFDEF LINUX}
     OpenGLLinux,
     {$ELSE}
     Windows,
     OpenGL2,
     {$ENDIF}

     TeeConst;

{ TGLLightSource }
Constructor TGLLightSource.Create(AOwner:TTeeOpenGL);
begin
  inherited;

  FDirection:=TGLPosition.Create(nil,0,AOwner.Changed);
  FDirection.Z:=-1;

  FPosition:=TGLPosition.Create(nil,-100,AOwner.Changed);

  FSpotDegrees:=180;
  FFixedPos:=True;
end;

Destructor TGLLightSource.Destroy;
begin
  FDirection.Free;
  FPosition.Free;
  inherited;
end;

Procedure TGLLightSource.SetDirection(const Value:TGLPosition);
begin
  FDirection.Assign(Value);
end;

Procedure TGLLightSource.SetPosition(const Value:TGLPosition);
begin
  FPosition.Assign(Value);
end;

Procedure TGLLightSource.Assign(Source:TPersistent);
begin
  if Source is TGLLightSource then
  with TGLLightSource(Source) do
  begin
    Self.Direction:=Direction;
    Self.FFixedPos:=FFixedPos;
    Self.Position:=Position;
    Self.FSpotDegrees:=FSpotDegrees;
    Self.FSpotExp:=FSpotExp;
    Self.FUseDirection:=FUseDirection;
  end;

  inherited;
end;

Procedure TGLLightSource.SetUseDirection(const Value:Boolean);
begin
  if FUseDirection<>Value then
  begin
    FUseDirection:=Value;
    IOwner.Repaint;
  end;
end;

procedure TGLLightSource.SetFixed(const Value: Boolean);
begin
  if FFixedPos<>Value then
  begin
    FFixedPos:=Value;
    IOwner.Repaint;
  end;
end;

Procedure TGLLightSource.SetSpotDegrees(const Value:Double);
begin
  if FSpotDegrees<>Value then
  begin
    FSpotDegrees:=Value;
    IOwner.Repaint;
  end;
end;

Procedure TGLLightSource.SetSpotExp(const Value:Integer);
begin
  if FSpotExp<>Value then
  begin
    FSpotExp:=Value;
    IOwner.Repaint;
  end;
end;

{ TGLLight }

Constructor TGLLight.Create(AOwner:TTeeOpenGL);
begin
  inherited Create;
  IOwner:=AOwner;

  FColor:=clSilver;
  FDiffuse:=clWhite;
  FSpecular:=clWhite;
end;

Procedure TGLLight.SetColor(const Value:TColor);
begin
  if FColor<>Value then
  begin
    FColor:=Value;
    IOwner.Repaint;
  end;
end;

Procedure TGLLight.SetDiffuse(const Value:TColor);
begin
  if FDiffuse<>Value then
  begin
    FDiffuse:=Value;
    IOwner.Repaint;
  end;
end;

Procedure TGLLight.SetSpecular(const Value:TColor);
begin
  if FSpecular<>Value then
  begin
    FSpecular:=Value;
    IOwner.Repaint;
  end;
end;

procedure TGLLight.SetVisible(Value:Boolean);
begin
  if FVisible<>Value then
  begin
    FVisible:=Value;
    IOwner.Repaint;
  end;
end;

Procedure TGLLight.GLColor(AColor:TColor; out Value:GLMat);
const tmpInv=1/128.0;
begin
  Value[0]:=(1+GetRValue(AColor)-128)*tmpInv;
  Value[1]:=(1+GetGValue(AColor)-128)*tmpInv;
  Value[2]:=(1+GetBValue(AColor)-128)*tmpInv;
  Value[3]:=1;
end;

Procedure TGLLight.Assign(Source:TPersistent);
begin
  if Source is TGLLight then
  With TGLLight(Source) do
  begin
    Self.FColor:=Color;
    Self.FVisible:=Visible;
  end
  else inherited;
end;

{ TGLLights }

Destructor TGLLights.Destroy;
var t : Integer;
begin
  for t:=0 to High(FItems) do
      FItems[t].Free;

  FItems:=nil;

  inherited;
end;

function TGLLights.Get(Index:Integer):TGLLightSource;
begin
  if (Index>=0) and (Index<Count) then
     result:=FItems[Index]
  else
     result:=nil;
end;

function TGLLights.Add:TGLLightSource;
var l : Integer;
begin
  l:=Length(FItems);
  SetLength(FItems,l+1);

  result:=TGLLightSource.Create(IOwner);
  FItems[l]:=result;
end;

function TGLLights.Count:Integer;
begin
  result:=Length(FItems);
end;

procedure TGLLights.Delete(Index:Integer);
var t,L : Integer;
begin
  L:=Length(FItems);

  if (Index>=0) and (Index<L) then
  begin
    FItems[Index].Free;

    for t:=Index to L-2 do
        FItems[t]:=FItems[t+1];

    SetLength(FItems,L-1);
  end;
end;

{ TTeeOpenGL }

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

  FLights:=TGLLights.Create;
  FLights.IOwner:=Self;

  FLights.Add;
  FLights.Add;
  FLights.Add;

  Light0.Visible:=True;

  FAmbientLight:=8; {%}
  FShininess:=0.5;
  FShadeQuality:=True;
  FTexQuality:=True;
  FAntialias:=True;
end;

type
  TTeePanelAccess=class(TCustomTeePanel);

Destructor TTeeOpenGL.Destroy;
begin
  FLights.Free;

  if Assigned(FTeePanel) then
  begin
    TTeePanelAccess(FTeePanel).GLComponent:=nil;

    if FActive then
       ResetOldCanvas;
  end;

  inherited;
end;

Function TTeeOpenGL.GetCanvas:TGLCanvas;
begin
  if Assigned(FTeePanel) and (FTeePanel.Canvas is TGLCanvas) then
     result:=TGLCanvas(FTeePanel.Canvas)
  else
     result:=nil;
end;

function RectHypot(const R:TRect):Single;
begin
  result:=Sqrt(Sqr(R.Right-R.Left)+Sqr(R.Bottom-R.Top));
end;

function VectorSum(const A,B:TPoint3DFloat):TPoint3DFloat;
begin
  result.X:=A.X+B.X;
  result.Y:=A.Y+B.Y;
  result.Z:=A.Z+B.Z;
end;

function VectorScalarProduct(const D:Single; const V:TPoint3DFloat):TPoint3DFloat;
begin
  result.X:=D*V.X;
  result.Y:=D*V.Y;
  result.Z:=D*V.Z;
end;

procedure TTeeOpenGL.DrawLamps;

  procedure DrawLamp(const ALight:TGLLightSource);
  var tmpDist : Single;
  begin
    with ALight do
    if Visible then
    begin
       with Position do
       begin
         Canvas.Pen.Hide;

         Canvas.Brush.Style:=bsSolid;
         Canvas.Brush.Color:=clYellow;
         Canvas.Brush.Gradient.Visible:=False;

         Canvas.Sphere(X,Y,Z,10);
       end;

       if UseDirection then
       begin
         Canvas.Pen.Show;
         Canvas.Pen.Color:=clYellow;

         tmpDist:=RectHypot(Canvas.Bounds);
         Canvas.Line(Position.Point,VectorSum(Position.Point,VectorScalarProduct(tmpDist,Direction.Point)));
       end;
    end;
  end;

var t : Integer;
begin
  if Active then
     for t:=0 to Lights.Count-1 do
         DrawLamp(Lights[t]);
end;

type
  TPrivateGLCanvas=class(TGLCanvas);

Procedure TTeeOpenGL.OnCanvasInit(Sender:TObject);

  Procedure SetLight(const ALight:TGLLightSource; Num:Integer);
  var tmpAmbient  : GLMat;
      tmpDiffuse  : GLMat;
      tmpSpecular : GLMat;
  begin
    with ALight do
    if Visible then
    begin
      if FixedPosition then
      begin
        glMatrixMode(GL_MODELVIEW);
        glPushMatrix;
        glLoadIdentity;

        //Canvas.DisableRotation;
      end;

      GLColor(FColor,tmpAmbient);
      GLColor(FDiffuse,tmpDiffuse);
      GLColor(FSpecular,tmpSpecular);

      TPrivateGLCanvas(Canvas).InitLight(Num,tmpAmbient,tmpDiffuse,tmpSpecular,
                                         Position.Point,Direction.Point,
                                         UseDirection,SpotDegrees,
                                         SpotExponent);

      if FixedPosition then
      begin
        glMatrixMode(GL_MODELVIEW);
        glPopMatrix;
        // Canvas.EnableRotation;
      end;
    end
    else
       glDisable(Num);
  end;

var t : Integer;
begin
  Canvas.Shininess:=FShininess;

  TPrivateGLCanvas(Canvas).InitAmbientLight(FAmbientLight);

  for t:=0 to Lights.Count-1 do
      SetLight(Lights[t],GL_LIGHT0+t);

  TPrivateGLCanvas(Canvas).SetAntiAlias(FAntiAlias);

  if Assigned(FOnInit) then
     FOnInit(Self);
end;

Procedure TTeeOpenGL.OnCanvasFinish(Sender:TObject);
begin
  if LightHelpers then
     DrawLamps;
end;

Procedure TTeeOpenGL.SetShininess(Const Value:Double);
begin
  SetDoubleProperty(FShininess,Value);
end;

Procedure TTeeOpenGL.SetShadeQuality(Value:Boolean);
begin
  if FShadeQuality<>Value then
  begin
    FShadeQuality:=Value;

    if Canvas<>nil then
       Canvas.ShadeQuality:=Value;

    Repaint;
  end;
end;

procedure TTeeOpenGL.Notification( AComponent: TComponent;
                                   Operation: TOperation);
begin
  inherited;

  if (Operation=opRemove) and Assigned(FTeePanel) and (AComponent=FTeePanel) then
     TeePanel:=nil;
end;

Procedure TTeeOpenGL.Activate;
var tmpCanvas : TGLCanvas;
begin
  if Assigned(FTeePanel) then
    if FActive then
    begin
      if not (FTeePanel.Canvas is TGLCanvas) then
      begin
        tmpCanvas:=TGLCanvas.Create;

        with tmpCanvas do
        begin
          FontStyle:=Self.FontStyle;
          DrawStyle:=Self.DrawStyle;
          ShadeQuality:=Self.FShadeQuality;

          OnInit:=OnCanvasInit;
          OnFinish:=OnCanvasFinish;

          UseBuffer:=FTeePanel.Canvas.UseBuffer;
        end;

        if FTeePanel.Canvas is TCanvas3D then
           IOldCanvas:=TCanvas3DClass(FTeePanel.Canvas.ClassType)
        else
           IOldCanvas:=nil;

        FTeePanel.Canvas:=tmpCanvas;

        tmpCanvas.TextureQuality:=FTexQuality;
      end;
    end
    else
    if FTeePanel.Canvas is TGLCanvas then
       ResetOldCanvas;
end;

procedure TTeeOpenGL.ResetOldCanvas;
var tmp : TCanvas3DClass;
begin
  tmp:=IOldCanvas;

  if not Assigned(tmp) then
     tmp:=TTeeCanvas3D;

  FTeePanel.Canvas:=tmp.Create;
end;

Procedure TTeeOpenGL.SetAmbientLight(Value:Integer);
begin
  if FAmbientLight<>Value then
  begin
    FAmbientLight:=Value;
    Repaint;
  end;
end;

type
  TGLCanvasAccess=class(TGLCanvas);
  
Procedure TTeeOpenGL.SetAntialias(Value:Boolean);
begin
  if FAntialias<>Value then
  begin
    FAntialias:=Value;

    if Canvas<>nil then
       TGLCanvasAccess(Canvas).SetAntialias(FAntialias);

    Repaint;
  end;
end;

Procedure TTeeOpenGL.SetFontExtrusion(const Value:Double);
begin
  if FFontExtrusion<>Value then
  begin
    FFontExtrusion:=Value;

    if Canvas<>nil then
       Canvas.FontExtrusion:=Value
    else
       Repaint;
  end;
end;

Procedure TTeeOpenGL.SetFontOutlines(Value:Boolean);
begin
  if FontOutlines<>Value then
  begin
    if Value then
       FontStyle:=fsOutline
    else
    if FontStyle=fsOutline then
       FontStyle:=fsNormal;
  end;
end;

Procedure TTeeOpenGL.SetLightHelpers(const Value:Boolean);
begin
  if FLightHelpers<>Value then
  begin
    FLightHelpers:=Value;
    Repaint;
  end;
end;

Procedure TTeeOpenGL.SetLightSource0(const Value:TGLLightSource);
begin
  Light0.Assign(Value);
end;

Procedure TTeeOpenGL.SetLightSource1(const Value:TGLLightSource);
begin
  Light1.Assign(Value);
end;

Procedure TTeeOpenGL.SetLightSource2(const Value:TGLLightSource);
begin
  Light2.Assign(Value);
end;

Procedure TTeeOpenGL.SetActive(Value:Boolean);
begin
  FActive:=Value;
  Activate;
end;

procedure TTeeOpenGL.Changed(Sender:TObject);
begin
  Repaint;
end;

Procedure TTeeOpenGL.Repaint;
begin
  if Canvas<>nil then
  begin
    FTeePanel.Repaint;

    if Assigned(FOnRepaint) then
       FOnRepaint(Self);
  end;
end;

Procedure TTeeOpenGL.SetTeePanel(const Value:TCustomTeePanel);
begin
  if FTeePanel<>Value then
  begin
    if Assigned(FTeePanel) then
       FTeePanel.RemoveFreeNotification(Self);

    FTeePanel:=Value;

    if Assigned(FTeePanel) then
    begin
      TTeePanelAccess(FTeePanel).GLComponent:=Self;
      FTeePanel.FreeNotification(Self);
      Activate;
    end
    else
      FActive:=False;

  end;
end;

Procedure TTeeOpenGL.SetDoubleProperty(Var Variable:Double; Const Value:Double);
begin
  if Variable<>Value then
  begin
    Variable:=Value;
    Repaint;
  end;
end;

procedure TTeeOpenGL.SetDrawStyle(const Value: TTeeCanvasSurfaceStyle);
begin
  if FDrawStyle<>Value then
  begin
    FDrawStyle:=Value;

    if Canvas<>nil then
       Canvas.DrawStyle:=FDrawStyle;

    Repaint;
  end;
end;

procedure TTeeOpenGL.SetTexQuality(const Value: Boolean);
begin
  if FTexQuality<>Value then
  begin
    FTexQuality:=Value;

    if Canvas<>nil then
       Canvas.TextureQuality:=FTexQuality;

    Repaint;
  end;
end;

function TTeeOpenGL.GetLight0:TGLLightSource;
begin
  result:=Lights[0];
end;

function TTeeOpenGL.GetLight1:TGLLightSource;
begin
  result:=Lights[1];
end;

function TTeeOpenGL.GetLight2:TGLLightSource;
begin
  result:=Lights[2];
end;

function TTeeOpenGL.GetWireframe: Boolean;
begin
  result:=FDrawStyle=tcsWire;
end;

procedure TTeeOpenGL.SetWireframe(const Value: Boolean);
begin
  if Value then
     DrawStyle:=tcsWire
  else
     DrawStyle:=tcsSolid;
end;

function TTeeOpenGL.GetFontOutlines: Boolean;
begin
  result:=FontStyle=fsOutline;
end;

procedure TTeeOpenGL.SetFontStyle(const Value: TTeeFontStyle);
begin
  if FontStyle<>Value then
  begin
    FFontStyle:=Value;

    if Canvas<>nil then
    With Canvas do
    begin
      DeleteFont;
      FontStyle:=Self.FontStyle;
    end;

    Repaint;
  end;
end;

end.

