unit Unit1;
{$INCLUDE CADSoftTools.INC}
//If you see error "File not found: 'CADSoftTools.INC'",
//then please contact info@cadsofttools.com to get a compilable version.
//If you have a compilable version, you need to copy the contents of
// Lib7/LibXE5win32/LibXE5win64... to Lib directory according to your
// Delphi version and target CPU platform.

interface
{$INCLUDE SGDXF.INC}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, OpenGL, ExtDlgs, Menus, ComCtrls, Buttons,
  CADImage, DXF, DWG, DXFConv,
  sgConsts, sgOpenGL, sgDrawingNavigator, sgOrbit3D, sgLists;

type

  TsgGLControl = class(TSGDrawingNavigator)
  end;

  TfmGLForm = class(TForm)
    pmMenu: TPopupMenu;
    pmiOpen: TMenuItem;
    pmiWireframe: TMenuItem;
    Panel1: TPanel;
    sbOpen: TSpeedButton;
    cbWireframe: TCheckBox;
    sbrStatusBar: TStatusBar;
    sbGLOrbit3D: TSpeedButton;
    cbLighting: TCheckBox;
    cbNormalize: TCheckBox;
    OpenPictureDialog: TOpenPictureDialog;
    rbMat1: TRadioButton;
    rbMat2: TRadioButton;
    pmi3DOrbit: TMenuItem;
    cbBack: TColorBox;
    Timer1: TTimer;
    cbPerspective: TCheckBox;
    N1: TMenuItem;
    Lights1: TMenuItem;
    pmiLight0: TMenuItem;
    pmiLight1: TMenuItem;
    pmiLight2: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure pmiOpenClick(Sender: TObject);
    procedure cbWireframeClick(Sender: TObject);
    procedure pmiWireframeClick(Sender: TObject);
    procedure sbGLOrbit3DClick(Sender: TObject);
    procedure cbLightingClick(Sender: TObject);
    procedure cbNormalizeClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure rbMat1Click(Sender: TObject);
    procedure cbBackSelect(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure cbPerspectiveClick(Sender: TObject);
    procedure pmiLightClick(Sender: TObject);
  private
    { Private declarations }
    rc: HGLRC;    // Rendering Context
    dc: HDC;     // Device Context
    FOffs: TFPoint;
    FPicture: TPicture;
    FPanel: TsgGLControl;
    FEntList: TList;
    FIsMouseDown: Boolean;
    FMouseCoords: TPoint;
    FMode: Integer;
    FParam: TsgCADIterate;
    FLightPos: array[0..2] of TArray4s;
    FDistance: Double;
    FFPSCount: Integer;
    FCenter: TFPoint;
    FDownPos: TFPoint;
    FContextPos: TPoint;
    FAbsWidth: Double;
    FAbsHeight: Double;
    FScale: Double;
    FBox: TFRect;
    FSceneBox: TFRect;
    FDepth: Double;
    //FRot: TFPoint;
    FMatrix: TglMatrixd;
    FInfoShowing: Boolean;
    procedure Idle(Sender: TObject; var Done: Boolean);
    procedure PanelMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PanelMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PanelMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure MaterialApply(Ambr: GLFloat; Ambg: GLFloat; Ambb: GLFloat;
              Difr: GLFloat; Difg: GLFloat; Difb: GLFloat;
              Specr: GLFloat; Specg: GLFloat; Specb: GLFloat; Shine: GLFloat);
    function GetImg: TsgCADImage;
    procedure DoPanelFocus;
    procedure ParamAnalyse;
    procedure Open(const FileName: string);
    procedure DeleteEntList;
    procedure OrbitMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure OrbitMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure OrbitMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    function GetPtCenter: TPoint;
    function GetEnt(Entity: TsgDXFEntity): Integer;
    procedure PanelResize(Sender: TObject);
//  function GetMatrix: TglMatrixd;
    procedure Initialize(const AImage: TsgCADImage);
    procedure PanelMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure PanelMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormActivate(Sender: TObject);
    property PtCenter: TPoint read GetPtCenter;
//   property ModelViewMatrixd: TglMatrixd read GetMatrix;
  public
    procedure ReloadEnities;
    procedure glDraw;
    procedure LoadEntities;
    procedure CloseDrawing;
    property Img: TsgCADImage read GetImg;
    property Panel: TsgGLControl read FPanel;
  end;

var
  fmGLForm: TfmGLForm;

implementation

{$R *.DFM}

uses
  Math, sgFunction;

const
  sFormCaption = 'CAD Import VCL with OpenGL demo';
  FPSInterval = 1000;

type
  TsgCADImageAccess = class(TsgCADImage);

procedure DoColor(AColor: TColor);
begin
  glColor4ub(AColor and $FF, (AColor shr 8) and $FF, (AColor shr 16) and $FF, (AColor shr 24) and $FF);
end;

function GetPt(const Point: TFPoint; AParam: TsgCADIterate): TFPoint;
begin
  if AParam.Insert <> nil then
  begin
    Result := FPointXMat(Point, AParam.Matrix);
  end
  else
    Result := Point;
end;

{ TfmGLForm }

function TfmGLForm.GetEnt(Entity: TsgDXFEntity): Integer;
var
  I, K, vIndex, vFirstIndex, vAbsIndex: Integer;
  n, pt, pt1, pt2, pt3: TFPoint;
  vEnt: TsgDXFEntity;
  vPoly: TsgDXFPolyline;
  vPoints: TList;
  vPts: array[0 .. 3] of PFPoint;
  vNext: Boolean;
  C: TColor;

  procedure PutVertex(const Point: TFPoint);
  var
    vPoint: TFPoint;
  begin
    vPoint := GetPt(Point, FParam);
    glVertex3dv(@vPoint);
  end;

  procedure PutVertexes(const P1, P2, P3: TFPoint);
  begin
    CalcNormal(@P1, @P2, @P3, @n);
    glNormal3dv(@n);
    glVertex3dv(@P1);
  end;

  procedure DrawTriangle(const P1, P2, P3: PFPoint);
  var
    pp1, pp2, pp3: TFPoint;
  begin
    glBegin(FMode);
      DoColor(C);
      pp1 := GetPt(PFPoint(P1)^, FParam);
      pp2 := GetPt(PFPoint(P2)^, FParam);
      pp3 := GetPt(PFPoint(P3)^, FParam);
      CalcNormal(@pp3, @pp2, @pp1, @n);
      glNormal3dv(@n);
      glVertex3dv(@pp1);
      glVertex3dv(@pp2);
      glVertex3dv(@pp3);
    glEnd;
  end;

  procedure DrawQuadrangle(const p, p1, p2, p3: TFPoint);
  var
    pp, pp1, pp2, pp3: TFPoint;
  begin
    glBegin(FMode);
      DoColor(C);
      pp := GetPt(p, FParam);
      pp1 := GetPt(p1, FParam);
      pp2 := GetPt(p2, FParam);
      pp3 := GetPt(p3, FParam);
      PutVertexes(pp, pp2, pp1);
      PutVertexes(pp1, pp, pp3);
      PutVertexes(pp2, pp1, pp);
      PutVertexes(pp3, pp1, pp);
    glEnd;
  end;

  procedure DrawPolyline(APoints: TFPointList);
  var
//    C: Integer;
    J: Integer;
    //P, vTmp: Pointer;
  begin
    FEntList.Add(vEnt);
    glNewList(FEntList.Count, GL_COMPILE);
      glBegin(FMode);
        DoColor(C);
//        glPolygonMode(GL_FRONT_AND_BACK, GL_FILL);
//        C := APoints.Count + Ord(TsgCADBasePolyline(vEnt).Closed);
//        P := GetMemory(C * SizeOf(TFPoint));
//        try
//          vTmp := P;
//          for J := 0 to APoints.Count - 1 do
//          begin
//            PFPoint(P)^ := PFPoint(APoints[J])^;
//            Inc(PByte(P), SizeOf(TFPoint));
//          end;
//          if TsgCADBasePolyline(vEnt).Closed then
//            PFPoint(P)^ := PFPoint(APoints[0])^;
//          glMap(GL_MAP1_VERTEX_3, 0, 0, 0, C, vTmp);
//        finally
//          FreeMem(vTmp);
//        end;
        for J := 0 to APoints.Count - 1 do
          PutVertex(APoints[J]);
        if TsgCADBasePolyline(vEnt).Closed then
          PutVertex(APoints[0]);
      glEnd;
    glEndList;
  end;

begin
  Result := 0;
  vEnt := Entity;
  C := EntColor(vEnt, FParam.Insert);
  if vEnt is TsgDXFSolid then
  begin
    pt := TsgDXFSolid(vEnt).Point;
    pt1 := TsgDXFSolid(vEnt).Point1;
    pt2 := TsgDXFSolid(vEnt).Point2;
    pt3 := TsgDXFSolid(vEnt).Point3;
    FEntList.Add(vEnt);
    glNewList(FEntList.Count, GL_COMPILE);
      DrawQuadrangle(pt, pt1, pt2, pt3);
    glEndList;
  end
  else
  if vEnt is TsgCADBasePolyline then
  begin
    if vEnt is TsgDXFPolyline then
    begin
      vPoly := TsgDXFPolyline(vEnt);
      if vPoly.IsPolyFaceMesh then
      begin
        vPoints := TList.Create;
        try
          FEntList.Add(vEnt);
          glNewList(FEntList.Count, GL_COMPILE);
            I := 0;
            repeat
              K := 0;
              vNext := False;
              vFirstIndex := NativeUInt(vPoly.PolyFaceVertexIndexes[I]);
              repeat
                vIndex := NativeUInt(vPoly.PolyFaceVertexIndexes[I]);
                vAbsIndex := Abs(vIndex) - 1;
                if (vAbsIndex >= 0) and (vAbsIndex < vPoly.PolyPoints.Count) then
                begin
                  vPts[K] := @vPoly.PolyPoints.List[vAbsIndex];
                  Inc(K);
                end
                else vNext := True;
                Inc(I);
                if (K = 4) and (vIndex = -vFirstIndex) then
                  vNext := True;
              until vNext or (I >= vPoly.PolyFaceVertexIndexes.Count) or (K = 4);
              DrawTriangle(vPts[0], vPts[1], vPts[2]);
            until (I >= vPoly.PolyFaceVertexIndexes.Count);
          glEndList;
        finally
          vPoints.Free;
        end;
      end
      else
        DrawPolyline(vPoly.PolyPoints);
    end
    else
      DrawPolyline(TsgCADBasePolyline(vEnt).PolyPoints);
  end
  else if vEnt is TsgDXFLine then
  begin
    pt := TsgDXFLine(vEnt).Point;
    pt1 := TsgDXFLine(vEnt).Point1;
    FEntList.Add(vEnt);
    glNewList(FEntList.Count, GL_COMPILE);
      glBegin(GL_LINE_STRIP);
        DoColor(C);
        PutVertex(pt);
        PutVertex(pt1);
      glEnd;
    glEndList;
  end;
end;

{------------------------------------------------------------------}
{  Function to load entities from dxf/dwg files                    }
{------------------------------------------------------------------}
procedure TfmGLForm.LoadEntities;
begin
  DeleteEntList;
  ReloadEnities;
  glLoadIdentity;                   // Reset View
  gluLookAt(0, 0, 1, 0, 0, 0, 0, 1, 0);
  glTranslated(FCenter.X, FCenter.Y, FCenter.Z);
  glMultMatrixd(@FMatrix);
  glTranslated(-FCenter.X, -FCenter.Y, -FCenter.Z);
end;

procedure TfmGLForm.glDraw;
var
  I: Integer;
  vO, vOffs: TFPoint;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);    // Clear The Screen And The Depth Buffer

  // do offset
  glPushMatrix;
  vO := GetCoord(cnstFPointZero);
  vOffs := GetCoord(FOffs.X, -FOffs.Y);
  glTranslated(vOffs.X - vO.X, vOffs.Y - vO.Y, vOffs.Z - vO.Z);
  for I := 1 to FEntList.Count do glCallList(I);

  glPushMatrix;
  glLoadIdentity;
  if pmiLight0.Checked then glLightfv(GL_LIGHT0, GL_POSITION, @FLightPos[0]);
  if pmiLight1.Checked then glLightfv(GL_LIGHT1, GL_POSITION, @FLightPos[1]);
  if pmiLight2.Checked then glLightfv(GL_LIGHT2, GL_POSITION, @FLightPos[2]);
  glPopMatrix;

  SwapBuffers(dc);
  Inc(FFPSCount);
  glPopMatrix;
