LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   A shader that uses a texture to distort the view by adjusting texture
6
   coordinates.
7
   Does not have any practical use, but is fun to play around with.
8

9
	 History :  
10
       22/04/10 - Yar - Fixes after GLState revision
11
       05/04/07 - DaStr - Contributed to GLScene
12
       04/11/06 - DaStr - Creation (based on demo by Rick)
13

14
}
15
unit cgPostTransformationShader;
16

17
interface
18

19
{$I GLScene.inc}
20

21
uses
22
  // VCL
23
  Classes, SysUtils,
24

25
   cene
26
  GLTexture,  GLCadencer, GLContext, OpenGLTokens, GLScene, GLCustomShader,
27
  GLRenderContextInfo, GLTextureFormat,
28

29
  // CG Shaders
30
  Cg, CgGL, GLCgShader;
31

32
type
33

34
  TGLCustomCGPostTransformationShader = class(TCustomCGShader, IGLPostShader)
35
  private
36
    FTransformationPower:      Single;
37
    FTransformationTexture: TGLTexture;
38
  protected
39
    procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override;
40

41
    // Implementing IGLPostShader.
42
    procedure DoUseTempTexture(const TempTexture: TGLTextureHandle; TextureTarget: TGLTextureTarget);
43
    function GetTextureTarget: TGLTextureTarget;
44
  public
45
    constructor Create(AOwner: TComponent); override;
46
    property TransformationPower: Single read FTransformationPower write FTransformationPower;
47
    property TransformationTexture: TGLTexture read FTransformationTexture write FTransformationTexture;
48
  end;
49

50
  TGLCGPostTransformationShader = class(TGLCustomCGPostTransformationShader)
51
  published
52
    property TransformationPower;
53
    property TransformationTexture;
54
  end;
55

56

57
implementation
58

59
{ TGLCustomCGPostTransformationShader }
60

61
constructor TGLCustomCGPostTransformationShader.Create(AOwner: TComponent);
62
begin
63
  inherited;
64
  with VertexProgram.Code do
65
  begin
66
    Add(' ');
67
    Add('void main( ');
68
    Add('                    float4  iPos  	: POSITION, ');
69
    Add('                    float2  iTex0	: TEXCOORD0, ');
70
    Add('                out float4  oPos  	: POSITION, ');
71
    Add('                out float2  oTex0 	: TEXCOORD0 ');
72
    Add('         ) ');
73
    Add('{ ');
74
    Add('			oPos  = iPos; ');
75
    Add('			oTex0 = iTex0; ');
76
    Add('} ');
77
  end;
78

79

80
  with FragmentProgram.Code do
81
  begin
82
    Add('void main( ');
83
    Add('                    float2 iTex0 	: TEXCOORD0, '); 
84
    Add('                out float4 oCol  	: COLOR, '); 
85
    Add(' '); 
86
    Add('            uniform samplerRECT snapshotTex, ');
87
    Add('            uniform sampler2D	transformTex, ');
88
    Add('            uniform float		screenW, ');
89
    Add('            uniform float		screenH, '); 
90
    Add('            uniform float		transformPower '); 
91
    Add('         ) '); 
92
    Add('{ '); 
93
    Add(' '); 
94
    Add('	/* Read the offset from the transformation texture '); 
95
    Add('		x offset is in the red channel, '); 
96
    Add('		y offset is in the green channel '); 
97
    Add('	*/ '); 
98
    Add('	float2	offset	= 2 * tex2D( transformTex, iTex0 ).rg -1; '); 
99
    Add(' '); 
100
    Add('	/* When using NPOT texture RECT, you need to scale up the texcoords with '); 
101
    Add('		the screenSize	*/ '); 
102
    Add('            iTex0.x    *= screenW; '); 
103
    Add('            iTex0.y    *= screenH; '); 
104
    Add(' '); 
105
    Add('    /* Apply offset		*/ '); 
106
    Add('    		iTex0	+= offset * transformPower; '); 
107
    Add(' '); 
108
    Add('	/* The result is the pixel from the snapshot, with offset	*/ '); 
109
    Add('    		oCol.rgb	= texRECT( snapshotTex, iTex0 ).rgb; '); 
110
    Add('			oCol.a		= 1; '); 
111
    Add('} '); 
112
  end;
113

114
  VertexProgram.OnApply := OnApplyVP;
115
  FragmentProgram.OnApply := OnApplyFP;
116
  FragmentProgram.OnUnApply := OnUnApplyFP;
117

118
  FTransformationPower := 70;
119
end;
120

121
procedure TGLCustomCGPostTransformationShader.DoApply(
122
  var rci: TGLRenderContextInfo; Sender: TObject);
123
begin
124
  inherited;
125
  FragmentProgram.ParamByName('screenW').SetAsScalar(rci.viewPortSize.cx);
126
  FragmentProgram.ParamByName('screenH').SetAsScalar(rci.viewPortSize.cy);
127
  FragmentProgram.ParamByName('transformTex').SetAsTexture2D(FTransformationTexture.Handle);
128
  FragmentProgram.ParamByName('transformTex').EnableTexture;
129
  FragmentProgram.ParamByName('transformPower').SetAsScalar(FTransformationPower);
130
end;
131

132
procedure TGLCustomCGPostTransformationShader.DoUseTempTexture(
133
  const TempTexture: TGLTextureHandle; TextureTarget: TGLTextureTarget);
134
begin
135
  FragmentProgram.ParamByName('snapshotTex').SetAsTextureRECT(TempTexture.Handle);
136
  FragmentProgram.ParamByName('snapshotTex').EnableTexture;
137
end;
138

139
function TGLCustomCGPostTransformationShader.GetTextureTarget: TGLTextureTarget;
140
begin
141
  Result := ttTextureRect;
142
end;
143

144
end.
145

146