GLScene/Examples/AdvDemos/GLSViewer/Source/fGLSViewer.pas

unit fGLSViewer;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  Winapi.OpenGL,
  Winapi.ShellAPI,
  System.SysUtils,
  System.Classes,
  System.IniFiles,
  System.Win.Registry,
  System.ImageList,
  System.Math,
  System.Actions,
  System.Types,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.ActnList,
  Vcl.Menus,
  Vcl.ImgList,
  Vcl.ToolWin,
  Vcl.ComCtrls,
  Vcl.ExtDlgs,
  Vcl.ExtCtrls,
  Vcl.ActnMan,
  Vcl.ActnCtrls,
  Vcl.ActnMenus,
  Vcl.StdActns,
  Vcl.BandActn,
  Vcl.StdStyleActnCtrls,
  Vcl.VirtualImageList,
  Vcl.BaseImageCollection,
  Vcl.ImageCollection,

  Stage.VectorTypes,
  GLS.VectorLists,
  Stage.Keyboard,
  Stage.VectorGeometry,
  GLS.Coordinates,
  GLS.BaseClasses,
  GLS.PersistentClasses,
  Stage.TextureFormat,
  GLS.XCollection,

  GLS.Material,
  GLS.Scene,
  GLS.SceneViewer,
  GLS.VectorFileObjects,
  GLS.Objects,
  GLS.Texture,
  GLS.Context,
  GLS.Cadencer,
  GLS.State,
  GLS.RenderContextInfo,
  GLS.Color,
  GLS.Graphics,
  GLS.MeshUtils,
  GLS.AsyncTimer,
  GLS.Graph,
  GLS.MeshBuilder,
  GLS.Navigator,
  Stage.Utils,
  GLS.GeomObjects,
  GLS.SimpleNavigation,
  GLS.Extrusion,
  GLS.MultiPolygon,
  GLS.FileTGA,
  GLS.Tree,
  GLS.SkyDome,

  fGLForm,
  fGLDialog,
  fGLAbout,
  fGLOptions,
  dImages,
  dDialogs, Vcl.PlatformDefaultStyleActnCtrls;