end;

procedure TfmGLForm.ParamAnalyse;
var
  S: string;
begin
  S := ParamStr(1);
  if FileExists(S) then
    Open(S);
end;

type
  TsgOrbit3DAccess = class(TsgOrbit3D);

procedure SetTestDrawing(APicture: TPicture);
const
  V = 1000;
  Ofs = 0.0;

  procedure AddSolid(AImg: TsgCADImage; P, P1, P2, P3: TFPoint; AColor: TColor);
  var
    vSolid: TsgDXFSolid;
  begin
    vSolid := TsgDXFSolid.Create;
    vSolid.Color := AColor;
    vSolid.Point := P;
    vSolid.Point1 := P1;
    vSolid.Point2 := P2;
    vSolid.Point3 := P3;
    AImg.Converter.Loads(vSolid);
    AImg.Converter.Sections[csEntities].AddEntity(vSolid);
  end;

  function AddLine(AImg: TsgCADImage; P, P1: TFPoint; AColor: TColor): TsgDXFLine;
  begin
    Result := TsgDXFLine.Create;
    Result.Point := P;
    Result.Point1 := P1;
    Result.Color := AColor;
    AImg.Converter.Loads(Result);
    AImg.Converter.Sections[csEntities].AddEntity(Result);
  end;

var
  vImg: TsgCADImage;

