Luxophia

LUX.GPU.OpenGL.Atom.Progra.pas
260 строк · 7.6 Кб
Перенос по словам
1
unit LUX.GPU.OpenGL.Atom.Progra;
2

3
interface //#################################################################### ■
4

5
uses System.SysUtils, System.Classes,
6
     Winapi.OpenGL, Winapi.OpenGLext,
7
     LUX,
8
     LUX.GPU.OpenGL.Atom,
9
     LUX.GPU.OpenGL.Atom.Porter;
10

11
type //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【型】
12

13
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
14

15
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
16

17
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLProgra
18

19
     IGLProgra = interface( LUX.GPU.OpenGL.Atom.IGLProgra )
20
     ['{8EB00198-A04B-4632-8B23-1DF1B171A75F}']
21
     {protected}
22
       ///// アクセス
23
       function GetFramers :TGLPorterF;
24
     {public}
25
       ///// プロパティ
26
       property Framers :TGLPorterF read GetFramers;
27
     end;
28

29
     //-------------------------------------------------------------------------
30

31
     TGLProgra = class( TGLAtomer, IGLProgra )
32
     private
33
     protected
34
       _Status  :Boolean;
35
       _Errors  :TStringList;
36
       _Framers :TGLPorterF;
37
       ///// イベント
38
       _OnLinked :TProc;
39
       ///// アクセス
40
       function GetStatus :Boolean;
41
       function GetErrors :TStringList;
42
       function GetFramers :TGLPorterF;
43
       ///// イベント
44
       function GetOnLinked :TProc;
45
       procedure SetOnLinked( const OnLinked_:TProc );
46
       procedure DoOnLinked; virtual;
47
       ///// メソッド
48
       function glGetStatus :Boolean;
49
       function glGetErrors :String;
50
     public
51
       constructor Create;
52
       destructor Destroy; override;
53
       ///// プロパティ
54
       property Status  :Boolean     read GetStatus ;
55
       property Errors  :TStringList read GetErrors ;
56
       property Framers :TGLPorterF  read GetFramers;
57
       ///// イベント
58
       property OnLinked :TProc read GetOnLinked write SetOnLinked;
59
       ///// メソッド
60
       function GetAttribLocation( const Name_:String ) :GLuint;
61
       function GetUniformLocation( const Name_:String ) :GLuint;
62
       function GetProgramResourceLocation( const Kind_:GLenum; const Name_:String ) :GLuint;
63
       function GetUniformBlockIndex( const Name_:String ) :GLuint;
64
       function GetProgramResourceIndex( const Kind_:GLenum; const Name_:String ) :GLuint;
65
       procedure BindFragDataLocation( const BinP_:GLuint; const Name_:String );
66
       procedure Attach( const Shader_:IGLShader ); virtual;
67
       procedure Detach( const Shader_:IGLShader ); virtual;
68
       procedure Link;
69
       procedure Use; virtual;
70
       procedure Unuse; virtual;
71
     end;
72

73
//const //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【定数】
74

75
//var //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【変数】
76

77
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
78

79
implementation //############################################################### ■
80

81
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
82

83
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
84

85
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLProgra
86

87
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
88

89
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
90

91
/////////////////////////////////////////////////////////////////////// アクセス
92

93
function TGLProgra.GetStatus :Boolean;
94
begin
95
     Result := _Status;
96
end;
97

98
function TGLProgra.GetErrors :TStringList;
99
begin
100
     Result := _Errors;
101
end;
102

103
//------------------------------------------------------------------------------
104

105
function TGLProgra.GetFramers :TGLPorterF;
106
begin
107
     Result := _Framers;
108
end;
109

110
/////////////////////////////////////////////////////////////////////// イベント
111

112
function TGLProgra.GetOnLinked :TProc;
113
begin
114
     Result := _OnLinked;
115
end;
116

117
procedure TGLProgra.SetOnLinked( const OnLinked_:TProc );
118
begin
119
     _OnLinked := OnLinked_;
120
end;
121

122
procedure TGLProgra.DoOnLinked;
123
begin
124
     if Assigned( _OnLinked ) then _OnLinked;
125
end;
126

