// // The graphics engine GLScene // unit GLSL.ShapeShaders; (* Erosion shader Erode surface object and render with Anisotropic Specular Reflection At this time one light source is supported *) interface {$I Stage.Defines.inc} uses Winapi.OpenGL, Winapi.OpenGLext, System.Classes, System.SysUtils, Stage.OpenGLTokens, GLS.Scene, GLS.BaseClasses, GLS.State, GLS.Context, GLS.Graphics, GLS.RenderContextInfo, GLS.Coordinates, Stage.VectorGeometry, Stage.VectorTypes, Stage.TextureFormat, GLS.Color, GLS.Texture, GLS.Material, GLSL.Shader, GLSL.CustomShader; //------------------ Cel Shader -------------------------- type (* A shader that applies cel shading through a vertex program and shade definition texture. Cel shading options: csoOutlines: Render a second outline pass. csoTextured: Allows for a primary texture that the cel shading is modulated with and forces the shade definition to render as a second texture. *) TGLCelShaderOption = (csoOutlines, csoTextured, csoNoBuildShadeTexture); TGLCelShaderOptions = set of TGLCelShaderOption; // An event for user defined cel intensity. TGLCelShaderGetIntensity = procedure(Sender: TObject; var intensity: Byte) of object; // A generic cel shader. TGLCelShader = class(TGLShader) private FOutlineWidth: Single; FCelShaderOptions: TGLCelShaderOptions; FVPHandle: TGLARBVertexProgramHandle; FShadeTexture: TGLTexture; FOnGetIntensity: TGLCelShaderGetIntensity; FOutlinePass, FUnApplyShadeTexture: Boolean; FOutlineColor: TGLColor; protected procedure SetCelShaderOptions(const val: TGLCelShaderOptions); procedure SetOutlineWidth(const val: Single); procedure SetOutlineColor(const val: TGLColor); procedure BuildShadeTexture; procedure Loaded; override; function GenerateVertexProgram: string; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override; function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override; property ShadeTexture: TGLTexture read FShadeTexture; published property CelShaderOptions: TGLCelShaderOptions read FCelShaderOptions write SetCelShaderOptions; property OutlineColor: TGLColor read FOutlineColor write SetOutlineColor; property OutlineWidth: Single read FOutlineWidth write SetOutlineWidth; property OnGetIntensity: TGLCelShaderGetIntensity read FOnGetIntensity write FOnGetIntensity; end; //------------- Erosion Shader --------------------- type (* Custom class for a shader that Erode surface object *) TGLCustomGLSLSimpleErosionShader = class(TGLCustomGLSLShader) private FMaterialLibrary: TGLAbstractMaterialLibrary; FMainTex : TGLTexture; FNoiseTex : TGLTexture; FErosionTex : TGLTexture; FMainTexName : TGLLibMaterialName; FNoiseTexName : TGLLibMaterialName; FErosionTexName : TGLLibMaterialName; FErosionScale: Single; FErosionFactor: Single; FIntensityFactor1: Single; FIntensityFactor2: Single; FSpecularColor : TGLColor; FAmbientColor : TGLColor; FAmbientFactor : Single; FDiffuseFactor : Single; FSpecularFactor : Single; FSpecularRoughness : Single; FAnisotropicRoughness : Single; function GetMaterialLibrary: TGLAbstractMaterialLibrary; procedure SetMainTexTexture(const Value: TGLTexture); procedure SetNoiseTexTexture(const Value: TGLTexture); procedure SetErosionTexTexture(const Value: TGLTexture); function GetMainTexName: TGLLibMaterialName; procedure SetMainTexName(const Value: TGLLibMaterialName); function GetNoiseTexName: TGLLibMaterialName; procedure SetNoiseTexName(const Value: TGLLibMaterialName); function GetErosionTexName: TGLLibMaterialName; procedure SetErosionTexName(const Value: TGLLibMaterialName); procedure SetAmbientColor(AValue: TGLColor); procedure SetSpecularColor(AValue: TGLColor); protected procedure DoApply(var rci : TGLRenderContextInfo; Sender : TObject); override; function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override; procedure SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary); virtual; procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner : TComponent); override; destructor Destroy; override; // property Color1: TGLColor read FColor1; // property Color2: TGLColor read FColor2; property MaterialLibrary: TGLAbstractMaterialLibrary read getMaterialLibrary write SetMaterialLibrary; property MainTexture: TGLTexture read FMainTex write SetMainTexTexture; property MainTextureName: TGLLibMaterialName read GetMainTexName write SetMainTexName; property NoiseTexture: TGLTexture read FNoiseTex write SetNoiseTexTexture; property NoiseTextureName: TGLLibMaterialName read GetNoiseTexName write SetNoiseTexName; property ErosionTexture: TGLTexture read FErosionTex write SetErosionTexTexture; property ErosionTextureName: TGLLibMaterialName read GetErosionTexName write SetErosionTexName; property ErosionFactor: Single read FErosionFactor write FErosionFactor; property ErosionScale: Single read FErosionFactor write FErosionFactor; property IntensityFactor1: Single read FIntensityFactor1 write FIntensityFactor1; property IntensityFactor2: Single read FIntensityFactor2 write FIntensityFactor2; property SpecularColor : TGLColor Read FSpecularColor Write setSpecularColor; property AmbientColor : TGLColor Read FAmbientColor Write setAmbientColor; property AmbientFactor : Single Read FAmbientFactor Write FAmbientFactor; property DiffuseFactor : Single Read FDiffuseFactor Write FDiffuseFactor; property SpecularFactor : Single Read FSpecularFactor Write FSpecularFactor; property SpecularRoughness : Single Read FSpecularRoughness Write FSpecularRoughness; property AnisotropicRoughness : Single Read FAnisotropicRoughness Write FAnisotropicRoughness; end; TGLSLSimpleErosionShader = class(TGLCustomGLSLSimpleErosionShader) published // property Color1; // property Color2; property MaterialLibrary; property MainTexture; property MainTextureName; property NoiseTexture; property NoiseTextureName; property ErosionTexture; property ErosionTextureName; property ErosionScale; property ErosionFactor; property IntensityFactor1; property IntensityFactor2; property SpecularColor; property AmbientColor; property AmbientFactor; property DiffuseFactor; property SpecularFactor; property SpecularRoughness; property AnisotropicRoughness; end; //-------------- Glass Shader -------------------- type (* Custom class for Glass shader: Environment mapping and refraction mapping using the fresnel terms *) TGLCustomGLSLGlassShader = class(TGLCustomGLSLShader) private FDiffuseColor: TGLColor; FDepth: Single; FMix: Single; FAlpha: Single; FMaterialLibrary: TGLAbstractMaterialLibrary; FMainTexture: TGLTexture; // EnvMap FMainTexName: TGLLibMaterialName; FRefractionTexture: TGLTexture; FRefractionTexName: TGLLibMaterialName; FOwnerObject: TGLBaseSceneObject; FBlendSrc: TGLBlendFunction; FBlendDst: TGLBlendFunction; function GetMaterialLibrary: TGLAbstractMaterialLibrary; procedure SetMainTexTexture(const Value: TGLTexture); function GetMainTexName: TGLLibMaterialName; procedure SetMainTexName(const Value: TGLLibMaterialName); procedure SetRefractionTexTexture(const Value: TGLTexture); function GetRefractionTexName: TGLLibMaterialName; procedure SetRefractionTexName(const Value: TGLLibMaterialName); procedure SetDiffuseColor(AValue: TGLColor); protected procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override; function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override; procedure SetMaterialLibrary(const Value : TGLAbstractMaterialLibrary); virtual; procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property DiffuseColor: TGLColor read FDiffuseColor Write SetDiffuseColor; property Depth: Single read FDepth write FDepth; property Mix: Single read FMix write FMix; property Alpha: Single read FAlpha write FAlpha; property MaterialLibrary: TGLAbstractMaterialLibrary read GetMaterialLibrary write SetMaterialLibrary; property MainTexture: TGLTexture read FMainTexture write SetMainTexTexture; property MainTextureName: TGLLibMaterialName read GetMainTexName write SetMainTexName; property RefractionTexture: TGLTexture read FRefractionTexture write SetRefractionTexTexture; property RefractionTextureName: TGLLibMaterialName read GetRefractionTexName write SetRefractionTexName; property OwnerObject: TGLBaseSceneObject read FOwnerObject write FOwnerObject; property BlendSrc: TGLBlendFunction read FBlendSrc write FBlendSrc default bfSrcAlpha; property BlendDst: TGLBlendFunction read FBlendDst write FBlendDst default bfDstAlpha; end; TGLSLGlassShader = class(TGLCustomGLSLGlassShader) published property DiffuseColor; property Depth; property Mix; property Alpha; property MaterialLibrary; property MainTexture; property MainTextureName; property RefractionTexture; property RefractionTextureName; property OwnerObject; property BlendSrc; property BlendDst; end; //-----------Gooch Shader ----------------------- type (* Custom class for Gooch Shader *) TGLCustomGLSLSimpleGoochShader = class(TGLCustomGLSLShader) private FDiffuseColor : TGLColor; FWarmColor : TGLColor; FCoolColor : TGLColor; FSpecularColor : TGLColor; FAmbientColor : TGLColor; FDiffuseWarm : Single; FDiffuseCool : Single; FAmbientFactor : Single; FDiffuseFactor : Single; FSpecularFactor : Single; FBlendingMode: TGLBlendingModeEx; procedure SetDiffuseColor(AValue: TGLColor); procedure SetAmbientColor(AValue: TGLColor); procedure SetSpecularColor(AValue: TGLColor); procedure SetWarmColor(AValue: TGLColor); procedure SetCoolColor(AValue: TGLColor); protected procedure DoApply(var rci : TGLRenderContextInfo; Sender : TObject); override; function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override; public constructor Create(AOwner : TComponent); override; destructor Destroy; override; property DiffuseColor : TGLColor read FDiffuseColor Write setDiffuseColor; property WarmColor : TGLColor read FWarmColor Write setWarmColor; property CoolColor : TGLColor Read FCoolColor Write setCoolColor; property SpecularColor : TGLColor Read FSpecularColor Write setSpecularColor; property AmbientColor : TGLColor Read FAmbientColor Write setAmbientColor; property WarmFactor : Single Read FDiffuseWarm Write FDiffuseWarm; property CoolFactor : Single Read FDiffuseCool Write FDiffuseCool; property AmbientFactor : Single Read FAmbientFactor Write FAmbientFactor; property DiffuseFactor : Single Read FDiffuseFactor Write FDiffuseFactor; property SpecularFactor : Single Read FSpecularFactor Write FSpecularFactor; property BlendingMode: TGLBlendingModeEx read FBlendingMode write FBlendingMode default bmxOpaque; end; type TGLSLSimpleGoochShader = class(TGLCustomGLSLSimpleGoochShader) published property DiffuseColor; property WarmColor; property CoolColor; property SpecularColor; property AmbientColor; property WarmFactor; property CoolFactor; property AmbientFactor; property DiffuseFactor; property SpecularFactor; end; //------------Fur Shader ------------------ type (* Custom class for Fur Shader *) TGLCustomGLSLFurShader = class(TGLCustomGLSLShader) private FMaterialLibrary: TGLAbstractMaterialLibrary; FCurrentPass: Integer; FPassCount: Single; FFurLength: Single; FMaxFurLength: Single; FFurScale: Single; FRandomFurLength : Boolean; FColorScale: TGLColor; FAmbient: TGLColor; FGravity : TGLCoordinates; FLightIntensity : Single; FMainTex : TGLTexture; FNoiseTex : TGLTexture; FNoiseTexName : TGLLibMaterialName; FMainTexName : TGLLibMaterialName; FBlendSrc : TGLBlendFunction; FBlendDst : TGLBlendFunction; // FBlendEquation : TGLBlendEquation; function GetMaterialLibrary: TGLAbstractMaterialLibrary; procedure SetMainTexTexture(const Value: TGLTexture); procedure SetNoiseTexTexture(const Value: TGLTexture); function GetNoiseTexName: TGLLibMaterialName; procedure SetNoiseTexName(const Value: TGLLibMaterialName); function GetMainTexName: TGLLibMaterialName; procedure SetMainTexName(const Value: TGLLibMaterialName); procedure SetGravity(APosition:TGLCoordinates); procedure SetAmbient(AValue: TGLColor); procedure SetColorScale(AValue: TGLColor); protected procedure DoApply(var rci : TGLRenderContextInfo; Sender : TObject); override; function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override; procedure SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary); virtual; procedure Notification(AComponent: TComponent; Operation: TOperation); override; public //Common stuff constructor Create(AOwner : TComponent); override; destructor Destroy; override; property PassCount: Single read FPassCount write FPassCount; property FurLength: Single read FFurLength write FFurLength; property MaxFurLength: Single read FMaxFurLength write FMaxFurLength; property FurDensity: Single read FFurScale write FFurScale; property RandomFurLength : Boolean read FRandomFurLength Write FRandomFurLength; property ColorScale: TGLColor read FColorScale Write setColorScale; property Ambient: TGLColor read FAmbient write setAmbient; property MaterialLibrary: TGLAbstractMaterialLibrary read getMaterialLibrary write SetMaterialLibrary; property MainTexture: TGLTexture read FMainTex write SetMainTexTexture; property MainTextureName: TGLLibMaterialName read GetMainTexName write SetMainTexName; property NoiseTexture: TGLTexture read FNoiseTex write SetNoiseTexTexture; property NoiseTextureName: TGLLibMaterialName read GetNoiseTexName write SetNoiseTexName; //property BlendEquation : TBlendEquation read FBlendEquation write FBlendEquation default beMin; property BlendSrc : TGLBlendFunction read FBlendSrc write FBlendSrc default bfSrcColor; property BlendDst : TGLBlendFunction read FBlendDst write FBlendDst default bfOneMinusDstColor; property Gravity : TGLCoordinates Read FGravity write setGravity; property LightIntensity : Single read FLightIntensity Write FLightIntensity; end; TGLSLFurShader = class(TGLCustomGLSLFurShader) published property PassCount; property FurLength; property MaxFurLength; property FurDensity; property RandomFurLength; property ColorScale; property Ambient; property LightIntensity; property Gravity; property BlendSrc; property BlendDst; property MainTexture; property MainTextureName; property NoiseTexture; property NoiseTextureName; end; //------------ Ivory Shader ---------------- type (* Custom class for a shader that simulate Ivory Material *) TGLCustomGLSLIvoryShader = class(TGLCustomGLSLShader) protected procedure DoApply(var rci : TGLRenderContextInfo; Sender : TObject); override; function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override; public constructor Create(AOwner : TComponent); override; destructor Destroy; override; end; type TGLSLIvoryShader = class(TGLCustomGLSLIvoryShader) end; //------------- Lattice Shader ---------------------- type (* Custom class for a shader that simulate Lattice *) TGLCustomGLSLSimpleLatticeShader = class(TGLCustomGLSLShader) private FLatticeScale: TGLCoordinates2; FLatticeThreshold: TGLCoordinates2; procedure SetLatticeScale(const Value: TGLCoordinates2); procedure SetLatticeThreshold(const Value: TGLCoordinates2); protected procedure DoApply(var rci : TGLRenderContextInfo; Sender : TObject); override; function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override; public constructor Create(AOwner : TComponent); override; destructor Destroy; override; property LatticeScale: TGLCoordinates2 read FLatticeScale write SetLatticeScale; property LatticeThreshold: TGLCoordinates2 read FLatticeThreshold write SetLatticeThreshold; end; (* Custom class for GLSLLatticeShader. A shader that simulate Lattice with Diffuse/Specular and support Texture *) TGLCustomGLSLLatticeShader = class(TGLCustomGLSLSimpleLatticeShader) private FAmbientColor: TGLColor; FDiffuseColor: TGLColor; FSpecularColor: TGLColor; FMaterialLibrary: TGLAbstractMaterialLibrary; FMainTexture: TGLTexture; FMainTexName : TGLLibMaterialName; FSpecularPower: Single; FLightPower: Single; function GetMaterialLibrary: TGLAbstractMaterialLibrary; procedure SetMainTexTexture(const Value: TGLTexture); function GetMainTexName: TGLLibMaterialName; procedure SetMainTexName(const Value: TGLLibMaterialName); procedure SetDiffuseColor(AValue: TGLColor); procedure SetAmbientColor(AValue: TGLColor); procedure SetSpecularColor(AValue: TGLColor); protected procedure DoInitialize(var rci : TGLRenderContextInfo; Sender : TObject); override; procedure DoApply(var rci : TGLRenderContextInfo; Sender : TObject); override; procedure SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary); virtual; procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner : TComponent); override; destructor Destroy; override; property DiffuseColor : TGLColor read FDiffuseColor Write setDiffuseColor; property SpecularColor : TGLColor Read FSpecularColor Write setSpecularColor; property AmbientColor : TGLColor Read FAmbientColor Write setAmbientColor; property MaterialLibrary: TGLAbstractMaterialLibrary read getMaterialLibrary write SetMaterialLibrary; property MainTexture: TGLTexture read FMainTexture write SetMainTexTexture; property MainTextureName: TGLLibMaterialName read GetMainTexName write SetMainTexName; property SpecularPower: Single read FSpecularPower write FSpecularPower; property LightPower: Single read FLightPower write FLightPower; end; TGLSLSimpleLatticeShader = class(TGLCustomGLSLSimpleLatticeShader) published property LatticeScale; property LatticeThreshold; end; TGLSLLatticeShader = class(TGLCustomGLSLLatticeShader) published property LatticeScale; property LatticeThreshold; property AmbientColor; property DiffuseColor; property SpecularColor; property MainTexture; property SpecularPower; property LightPower; end; //----------------- SEM Shader --------------------- type (* Custom class for SEM Shader : Spherical Environment Mapping *) TGLCustomGLSLSemShader = class(TGLCustomGLSLShader) private FAmbientColor: TGLColor; // FDiffuseColor: TGLColor; FSpecularColor: TGLColor; FAmbientFactor : Single; FDiffuseFactor : Single; FSpecularFactor : Single; FMaterialLibrary: TGLAbstractMaterialLibrary; FMainTexture: TGLTexture; FMainTexName : TGLLibMaterialName; // FSpecularPower: Single; // FLightPower: Single; function GetMaterialLibrary: TGLAbstractMaterialLibrary; procedure SetMainTexTexture(const Value: TGLTexture); function GetMainTexName: TGLLibMaterialName; procedure SetMainTexName(const Value: TGLLibMaterialName); //procedure SetDiffuseColor(AValue: TGLColor); procedure SetAmbientColor(AValue: TGLColor); procedure SetSpecularColor(AValue: TGLColor); protected procedure DoApply(var rci : TGLRenderContextInfo; Sender : TObject); override; function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override; procedure SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary); virtual; procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner : TComponent); override; destructor Destroy; override; // property DiffuseColor : TGLColor read FDiffuseColor Write setDiffuseColor; property SpecularColor : TGLColor Read FSpecularColor Write setSpecularColor; property AmbientColor : TGLColor Read FAmbientColor Write setAmbientColor; property AmbientFactor : Single Read FAmbientFactor Write FAmbientFactor; property DiffuseFactor : Single Read FDiffuseFactor Write FDiffuseFactor; property SpecularFactor : Single Read FSpecularFactor Write FSpecularFactor; property MaterialLibrary: TGLAbstractMaterialLibrary read getMaterialLibrary write SetMaterialLibrary; property MainTexture: TGLTexture read FMainTexture write SetMainTexTexture; property MainTextureName: TGLLibMaterialName read GetMainTexName write SetMainTexName; // property SpecularPower: Single read FSpecularPower write FSpecularPower; // property LightPower: Single read FLightPower write FLightPower; end; TGLSLSemShader = class(TGLCustomGLSLSemShader) published property AmbientColor; // property DiffuseColor; property SpecularColor; property AmbientFactor; property DiffuseFactor; property SpecularFactor; property MaterialLibrary; property MainTexture; property MainTextureName; end; //----------------- Toon Shader --------------------- type (* Custom class for Toon Shader *) TGLCustomGLSLToonShader = class(TGLCustomGLSLShader) private FHighlightColor : TGLColor; FMidColor : TGLColor; FLightenShadowColor : TGLColor; FDarkenShadowColor : TGLColor; FOutlineColor : TGLColor; FHighlightSize : Single; FMidSize : Single; FShadowSize : Single; FOutlineWidth : Single; procedure SetHighLightColor(AValue: TGLColor); procedure SetMidColor(AValue: TGLColor); procedure SetLightenShadowColor(AValue: TGLColor); procedure SetDarkenShadowColor(AValue: TGLColor); procedure SetOutlineColor(AValue: TGLColor); protected procedure DoApply(var rci : TGLRenderContextInfo; Sender : TObject); override; function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override; public constructor Create(AOwner : TComponent); override; destructor Destroy; override; property HighlightColor : TGLColor read FHighlightColor Write setHighlightColor; property MidColor : TGLColor read FMidColor Write setMidColor; property LightenShadowColor : TGLColor Read FLightenShadowColor Write setLightenShadowColor; property DarkenShadowrColor : TGLColor Read FDarkenShadowColor Write setDarkenShadowColor; property OutlinetColor : TGLColor Read FOutlineColor Write setOutlineColor; property HighlightSize : Single read FHighlightSize write FHighlightSize; property MidSize : Single read FMidSize write FMidSize; property ShadowSize : Single read FShadowSize write FShadowSize; property OutlineWidth : Single read FOutlineWidth write FOutlineWidth; end; type TGLSLToonShader = class(TGLCustomGLSLToonShader) published property HighlightColor; property MidColor; property LightenShadowColor; property DarkenShadowrColor; property OutlinetColor; property HighlightSize; property MidSize; property ShadowSize; property OutlineWidth; end; //----------- Vertex Displacement Shader ----------- (* VertexDisplacement shader: Basic Vertex Displacement with Perlin Noise You can Improved it: The vertex displacement can be done by reading a 2D or 3D texture. It can be done along the normal or the tangent. It can be scaled, twisted, modulated, inverted... Converted from : https://www.clicktorelease.com/blog/vertex-displacement-noise-3d-webgl-glsl-three-js At this time only one light source is supported *) TGLCustomGLSLVertexDisplacementShader = class(TGLCustomGLSLShader) private FAmbientColor: TGLColor; // FDiffuseColor: TGLColor; FSpecularColor: TGLColor; FAmbientFactor : Single; FDiffuseFactor : Single; FSpecularFactor : Single; FMaterialLibrary: TGLAbstractMaterialLibrary; FMainTexture: TGLTexture; FMainTexName : TGLLibMaterialName; FElapsedTime : Single; FNoise : Single; FDisplacementScale : Single; FNoiseScale : Single; FTurbulenceFactor : Single; FNoisePeriod : Single; FTimeFactor : Single; function GetMaterialLibrary: TGLAbstractMaterialLibrary; procedure SetMainTexTexture(const Value: TGLTexture); function GetMainTexName: TGLLibMaterialName; procedure SetMainTexName(const Value: TGLLibMaterialName); //procedure SetDiffuseColor(AValue: TGLColor); procedure SetAmbientColor(AValue: TGLColor); procedure SetSpecularColor(AValue: TGLColor); protected procedure DoApply(var rci : TGLRenderContextInfo; Sender : TObject); override; function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override; procedure SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary); virtual; procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner : TComponent); override; destructor Destroy; override; // property DiffuseColor : TGLColor read FDiffuseColor Write setDiffuseColor; property SpecularColor : TGLColor Read FSpecularColor Write setSpecularColor; property AmbientColor : TGLColor Read FAmbientColor Write setAmbientColor; property AmbientFactor : Single Read FAmbientFactor Write FAmbientFactor; property DiffuseFactor : Single Read FDiffuseFactor Write FDiffuseFactor; property SpecularFactor : Single Read FSpecularFactor Write FSpecularFactor; property MaterialLibrary: TGLAbstractMaterialLibrary read getMaterialLibrary write SetMaterialLibrary; property MainTexture: TGLTexture read FMainTexture write SetMainTexTexture; property MainTextureName: TGLLibMaterialName read GetMainTexName write SetMainTexName; property ElapsedTime: Single read FElapsedTime write FElapsedTime; property NoiseFactor : Single read FNoise write FNoise; property NoiseScale : Single read FNoiseScale write FNoiseScale; property TurbulenceFactor : Single read FTurbulenceFactor write FTurbulenceFactor; property NoisePeriod : Single read FNoisePeriod write FNoisePeriod; property DisplacementScale : Single read FDisplacementScale write FDisplacementScale; property TimeFactor : Single read FTimeFactor write FTimeFactor; end; TGLSLVertexDisplacementShader = class(TGLCustomGLSLVertexDisplacementShader) published property AmbientColor; // property DiffuseColor; property SpecularColor; property AmbientFactor; property DiffuseFactor; property SpecularFactor; property MaterialLibrary; property MainTexture; property MainTextureName; property ElapsedTime; property NoiseFactor; property NoiseScale; property TurbulenceFactor; property NoisePeriod; property DisplacementScale; property TimeFactor; end; //---------------------------------------------------------- implementation //---------------------------------------------------------- const fBuffSize: Integer = 512; (*************************************************** TGLCelShader ***************************************************) constructor TGLCelShader.Create(AOwner: TComponent); begin inherited; FOutlineWidth := 3; FCelShaderOptions := [csoOutlines]; FShadeTexture := TGLTexture.Create(Self); with FShadeTexture do begin Enabled := True; MinFilter := miNearest; MagFilter := maNearest; TextureWrap := twNone; TextureMode := tmModulate; end; FOutlineColor := TGLColor.Create(Self); FOutlineColor.OnNotifyChange := NotifyChange; FOutlineColor.Initialize(clrBlack); ShaderStyle := ssLowLevel; FVPHandle := TGLARBVertexProgramHandle.Create; end; destructor TGLCelShader.Destroy; begin FVPHandle.Free; FShadeTexture.Free; FOutlineColor.Free; inherited; end; procedure TGLCelShader.Loaded; begin inherited; BuildShadeTexture; end; procedure TGLCelShader.BuildShadeTexture; var bmp32: TGLBitmap32; i: Integer; intensity: Byte; begin if csoNoBuildShadeTexture in FCelShaderOptions then exit; with FShadeTexture do begin ImageClassName := 'TGLBlankImage'; TGLBlankImage(Image).Width := 128; TGLBlankImage(Image).Height := 2; end; bmp32 := FShadeTexture.Image.GetBitmap32; bmp32.Blank := false; for i := 0 to bmp32.Width - 1 do begin intensity := i * (256 div bmp32.Width); if Assigned(FOnGetIntensity) then FOnGetIntensity(Self, intensity) else begin if intensity > 230 then intensity := 255 else if intensity > 150 then intensity := 230 else if intensity > 100 then intensity := intensity + 50 else intensity := 150; end; bmp32.Data^[i].r := intensity; bmp32.Data^[i].g := intensity; bmp32.Data^[i].b := intensity; bmp32.Data^[i].a := 1; bmp32.Data^[i + bmp32.Width] := bmp32.Data^[i]; end; end; function TGLCelShader.GenerateVertexProgram: string; var VP: TStringList; begin VP := TStringList.Create; VP.Add('!!ARBvp1.0'); VP.Add('OPTION ARB_position_invariant;'); VP.Add('PARAM mvinv[4] = { state.matrix.modelview.inverse };'); VP.Add('PARAM lightPos = program.local[0];'); VP.Add('TEMP temp, light, normal;'); VP.Add(' DP4 light.x, mvinv[0], lightPos;'); VP.Add(' DP4 light.y, mvinv[1], lightPos;'); VP.Add(' DP4 light.z, mvinv[2], lightPos;'); VP.Add(' ADD light, light, -vertex.position;'); VP.Add(' DP3 temp.x, light, light;'); VP.Add(' RSQ temp.x, temp.x;'); VP.Add(' MUL light, temp.x, light;'); VP.Add(' DP3 temp, vertex.normal, vertex.normal;'); VP.Add(' RSQ temp.x, temp.x;'); VP.Add(' MUL normal, temp.x, vertex.normal;'); VP.Add(' MOV result.color, state.material.diffuse;'); if csoTextured in FCelShaderOptions then begin VP.Add(' MOV result.texcoord[0], vertex.texcoord[0];'); VP.Add(' DP3 result.texcoord[1].x, normal, light;'); end else begin VP.Add(' DP3 result.texcoord[0].x, normal, light;'); end; VP.Add('END'); Result := VP.Text; VP.Free; end; procedure TGLCelShader.DoApply(var rci: TGLRenderContextInfo; Sender: TObject); var light: TGLVector; begin if (csDesigning in ComponentState) then exit; FVPHandle.AllocateHandle; if FVPHandle.IsDataNeedUpdate then begin FVPHandle.LoadARBProgram(GenerateVertexProgram); Enabled := FVPHandle.Ready; FVPHandle.NotifyDataUpdated; if not Enabled then Abort; end; rci.GLStates.Disable(stLighting); gl.GetLightfv(GL_LIGHT0, GL_POSITION, @light.X); FVPHandle.Enable; FVPHandle.Bind; gl.ProgramLocalParameter4fv(GL_VERTEX_PROGRAM_NV, 0, @light.X); if (csoTextured in FCelShaderOptions) then FShadeTexture.ApplyAsTexture2(rci, nil) else FShadeTexture.Apply(rci); FOutlinePass := csoOutlines in FCelShaderOptions; FUnApplyShadeTexture := True; end; function TGLCelShader.DoUnApply(var rci: TGLRenderContextInfo): Boolean; begin Result := False; if (csDesigning in ComponentState) then exit; FVPHandle.Disable; if FUnApplyShadeTexture then begin if (csoTextured in FCelShaderOptions) then FShadeTexture.UnApplyAsTexture2(rci, false) else FShadeTexture.UnApply(rci); FUnApplyShadeTexture := False; end; if FOutlinePass then with rci.GLStates do begin ActiveTexture := 0; ActiveTextureEnabled[ttTexture2D] := False; Enable(stBlend); Enable(stLineSmooth); Disable(stLineStipple); Enable(stCullFace); PolygonMode := pmLines; LineWidth := FOutlineWidth; CullFaceMode := cmFront; LineSmoothHint := hintNicest; SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha); DepthFunc := cfLEqual; gl.Color4fv(FOutlineColor.AsAddress); Result := True; FOutlinePass := False; Exit; end else with rci.GLStates do begin rci.GLStates.PolygonMode := pmFill; rci.GLStates.CullFaceMode := cmBack; rci.GLStates.DepthFunc := cfLEqual; end; end; procedure TGLCelShader.SetCelShaderOptions(const val: TGLCelShaderOptions); begin if val <> FCelShaderOptions then begin FCelShaderOptions := val; BuildShadeTexture; FVPHandle.NotifyChangesOfData; NotifyChange(Self); end; end; procedure TGLCelShader.SetOutlineWidth(const val: Single); begin if val <> FOutlineWidth then begin FOutlineWidth := val; NotifyChange(Self); end; end; procedure TGLCelShader.SetOutlineColor(const val: TGLColor); begin if val <> FOutlineColor then begin FOutlineColor.Assign(val); NotifyChange(Self); end; end; (**************************************** TGLCustomGLSLSimpleErosionShader *****************************************) constructor TGLCustomGLSLSimpleErosionShader.Create(AOwner: TComponent); begin inherited; with VertexProgram.Code do begin Add('uniform float Scale; '); Add('varying vec3 normal; '); Add('varying vec2 vTexCoord; '); Add('varying vec3 lightVec; '); Add('varying vec3 viewVec; '); Add('varying vec3 Position; '); Add(' '); Add('void main(void) { '); // Add(' mat4 mWorld = gl_ModelViewMatrix; '); Add(' vec3 Normal = gl_Normal; '); Add(' vec4 lightPos = gl_LightSource[0].position;'); Add(' vec4 vert = gl_ModelViewMatrix * gl_Vertex; '); Add(' normal = gl_NormalMatrix * gl_Normal; '); Add(' Position = vec3(gl_Vertex)*Scale; '); Add(' vTexCoord = gl_MultiTexCoord0; '); Add(' lightVec = vec3(lightPos - vert); '); Add(' viewVec = -vec3(vert); '); Add(' gl_Position = ftransform(); '); Add('} '); end; with FragmentProgram.Code do begin Add('uniform float ErosionFactor; '); Add('uniform float IntensityFactor1; '); Add('uniform float IntensityFactor2; '); Add('uniform sampler2D MainTexture; '); Add('uniform sampler2D Noise2d; '); Add('uniform sampler2D ErosionTexture; '); Add('uniform vec4 SpecularColor; '); Add('uniform vec4 AmbientColor; '); Add('uniform float DiffuseIntensity; '); Add('uniform float AmbientIntensity; '); Add('uniform float SpecularIntensity; '); Add('uniform float SpecularRoughness; '); Add('uniform float AnisoRoughness; '); Add('varying vec3 normal; '); Add('varying vec2 vTexCoord; '); Add('varying vec3 lightVec; '); Add('varying vec3 viewVec; '); Add('varying vec3 Position; '); Add(' '); Add('void main (void) '); Add('{ '); Add(' vec3 offset = vec3(- ErosionFactor, - ErosionFactor + 0.06, - ErosionFactor * 0.92); '); Add(' vec4 DiffuseColor; '); Add(' vec4 Color1 = texture2D(MainTexture,vTexCoord); '); Add(' vec4 Color2 = texture2D(ErosionTexture,vTexCoord); '); Add(' // Compute noise '); Add(' vec3 noiseCoord = Position.xyz + offset; '); Add(' vec4 noiseVec = texture2D(Noise2d, noiseCoord.xy); '); Add(' float intensity = (abs(noiseVec[0] - 0.25) + '); Add(' abs(noiseVec[1] - 0.125) + '); Add(' abs(noiseVec[2] - 0.0625) + '); Add(' abs(noiseVec[3] - 0.03125)); '); Add(' // continue noise evaluation'); Add(' intensity = IntensityFactor1 * (noiseVec.x + noiseVec.y+ noiseVec.z + noiseVec.w); '); Add(' intensity = IntensityFactor2 * abs(2.0 * intensity -1.0); '); Add(' // discard pixels in a psuedo-random fashion (noise) '); Add(' if (intensity < fract(0.5 - offset.x - offset.y - offset.z)) discard; '); Add(' // color fragments different colors using noise '); Add(' clamp(intensity, 0.0, 1.0); '); Add(' Color2.a =1.0-intensity; '); Add(' Color1.a =1.0; '); Add(' DiffuseColor = mix(Color2, Color1, intensity); '); Add(' DiffuseColor.a = intensity; '); Add(' // Anisotropic Specular Lighting Reflection '); // Anisotropic Specular Reflection // This is useful for depicting surfaces // such as velvet or brushed metal, // it allows you to stretch the highlight along a // SpecDirection vector (in object space) // add new var and replace the follow line // vec3 T = cross(norm,V) by vec3 T = cross(norm,normalize(SpecDirection)); Add(' vec3 norm = normalize(normal); '); Add(' vec3 L = normalize(lightVec); '); Add(' vec3 V = normalize(viewVec); '); Add(' vec3 halfAngle = normalize(L + V); '); Add(' vec3 T = cross(norm,V); '); Add(' float NdotL = dot(L, norm); '); Add(' float NdotH = clamp(dot(halfAngle, norm), 0.0, 1.0); '); Add(' // "Half-Lambert" technique for more pleasing diffuse term '); Add(' float diffuse = 0.5 * NdotL + 0.5; '); Add(' float specular = pow(NdotH,1.0/SpecularRoughness); '); //54 Add(' // Heidrich-Seidel anisotropic distribution '); Add(' float ldott = dot(L,T); '); Add(' float vdott = dot(V,T); '); Add(' float aniso = pow(sin(ldott)*sin(vdott) + cos(ldott)*cos(vdott),1.0/AnisoRoughness); '); Add(' vec3 FinalColour = AmbientColor*AmbientIntensity + '); Add(' DiffuseColor*diffuse*DiffuseIntensity + '); Add(' SpecularColor*aniso*specular*SpecularIntensity; '); Add(' gl_FragColor = vec4(FinalColour,intensity); '); Add('} '); end; //setup initial parameters FAmbientColor := TGLColor.Create(self); FAmbientColor.SetColor(0.2,0.2,0.2,1.0); FSpecularColor := TGLColor.Create(self); FSpecularColor.SetColor(0.75,0.75,0.75,1.0); FAmbientFactor := 0.8; FDiffuseFactor :=0.9; FSpecularFactor :=0.8; FSpecularRoughness :=0.45; FAnisotropicRoughness :=0.35; FErosionScale := 0.03; FErosionFactor := 0.35; FIntensityFactor1 := 0.75; FIntensityFactor2 := 1.95; end; destructor TGLCustomGLSLSimpleErosionShader.Destroy; begin FAmbientColor.Free; FSpecularColor.Free; inherited; end; procedure TGLCustomGLSLSimpleErosionShader.DoApply(var rci : TGLRenderContextInfo; Sender : TObject); begin GetGLSLProg.UseProgramObject; param['AmbientColor'].AsVector4f := FAmbientColor.Color; param['SpecularColor'].AsVector4f := FSpecularColor.Color; param['AmbientIntensity'].AsVector1f := FAmbientFactor; param['DiffuseIntensity'].AsVector1f := FDiffuseFactor; param['SpecularIntensity'].AsVector1f := FSpecularFactor; param['SpecularRoughness'].AsVector1f := FSpecularRoughness; param['AnisoRoughness'].AsVector1f := FAnisotropicRoughness; param['ErosionFactor'].AsVector1f := FErosionFactor; param['IntensityFactor1'].AsVector1f := FIntensityFactor1; param['IntensityFactor2'].AsVector1f := FIntensityFactor2; param['Scale'].AsVector1f := FErosionScale; param['MainTexture'].AsTexture2D[0] := FMainTex; param['Noise2d'].AsTexture2D[1] := FNoiseTex; param['ErosionTexture'].AsTexture2D[2] := FErosionTex; // GetGLSLProg.UniformTextureHandle['Noise2d', 1, GL_TEXTURE_2D] := FNoiseTexture.Handle; end; function TGLCustomGLSLSimpleErosionShader.DoUnApply(var rci: TGLRenderContextInfo): Boolean; begin GetGLSLProg.EndUseProgramObject; //gl.PopAttrib; Result := False; end; function TGLCustomGLSLSimpleErosionShader.GetMaterialLibrary: TGLAbstractMaterialLibrary; begin Result := FMaterialLibrary; end; procedure TGLCustomGLSLSimpleErosionShader.SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary); begin if FMaterialLibrary <> nil then FMaterialLibrary.RemoveFreeNotification(Self); FMaterialLibrary := Value; if (FMaterialLibrary <> nil) and (FMaterialLibrary is TGLAbstractMaterialLibrary) then FMaterialLibrary.FreeNotification(Self); end; procedure TGLCustomGLSLSimpleErosionShader.SetMainTexTexture(const Value: TGLTexture); begin if FMainTex = Value then Exit; FMainTex := Value; NotifyChange(Self) end; procedure TGLCustomGLSLSimpleErosionShader.SetNoiseTexTexture(const Value: TGLTexture); begin if FNoiseTex = Value then Exit; FNoiseTex := Value; NotifyChange(Self); end; procedure TGLCustomGLSLSimpleErosionShader.SetErosionTexTexture(const Value: TGLTexture); begin if FErosionTex = Value then Exit; FErosionTex := Value; NotifyChange(Self); end; function TGLCustomGLSLSimpleErosionShader.GetNoiseTexName: TGLLibMaterialName; begin Result := TGLMaterialLibrary(FMaterialLibrary).GetNameOfTexture(FNoiseTex); if Result = '' then Result := FNoiseTexName; end; procedure TGLCustomGLSLSimpleErosionShader.SetNoiseTexName(const Value: TGLLibMaterialName); begin //Assert(not(assigned(FMaterialLibrary)),'You must set Material Library Before'); if FNoiseTexName = Value then Exit; FNoiseTexName := Value; FNoiseTex := TGLMaterialLibrary(FMaterialLibrary).TextureByName(FNoiseTexName); NotifyChange(Self); end; function TGLCustomGLSLSimpleErosionShader.GetMainTexName: TGLLibMaterialName; begin Result := TGLMaterialLibrary(FMaterialLibrary).GetNameOfTexture(FMainTex); if Result = '' then Result := FMainTexName; end; procedure TGLCustomGLSLSimpleErosionShader.SetMainTexName(const Value: TGLLibMaterialName); begin // Assert(not(assigned(FMaterialLibrary)),'You must set Material Library Before'); if FMainTexName = Value then Exit; FMainTexName := Value; FMainTex := TGLMaterialLibrary(FMaterialLibrary).TextureByName(FMainTexName); NotifyChange(Self); end; function TGLCustomGLSLSimpleErosionShader.GetErosionTexName: TGLLibMaterialName; begin Result := TGLMaterialLibrary(FMaterialLibrary).GetNameOfTexture(FErosionTex); if Result = '' then Result := FErosionTexName; end; procedure TGLCustomGLSLSimpleErosionShader.SetErosionTexName(const Value: TGLLibMaterialName); begin // Assert(not(assigned(FMaterialLibrary)),'You must set Material Library Before'); if FErosionTexName = Value then Exit; FErosionTexName := Value; FErosionTex := TGLMaterialLibrary(FMaterialLibrary).TextureByName(FErosionTexName); NotifyChange(Self); end; procedure TGLCustomGLSLSimpleErosionShader.SetAmbientColor(AValue: TGLColor); begin FAmbientColor.DirectColor := AValue.Color; end; procedure TGLCustomGLSLSimpleErosionShader.SetSpecularColor(AValue: TGLColor); begin FSpecularColor.DirectColor := AValue.Color; end; procedure TGLCustomGLSLSimpleErosionShader.Notification(AComponent: TComponent; Operation: TOperation); var Index: Integer; begin inherited; if Operation = opRemove then if AComponent = FMaterialLibrary then if FMaterialLibrary <> nil then begin // Need to nil the textures that were owned by it if FNoiseTex <> nil then begin Index := TGLMaterialLibrary(FMaterialLibrary).Materials.GetTextureIndex(FNoiseTex); if Index <> -1 then SetNoiseTexTexture(nil); end; if FMainTex <> nil then begin Index := TGLMaterialLibrary(FMaterialLibrary).Materials.GetTextureIndex(FMainTex); if Index <> -1 then SetMainTexTexture(nil); end; if FErosionTex <> nil then begin Index := TGLMaterialLibrary(FMaterialLibrary).Materials.GetTextureIndex(FErosionTex); if Index <> -1 then SetErosionTexTexture(nil); end; FMaterialLibrary := nil; end; end; (* --------------------------------- TGLCustomGLSLGlassShader ---------------------------------- *) constructor TGLCustomGLSLGlassShader.Create(AOwner: TComponent); begin inherited; with VertexProgram.Code do begin clear; Add('varying vec3 Normal; '); Add('varying vec3 EyeDir; '); Add('varying vec4 EyePos; '); Add('varying float LightIntensity; '); Add('void main(void) '); Add('{ '); Add(' gl_Position = ftransform(); '); Add(' vec3 LightPos = gl_LightSource[0].position.xyz;'); Add(' Normal = normalize(gl_NormalMatrix * gl_Normal); '); Add(' vec4 pos = gl_ModelViewMatrix * gl_Vertex; '); Add(' EyeDir = -pos.xyz; '); Add(' EyePos = gl_ModelViewProjectionMatrix * gl_Vertex; '); Add(' LightIntensity = max(dot(normalize(LightPos - EyeDir), Normal), 0.0); '); Add('} '); end; with FragmentProgram.Code do begin clear; Add('const vec3 Xunitvec = vec3 (1.0, 0.0, 0.0); '); Add('const vec3 Yunitvec = vec3 (0.0, 1.0, 0.0); '); Add('uniform vec4 BaseColor; '); Add('uniform float Depth; '); Add('uniform float MixRatio; '); Add('uniform float AlphaIntensity; '); // need to scale our framebuffer - it has a fixed width/height of 2048 Add('uniform float FrameWidth; '); Add('uniform float FrameHeight; '); Add('uniform sampler2D EnvMap; '); Add('uniform sampler2D RefractionMap; '); Add('varying vec3 Normal; '); Add('varying vec3 EyeDir; '); Add('varying vec4 EyePos; '); Add('varying float LightIntensity; '); Add('void main (void) '); Add('{ '); // Compute reflection vector Add(' vec3 reflectDir = reflect(EyeDir, Normal); '); // Compute altitude and azimuth angles Add(' vec2 index; '); Add(' index.y = dot(normalize(reflectDir), Yunitvec); '); Add(' reflectDir.y = 0.0; '); Add(' index.x = dot(normalize(reflectDir), Xunitvec) * 0.5; '); // Translate index values into proper range Add(' if (reflectDir.z >= 0.0) '); Add(' index = (index + 1.0) * 0.5; '); Add(' else '); Add(' { '); Add(' index.t = (index.t + 1.0) * 0.5; '); Add(' index.s = (-index.s) * 0.5 + 1.0; '); Add(' } '); // if reflectDir.z >= 0.0, s will go from 0.25 to 0.75 // if reflectDir.z < 0.0, s will go from 0.75 to 1.25, and // that's OK, because we've set the texture to wrap. // Do a lookup into the environment map. Add(' vec4 envColor = texture2D(EnvMap, index); '); // calc fresnels term. This allows a view dependant blend of reflection/refraction Add(' float fresnel = abs(dot(normalize(EyeDir), Normal)); '); Add(' fresnel *= MixRatio; '); Add(' fresnel = clamp(fresnel, 0.1, 0.9); '); // calc refraction Add(' vec3 refractionDir = normalize(EyeDir) - normalize(Normal); '); // Scale the refraction so the z element is equal to depth Add(' float depthVal = Depth / -refractionDir.z; '); // perform the div by w Add(' float recipW = 1.0 / EyePos.w; '); Add(' vec2 eye = EyePos.xy * vec2(recipW); '); // calc the refraction lookup Add(' index.s = (eye.x + refractionDir.x * depthVal); '); Add(' index.t = (eye.y + refractionDir.y * depthVal); '); // scale and shift so we're in the range 0-1 Add(' index.s = index.s / 2.0 + 0.5; '); Add(' index.t = index.t / 2.0 + 0.5; '); // as we're looking at the framebuffer, we want it clamping at the edge of the rendered scene, not the edge of the texture, // so we clamp before scaling to fit Add(' float recip1k = 1.0 / 2048.0; '); Add(' index.s = clamp(index.s, 0.0, 1.0 - recip1k); '); Add(' index.t = clamp(index.t, 0.0, 1.0 - recip1k); '); // scale the texture so we just see the rendered framebuffer Add(' index.s = index.s * FrameWidth * recip1k; '); Add(' index.t = index.t * FrameHeight * recip1k; '); Add(' vec4 RefractionColor = texture2D(RefractionMap, index.st); '); // Add(' RefractionColor.a = 0.9; '); // Add(' RefractionColor = RefractionColor+vec3(0.75,0.75,0.75); ');// // Add lighting to base color and mix // Add(' vec4 base = LightIntensity * BaseColor; '); Add(' envColor = mix(envColor, BaseColor,LightIntensity); '); Add(' envColor = mix(envColor, RefractionColor, fresnel); '); Add(' envColor.a = AlphaIntensity; '); Add(' gl_FragColor = envColor; //vec4 (envColor.rgb, 0.3); '); Add('} '); end; // FMainTexture := TGLTexture.Create(nil); // FMainTexture.Disabled := False; // FMainTexture.Enabled := True; // setup initial parameters FDiffuseColor := TGLColor.Create(Self); FDepth := 0.1; FMix := 1.0; FAlpha := 1.0; FDiffuseColor.SetColor(0.15, 0.15, 0.15, 1.0); FBlendSrc := bfSrcAlpha; FBlendDst := bfDstAlpha; end; destructor TGLCustomGLSLGlassShader.Destroy; begin FDiffuseColor.Destroy; inherited; end; procedure TGLCustomGLSLGlassShader.DoApply(var rci: TGLRenderContextInfo; Sender: TObject); begin // Auto Render EnvMap // capture and create material from framebuffer // I don't say why but We need to reset and reaffect our texture otherwise one of the texture is broken with FMainTexture do begin PrepareBuildList; gl.ActiveTexture(GL_TEXTURE0_ARB); gl.BindTexture(GL_TEXTURE_2D, Handle); gl.ActiveTexture(GL_TEXTURE0_ARB); end; with FRefractionTexture do begin PrepareBuildList; gl.ActiveTexture(GL_TEXTURE1_ARB); gl.BindTexture(GL_TEXTURE_2D, Handle); gl.ActiveTexture(GL_TEXTURE0_ARB); end; FOwnerObject.Visible := False; TGLSceneBuffer(rci.buffer).CopyToTexture(FMainTexture); FOwnerObject.Visible := True; GetGLSLProg.UseProgramObject; // GetGLSLProg.Uniform4f['BaseColor'] := FDiffuseColor.Color; // GetGLSLProg.Uniform1f['Depth'] := FDepth; // GetGLSLProg.Uniform1f['MixRatio'] := FMix; // 0 - 2 // GetGLSLProg.Uniform1f['FrameWidth'] := fBuffSize * 3.125; // GetGLSLProg.Uniform1f['FrameHeight'] := fBuffSize * 3.125; // SetTex('EnvMap',FMainTexture); --> BUG // SetTex('RefractionMap',FRefractionTexture); param['BaseColor'].AsVector4f := FDiffuseColor.Color; param['Depth'].AsVector1f := FDepth; // 0 - 0.3 param['MixRatio'].AsVector1f := FMix; // 0 - 2 param['AlphaIntensity'].AsVector1f := FAlpha; // 0 - 2 param['FrameWidth'].AsVector1f := fBuffSize * 3.75; param['FrameHeight'].AsVector1f := fBuffSize * 3.75; param['EnvMap'].AsTexture2D[0] := FMainTexture; param['RefractionMap'].AsTexture2D[1] := FRefractionTexture; gl.Enable(GL_BLEND); gl.BlendFunc(cGLBlendFunctionToGLEnum[FBlendSrc], cGLBlendFunctionToGLEnum[FBlendDst]); end; function TGLCustomGLSLGlassShader.DoUnApply (var rci: TGLRenderContextInfo): Boolean; begin gl.Disable(GL_BLEND); GetGLSLProg.EndUseProgramObject; Result := False; end; function TGLCustomGLSLGlassShader.GetMaterialLibrary : TGLAbstractMaterialLibrary; begin Result := FMaterialLibrary; end; procedure TGLCustomGLSLGlassShader.SetMaterialLibrary (const Value: TGLAbstractMaterialLibrary); begin if FMaterialLibrary <> nil then FMaterialLibrary.RemoveFreeNotification(Self); FMaterialLibrary := Value; if (FMaterialLibrary <> nil) and (FMaterialLibrary is TGLAbstractMaterialLibrary) then FMaterialLibrary.FreeNotification(Self); end; procedure TGLCustomGLSLGlassShader.SetMainTexTexture(const Value: TGLTexture); begin if FMainTexture = Value then Exit; FMainTexture := Value; NotifyChange(Self) end; function TGLCustomGLSLGlassShader.GetMainTexName: TGLLibMaterialName; begin Result := TGLMaterialLibrary(FMaterialLibrary).GetNameOfTexture(FMainTexture); if Result = '' then Result := FMainTexName; end; procedure TGLCustomGLSLGlassShader.SetMainTexName (const Value: TGLLibMaterialName); begin // Assert(not(assigned(FMaterialLibrary)),'You must set Material Library Before'); if FMainTexName = Value then Exit; FMainTexName := Value; FMainTexture := TGLMaterialLibrary(FMaterialLibrary) .TextureByName(FMainTexName); NotifyChange(Self); end; procedure TGLCustomGLSLGlassShader.SetRefractionTexTexture (const Value: TGLTexture); begin if FRefractionTexture = Value then Exit; FRefractionTexture := Value; NotifyChange(Self) end; function TGLCustomGLSLGlassShader.GetRefractionTexName: TGLLibMaterialName; begin Result := TGLMaterialLibrary(FMaterialLibrary) .GetNameOfTexture(FRefractionTexture); if Result = '' then Result := FRefractionTexName; end; procedure TGLCustomGLSLGlassShader.SetRefractionTexName (const Value: TGLLibMaterialName); begin // Assert(not(assigned(FMaterialLibrary)),'You must set Material Library Before'); if FRefractionTexName = Value then Exit; FRefractionTexName := Value; FRefractionTexture := TGLMaterialLibrary(FMaterialLibrary) .TextureByName(FRefractionTexName); NotifyChange(Self); end; procedure TGLCustomGLSLGlassShader.SetDiffuseColor(AValue: TGLColor); begin FDiffuseColor.DirectColor := AValue.Color; end; procedure TGLCustomGLSLGlassShader.Notification(AComponent: TComponent; Operation: TOperation); var Index: Integer; begin inherited; if Operation = opRemove then if AComponent = FMaterialLibrary then if FMaterialLibrary <> nil then begin if FMainTexture <> nil then begin Index := TGLMaterialLibrary(FMaterialLibrary) .Materials.GetTextureIndex(FMainTexture); if Index <> -1 then SetMainTexTexture(nil); end; if FRefractionTexture <> nil then begin Index := TGLMaterialLibrary(FMaterialLibrary) .Materials.GetTextureIndex(FRefractionTexture); if Index <> -1 then SetRefractionTexTexture(nil); end; FMaterialLibrary := nil; end; end; //------------------------------------------------------------- // TGLCustomGLSLSimpleGoochShader //------------------------------------------------------------- constructor TGLCustomGLSLSimpleGoochShader.Create(AOwner: TComponent); begin inherited; with VertexProgram.Code do begin Clear; Add('varying vec3 vNormal; '); Add('varying vec3 lightVec; '); Add('varying vec3 viewVec; '); Add('varying vec3 ReflectVec; '); Add(' '); Add('void main() '); Add('{ '); Add(' gl_Position = gl_ModelViewProjectionMatrix * gl_Vertex; '); Add(' vec4 lightPos = gl_LightSource[0].position;'); Add(' vec4 vert = gl_ModelViewMatrix * gl_Vertex; '); Add(' vec3 normal = gl_NormalMatrix * gl_Normal; '); Add(' vNormal = normalize(normal); '); Add(' lightVec = vec3(lightPos - vert); '); Add(' ReflectVec = normalize(reflect(-lightVec, vNormal)); '); Add(' viewVec = -vec3(vert); '); Add('} '); end; with FragmentProgram.Code do begin Clear; Add('uniform vec4 SurfaceColor; '); Add('uniform vec4 WarmColor; '); Add('uniform vec4 CoolColor; '); Add('uniform vec4 SpecularColor; '); Add('uniform vec4 AmbientColor; '); Add('uniform float DiffuseWarm; '); Add('uniform float DiffuseCool; '); Add('uniform float AmbientFactor; '); Add('uniform float DiffuseFactor; '); Add('uniform float SpecularFactor; '); Add('varying vec3 vNormal; '); Add('varying vec3 lightVec; '); Add('varying vec3 viewVec; '); Add('varying vec3 ReflectVec; '); Add(' '); Add('void main() '); Add('{ '); Add('vec3 L = normalize(lightVec); '); Add('vec3 V = normalize(viewVec); '); Add('vec3 halfAngle = normalize(L + V); '); Add('float NdotL = (dot(L, vNormal) + 1.0) * 0.5; '); Add('float NdotH = clamp(dot(halfAngle, vNormal), 0.0, 1.0); '); Add('// "Half-Lambert" technique for more pleasing diffuse term '); Add('float diffuse = 0.5 * NdotL + 0.5; '); Add('vec3 nreflect = normalize(ReflectVec); '); Add('float specular = max(dot(nreflect, V), 0.0); '); Add('specular = pow(specular, 64.0); '); Add('vec4 kCool = min(CoolColor + DiffuseCool * SurfaceColor, 1.0); '); Add('vec4 kWarm = min(WarmColor + DiffuseWarm * SurfaceColor, 1.0); '); Add('vec4 Cgooch = mix(kWarm, kCool, diffuse); '); Add('vec3 result = AmbientFactor * AmbientColor.rgb + DiffuseFactor * Cgooch.rgb + SpecularColor.rgb * SpecularFactor *specular; '); Add('gl_FragColor = vec4(result,SurfaceColor.a); '); Add('} '); end; // Initial stuff. FDiffuseColor := TGLColor.Create(self); FDiffuseColor.SetColor(0.75,0.75,0.75,1.0); FWarmColor := TGLColor.Create(self); FWarmColor.SetColor(0.88,0.81,0.49,1.0); FCoolColor := TGLColor.Create(self); FCoolColor.SetColor(0.58,0.10,0.76,1.0); FAmbientColor := TGLColor.Create(self); FAmbientColor.SetColor(0.3,0.3,0.3,1.0); FSpecularColor := TGLColor.Create(self); FSpecularColor.SetColor(1.0,1.0,1.0,1.0); FDiffuseWarm := 0.55; FDiffuseCool := 0.30; FAmbientFactor := 1.0; FDiffuseFactor :=0.8; FSpecularFactor :=0.9; FBlendingMode:=bmxOpaque; end; destructor TGLCustomGLSLSimpleGoochShader.Destroy; begin FDiffuseColor.Free; FWarmColor.Free; FCoolColor.Free; FSpecularColor.Free; FAmbientColor.Free; inherited; end; procedure TGLCustomGLSLSimpleGoochShader.DoApply(var rci: TGLRenderContextInfo; Sender: TObject); begin GetGLSLProg.UseProgramObject; param['SurfaceColor'].AsVector4f := FDiffuseColor.Color; param['WarmColor'].AsVector4f := FWarmColor.Color; param['CoolColor'].AsVector4f := FCoolColor.Color; param['AmbientColor'].AsVector4f := FAmbientColor.Color; param['SpecularColor'].AsVector4f := FSpecularColor.Color; param['DiffuseWarm'].AsVector1f := FDiffuseWarm; param['DiffuseCool'].AsVector1f := FDiffuseCool; param['AmbientFactor'].AsVector1f := FAmbientFactor; param['DiffuseFactor'].AsVector1f := FDiffuseFactor; param['SpecularFactor'].AsVector1f := FSpecularFactor; // gl.PushAttrib(GL_COLOR_BUFFER_BIT); ApplyBlendingModeEx(FBlendingMode); // gl.Enable(GL_BLEND); // gl.BlendFunc(cGLBlendFunctionToGLEnum[FBlendSrc],cGLBlendFunctionToGLEnum[FBlendDst]); end; function TGLCustomGLSLSimpleGoochShader.DoUnApply(var rci: TGLRenderContextInfo): Boolean; begin gl.ActiveTexture(GL_TEXTURE0_ARB); GetGLSLProg.EndUseProgramObject; UnApplyBlendingModeEx; // gl.PopAttrib; Result := False; end; procedure TGLCustomGLSLSimpleGoochShader.SetDiffuseColor(AValue: TGLColor); begin FDiffuseColor.DirectColor := AValue.Color; end; procedure TGLCustomGLSLSimpleGoochShader.SetAmbientColor(AValue: TGLColor); begin FAmbientColor.DirectColor := AValue.Color; end; procedure TGLCustomGLSLSimpleGoochShader.SetSpecularColor(AValue: TGLColor); begin FSpecularColor.DirectColor := AValue.Color; end; procedure TGLCustomGLSLSimpleGoochShader.SetWarmColor(AValue: TGLColor); begin FWarmColor.DirectColor := AValue.Color; end; procedure TGLCustomGLSLSimpleGoochShader.SetCoolColor(AValue: TGLColor); begin FCoolColor.DirectColor := AValue.Color; end; (*------------------------------------------ // TGLCustomGLSLFurShader ------------------------------------------*) constructor TGLCustomGLSLFurShader.Create(AOwner: TComponent); begin inherited; with VertexProgram.Code do begin clear; Add('uniform float fFurLength; '); Add('uniform float fFurMaxLength; '); Add('uniform float pass_index; '); Add('uniform int UseRandomLength; '); Add('uniform float fLayer; // 0 to 1 for the level '); Add('uniform vec3 vGravity; '); Add('varying vec3 normal; '); Add('varying vec2 vTexCoord; '); Add('varying vec3 lightVec; '); // Add('varying vec3 viewVec; '); Add('float rand(vec2 co){ '); Add(' return fract(sin(dot(co.xy ,vec2(12.9898,78.233))) * 43758.5453); '); Add('} '); Add('void main() '); Add('{ '); Add(' mat4 mWorld = gl_ModelViewMatrix; '); Add(' vec3 Normal = gl_Normal; '); Add(' vec4 Position = gl_Vertex; '); Add(' vec4 lightPos = gl_LightSource[0].position;'); Add(' vec4 vert = gl_ModelViewMatrix * gl_Vertex; '); Add(' normal = gl_NormalMatrix * gl_Normal; '); // Additional Gravit/Force Code Add(' vec3 vGravity2 = vGravity *mat3(mWorld ); '); // We use the pow function, so that only the tips of the hairs bend Add(' float k = pow(fLayer, 3.0); '); // Random the Hair length perhaps will can use a texture map for controling. Add(' vec3 vNormal = normalize( Normal * mat3(mWorld )); '); Add(' float RandomFurLength; '); Add(' if (UseRandomLength == 1) { RandomFurLength = fFurLength+fFurLength*rand(vNormal.xy); } '); Add(' else { RandomFurLength = fFurLength ; } '); Add(' RandomFurLength = pass_index*(RandomFurLength * vNormal); '); Add(' if (RandomFurLength > fFurMaxLength ) { RandomFurLength = fFurMaxLength; } '); Add(' Position.xyz += RandomFurLength +(vGravity2 * k); '); Add(' Position.xyz += pass_index*(fFurLength * Normal)+(vGravity2 * k); '); Add(' vTexCoord = gl_MultiTexCoord0; '); Add(' '); Add(' gl_Position = gl_ModelViewProjectionMatrix * Position; '); Add(' lightVec = vec3(lightPos - vert); '); // Add(' viewVec = -vec3(vert); '); Add('normal = vNormal; '); Add('} '); end; with FragmentProgram.Code do begin clear; Add('uniform vec4 fcolorScale; '); Add('uniform float pass_index; '); Add('uniform float fFurScale; '); Add('uniform vec4 vAmbient; '); Add('uniform float fLayer; // 0 to 1 for the level '); Add('uniform float vLightIntensity; '); Add('uniform sampler2D FurTexture; '); Add('uniform sampler2D ColourTexture; '); //textures Add('varying vec2 vTexCoord; '); Add('varying vec3 normal; '); Add('varying vec3 lightVec; '); // Add('varying vec3 viewVec; '); Add('void main() '); Add('{ '); // A Faking shadow Add(' vec4 fAlpha = texture2D( FurTexture, vTexCoord*fFurScale ); '); Add(' float fakeShadow = mix(0.3, 1.0, fAlpha.a-fLayer); '); Add(' '); Add(' vec4 FinalColour = vec4(0.0,0.0,0.0,1.0); '); Add('FinalColour = (fcolorScale*texture2D( ColourTexture, vTexCoord))*fakeShadow; '); // This comment part it's for controling if we must draw the hair according the red channel and the alpha in NoiseMap // Don' t work well a this time the NoiseMap must be perfect // Add('float visibility = 0.0; '); // Add('if (pass_index == 1.0) '); // Add('{ '); // Add(' visibility = 1.0; '); // Add('} '); // Add('else '); // Add('{ '); // Add(' if (fAlpha.a nil then FMaterialLibrary.RemoveFreeNotification(Self); FMaterialLibrary := Value; if (FMaterialLibrary <> nil) and (FMaterialLibrary is TGLAbstractMaterialLibrary) then FMaterialLibrary.FreeNotification(Self); end; procedure TGLCustomGLSLFurShader.SetMainTexTexture(const Value: TGLTexture); begin if FMainTex = Value then Exit; FMainTex := Value; NotifyChange(self) end; procedure TGLCustomGLSLFurShader.SetNoiseTexTexture(const Value: TGLTexture); begin if FNoiseTex = Value then Exit; FNoiseTex := Value; NotifyChange(self); end; function TGLCustomGLSLFurShader.GetNoiseTexName: TGLLibMaterialName; begin Result := TGLMaterialLibrary(FMaterialLibrary).GetNameOfTexture(FNoiseTex); if Result = '' then Result := FNoiseTexName; end; procedure TGLCustomGLSLFurShader.SetNoiseTexName (const Value: TGLLibMaterialName); begin // Assert(not(assigned(FMaterialLibrary)),'You must set Material Library Before'); if FNoiseTexName = Value then Exit; FNoiseTexName := Value; FNoiseTex := TGLMaterialLibrary(FMaterialLibrary) .TextureByName(FNoiseTexName); NotifyChange(self); end; function TGLCustomGLSLFurShader.GetMainTexName: TGLLibMaterialName; begin Result := TGLMaterialLibrary(FMaterialLibrary).GetNameOfTexture(FMainTex); if Result = '' then Result := FMainTexName; end; procedure TGLCustomGLSLFurShader.SetMainTexName (const Value: TGLLibMaterialName); begin // Assert(not(assigned(FMaterialLibrary)),'You must set Material Library Before'); if FMainTexName = Value then Exit; FMainTexName := Value; FMainTex := TGLMaterialLibrary(FMaterialLibrary) .TextureByName(FMainTexName); NotifyChange(self); end; procedure TGLCustomGLSLFurShader.Notification(AComponent: TComponent; Operation: TOperation); var Index: Integer; begin inherited; if Operation = opRemove then if AComponent = FMaterialLibrary then if FMaterialLibrary <> nil then begin // Need to nil the textures that were owned by it if FNoiseTex <> nil then begin Index := TGLMaterialLibrary(FMaterialLibrary) .Materials.GetTextureIndex(FNoiseTex); if Index <> -1 then SetNoiseTexTexture(nil); end; if FMainTex <> nil then begin Index := TGLMaterialLibrary(FMaterialLibrary) .Materials.GetTextureIndex(FMainTex); if Index <> -1 then SetMainTexTexture(nil); end; FMaterialLibrary := nil; end; end; procedure TGLCustomGLSLFurShader.SetGravity(APosition: TGLCoordinates); begin FGravity.SetPoint(APosition.DirectX, APosition.DirectY, APosition.DirectZ); end; procedure TGLCustomGLSLFurShader.SetAmbient(AValue: TGLColor); begin FAmbient.DirectColor := AValue.Color; end; procedure TGLCustomGLSLFurShader.SetColorScale(AValue: TGLColor); begin FColorScale.DirectColor := AValue.Color; end; (***************************************************** TGLCustomGLSLIvoryShader ****************************************************) constructor TGLCustomGLSLIvoryShader.Create(AOwner: TComponent); begin inherited; with VertexProgram.Code do begin clear; Add('varying vec3 normal; '); Add('varying vec3 lightVec; '); Add('varying vec3 viewVec; '); Add(' '); Add('void main() '); Add('{ '); Add(' gl_Position = gl_ModelViewProjectionMatrix * gl_Vertex; '); Add(' vec4 lightPos = gl_LightSource[0].position;'); Add(' vec4 vert = gl_ModelViewMatrix * gl_Vertex; '); Add(' normal = gl_NormalMatrix * gl_Normal; '); Add(' lightVec = vec3(lightPos - vert); '); Add(' viewVec = -vec3(vert); '); Add('} '); end; with FragmentProgram.Code do begin clear; Add('varying vec3 normal; '); Add('varying vec3 lightVec; '); Add('varying vec3 viewVec; '); Add(' '); Add('void main() '); Add('{ '); Add('vec3 norm = normalize(normal); '); Add('vec3 L = normalize(lightVec); '); Add('vec3 V = normalize(viewVec); '); Add('vec3 halfAngle = normalize(L + V); '); Add('float NdotL = dot(L, norm); '); Add('float NdotH = clamp(dot(halfAngle, norm), 0.0, 1.0); '); Add('// "Half-Lambert" technique for more pleasing diffuse term '); Add('float diffuse = 0.5 * NdotL + 0.5; '); Add('float specular = pow(NdotH, 64.0); '); Add('float result = diffuse + specular; '); Add('gl_FragColor = vec4(result); '); Add('} '); end; // Initial stuff. end; destructor TGLCustomGLSLIvoryShader.Destroy; begin inherited; end; procedure TGLCustomGLSLIvoryShader.DoApply(var rci: TGLRenderContextInfo; Sender: TObject); begin GetGLSLProg.UseProgramObject; end; function TGLCustomGLSLIvoryShader.DoUnApply (var rci: TGLRenderContextInfo): Boolean; begin Result := False; GetGLSLProg.EndUseProgramObject; end; (***************************************************** TGLCustomGLSLSimpleLatticeShader *****************************************************) constructor TGLCustomGLSLSimpleLatticeShader.Create(AOwner: TComponent); begin inherited; with FragmentProgram.Code do begin clear; Add(' uniform vec2 Scale; '); Add(' uniform vec2 Threshold; '); Add(' '); Add(' void main (void) '); Add('{ '); Add(' float ss = fract(gl_TexCoord[0].s * Scale.s); '); Add(' float tt = fract(gl_TexCoord[0].t * Scale.t); '); Add(' '); Add(' if ((ss > Threshold.s) && (tt > Threshold.t)) discard; '); Add(' gl_FragColor = gl_Color;'); Add('} '); end; // Initial stuff. FLatticeScale := TGLCoordinates2.Create(self); FLatticeThreshold := TGLCoordinates2.Create(self); FLatticeScale.SetPoint2D(10, 40); FLatticeThreshold.SetPoint2D(0.15, 0.3); end; destructor TGLCustomGLSLSimpleLatticeShader.Destroy; begin FLatticeScale.Destroy; FLatticeThreshold.Destroy; inherited; end; procedure TGLCustomGLSLSimpleLatticeShader.DoApply (var rci: TGLRenderContextInfo; Sender: TObject); begin GetGLSLProg.UseProgramObject; param['Scale'].AsVector2f := FLatticeScale.AsPoint2D; param['Threshold'].AsVector2f := FLatticeThreshold.AsPoint2D; end; function TGLCustomGLSLSimpleLatticeShader.DoUnApply (var rci: TGLRenderContextInfo): Boolean; begin Result := False; // gl.ActiveTexture(GL_TEXTURE0_ARB); GetGLSLProg.EndUseProgramObject; end; procedure TGLCustomGLSLSimpleLatticeShader.SetLatticeScale (const Value: TGLCoordinates2); begin FLatticeScale.Assign(Value); end; procedure TGLCustomGLSLSimpleLatticeShader.SetLatticeThreshold (const Value: TGLCoordinates2); begin FLatticeThreshold.Assign(Value); end; // TGLCustomGLSLLatticeShader constructor TGLCustomGLSLLatticeShader.Create(AOwner: TComponent); begin inherited; FAmbientColor := TGLColor.Create(self); FDiffuseColor := TGLColor.Create(self); FSpecularColor := TGLColor.Create(self); // setup initial parameters FAmbientColor.SetColor(0.15, 0.15, 0.15, 1); FDiffuseColor.SetColor(1, 1, 1, 1); FSpecularColor.SetColor(1, 1, 1, 1); FSpecularPower := 8; // 6 FLightPower := 1; end; destructor TGLCustomGLSLLatticeShader.Destroy; begin FAmbientColor.Destroy; FDiffuseColor.Destroy; FSpecularColor.Destroy; inherited; end; procedure TGLCustomGLSLLatticeShader.DoApply(var rci: TGLRenderContextInfo; Sender: TObject); begin inherited; param['AmbientColor'].AsVector4f := FAmbientColor.Color; param['DiffuseColor'].AsVector4f := FDiffuseColor.Color; param['SpecularColor'].AsVector4f := FSpecularColor.Color; param['SpecPower'].AsVector1f := FSpecularPower; param['LightIntensity'].AsVector1f := FLightPower; param['MainTexture'].AsTexture2D[0] := FMainTexture; end; procedure TGLCustomGLSLLatticeShader.DoInitialize (var rci: TGLRenderContextInfo; Sender: TObject); begin with VertexProgram.Code do begin clear; Add('varying vec3 Normal; '); Add('varying vec3 LightVector; '); Add('varying vec3 CameraVector; '); Add('varying vec2 Texcoord; '); Add(' '); Add(' '); Add('void main(void) '); Add('{ '); Add(' gl_Position = ftransform(); '); Add(' Texcoord = gl_MultiTexCoord0.xy; '); Add(' Normal = normalize(gl_NormalMatrix * gl_Normal); '); Add(' vec3 p = (gl_ModelViewMatrix * gl_Vertex).xyz; '); Add(' LightVector = normalize(gl_LightSource[0].position.xyz - p); '); Add(' CameraVector = normalize(p); '); Add('} '); end; with FragmentProgram.Code do begin clear; Add(' uniform vec2 Scale; '); Add(' uniform vec2 Threshold; '); Add(' '); Add('uniform vec4 AmbientColor; '); Add('uniform vec4 DiffuseColor; '); Add('uniform vec4 SpecularColor; '); Add(' '); Add('uniform float LightIntensity; '); Add('uniform float SpecPower; '); Add('uniform sampler2D MainTexture; '); Add(' '); Add('varying vec3 Normal; '); Add('varying vec3 LightVector; '); Add('varying vec3 CameraVector; '); Add('varying vec2 Texcoord; '); Add(' '); Add('void main(void) '); Add('{ '); Add(' float ss = fract(Texcoord[0] * Scale.s); '); Add(' float tt = fract(Texcoord[1] * Scale.t); '); Add(' '); Add(' if ((ss > Threshold.s) && (tt > Threshold.t)) discard; '); Add(' '); Add(' vec4 TextureContrib = texture2D(MainTexture, Texcoord); '); Add(' vec4 DiffuseContrib = clamp(DiffuseColor * dot(LightVector, Normal), 0.0, 1.0); '); Add(' '); Add(' vec3 reflect_vec = reflect(CameraVector, -Normal); '); Add(' float Temp = dot(reflect_vec, LightVector); '); Add(' vec4 SpecContrib = SpecularColor * clamp(pow(Temp, SpecPower), 0.0, 0.95); '); Add(' '); Add(' gl_FragColor = TextureContrib * LightIntensity * (AmbientColor + DiffuseContrib) + LightIntensity * SpecContrib; '); Add('} '); end; inherited; end; function TGLCustomGLSLLatticeShader.GetMaterialLibrary : TGLAbstractMaterialLibrary; begin Result := FMaterialLibrary; end; procedure TGLCustomGLSLLatticeShader.SetMaterialLibrary (const Value: TGLAbstractMaterialLibrary); begin if FMaterialLibrary <> nil then FMaterialLibrary.RemoveFreeNotification(self); FMaterialLibrary := Value; if (FMaterialLibrary <> nil) and (FMaterialLibrary is TGLAbstractMaterialLibrary) then FMaterialLibrary.FreeNotification(self); end; procedure TGLCustomGLSLLatticeShader.SetMainTexTexture (const Value: TGLTexture); begin if FMainTexture = Value then Exit; FMainTexture := Value; NotifyChange(self) end; function TGLCustomGLSLLatticeShader.GetMainTexName: TGLLibMaterialName; begin Result := TGLMaterialLibrary(FMaterialLibrary) .GetNameOfTexture(FMainTexture); if Result = '' then Result := FMainTexName; end; procedure TGLCustomGLSLLatticeShader.SetMainTexName (const Value: TGLLibMaterialName); begin // Assert(not(assigned(FMaterialLibrary)),'You must set Material Library Before'); if FMainTexName = Value then Exit; FMainTexName := Value; FMainTexture := TGLMaterialLibrary(FMaterialLibrary) .TextureByName(FMainTexName); NotifyChange(self); end; procedure TGLCustomGLSLLatticeShader.SetDiffuseColor(AValue: TGLColor); begin FDiffuseColor.DirectColor := AValue.Color; end; procedure TGLCustomGLSLLatticeShader.SetAmbientColor(AValue: TGLColor); begin FAmbientColor.DirectColor := AValue.Color; end; procedure TGLCustomGLSLLatticeShader.SetSpecularColor(AValue: TGLColor); begin FSpecularColor.DirectColor := AValue.Color; end; procedure TGLCustomGLSLLatticeShader.Notification(AComponent: TComponent; Operation: TOperation); var Index: Integer; begin inherited; if Operation = opRemove then if AComponent = FMaterialLibrary then if FMaterialLibrary <> nil then begin if FMainTexture <> nil then begin Index := TGLMaterialLibrary(FMaterialLibrary) .Materials.GetTextureIndex(FMainTexture); if Index <> -1 then SetMainTexTexture(nil); end; FMaterialLibrary := nil; end; end; (************************************************* TGLCustomGLSLSemShader ************************************************) constructor TGLCustomGLSLSemShader.Create(AOwner: TComponent); begin inherited; with VertexProgram.Code do begin clear; Add('varying vec3 viewVec; '); Add('varying vec3 normal; '); Add('varying vec3 lightVec; '); Add('void main() { '); Add(' vec4 p = gl_ModelViewMatrix * gl_Vertex; '); Add(' vec4 lightPos = gl_LightSource[0].position;'); Add(' lightVec = vec3(lightPos - p); '); Add(' viewVec = -vec3(p); '); Add(' normal = normalize(gl_NormalMatrix * gl_Normal ); '); Add(' gl_Position = gl_ModelViewProjectionMatrix * gl_Vertex; '); Add('} '); end; with FragmentProgram.Code do begin clear; Add('uniform vec4 AmbientColor; '); Add('uniform vec4 SpecularColor; '); Add('uniform float DiffuseIntensity; '); Add('uniform float AmbientIntensity; '); Add('uniform float SpecularIntensity; '); Add('uniform sampler2D MainTexture; '); Add('varying vec3 viewVec; '); Add('varying vec3 normal; '); Add('varying vec3 lightVec; '); Add('void main() { '); Add(' vec3 V = normalize(viewVec); '); Add(' vec3 r = reflect( V, normal ); '); Add(' float m = 2.0 * sqrt( pow( r.x, 2.0 ) + pow( r.y, 2.0 ) + pow( r.z + 1.0, 2.0 ) ); '); Add(' vec2 vN = r.xy / m + 0.5; '); Add(' vec4 DiffuseColor; '); Add(' DiffuseColor = texture2D( MainTexture, vN ); //.rgb; '); // Simple Lighting Add(' vec3 L = normalize(lightVec); '); Add(' vec3 halfAngle = normalize(L + V); '); Add(' float NdotL = dot(L, normal); '); Add(' float NdotH = clamp(dot(halfAngle, normal), 0.0, 1.0); '); Add(' // "Half-Lambert" technique for more pleasing diffuse term '); Add(' float diffuse = DiffuseColor*(0.5 * NdotL + 0.5); '); Add(' float specular = pow(NdotH, 64.0); '); Add(' vec4 FinalColour = AmbientColor*AmbientIntensity + '); Add(' DiffuseColor*diffuse*DiffuseIntensity + '); Add(' SpecularColor*specular*SpecularIntensity; '); Add(' gl_FragColor = FinalColour; //vec4( FinalColour, 1.0 ); '); Add('} '); end; FAmbientColor := TGLColor.Create(self); // FDiffuseColor := TGLColor.Create(Self); FSpecularColor := TGLColor.Create(self); // setup initial parameters FAmbientColor.SetColor(0.15, 0.15, 0.15, 1.0); // FDiffuseColor.SetColor(1, 1, 1, 1); FSpecularColor.SetColor(1.0, 1.0, 1.0, 1.0); FAmbientFactor := 0.8; FDiffuseFactor := 0.9; FSpecularFactor := 0.8; end; destructor TGLCustomGLSLSemShader.Destroy; begin FAmbientColor.Destroy; // FDiffuseColor.Destroy; FSpecularColor.Destroy; inherited; end; procedure TGLCustomGLSLSemShader.DoApply(var rci: TGLRenderContextInfo; Sender: TObject); begin GetGLSLProg.UseProgramObject; // Param['DiffuseColor'].AsVector4f := FDiffuseColor.Color; param['AmbientColor'].AsVector4f := FAmbientColor.Color; param['SpecularColor'].AsVector4f := FSpecularColor.Color; param['AmbientIntensity'].AsVector1f := FAmbientFactor; param['DiffuseIntensity'].AsVector1f := FDiffuseFactor; param['SpecularIntensity'].AsVector1f := FSpecularFactor; // Param['SpecPower'].AsVector1f := FSpecularPower; // Param['LightIntensity'].AsVector1f := FLightPower; param['MainTexture'].AsTexture2D[0] := FMainTexture; end; function TGLCustomGLSLSemShader.DoUnApply (var rci: TGLRenderContextInfo): Boolean; begin gl.ActiveTexture(GL_TEXTURE0_ARB); GetGLSLProg.EndUseProgramObject; Result := False; end; function TGLCustomGLSLSemShader.GetMaterialLibrary : TGLAbstractMaterialLibrary; begin Result := FMaterialLibrary; end; procedure TGLCustomGLSLSemShader.SetMaterialLibrary (const Value: TGLAbstractMaterialLibrary); begin if FMaterialLibrary <> nil then FMaterialLibrary.RemoveFreeNotification(self); FMaterialLibrary := Value; if (FMaterialLibrary <> nil) and (FMaterialLibrary is TGLAbstractMaterialLibrary) then FMaterialLibrary.FreeNotification(self); end; procedure TGLCustomGLSLSemShader.SetMainTexTexture(const Value: TGLTexture); begin if FMainTexture = Value then Exit; FMainTexture := Value; NotifyChange(self) end; function TGLCustomGLSLSemShader.GetMainTexName: TGLLibMaterialName; begin Result := TGLMaterialLibrary(FMaterialLibrary) .GetNameOfTexture(FMainTexture); if Result = '' then Result := FMainTexName; end; procedure TGLCustomGLSLSemShader.SetMainTexName (const Value: TGLLibMaterialName); begin // Assert(not(assigned(FMaterialLibrary)),'You must set Material Library Before'); if FMainTexName = Value then Exit; FMainTexName := Value; FMainTexture := TGLMaterialLibrary(FMaterialLibrary) .TextureByName(FMainTexName); NotifyChange(self); end; // procedure TGLCustomGLSLSemShader.SetDiffuseColor(AValue: TGLColor); // begin // FDiffuseColor.DirectColor := AValue.Color; // end; procedure TGLCustomGLSLSemShader.SetAmbientColor(AValue: TGLColor); begin FAmbientColor.DirectColor := AValue.Color; end; procedure TGLCustomGLSLSemShader.SetSpecularColor(AValue: TGLColor); begin FSpecularColor.DirectColor := AValue.Color; end; procedure TGLCustomGLSLSemShader.Notification(AComponent: TComponent; Operation: TOperation); var Index: Integer; begin inherited; if Operation = opRemove then if AComponent = FMaterialLibrary then if FMaterialLibrary <> nil then begin if FMainTexture <> nil then begin Index := TGLMaterialLibrary(FMaterialLibrary) .Materials.GetTextureIndex(FMainTexture); if Index <> -1 then SetMainTexTexture(nil); end; FMaterialLibrary := nil; end; end; (**************************************** TGLCustomGLSLToonShader ****************************************) constructor TGLCustomGLSLToonShader.Create(AOwner: TComponent); begin inherited; with VertexProgram.Code do begin Clear; Add('varying vec3 vNormal; '); Add('varying vec3 LightVec; '); Add('varying vec3 ViewVec; '); Add(' '); Add('void main() '); Add('{ '); Add(' vec4 lightPos = gl_LightSource[0].position;'); Add(' vec4 vert = gl_ModelViewMatrix * gl_Vertex; '); Add(' vec3 normal = gl_NormalMatrix * gl_Normal; '); Add(' vNormal = normalize(normal); '); Add(' LightVec = vec3(lightPos - vert); '); Add(' ViewVec = -vec3(vert); '); //Add(' gl_Position = gl_ModelViewProjectionMatrix * gl_Vertex; '); Add(' gl_Position = ftransform(); '); Add('} '); end; with FragmentProgram.Code do begin Clear; Add('uniform vec4 HighlightColor; '); Add('uniform vec4 MidColor; '); Add('uniform vec4 LightenShadowColor; '); Add('uniform vec4 DarkenShadowColor; '); Add('uniform vec4 OutlineColor; '); Add('uniform float HighlightSize; '); // 0.95 Add('uniform float MidSize; '); // 0.5 Add('uniform float ShadowSize; '); // 0.25 Add('uniform float OutlineWidth; '); Add('varying vec3 vNormal; '); Add('varying vec3 LightVec; '); Add('varying vec3 ViewVec; '); Add('void main() '); Add('{ '); Add(' vec3 n = normalize(vNormal); '); Add(' vec3 l = normalize(LightVec); '); Add(' vec3 v = normalize(ViewVec); '); Add(' float lambert = dot(l,n); '); Add(' vec4 colour = MidColor; '); Add(' if (lambert>HighlightSize) colour = HighlightColor; '); Add(' else if (lambert>MidSize) colour = MidColor; '); Add(' else if (lambert>ShadowSize) colour = LightenShadowColor; '); Add(' else if (lambert nil then FMaterialLibrary.RemoveFreeNotification(Self); FMaterialLibrary := Value; if (FMaterialLibrary <> nil) and (FMaterialLibrary is TGLAbstractMaterialLibrary) then FMaterialLibrary.FreeNotification(Self); end; procedure TGLCustomGLSLVertexDisplacementShader.SetMainTexTexture(const Value: TGLTexture); begin if FMainTexture = Value then Exit; FMainTexture := Value; NotifyChange(Self) end; function TGLCustomGLSLVertexDisplacementShader.GetMainTexName: TGLLibMaterialName; begin Result := TGLMaterialLibrary(FMaterialLibrary).GetNameOfTexture(FMainTexture); if Result = '' then Result := FMainTexName; end; procedure TGLCustomGLSLVertexDisplacementShader.SetMainTexName(const Value: TGLLibMaterialName); begin // Assert(not(assigned(FMaterialLibrary)),'You must set Material Library Before'); if FMainTexName = Value then Exit; FMainTexName := Value; FMainTexture := TGLMaterialLibrary(FMaterialLibrary).TextureByName(FMainTexName); NotifyChange(Self); end; //procedure TGLCustomGLSLVertexDisplacementShader.SetDiffuseColor(AValue: TGLColor); //begin // FDiffuseColor.DirectColor := AValue.Color; //end; procedure TGLCustomGLSLVertexDisplacementShader.SetAmbientColor(AValue: TGLColor); begin FAmbientColor.DirectColor := AValue.Color; end; procedure TGLCustomGLSLVertexDisplacementShader.SetSpecularColor(AValue: TGLColor); begin FSpecularColor.DirectColor := AValue.Color; end; procedure TGLCustomGLSLVertexDisplacementShader.Notification (AComponent: TComponent; Operation: TOperation); var Index: Integer; begin inherited; if Operation = opRemove then if AComponent = FMaterialLibrary then if FMaterialLibrary <> nil then begin if FMainTexture <> nil then begin Index := TGLMaterialLibrary(FMaterialLibrary) .Materials.GetTextureIndex(FMainTexture); if Index <> -1 then SetMainTexTexture(nil); end; FMaterialLibrary := nil; end; end; end.