begin
  vImg := TsgCADImage.Create;
  try
    vImg.IsWithoutBorder := True;
    TsgCADImageAccess(vImg).Converter.InitializeSections;
    TsgCADImageAccess(vImg).GetExtents;
    AddSolid(vImg, MakeFPoint(-V + Ofs, -V + Ofs, V + Ofs),
                   MakeFPoint(-V + Ofs, V + Ofs, V + Ofs),
                   MakeFPoint(V + Ofs, V + Ofs, V + Ofs),
                   MakeFPoint(V + Ofs, -V + Ofs, V + Ofs), clRed);
    AddSolid(vImg, MakeFPoint(-V + Ofs, -V + Ofs, V + Ofs),
                   MakeFPoint(-V + Ofs, -V + Ofs, -V + Ofs),
                   MakeFPoint(V + Ofs, -V + Ofs, -V + Ofs),
                   MakeFPoint(V + Ofs, -V + Ofs, V + Ofs), clGreen);
    AddSolid(vImg, MakeFPoint(-V + Ofs, -V + Ofs, V + Ofs),
                   MakeFPoint(-V + Ofs, -V + Ofs, -V + Ofs),
                   MakeFPoint(-V + Ofs, V + Ofs, -V + Ofs),
                   MakeFPoint(-V + Ofs, V + Ofs, V + Ofs), clBlue);
    AddLine(vImg, MakeFPoint(0, 0, 0), MakeFPoint(2*V, 0, 0), clRed);
    AddLine(vImg, MakeFPoint(0, 0, 0), MakeFPoint(0, 2*V, 0), clGreen);
    AddLine(vImg, MakeFPoint(0, 0, 0), MakeFPoint(0, 0, 2*V), clBlue);
    APicture.Graphic := vImg;
  finally
    vImg.Free;
  end;
