unit fCgCellShader; interface uses System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Imaging.Jpeg, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Imports.cgGL, GLS.Scene, GLS.VectorTypes, GLS.VectorGeometry, GLS.Objects, GLS.Cadencer, GLS.Texture, GLS.SceneViewer, GLS.VectorFileObjects, GLS.AsyncTimer, GLS.Material, GLS.Coordinates, GLS.BaseClasses, GLS.Utils, GLS.FileMD2, Cg.Shader; type TFormCellShading = class(TForm) GLScene1: TGLScene; GLSceneViewer1: TGLSceneViewer; CgCellShader: TCgShader; GLMaterialLibrary1: TGLMaterialLibrary; GLCadencer1: TGLCadencer; GLCamera1: TGLCamera; GLDummyCube1: TGLDummyCube; GLLightSource1: TGLLightSource; GLActor1: TGLActor; AsyncTimer1: TGLAsyncTimer; procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure CgCellShaderApplyVP(CgProgram: TCgProgram; Sender: TObject); procedure FormCreate(Sender: TObject); procedure CgCellShaderInitialize(CgShader: TCustomCgShader); procedure CgCellShaderApplyFP(CgProgram: TCgProgram; Sender: TObject); procedure CgCellShaderUnApplyFP(CgProgram: TCgProgram); procedure AsyncTimer1Timer(Sender: TObject); public mx, my: Integer; end; var FormCellShading: TFormCellShading; implementation {$R *.dfm} procedure TFormCellShading.FormCreate(Sender: TObject); var r: Single; begin SetGLSceneMediaDir(); // Load the vertex and fragment Cg programs from Shaders dir CgCellShader.VertexProgram.LoadFromFile('Shaders\cellshading_vp.cg'); CgCellShader.FragmentProgram.LoadFromFile('Shaders\cellshading_fp.cg'); // Load and scale the actor GLActor1.LoadFromFile('waste.md2'); r := GLActor1.BoundingSphereRadius; GLActor1.Scale.SetVector(2.5 / r, 2.5 / r, 2.5 / r); GLActor1.AnimationMode := aamLoop; // Load the texture GLMaterialLibrary1.Materials[0].Material.Texture.Image.LoadFromFile ('wastecell.jpg'); end; procedure TFormCellShading.CgCellShaderApplyVP(CgProgram: TCgProgram; Sender: TObject); begin // Apply the per frame uniform parameters with CgProgram do begin ParamByName('LightDir').SetAsVector(GLLightSource1.AbsoluteDirection); ParamByName('ModelViewProj').SetAsStateMatrix (CG_GL_MODELVIEW_PROJECTION_MATRIX, CG_GL_MATRIX_IDENTITY); ParamByName('ModelViewIT').SetAsStateMatrix(CG_GL_MODELVIEW_MATRIX, CG_GL_MATRIX_INVERSE_TRANSPOSE); end; end; procedure TFormCellShading.CgCellShaderInitialize(CgShader: TCustomCgShader); begin // Set up the texture sampler parameter CgCellShader.FragmentProgram.ParamByName('Map0') .SetAsTexture2D(GLMaterialLibrary1.Materials[0].Material.Texture.Handle); end; procedure TFormCellShading.CgCellShaderApplyFP(CgProgram: TCgProgram; Sender: TObject); begin // Enable the texture map sampler for use in the fragment // program CgProgram.ParamByName('Map0').EnableTexture(); end; procedure TFormCellShading.CgCellShaderUnApplyFP(CgProgram: TCgProgram); begin // Disable the texture map sampler CgProgram.ParamByName('Map0').DisableTexture(); end; procedure TFormCellShading.GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin mx := X; my := Y; end; procedure TFormCellShading.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if ssLeft in Shift then GLCamera1.MoveAroundTarget(my - Y, mx - X); mx := X; my := Y; end; procedure TFormCellShading.AsyncTimer1Timer(Sender: TObject); begin FormCellShading.Caption := Format('Cg Cell Shading - %.2f FPS', [GLSceneViewer1.FramesPerSecond]); GLSceneViewer1.ResetPerformanceMonitor; end; end.