127
/////////////////////////////////////////////////////////////////////// メソッド
128

129
function TGLProgra.glGetStatus :Boolean;
130
var
131
   S :GLint;
132
begin
133
     glGetProgramiv( _ID, GL_LINK_STATUS, @S );
134

135
     Result := ( S = GL_TRUE );
136
end;
137

138
function TGLProgra.glGetErrors :String;
139
var
140
   N :GLint;
141
   Cs :TArray<GLchar>;
142
   CsN :GLsizei;
143
begin
144
     glGetProgramiv( _ID, GL_INFO_LOG_LENGTH, @N );
145

146
     SetLength( Cs, N );
147

148
     glGetProgramInfoLog( _ID, N, @CsN, PGLchar( Cs ) );
149

150
     SetString( Result, PGLchar( Cs ), CsN );
151
end;
152

153
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
154

155
constructor TGLProgra.Create;
156
begin
157
     inherited Create;
158

159
     _Errors := TStringList.Create;
160

161
     _Framers := TGLPorterF.Create( Self as IGLProgra );
162

163
     _ID     := glCreateProgram;
164
     _Status := False;
165

166
     _OnLinked := nil;
167
end;
168

169
destructor TGLProgra.Destroy;
170
begin
171
     glDeleteProgram( _ID );
172

173
     _Framers.Free;
174

175
     _Errors.Free;
176

177
     inherited;
178
end;
179

180
/////////////////////////////////////////////////////////////////////// メソッド
181

182
function TGLProgra.GetAttribLocation( const Name_:String ) :GLuint;
183
begin
184
     Result := glGetAttribLocation( _ID, PAnsiChar( AnsiString( Name_ ) ) );
185
end;
186

187
function TGLProgra.GetUniformLocation( const Name_:String ) :GLuint;
188
begin
189
     Result := glGetUniformLocation( _ID, PAnsiChar( AnsiString( Name_ ) ) );
190
end;
191

192
function TGLProgra.GetProgramResourceLocation( const Kind_:GLenum; const Name_:String ) :GLuint;
193
begin
194
     Result := glGetProgramResourceLocation( _ID, Kind_, PAnsiChar( AnsiString( Name_ ) ) );
195
end;
196

197
//------------------------------------------------------------------------------
198

199
function TGLProgra.GetUniformBlockIndex( const Name_:String ) :GLuint;
200
begin
201
     Result := glGetUniformBlockIndex( _ID, PAnsiChar( AnsiString( Name_ ) ) );
202
end;
203

204
function TGLProgra.GetProgramResourceIndex( const Kind_:GLenum; const Name_:String ) :GLuint;
205
begin
206
     Result := glGetProgramResourceIndex( _ID, Kind_, PAnsiChar( AnsiString( Name_ ) ) );
207
end;
208

209
//------------------------------------------------------------------------------
210

211
procedure TGLProgra.BindFragDataLocation( const BinP_:GLuint; const Name_:String );
212
begin
213
     glBindFragDataLocation( _ID, BinP_, PGLchar( AnsiString( Name_ ) ) );
214
end;
215

216
//------------------------------------------------------------------------------
217

218
procedure TGLProgra.Attach( const Shader_:IGLShader );
219
begin
220
     glAttachShader( _ID, Shader_.ID );
221
end;
222

223
procedure TGLProgra.Detach( const Shader_:IGLShader );
224
begin
225
     glDetachShader( _ID, Shader_.ID );
226
end;
227

228
//------------------------------------------------------------------------------
229

230
procedure TGLProgra.Link;
231
begin
232
     glLinkProgram( _ID );
233

234
     _Status      := glGetStatus;
235
     _Errors.Text := glGetErrors;
236

237
     DoOnLinked;
238
end;
239

240
//------------------------------------------------------------------------------
241

242
procedure TGLProgra.Use;
243
begin
244
     glUseProgram( _ID );
245
end;
246

247
procedure TGLProgra.Unuse;
248
begin
249
     glUseProgram( 0 );
250
end;
251

252
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
253

254
//############################################################################## □
255

256
initialization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 初期化
257

258
finalization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 最終化
259

260
end. //######################################################################### ■
Luxophia

Использование cookies