end;

procedure TfmGLForm.FormActivate(Sender: TObject);
begin
  if not FInfoShowing then
  begin
    FInfoShowing := True;
    ShowMessage('Simple OpenGL application is designed to display only the following entities: '+#13#10+
      'SOLID, 3DFACE, POLYLINE, LWPOLYLINE, LINE.'#13#10 + 'Please see also 3D demo.' );
  end;
  Open('');
end;

{------------------------------------------------------------------}
{  Create the form and initialize openGL                           }
{------------------------------------------------------------------}

procedure TfmGLForm.FormCreate(Sender: TObject);

const
  cnstLight = 0.4;

var
  pfd: TPIXELFORMATDESCRIPTOR;
  pf: Integer;
  Done: boolean;
  vLd: TArray4s;
  vLa: TArray4s;
  vLs: TArray4s;
  vLightKoef: Double;
begin
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
  FBox := MakeFRect(-0.5, 0.5, -0.5, 0.5, -0.5, 0.5);
  FSceneBox := FBox;
  FMode := GL_TRIANGLE_FAN;
  FEntList := TList.Create;
  FPicture := TPicture.Create;
  pmiWireframe.Checked := cbWireframe.Checked;
  OpenPictureDialog.Filter := GraphicFilter(TsgCADImage);

  FPanel := TsgGLControl.Create(Self);
  FPanel.Parent := Self;
  FPanel.OnMouseWheelDown := PanelMouseWheelDown;
  FPanel.OnMouseWheelUp := PanelMouseWheelUp;
  FPanel.OnMouseMove := PanelMouseMove;
  FPanel.OnMouseDown := PanelMouseDown;
  FPanel.OnMouseUp := PanelMouseUp;
  FPanel.Align := alClient;
  FPanel.MouseDragging := False;
  FPanel.DoubleBuffered := True;
  FPanel.RectZooming := False;
  FPanel.OnResize := PanelResize;
  FPanel.BeginUpdate;

  IdentSwapMatrix;

  dc:=GetDC(Panel.Handle);
  Panel.Orbit3D.Visible := True;
  TsgOrbit3DAccess(FPanel.Orbit3D).OnMouseMove := OrbitMouseMove;
  TsgOrbit3DAccess(FPanel.Orbit3D).OnMouseDown := OrbitMouseDown;
  TsgOrbit3DAccess(FPanel.Orbit3D).OnMouseUp := OrbitMouseUp;

  // PixelFormat
  FillChar(pfd, SizeOf(TPIXELFORMATDESCRIPTOR), 0);
  pfd.nSize := SizeOf(pfd);
  pfd.nVersion := 1;
  pfd.dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;// or 0;
  pfd.iPixelType := PFD_TYPE_RGBA;      // PFD_TYPE_RGBA or PFD_TYPEINDEX
  pfd.cColorBits := 128;

  pf := ChoosePixelFormat(dc, @pfd);   // Returns format that most closely matches above pixel format
  SetPixelFormat(dc, pf, @pfd);

  rc := wglCreateContext(dc);    // Rendering Context = window-glCreateContext
  wglMakeCurrent(dc, rc);        // Make the DC (Panel) the rendering Context

  // Initialise GL environment variables
  glInit;
  PanelResize(sender);    // sets up the perspective
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);    // Clear The Screen And The Depth Buffer

  {}
  vLightKoef := 0.35;
  vLa[0] := vLightKoef * (cnstLight + 0.2);
  vLa[1] := vLightKoef * (cnstLight + 0.2);
  vLa[2] := vLightKoef * (cnstLight + 0.2);
  vLa[3] := 0;
  glLightfv(GL_LIGHT0, GL_AMBIENT, @vLa);
  vLd[0] := vLightKoef * cnstLight;
  vLd[1] := vLightKoef * cnstLight;
  vLd[2] := vLightKoef * cnstLight;
  vLd[3] := 0;
  glLightfv(GL_LIGHT0, GL_DIFFUSE, @vLd);
  vLs[0] := vLightKoef * (cnstLight + 0.2);
  vLs[1] := vLightKoef * (cnstLight + 0.2);
  vLs[2] := vLightKoef * (cnstLight + 0.2);
  vLs[3] := 0;
  glLightfv(GL_LIGHT0, GL_SPECULAR, @vLs);

  vLa[0] := vLightKoef * (cnstLight + 0.1);
  vLa[1] := vLightKoef * (cnstLight + 0.1);
  vLa[2] := vLightKoef * (cnstLight + 0.1);
  vLa[3] := 0;
  glLightfv(GL_LIGHT1, GL_AMBIENT, @vLa);
  vLd[0] := vLightKoef * (cnstLight + 0.4);
  vLd[1] := vLightKoef * (cnstLight + 0.4);
  vLd[2] := vLightKoef * (cnstLight + 0.4);
  vLd[3] := 0;
  glLightfv(GL_LIGHT1, GL_DIFFUSE, @vLd);
  vLs[0] := vLightKoef * (cnstLight + 0.4);
  vLs[1] := vLightKoef * (cnstLight + 0.4);
  vLs[2] := vLightKoef * (cnstLight + 0.4);
  vLs[3] := 0;
  glLightfv(GL_LIGHT1, GL_SPECULAR, @vLs);

  vLa[0] := vLightKoef * cnstLight;
  vLa[1] := vLightKoef * cnstLight;
  vLa[2] := vLightKoef * cnstLight;
  vLa[3] := 0;
  glLightfv(GL_LIGHT2, GL_AMBIENT, @vLa);
  vLd[0] := vLightKoef * cnstLight;
  vLd[1] := vLightKoef * cnstLight;
  vLd[2] := vLightKoef * cnstLight;
  vLd[3] := 0;
  glLightfv(GL_LIGHT2, GL_DIFFUSE, @vLd);
  vLs[0] := vLightKoef * cnstLight;
  vLs[1] := vLightKoef * cnstLight;
  vLs[2] := vLightKoef * cnstLight;
  vLs[3] := 0;
  glLightfv(GL_LIGHT2, GL_SPECULAR, @vLs);

  glEnable(GL_LIGHT0);
  glEnable(GL_LIGHT1);
  glEnable(GL_LIGHT2);