type
  TfrmGLSViewer = class(TGLForm)
    StatusBar: TStatusBar;
    Scene: TGLScene;
    ffObject: TGLFreeForm;
    LightSource: TGLLightSource;
    CubeLines: TGLCube;
    dcObject: TGLDummyCube;
    Camera: TGLCamera;
    dcAxis: TGLDummyCube;
    Cadencer: TGLCadencer;
    Timer: TTimer;
    snViewer: TGLSceneViewer;
    ActionManager: TActionManager;
    acOptimizeMesh: TAction;
    acProcessInvertNormals: TAction;
    acReverseRendering: TAction;
    acConvertToTriangles: TAction;
    acProcessStripify: TAction;
    acToolsOptions: TAction;
    acToolsFaceCulling: TAction;
    acToolsTexturing: TAction;
    acToolsLighting: TAction;
    acToolsCustomize: TCustomizeActionBars;
    acToolsShowFPS: TAction;
    acViewSmoothShading: TAction;
    acViewFlatShading: TAction;
    acViewFlatLines: TAction;
    acViewHiddenLines: TAction;
    acViewWireFrame: TAction;
    acViewZoomIn: TAction;
    acViewZoomOut: TAction;
    acViewReset: TAction;
    acFileOpen: TAction;
    acFilePick: TAction;
    acFileOpenTexLib: TAction;
    acFileSaveAs: TAction;
    acFileSaveTextures: TAction;
    acFileExit: TAction;
    acHelpContents: THelpContents;
    acHelpTopicSearch: THelpTopicSearch;
    acHelpGLSHomePage: TAction;
    acHelpAbout: TAction;
    acAADefault: TAction;
    acAA2X: TAction;
    acAA4X: TAction;
    acEditUndo: TEditUndo;
    acEditCut: TEditCut;
    acEditCopy: TEditCopy;
    acEditPaste: TEditPaste;
    acEditSelectAll: TEditSelectAll;
    acEditDelete: TEditDelete;
    ImageListMenu: TImageList;
    ControlBar: TControlBar;
    amMenuBar: TActionMainMenuBar;
    acAA8X: TAction;
    acAA16X: TAction;
    acCSA8X: TAction;
    acCSA16X: TAction;
    atbTools: TActionToolBar;
    atbView: TActionToolBar;
    atbFile: TActionToolBar;
    acPoints: TAction;
    AsyncTimer: TGLAsyncTimer;
    dcWorld: TGLDummyCube;
    XYZGrid: TGLXYZGrid;
    acToolsNaviCube: TAction;
    Points: TGLPoints;
    acToolsInfo: TAction;
    GLSimpleNavigation: TGLSimpleNavigation;
    acSpheres: TAction;
    PanelLeft: TPanel;
    tvScene: TTreeView;
    acSaveTreeView: TAction;
    acLoadTreeView: TAction;
    Pipe: TGLPipe;
    Torus: TGLTorus;
    Teapot: TGLTeapot;
    Tree: TGLTree;
    acClear: TAction;
    acLandscape: TAction;
    acRoom: TAction;
    procedure AsyncTimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure snViewerMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure snViewerMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure snViewerMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure snViewerBeforeRender(Sender: TObject);
    procedure snViewerAfterRender(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure MaterialLibTextureNeeded(Sender: TObject;
      var textureFileName: String);
    procedure acInvertNormalsExecute(Sender: TObject);
    procedure acSaveAsUpdate(Sender: TObject);
    procedure acReverseRenderingOrderExecute(Sender: TObject);
    procedure acConvertToIndexedTrianglesExecute(Sender: TObject);
    procedure CadencerProgress(Sender: TObject;
      const deltaTime, newTime: Double);
    procedure TimerTimer(Sender: TObject);
    procedure acOptimizeExecute(Sender: TObject);
    procedure acStripifyExecute(Sender: TObject);
    procedure acHelpAboutExecute(Sender: TObject);
    procedure acFilePickExecute(Sender: TObject);
    procedure acFileOpenTexLibExecute(Sender: TObject);
    procedure acFileOpenExecute(Sender: TObject);
    procedure acFileSaveAsExecute(Sender: TObject);
    procedure acFileSaveTexturesExecute(Sender: TObject);
    procedure acFileExitExecute(Sender: TObject);
    procedure acToolsOptionsExecute(Sender: TObject);
    procedure acToolsTexturingExecute(Sender: TObject);
    procedure acToolsFaceCullingExecute(Sender: TObject);
    procedure acToolsLightingExecute(Sender: TObject);
    procedure acToolsShowFPSExecute(Sender: TObject);
    procedure acAADefaultExecute(Sender: TObject);
    procedure acViewSmoothShadingExecute(Sender: TObject);
    procedure acViewFlatShadingExecute(Sender: TObject);
    procedure acViewFlatLinesExecute(Sender: TObject);
    procedure acViewHiddenLinesExecute(Sender: TObject);
    procedure acViewWireFrameExecute(Sender: TObject);
    procedure acViewResetExecute(Sender: TObject);
    procedure acViewZoomOutExecute(Sender: TObject);
    procedure acViewZoomInExecute(Sender: TObject);
    procedure acPointsExecute(Sender: TObject);
    procedure acToolsNaviCubeExecute(Sender: TObject);
    procedure acToolsInfoExecute(Sender: TObject);
    procedure snViewerMouseLeave(Sender: TObject);
    procedure tvSceneCheckStateChanged(Sender: TCustomTreeView; Node: TTreeNode;
      CheckState: TNodeCheckState);
    procedure acHelpGLSHomePageExecute(Sender: TObject);
    procedure acHelpContentsExecute(Sender: TObject);
    procedure acHelpTopicSearchExecute(Sender: TObject);
    procedure acSaveTreeViewExecute(Sender: TObject);
    procedure acLoadTreeViewExecute(Sender: TObject);
    procedure tvSceneClick(Sender: TObject);
    procedure acSpheresExecute(Sender: TObject);
    procedure acLandscapeExecute(Sender: TObject);
    procedure acRoomExecute(Sender: TObject);
  private
    AssetPath: TFileName;
    TextureDir: TFileName;
    // Base objects
    Lines: TGLLines;
    Plane: TGLPlane;
    Polygon: TGLPolygon;
    Cube: TGLCube;
    Frustrum: TGLFrustrum;
    Sphere: TGLSphere;
    Disk: TGLDisk;
    Cone: TGLCone;
    Cylinder: TGLCylinder;
    Capsule: TGLCapsule;
    Dodecahedron: TGLDodecahedron;
    Icosahedron: TGLIcosahedron;
    Hexahedron: TGLHexahedron;
    Octahedron: TGLOctahedron;
    Tetrahedron: TGLTetrahedron;
    SuperEllipsoid: TGLSuperEllipsoid;
    // Advanced objects
    Annulus: TGLAnnulus;
    ArrowLine: TGLArrowLine;
    ArrowArc: TGLArrowArc;
    MultiPolygon: TGLMultiPolygon;
    RevolutionSolid: TGLRevolutionSolid;
    ExtrusionSolid: TGLExtrusionSolid;
    // Mesh objects
    Actor: TGLActor;
    FreeForm: TGLFreeForm;
    MeshObject: TGLMeshObject;
    // Environment objects
    SkyBox: TGLSkyBox;
    SkyDome: TGLSkyDome;
    EarthSkyDome: TGLEarthSkyDome;

    procedure DoResetCamera;
    procedure SetupFreeFormShading;
    procedure ApplyShadeModeToMaterial(aMaterial: TGLMaterial);
    procedure ApplyShadeMode;
    procedure ApplyFSAA;
    procedure ApplyFaceCull;
    procedure ApplyTexturing;
    procedure ApplyFPS;
    procedure DoOpen(const FileName: String);
  public
    md, nthShow: Boolean;
    mx, my: Integer;
    hlShader: TGLShader;
    lastFileName: String;
    lastLoadWithTextures: Boolean;
    procedure ApplyBgColor;
    procedure ReadIniFile; override;
    procedure WriteIniFile;
  end;

var
  frmGLSViewer: TfrmGLSViewer;
  NaviCube: TGLNaviCube;

implementation //-------------------------------------------------------------

{$R *.dfm}

uses
  GLS.FileOBJ,
  GLS.FileSTL,
  GLS.FileLWO,
  GLS.FileQ3BSP,
  GLS.FileOCT,
  GLS.FileMS3D,
  GLS.FileNMF,
  GLS.FileMD3,
  GLS.File3DS,
  GLS.FileMD2,
  GLS.FileSMD,
  GLS.FilePLY,
  GLS.FileGTS,
  GLS.FileVRML,
  GLS.FileMD5,
  GLS.FileTIN,
  GLS.FileDXF,
  GLS.FileGRD,
  GLS.FileX,
  GLS.FileGLTF;

type
  // Hidden line shader (specific implem for the viewer, *not* generic)
  THiddenLineShader = class(TGLShader)
  private
    LinesColor: TGLColorVector;
    BackgroundColor: TGLColorVector;
    PassCount: Integer;
  public
    procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override;
    function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override;
  end;

//---------------------------------------------------------------------------
procedure THiddenLineShader.DoApply(var rci: TGLRenderContextInfo;
  Sender: TObject);
begin
  PassCount := 1;
  with rci.GLStates do
  begin
    PolygonMode := pmFill;
    gl.Color3fv(@BackgroundColor);
    ActiveTextureEnabled[ttTexture2D] := False;
    Enable(stPolygonOffsetFill);
    PolygonOffsetFactor := 1;
    PolygonOffsetUnits := 2;
  end;
end;

function THiddenLineShader.DoUnApply(var rci: TGLRenderContextInfo): Boolean;
begin
  case PassCount of
    1:
      with rci.GLStates do
      begin
        PassCount := 2;
        PolygonMode := pmLines;
        glColor3fv(@LinesColor);
        Disable(stLighting);
        Result := True;
      end;
    2:
      begin
        rci.GLStates.Disable(stPolygonOffsetFill);
        Result := False;
      end;
  else
    // doesn't hurt to be cautious
    Assert(False);
    Result := False;
  end;
end;

//---------------------------------------------------------------
procedure TfrmGLSViewer.FormCreate(Sender: TObject);
begin
  AssetPath := GetCurrentAssetPath();
  TextureDir := AssetPath + '\texture';
  SetCurrentDir(TextureDir);

  NaviCube := TGLNaviCube.CreateAsChild(Scene.Objects);
  NaviCube.SceneViewer := snViewer;
  NaviCube.FPS := 30;

 // instantiate our specific hidden-lines shader
  hlShader := THiddenLineShader.Create(Self);
  ffObject.IgnoreMissingTextures := True;

  tvScene.FullExpand;
  tvScene.Select(tvScene.Items[9]);  // goto to Cube
  tvSceneClick(Self);
  inherited;
end;

//---------------------------------------------------------------
procedure TfrmGLSViewer.FormShow(Sender: TObject);
begin
  if not nthShow then
  begin
    // using formats supported by gls
    dmDialogs.OpenDialog.InitialDir := AssetPath + '\model';;
    dmDialogs.OpenDialog.Filter := VectorFileFormatsFilter;
    dmDialogs.SaveDialog.Filter := VectorFileFormatsSaveFilter;
    ApplyFSAA;
    ApplyFaceCull;
    ApplyFPS;
    if ParamCount > 0 then
      DoOpen(ParamStr(0));
    nthShow := True;
  end;
end;

//---------------------------------------------------------------
procedure TfrmGLSViewer.acFileOpenExecute(Sender: TObject);
begin
  NaviCube.ActiveMouse := False;
  if dmDialogs.OpenDialog.Execute then
    DoOpen(dmDialogs.OpenDialog.FileName);
end;

//---------------------------------------------------------------
procedure TfrmGLSViewer.acFileOpenTexLibExecute(Sender: TObject);
var
  I: Integer;
begin
  dmDialogs.ODTextures.InitialDir := AssetPath + '\texture';;
  if dmDialogs.ODTextures.Execute then
  begin
    dmImages.MaterialLib.LoadFromFile(dmDialogs.ODTextures.FileName);
    for I := 0 to dmImages.MaterialLib.Materials.Count - 1 do
      with dmImages.MaterialLib.Materials[I].Material do
        BackProperties.Assign(FrontProperties);
    ApplyShadeMode;
    ApplyTexturing;
  end;
end;

//---------------------------------------------------------------
procedure TfrmGLSViewer.acFilePickExecute(Sender: TObject);
begin
  dmDialogs.ODTextures.InitialDir := AssetPath + '\texture';;
  if dmDialogs.opDialog.Execute then
  begin
    with dmImages.MaterialLib.Materials do
    begin
      with Items[Count - 1] do
      begin
        Tag := 1;
        Material.Texture.Image.LoadFromFile(dmDialogs.opDialog.FileName);
        Material.Texture.Enabled := True;
      end;
    end;
    ApplyTexturing;
  end;
end;

//---------------------------------------------------------------
procedure TfrmGLSViewer.acFileSaveAsExecute(Sender: TObject);
var
  ext: String;
begin
  if dmDialogs.SaveDialog.Execute then
  begin
    ext := ExtractFileExt(dmDialogs.SaveDialog.FileName);
    if ext = '' then
      dmDialogs.SaveDialog.FileName :=
        ChangeFileExt(dmDialogs.SaveDialog.FileName,
        '.' + GetVectorFileFormats.FindExtByIndex
        (dmDialogs.SaveDialog.FilterIndex, False, True));
    if GetVectorFileFormats.FindFromFileName(dmDialogs.SaveDialog.FileName) = nil
    then
      ShowMessage('Unsupported file extension')
    else
      ffObject.SaveToFile(dmDialogs.SaveDialog.FileName);
  end;
end;

procedure TfrmGLSViewer.acFileSaveTexturesExecute(Sender: TObject);
begin
  if dmDialogs.SDTextures.Execute then
    dmImages.MaterialLib.SaveToFile(dmDialogs.SDTextures.FileName);
end;

procedure TfrmGLSViewer.snViewerBeforeRender(Sender: TObject);
begin
  THiddenLineShader(hlShader).LinesColor := VectorMake(107 / 256, 123 / 256,
    173 / 256, 1);
  THiddenLineShader(hlShader).BackgroundColor :=
    ConvertWinColor(snViewer.Buffer.BackgroundColor);
  if not gl.ARB_multisample then
  begin
    acAADefault.Checked := True;
    acAA2X.Enabled := False;
    acAA4X.Enabled := False;
    acAA8X.Enabled := False;
    acAA16X.Enabled := False;
    acCSA8X.Enabled := False;
    acCSA16X.Enabled := False;
  end;
end;

procedure TfrmGLSViewer.snViewerAfterRender(Sender: TObject);
begin
  ApplyFSAA;
  Screen.Cursor := crDefault;
end;

procedure TfrmGLSViewer.DoResetCamera;
var
  objSize: Single;
begin
  dcObject.Position.AsVector := NullHmgPoint;
  Camera.Position.SetPoint(0, 4, 5);
  ffObject.Position.AsVector := NullHmgPoint;
  ffObject.Up.Assign(dcAxis.Up);
  ffObject.Direction.Assign(dcAxis.Direction);

  objSize := ffObject.BoundingSphereRadius;
  if objSize > 0 then
  begin
    if objSize < 1 then
    begin
      Camera.SceneScale := 1 / objSize;
      objSize := 1;
    end
    else
      Camera.SceneScale := 1;
    Camera.AdjustDistanceToTarget(objSize * 0.27);
    Camera.DepthOfView := 1.5 * Camera.DistanceToTarget + 2 * objSize;
  end;
end;

procedure TfrmGLSViewer.ApplyShadeModeToMaterial(aMaterial: TGLMaterial);
begin
  if acViewSmoothShading.Checked then
  begin
    snViewer.Buffer.Lighting := True;
    snViewer.Buffer.ShadeModel := smSmooth;
    aMaterial.PolygonMode := pmFill;
  end
  else if acViewFlatShading.Checked then
  begin
    snViewer.Buffer.Lighting := True;
    snViewer.Buffer.ShadeModel := smFlat;
    aMaterial.PolygonMode := pmFill;
  end
  else if acViewFlatLines.Checked then
  begin
    snViewer.Buffer.Lighting := True;
    snViewer.Buffer.ShadeModel := smFlat;
    aMaterial.PolygonMode := pmLines;
  end
  else if acViewHiddenLines.Checked then
  begin
    snViewer.Buffer.Lighting := False;
    snViewer.Buffer.ShadeModel := smSmooth;
    aMaterial.PolygonMode := pmLines;
  end
  else if acViewWireFrame.Checked then
  begin
    snViewer.Buffer.Lighting := False;
    snViewer.Buffer.ShadeModel := smSmooth;
    aMaterial.PolygonMode := pmLines;
  end;
end;

procedure TfrmGLSViewer.ApplyShadeMode;
var
  I: Integer;
begin
  with dmImages.MaterialLib.Materials do
    for I := 0 to Count - 1 do
    begin
      ApplyShadeModeToMaterial(Items[I].Material);
      if (acViewHiddenLines.Checked) or (acViewFlatLines.Checked) then
        Items[I].Shader := hlShader
      else
        Items[I].Shader := nil;
    end;
  snViewer.Buffer.Lighting := acToolsLighting.Checked;
  ffObject.StructureChanged;
end;

procedure TfrmGLSViewer.ApplyFSAA;
begin
  with snViewer.Buffer do
  begin
    if acAADefault.Checked then
      AntiAliasing := aaDefault
    else if acAA2X.Checked then
      AntiAliasing := aa2x
    else if acAA4X.Checked then
      AntiAliasing := aa4x
    else if acAA8X.Checked then
      AntiAliasing := aa8x
    else if acAA16X.Checked then
      AntiAliasing := aa16x
    else if acCSA8X.Checked then
      AntiAliasing := csa8x
    else if acCSA16X.Checked then
      AntiAliasing := csa16x;
  end;
end;

procedure TfrmGLSViewer.ApplyFaceCull;
begin
  with snViewer.Buffer do
  begin
    if acToolsFaceCulling.Checked then
    begin
      FaceCulling := True;
      ContextOptions := ContextOptions - [roTwoSideLighting];
    end
    else
    begin
      FaceCulling := False;
      ContextOptions := ContextOptions + [roTwoSideLighting];
    end;
  end;
end;

procedure TfrmGLSViewer.ApplyBgColor;
var
  bmp: TBitmap;
  col: TColor;
begin
  bmp := TBitmap.Create;
  try
    bmp.Width := 16;
    bmp.Height := 16;
    col := ColorToRGB(dmDialogs.ColorDialog.Color);
    snViewer.Buffer.BackgroundColor := col;
    bmp.Canvas.Pen.Color := col xor $FFFFFF;
    bmp.Canvas.Rectangle(0, 0, 16, 16);
    bmp.Canvas.Brush.Color := col;
  finally
    bmp.Free;
  end;
end;

procedure TfrmGLSViewer.ApplyTexturing;
var
  I: Integer;
begin
  with dmImages.MaterialLib.Materials do
    for I := 0 to Count - 1 do
    begin
      with Items[I].Material.Texture do
      begin
        if Enabled then
          Items[I].Tag := Integer(True);
        Enabled := Boolean(Items[I].Tag) and acToolsTexturing.Checked;
      end;
    end;
  ffObject.StructureChanged;
end;

//--------------------------------------------------------
procedure TfrmGLSViewer.AsyncTimerTimer(Sender: TObject);
begin
  snViewer.ResetPerformanceMonitor;
end;

procedure TfrmGLSViewer.ApplyFPS;
begin
  if acToolsShowFPS.Checked then
  begin
    Timer.Enabled := True;
    Cadencer.Enabled := True;
  end
  else
  begin
    Timer.Enabled := False;
    Cadencer.Enabled := False;
//    StatusBar.Panels[3].Text := ' FPS';
  end;
end;

procedure TfrmGLSViewer.SetupFreeFormShading;
var
  I: Integer;
  LibMat: TGLLibMaterial;
begin
  if dmImages.MaterialLib.Materials.Count = 0 then
  begin
    ffObject.Material.MaterialLibrary := dmImages.MaterialLib;
    LibMat := dmImages.MaterialLib.Materials.Add;
    ffObject.Material.LibMaterialName := LibMat.Name;
    LibMat.Material.FrontProperties.Diffuse.Red := 0;
  end;
  for I := 0 to dmImages.MaterialLib.Materials.Count - 1 do
    with dmImages.MaterialLib.Materials[I].Material do
      BackProperties.Assign(FrontProperties);
  ApplyShadeMode;
  ApplyTexturing;
  ApplyFPS;
end;

procedure TfrmGLSViewer.DoOpen(const FileName: String);
var
  min, max: TAffineVector;
  Name: TFileName;
begin
  if not FileExists(FileName) then
    Exit;
  Screen.Cursor := crHourGlass;
  frmGLSViewer.Caption := 'GLSViewer - ' + FileName;
  dmImages.MaterialLib.Materials.Clear;
  ffObject.MeshObjects.Clear;
  ffObject.LoadFromFile(FileName);
  SetupFreeFormShading;
  acFileSaveTextures.Enabled := (dmImages.MaterialLib.Materials.Count > 0);
  acFileOpenTexLib.Enabled := (dmImages.MaterialLib.Materials.Count > 0);
  lastFileName := FileName;
  lastLoadWithTextures := acToolsTexturing.Enabled;
  ffObject.GetExtents(min, max);
  CubeLines.CubeWidth := max.X - min.X;
  CubeLines.CubeHeight := max.Y - min.Y;
  CubeLines.CubeDepth := max.Z - min.Z;
  CubeLines.Position.AsAffineVector := VectorLerp(min, max, 0.5);
  StatusBar.Panels[0].Text := 'X: ' + ' ';
  StatusBar.Panels[1].Text := 'Y: ' + ' ';
  StatusBar.Panels[2].Text := 'Z: ' + ' ';
  Name := ExtractFileName(FileName);
  StatusBar.Panels[3].Text := Name;
  DoResetCamera;
end;

procedure TfrmGLSViewer.snViewerMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  mx := X;
  my := Y;
  md := True;
end;

procedure TfrmGLSViewer.snViewerMouseLeave(Sender: TObject);
begin
  Cadencer.Enabled := False;
end;

procedure TfrmGLSViewer.snViewerMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  d: Single;
begin
  if md and (Shift <> []) then
  begin
    if ssLeft in Shift then
      if ssShift in Shift then
        Camera.MoveAroundTarget((my - Y) * 0.1, (mx - X) * 0.1)
      else
        Camera.MoveAroundTarget(my - Y, mx - X)
    else if ssRight in Shift then
    begin
      d := Camera.DistanceToTarget * 0.01 * (X - mx + Y - my);
      if IsKeyDown('x') then
        ffObject.Translate(d, 0, 0)
      else if IsKeyDown('y') then
        ffObject.Translate(0, d, 0)
      else if IsKeyDown('z') then
        ffObject.Translate(0, 0, d)
      else
      begin
        if ssShift in Shift then
          Camera.RotateObject(ffObject, (my - Y) * 0.1, (mx - X) * 0.1)
        else
          Camera.RotateObject(ffObject, my - Y, mx - X);
      end;
    end;
    mx := X;
    my := Y;
  end;
end;

procedure TfrmGLSViewer.snViewerMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  md := False;
end;

procedure TfrmGLSViewer.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  if ffObject.MeshObjects.Count > 0 then
  begin
    Camera.AdjustDistanceToTarget(Power(1.05, WheelDelta / 120));
    Camera.DepthOfView := 2 * Camera.DistanceToTarget + 2 *
      ffObject.BoundingSphereRadius;
  end;
  Handled := True;
end;

procedure TfrmGLSViewer.MaterialLibTextureNeeded(Sender: TObject;
  var textureFileName: String);
begin
  if not acToolsTexturing.Enabled then
    textureFileName := '';
end;

procedure TfrmGLSViewer.acInvertNormalsExecute(Sender: TObject);
var
  I: Integer;
begin
  with ffObject.MeshObjects do
    for I := 0 to Count - 1 do
      Items[I].Normals.Scale(-1);
  ffObject.StructureChanged;
end;

procedure TfrmGLSViewer.acReverseRenderingOrderExecute(Sender: TObject);
var
  I, j, n: Integer;
  fg: TGLFaceGroup;
begin
  with ffObject.MeshObjects do
  begin
    // invert meshobjects order
    for I := 0 to (Count div 2) do
      Exchange(I, Count - 1 - I);
    // for each mesh object
    for I := 0 to Count - 1 do
      with Items[I] do
      begin
        // invert facegroups order
        n := FaceGroups.Count;
        for j := 0 to (n div 2) do
          Exchange(j, n - 1 - j);
        // for each facegroup
        for j := 0 to n - 1 do
        begin
          fg := FaceGroups[j];
          fg.Reverse;
        end;
      end;
  end;
  ffObject.StructureChanged;
end;

procedure TfrmGLSViewer.acRoomExecute(Sender: TObject);
begin
  // Room
end;

procedure TfrmGLSViewer.acSaveAsUpdate(Sender: TObject);
begin
  acFileSaveAs.Enabled := (ffObject.MeshObjects.Count > 0);
end;

procedure TfrmGLSViewer.acHelpAboutExecute(Sender: TObject);
begin
  with TGLAbout.Create(Self) do
    try
      ShowModal;
    finally
      Free;
    end;
end;

procedure TfrmGLSViewer.acHelpContentsExecute(Sender: TObject);
begin
  inherited;
  ShellExecute(0, 'open', 'https://en.wikipedia.org/wiki/GLScene', '', '', SW_SHOW);
end;

procedure TfrmGLSViewer.acHelpTopicSearchExecute(Sender: TObject);
begin
  inherited;
  ShellExecute(0, 'open', 'https://glscene.org', '', '', SW_SHOW);
end;

procedure TfrmGLSViewer.acHelpGLSHomePageExecute(Sender: TObject);
begin
  inherited;
  ShellExecute(0, 'open','https://github.com/glscene', '', '', SW_SHOW);
end;


procedure TfrmGLSViewer.acAADefaultExecute(Sender: TObject);
begin
  (Sender as TAction).Checked := True;
  ApplyFSAA;
end;

procedure TfrmGLSViewer.acConvertToIndexedTrianglesExecute(Sender: TObject);
var
  v: TGLAffineVectorList;
  I: TGLIntegerList;
  m: TGLMeshObject;
  fg: TFGVertexIndexList;
begin
  v := ffObject.MeshObjects.ExtractTriangles;
  try
    I := BuildVectorCountOptimizedIndices(v);
    try
      RemapAndCleanupReferences(v, I);
      IncreaseCoherency(I, 12);
      I.Capacity := I.Count;
      ffObject.MeshObjects.Clean;
      m := TGLMeshObject.CreateOwned(ffObject.MeshObjects);
      m.Vertices := v;
      m.BuildNormals(I, momTriangles);
      m.Mode := momFaceGroups;
      fg := TFGVertexIndexList.CreateOwned(m.FaceGroups);
      fg.VertexIndices := I;
      fg.Mode := fgmmTriangles;
      ffObject.StructureChanged;
    finally
      I.Free;
    end;
  finally
    v.Free;
  end;
  dmImages.MaterialLib.Materials.Clear;
  SetupFreeFormShading;
end;

procedure TfrmGLSViewer.acStripifyExecute(Sender: TObject);
var
  I: Integer;
  mo: TGLMeshObject;
  fg: TFGVertexIndexList;
  strips: TGLPersistentObjectList;
begin
  acConvertToTriangles.Execute;
  mo := ffObject.MeshObjects[0];
  fg := (mo.FaceGroups[0] as TFGVertexIndexList);
  strips := StripifyMesh(fg.VertexIndices, mo.Vertices.Count, True);
  try
    fg.Free;
    for I := 0 to strips.Count - 1 do
    begin
      fg := TFGVertexIndexList.CreateOwned(mo.FaceGroups);
      fg.VertexIndices := (strips[I] as TGLIntegerList);
      if I = 0 then
        fg.Mode := fgmmTriangles
      else
        fg.Mode := fgmmTriangleStrip;
    end;
  finally
    strips.Free;
  end;
end;

procedure TfrmGLSViewer.acSaveTreeViewExecute(Sender: TObject);
begin
  if dmDialogs.SaveDialog.Execute then
  begin
    tvScene.SaveToFile(dmDialogs.SaveDialog.FileName);
  end;
end;

procedure TfrmGLSViewer.acSpheresExecute(Sender: TObject);
begin
  inherited;
  // random spheres
end;

procedure TfrmGLSViewer.acLandscapeExecute(Sender: TObject);
begin
  inherited;
  // Hills
end;

procedure TfrmGLSViewer.acLoadTreeViewExecute(Sender: TObject);
begin
  inherited;
  //
end;

procedure TfrmGLSViewer.acViewFlatShadingExecute(Sender: TObject);
begin
  ApplyShadeMode;
end;

procedure TfrmGLSViewer.acViewHiddenLinesExecute(Sender: TObject);
begin
  ApplyShadeMode;
end;

procedure TfrmGLSViewer.acViewResetExecute(Sender: TObject);
begin
  DoResetCamera;
end;

procedure TfrmGLSViewer.acViewFlatLinesExecute(Sender: TObject);
begin
  ApplyShadeMode;
end;

procedure TfrmGLSViewer.acViewSmoothShadingExecute(Sender: TObject);
begin
  ApplyShadeMode;
end;

procedure TfrmGLSViewer.acViewWireFrameExecute(Sender: TObject);
begin
  ApplyShadeMode;
end;

procedure TfrmGLSViewer.acViewZoomInExecute(Sender: TObject);
var
  h: Boolean;
begin
  FormMouseWheel(Self, [], -120 * 4, Point(0, 0), h);
end;

procedure TfrmGLSViewer.acViewZoomOutExecute(Sender: TObject);
var
  h: Boolean;
begin
  FormMouseWheel(Self, [], 120 * 4, Point(0, 0), h);
end;

procedure TfrmGLSViewer.acOptimizeExecute(Sender: TObject);
begin
  OptimizeMesh(ffObject.MeshObjects, [mooVertexCache, mooSortByMaterials]);
  ffObject.StructureChanged;
  SetupFreeFormShading;
end;

procedure TfrmGLSViewer.acToolsOptionsExecute(Sender: TObject);
begin
  with TFormOptions.Create(Self) do
    try
      ShowModal;
    finally
      Free;
    end;
end;

procedure TfrmGLSViewer.acToolsFaceCullingExecute(Sender: TObject);
begin
  acToolsFaceCulling.Checked := not acToolsFaceCulling.Checked;
  ApplyFaceCull;
end;

procedure TfrmGLSViewer.acToolsInfoExecute(Sender: TObject);
begin
  with TGLDialog.Create(Self) do
    try
      Memo.Lines[0] := 'Triangles: ' +
        IntToStr(ffObject.MeshObjects.TriangleCount);
      Memo.Lines[1] := 'Area: ' + FloatToStr(ffObject.MeshObjects.Area);
      Memo.Lines[2] := 'Volume: ' + FloatToStr(ffObject.MeshObjects.Volume);
      ShowModal;
    finally
      Free;
    end;
end;

procedure TfrmGLSViewer.acToolsLightingExecute(Sender: TObject);
begin
  acToolsLighting.Checked := not acToolsLighting.Checked;
  // TBLighting
  ApplyShadeMode;
end;

procedure TfrmGLSViewer.acToolsShowFPSExecute(Sender: TObject);
begin
  acToolsShowFPS.Checked := not acToolsShowFPS.Checked;
  ApplyFPS;
end;

procedure TfrmGLSViewer.acToolsTexturingExecute(Sender: TObject);
begin
  acToolsTexturing.Checked := not acToolsTexturing.Checked;
  if acToolsTexturing.Checked then
    if lastLoadWithTextures then
      ApplyTexturing
    else
    begin
      DoOpen(lastFileName);
    end
  else
    ApplyTexturing;
end;

procedure TfrmGLSViewer.acToolsNaviCubeExecute(Sender: TObject);
begin
  acToolsNaviCube.Checked := not acToolsNaviCube.Checked;
  if acToolsNaviCube.Checked = True then
  begin
    NaviCube.Visible := True;
    Cadencer.Enabled := True;
  end
  else
  begin
    NaviCube.Visible := False;
    Cadencer.Enabled := False;
  end;
  snViewer.Invalidate;
end;

//------------------------------------------------------
// Show Base and Additional Objects
//------------------------------------------------------
procedure TfrmGLSViewer.acPointsExecute(Sender: TObject);
var
  I: Integer;
  Color: TVector4f;
  NumPoints: Integer;
  X, Y, Z: Single;

begin
  NumPoints := 10000;
  Points.Size := 5.0;
  Points.Style := psSmooth;
  for I := 0 to NumPoints - 1 do
  begin
    X := Random(20) - 10;
    Y := Random(20) - 10;
    Z := Random(20) - 10;

    Points.Positions.Add(X * 0.05, Y * 0.05, Z * 0.05);
    // Fill array of GLPoints
    Color.X := Random();
    Color.Y := Random();
    Color.Z := Random();
    Points.Colors.AddPoint(Color.X, Color.Y, 0);
  end;
end;

procedure TfrmGLSViewer.acFileExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TfrmGLSViewer.CadencerProgress(Sender: TObject;
  const deltaTime, newTime: Double);
begin
  if NaviCube.InactiveTime > 5 then
  begin
    if NaviCube.InactiveTime < 8 then
      Camera.TurnAngle := Camera.TurnAngle + (NaviCube.InactiveTime - 5) *
        deltaTime * 2
    else
      Camera.TurnAngle := Camera.TurnAngle + deltaTime * 6;
  end;
  snViewer.Refresh;
  if Self.Focused then
    snViewer.Invalidate;
end;

procedure TfrmGLSViewer.TimerTimer(Sender: TObject);
begin
//  StatusBar.Panels[3].Text := Format('%.1f  FPS', [snViewer.FramesPerSecond]);
  snViewer.ResetPerformanceMonitor;
end;

//---------------------------------------------------------------------------
procedure TfrmGLSViewer.tvSceneCheckStateChanged(Sender: TCustomTreeView;
  Node: TTreeNode; CheckState: TNodeCheckState);
begin
  inherited;
  // Add or removed scene's objects
end;

//---------------------------------------------------------------------------
procedure TfrmGLSViewer.tvSceneClick(Sender: TObject);
var
  I: Integer;
  pos1, pos2: TGLVector;

const
  Nlines = 1000;
begin
  dcObject.DeleteChildren;

  // Visibility of all dcWorld.Children
  for I := 0 to dcWorld.Count -1 do
    (dcWorld.Children[I] as TGLBaseSceneObject).Visible := False;

  if tvScene.Selected.Text = 'Cube' then; // may be as another choice
  case tvScene.Selected.SelectedIndex of
    0: Camera.ShowAxes := not Camera.ShowAxes;
    1: LightSource.Shining := not LightSource.Shining;
    2: begin
         dcWorld.VisibleAtRunTime := not dcWorld.VisibleAtRunTime;
         dcObject.VisibleAtRunTime := not dcObject.VisibleAtRunTime;
         dcAxis.VisibleAtRunTime := not dcAxis.VisibleAtRunTime;
       end;
    3:;//Sprite
    4: //Points in dcWorld
    begin
      Points.Visible := True;
      acPointsExecute(Sender);
    end;
    5: //Lines
    for i := 0 to Nlines - 1 do
    begin
      Lines := TGLLines.CreateAsChild(dcObject);
      SetVector(pos1, Random()-0.5, Random()-0.5, Random()-0.5);
      SetVector(pos2, Random()-0.5, Random()-0.5, Random()-0.5);
      Lines.NodesAspect := lnaInvisible;
      Lines.AddNode(pos1);
      Lines.AddNode(pos2);
      Lines.LineColor.RandomColor;
      /// e.g. Lines.AddChild(ff);
    end;
    6: //Plane
    begin
      Plane := TGLPlane.CreateAsChild(dcObject);
      Plane.Direction.SetVector(0, 1, 0);  // vertical - (0, 0, 1); slope - (0.3, 1, 0.1);
      Plane.Material.FrontProperties.Diffuse.RandomColor();
    end;
    7: //Polygon
    begin
      Polygon := TGLPolygon.CreateAsChild(dcObject);
      Polygon.Material.FrontProperties.Diffuse.RandomColor();
    end;
    8: // Cube
    begin
      Cube := TGLCube.CreateAsChild(dcObject);
    //  Cube.Position.SetPoint(0, 0, Random(3));
      Cube.Material.FrontProperties.Diffuse.RandomColor();
    end;
    9: // Frustrum
    begin
      Frustrum := TGLFrustrum.CreateAsChild(dcObject);
      Frustrum.Material.FrontProperties.Diffuse.RandomColor();
      //;
    end;
    10: // Sphere
    begin
      Sphere := TGLSphere.CreateAsChild(dcObject);
      // Sphere.Material.FrontProperties.Diffuse.Color := clrBlue;
      Sphere.Material.FrontProperties.Diffuse.RandomColor();
    end;
    11: // Disk;
    begin
      Disk := TGLDisk.CreateAsChild(dcObject);
      Disk.Material.FrontProperties.Diffuse.RandomColor();
    end;
    12: // Cone
    begin
      Cone := TGLCone.CreateAsChild(dcObject);
      Cone.Material.FrontProperties.Diffuse.RandomColor();
    end;
    13: // Cylinder
    begin
      Cylinder := TGLCylinder.CreateAsChild(dcObject);
      Cylinder.Material.FrontProperties.Diffuse.RandomColor();
    end;
    14: // Capsule
    begin
      Capsule := TGLCapsule.CreateAsChild(dcObject);
      Capsule.Material.FrontProperties.Diffuse.RandomColor();
    end;
    15: // Dodecahedron
    begin
      Dodecahedron := TGLDodecahedron.CreateAsChild(dcObject);
      Dodecahedron.Material.FrontProperties.Diffuse.RandomColor();
    end;
    16: // Icosahedron
    begin
      Icosahedron := TGLIcosahedron.CreateAsChild(dcObject);
      Icosahedron.Material.FrontProperties.Diffuse.RandomColor();
    end;
    17: // Hexahedron
    begin
      Hexahedron := TGLHexahedron.CreateAsChild(dcObject);
      Hexahedron.Material.FrontProperties.Diffuse.RandomColor();
      Hexahedron.Scale.SetVector(0.5,0.5,0.5);
    end;
    18: // Octahedron
    begin
      Octahedron := TGLOctahedron.CreateAsChild(dcObject);
      Octahedron.Material.BackProperties.Diffuse.Color := clrRed;
      Octahedron.Scale.SetVector(0.5,0.5,0.5);
    end;
    19: // Tetrahedron
    begin
      Tetrahedron := TGLTetrahedron.CreateAsChild(dcObject);
      Tetrahedron.Material.BackProperties.Diffuse.RandomColor();
    end;
    20: // SuperEllipsoid
    begin
      SuperEllipsoid := TGLSuperEllipsoid.CreateAsChild(dcObject);
      SuperEllipsoid.Material.FrontProperties.Diffuse.Color := clrTeal;
    end;
    21: //Animated sprite
    begin
      //
    end;
    22: // ArrowLine
    begin
      ArrowLine := TGLArrowLine.CreateAsChild(dcObject);
      ArrowLine.Material.FrontProperties.Diffuse.RandomColor();
    end;
    23: // ArrowArc
    begin
      ArrowArc := TGLArrowArc.CreateAsChild(dcObject);
      ArrowArc.Material.FrontProperties.Diffuse.RandomColor();
    end;
    24: // Annulus
    begin
      Annulus := TGLAnnulus.CreateAsChild(dcObject);
      Annulus.Material.FrontProperties.Diffuse.RandomColor();
    end;
    25: // ExtrusionSolid
    begin
      ExtrusionSolid := TGLExtrusionSolid.CreateAsChild(dcObject);
      ExtrusionSolid.Material.FrontProperties.Diffuse.RandomColor();
    end;
    26: // MultiPolygon
    begin
      MultiPolygon := TGLMultiPolygon.CreateAsChild(dcObject);
      MultiPolygon.Material.FrontProperties.Diffuse.RandomColor();
    end;
    27: // Pipe in dcWorld
    begin
      Pipe.Visible := True;
      Pipe.Material.FrontProperties.Diffuse.RandomColor();
    end;
    28: // RevolutionSolid
    begin
      RevolutionSolid := TGLRevolutionSolid.CreateAsChild(dcObject);
      RevolutionSolid.Material.FrontProperties.Diffuse.RandomColor();
    end;
    29: // Torus exists in dcWorld
    begin
      Torus.Visible := True;
      Torus.Material.FrontProperties.Diffuse.RandomColor();
    end;
    30: //Actor
    begin
      Actor := TGLActor.CreateAsChild(dcObject);
      SetCurrentDir(AssetPath  + '\modelext');
      Actor.LoadFromFile('waste.md2');
      Actor.Material.Texture.Disabled := False;
      Actor.Material.Texture.Image.LoadFromFile('Waste.jpg');
      Actor.Roll(90);
      Actor.Pitch(90);
      Actor.Turn(90);
      Actor.Scale.Scale(0.05);
    end;
    31: //FreeForm
    begin
      //
    end;
    32: //Mesh
    begin
      //
    end;
    33: //TilePlane
    begin
      //
    end;
    34: //Portal
    begin
      //
    end;
    35: //TerrainRenderer
    begin
      //
    end;
    41: //Atmosphere
    begin
      //
    end;
    42: //SkyBox
    begin
      //
    end;
    43: //SkyDome
    begin
      //
    end;
    44: //EarthSkyDome
    begin
      //
    end;
    79: // Teapot in dcWorld
    begin
      Teapot.Visible := True;
      Teapot.Material.FrontProperties.Diffuse.RandomColor();
      Teapot.Scale.SetVector(1.5,1.5,1.5);
    end;
    80: // Tree in dcWorld
    begin
      Tree.Visible := True;
      Tree.Scale.SetVector(0.5,0.5,0.5);
      dmImages.MLTree.AddTextureMaterial('TreeBark', 'zbark_016.jpg').Material.Texture.TextureMode := tmModulate;
      dmImages.MLTree.AddTextureMaterial('LeafTexture', 'leaf.tga').Material.Texture.TextureMode := tmModulate;
      dmImages.MLTree.AddTextureMaterial('FrutTexture', 'maple_multi.tga').Material.Texture.TextureMode := tmModulate;
    end;
  end;
end;

procedure TfrmGLSViewer.ReadIniFile;
begin
  inherited;
  IniFile := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
  try
    Top := IniFile.ReadInteger(Name, 'Top', 100);
    Left := IniFile.ReadInteger(Name, 'Left', 200);
  finally
    IniFile.Free;
  end;
end;

procedure TfrmGLSViewer.WriteIniFile;
begin
  IniFile := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
  with IniFile do
    try
      WriteInteger(Name, 'Top', Top);
      WriteInteger(Name, 'Left', Left);
      // WriteBool(Name, 'InitMax', WindowState = wsMaximized);
    finally
      IniFile.Free;
    end;
  inherited;
end;

initialization //--------------------------------------------------------------

  FormatSettings.DecimalSeparator := '.';

end.