//  glLightModelf(GL_QUADRATIC_ATTENUATION, 1);
//  glLightModelf(GL_LINEAR_ATTENUATION, 1);
  {}
  glFrontFace(GL_CW);
  glLightModelf(GL_LIGHT_MODEL_TWO_SIDE, 0.5);
//  glLightModelf(GL_LIGHT_MODEL_LOCAL_VIEWER, 0.5);

  Idle(Sender, Done);
  Application.OnIdle := Idle;

  FDownPos := cnstFPointZero;
  FOffs := cnstFPointZero;
  cbBackSelect(Sender);
  rbMat1Click(Sender);

  OnActivate := FormActivate;
end;

{------------------------------------------------------------------}
{  Release rendering context when form gets detroyed               }
{------------------------------------------------------------------}
procedure TfmGLForm.FormDestroy(Sender: TObject);
begin
  DeleteEntList;
  FEntList.Free;
  wglMakeCurrent(0,0);
  wglDeleteContext(rc);
  FPicture.Free;
  ReleaseDC(Panel.Handle, dc);
  FPanel.EndUpdate;
end;

{------------------------------------------------------------------}
{  Application onIdle event                                        }
{------------------------------------------------------------------}
procedure TfmGLForm.Idle(Sender: TObject; var Done: Boolean);
begin
  glDraw;
end;

procedure TfmGLForm.Initialize(const AImage: TsgCADImage);
var
  I, J: Integer;
begin
  FillChar(FMatrix, SizeOf(FMatrix), 0);
  FDownPos := cnstFPointZero;
  FOffs := cnstFPointZero;
  FillChar(FParam, SizeOf(TsgCADIterate), 0);
  if Assigned(AImage) then
  begin
    FBox := AImage.CurrentLayout.Box;
    FParam.Matrix := Img.CurrentLayout.RotMatrix;
  end
  else
  begin
    FBox := MakeFRect(-0.5, 0.5, -0.5, 0.5, -0.5, 0.5);
    FParam.Matrix := cnstIdentityMat;
  end;
  FAbsWidth := FBox.Right - FBox.Left;
  FAbsHeight := FBox.Top - FBox.Bottom;
  FDepth := FBox.Z2 - FBox.Z1;
  FCenter := MakeFPoint((FBox.Right + FBox.Left) / 2,
    (FBox.Top + FBox.Bottom) / 2, (FBox.Z2 + FBox.Z1) / 2);
  FDistance := 3 * DistanceFPoint(FCenter, FBox.TopLeft);

  FLightPos[0][0] := FCenter.X - FDistance;
  FLightPos[0][1] := FCenter.Y + FDistance;
  FLightPos[0][2] := FCenter.Z + FDistance;

  FLightPos[1][0] := FCenter.X;
  FLightPos[1][1] := FCenter.Y;
  FLightPos[1][2] := FCenter.Z + FDistance;

  FLightPos[2][0] := FCenter.X + FDistance;
  FLightPos[2][1] := FCenter.Y + FDistance;
  FLightPos[2][2] := FCenter.Z + FDistance;

  FScale := 1 / FDistance; //??
  //FParam.Matrix := MatXMat(FParam.Matrix, StdMat(MakeFPoint(1, 1, 1), MakeFPoint(-FCenter.X, -FCenter.Y, -FCenter.Z)));
  // copy sg matrix to gl matrix
  for I := 0 to 3 do
    for J := 0 to 2 do
      FMatrix[I, J] := FParam.Matrix.M[I, J];
  FMatrix[3, 3] := 1;
end;

{------------------------------------------------------------------}
{  If the panel resizes, reset the GL scene                        }
{------------------------------------------------------------------}
procedure TfmGLForm.PanelResize(Sender: TObject);
var
  R: TRect;
begin
  R := Panel.ClientRect;
  FSceneBox := ResetGLScene(R, FBox, not cbPerspective.Checked, True);
end;

procedure TfmGLForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #27 then
    Close;
end;

procedure TfmGLForm.DeleteEntList;
begin
  if Assigned(FEntList) and (FEntList.Count > 0) then
  begin
    glDeleteLists(1, FEntList.Count);
    FEntList.Clear;
  end;
end;

procedure TfmGLForm.Open(const FileName: string);
begin
  CloseDrawing;
  try
    Application.OnIdle := nil;
    Timer1.Enabled := False;
    try
      if FileExists(FileName) then
       FPicture.LoadFromFile(FileName)
      else
        SetTestDrawing(FPicture);
      if Img <> nil then
        Img.GetExtents;
      Initialize(Img);
      PanelResize(nil); // reset OpenGL scene
      LoadEntities;
      rbMat1Click(nil); // apply material
      sbrStatusBar.Panels[0].Text := FileName;
    finally
      Application.OnIdle := Idle;
      Timer1.Enabled := True;
    end;
  except
    sbrStatusBar.Panels[0].Text := '';
  end;
end;

procedure TfmGLForm.pmiLightClick(Sender: TObject);
begin
  if TMenuItem(Sender).Checked then
    glEnable(GL_LIGHT0 + TCheckBox(Sender).Tag)
  else
    glDisable(GL_LIGHT0 + TCheckBox(Sender).Tag);
end;

procedure TfmGLForm.pmiOpenClick(Sender: TObject);
begin
  if OpenPictureDialog.Execute then
    Open(OpenPictureDialog.FileName);
end;

procedure TfmGLForm.cbWireframeClick(Sender: TObject);
begin
  pmiWireframe.Checked := cbWireframe.Checked;
  if pmiWireframe.Checked then
    FMode := GL_LINE_LOOP
  else
    FMode := GL_TRIANGLE_FAN;
  ReloadEnities;
end;

procedure TfmGLForm.CloseDrawing;
begin
  FPicture.Graphic := nil;
  Self.sbrStatusBar.Panels[0].Text := '';
  Initialize(nil);
  glLoadIdentity;                   // Reset View
end;

procedure TfmGLForm.pmiWireframeClick(Sender: TObject);
begin
  pmiWireframe.Checked := not pmiWireframe.Checked;
  cbWireframe.Checked := pmiWireframe.Checked;
end;

procedure TfmGLForm.rbMat1Click(Sender: TObject);
begin
  if rbMat1.Checked then
    MaterialApply(0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.7)
  else
    MaterialApply(0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2);
end;

procedure TfmGLForm.ReloadEnities;
begin
  DeleteEntList;
  if Img <> nil then
  begin
    Img.Converter.AutoInsert := True;
    Img.Converter.Iterate(GetEnt, nil, FParam);
  end;
end;

procedure TfmGLForm.cbBackSelect(Sender: TObject);
var
  vColor: TColor;
  vRGB: array[0 .. 3] of Byte absolute vColor;
begin
  vColor := ColorToRGB(cbBack.Selected);
  glClearColor(vRGB[0] / 256, vRGB[1] / 256, vRGB[2] / 256, 0);
end;

procedure TfmGLForm.sbGLOrbit3DClick(Sender: TObject);
begin
  if Sender is TMenuItem then
  begin
    pmi3DOrbit.Checked := not pmi3DOrbit.Checked;
    sbGLOrbit3D.Down := pmi3DOrbit.Checked;
  end
  else
    if Sender is TSpeedButton then
      pmi3DOrbit.Checked := sbGLOrbit3D.Down;
  FPanel.Orbit3D.Visible := sbGLOrbit3D.Down;
end;

procedure TfmGLForm.Timer1Timer(Sender: TObject);
begin
  Caption := sFormCaption + ' - ' + IntToStr(Round(FFPSCount * 1000/FPSInterval)) + ' fps';
  FFPSCount := 0;
end;

procedure TfmGLForm.OrbitMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  dX, dY: Integer;

  procedure DoRotate(Aaxis: TsgAxes; Angle: Double);
  var
    P1, P: TArray4s;
    M: TglMatrix;
  begin
    FillChar(P1, SizeOf(P1), 0);
    glTranslated(FCenter.X, FCenter.Y, FCenter.Z);
    P1[Integer(Aaxis)] := 1;
    glGetFloatv(GL_MODELVIEW_MATRIX, @M);
    FixPoint(@P1, @P, @M);
    glRotated(Angle, P[0], P[1], P[2]);
    glTranslated(-FCenter.X, -FCenter.Y, -FCenter.Z);
  end;

begin
  if FIsMouseDown then
  begin
    dX := X - FMouseCoords.X;
    dY := Y - FMouseCoords.Y;
    case Tsg3DStates(FPanel.Orbit3D.Cursor - 1) of
      stateX:
        DoRotate(axisX, dX);
      stateY:
        DoRotate(axisY, dY);
      stateZ:
        begin
          if Abs(dX) > Abs(dY) then
          begin
            if FMouseCoords.Y < PtCenter.Y then
              DoRotate(axisZ, -dX)
            else
              DoRotate(axisZ, dX)
          end
          else
          begin
            if FMouseCoords.X < PtCenter.X then
              DoRotate(axisZ, dY)
            else
              DoRotate(axisZ, -dY)
          end;
        end;
      stateXY:
        begin
          DoRotate(axisX, dY);
          DoRotate(axisY, dX);
        end;
    end;
    FMouseCoords := Point(X, Y);
  end;
  DoPanelFocus;
  glDraw;
end;

procedure TfmGLForm.OrbitMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and (dc <> 0) then
  begin
    FIsMouseDown := True;
    FMouseCoords := Point(X, Y);
  end;
end;

procedure TfmGLForm.OrbitMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and (dc <> 0) then
  begin
    FIsMouseDown := False;
  end;
end;

procedure TfmGLForm.DoPanelFocus;
begin
  if Panel.Visible and Panel.Enabled and
     not Panel.Focused and Panel.CanFocus then
    Panel.SetFocus;
end;

procedure TfmGLForm.PanelMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if [ssRight, ssMiddle] * Shift <> [] then
  begin
    FOffs := MakeFPoint(X - FDownPos.X, Y - FDownPos.Y, 0);
    glDraw;
  end
  else
    DoPanelFocus;
end;

procedure TfmGLForm.PanelMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FContextPos := Point(X, Y);
  FDownPos := MakeFPoint(X - FOffs.X, Y - FOffs.Y, 0);
  if Button in [mbRight, mbMiddle] then
  begin
    Panel.Cursor := crHandPoint;
    SetCapture(Panel.Handle);
  end;
end;

procedure TfmGLForm.PanelMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  if (Button in [mbRight, mbMiddle]) and (GetCapture = Panel.Handle) then
  begin
    if (FContextPos.X = X) and (FContextPos.Y = Y) then
    begin
      P := Panel.ClientToScreen(Point(X, Y));
      pmMenu.Popup(P.X, P.Y);
    end
    else
    begin
      FOffs := MakeFPoint(X - FDownPos.X, Y - FDownPos.Y, 0);
      FPanel.Cursor := crDefault;
      ReleaseCapture;
    end;
  end;
end;

procedure TfmGLForm.cbNormalizeClick(Sender: TObject);
begin
  if cbNormalize.Checked then
    glEnable(GL_NORMALIZE)
  else
    glDisable(GL_NORMALIZE);
end;

procedure TfmGLForm.cbPerspectiveClick(Sender: TObject);
begin
  PanelResize(nil);
end;

procedure TfmGLForm.cbLightingClick(Sender: TObject);
begin
  if cbLighting.Checked then
    glEnable(GL_LIGHTING)
  else
    glDisable(GL_LIGHTING);
end;

procedure TfmGLForm.MaterialApply(Ambr, Ambg, Ambb, Difr, Difg, Difb, Specr,
  Specg, Specb, Shine: GLFloat);
var
  Mat: TArray4s;
begin
  Mat[0] := Ambr;
  Mat[1] := Ambg;
  Mat[2] := Ambb;
  Mat[3] := Shine;
  glMaterialfv(GL_FRONT_AND_BACK, GL_AMBIENT, @mat);
  //glMaterialfv(GL_BACK, GL_AMBIENT, @mat);
  Mat[0] := Difr;
  Mat[1] := Difg;
  Mat[2] := Difb;
  Mat[3] := Shine;
  glMaterialfv(GL_FRONT_AND_BACK, GL_DIFFUSE, @mat);
  //glMaterialfv(GL_BACK, GL_DIFFUSE, @mat);
  Mat[0] := Specr;
  Mat[1] := Specg;
  Mat[2] := Specb;
  Mat[3] := Shine;
  glMaterialfv(GL_FRONT_AND_BACK, GL_SPECULAR, @mat);
  glMaterialf(GL_FRONT_AND_BACK, GL_SHININESS, Shine * 128.0);
  //glMaterialfv(GL_BACK, GL_SPECULAR, @mat);
end;

procedure TfmGLForm.PanelMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  glTranslated(FCenter.X, FCenter.Y, FCenter.Z);
  glScale(0.8, 0.8, 0.8);
  glTranslated(-FCenter.X, -FCenter.Y, -FCenter.Z);
end;

procedure TfmGLForm.PanelMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  glTranslated(FCenter.X, FCenter.Y, FCenter.Z);
  glScale(1.2, 1.2, 1.2);
  glTranslated(-FCenter.X, -FCenter.Y, -FCenter.Z);
end;

function TfmGLForm.GetImg: TsgCADImage;
begin
  Result := nil;
  if FPicture.Graphic is TsgCADImage then
    Result := TsgCADImage(FPicture.Graphic);
end;

//function TfmGLForm.GetMatrix: TglMatrixd;
//begin
//  glGetDoublev(GL_MODELVIEW_MATRIX, @Result);
//end;

function TfmGLForm.GetPtCenter: TPoint;
begin
  Result.X := (FPanel.ClientRect.Left + FPanel.ClientRect.Right) div 2;
  Result.Y := (FPanel.ClientRect.Top + FPanel.ClientRect.Bottom) div 2;
end;

procedure TfmGLForm.FormShow(Sender: TObject);
begin
  ParamAnalyse;
end;

end.
