Browse Source

* Initial Commit

Bergmann89 5 years ago
commit
4e1207880c
9 changed files with 4549 additions and 0 deletions
  1. 105 0
      uglcArrayBuffer.pas
  2. 254 0
      uglcCamera.pas
  3. 622 0
      uglcFrameBufferObject.pas
  4. 424 0
      uglcLight.pas
  5. 931 0
      uglcShader.pas
  6. 318 0
      uglcTypes.pas
  7. 318 0
      ugluMatrix.pas
  8. 384 0
      ugluQuaternion.pas
  9. 1193 0
      ugluVector.pas

+ 105 - 0
uglcArrayBuffer.pas

@@ -0,0 +1,105 @@
1
+unit uglcArrayBuffer;
2
+
3
+{ Package:      OpenGLCore
4
+  Prefix:       glc - OpenGL Core
5
+  Beschreibung: diese Unit enthält eine Klassen-Kapselung für OpenGL Array Buffer }
6
+
7
+{$mode objfpc}{$H+}
8
+
9
+interface
10
+
11
+uses
12
+  dglOpenGL, sysutils, uglcTypes;
13
+
14
+type
15
+  EglcArrayBuffer = class(Exception);
16
+  TglcArrayBuffer = class(TObject)
17
+  private
18
+    fID: GLuint;
19
+    fTarget: TglcBufferTarget;
20
+    fUsage: TglcBufferUsage;
21
+  protected
22
+    fDataCount: Integer;
23
+    fDataSize: Integer;
24
+  public
25
+    property ID:        gluInt           read fID;
26
+    property Target:    TglcBufferTarget read fTarget;
27
+    property Usage:     TglcBufferUsage  read fUsage;
28
+    property DataCount: Integer          read fDataCount;
29
+    property DataSize:  Integer          read fDataSize;
30
+
31
+    procedure BufferData(const aDataCount, aDataSize: Cardinal; const aUsage: TglcBufferUsage; const aData: Pointer);
32
+    function MapBuffer(const aAccess: TglcBufferAccess): Pointer;
33
+    procedure UnmapBuffer;
34
+    procedure Bind;
35
+    procedure Unbind;
36
+    constructor Create(const aTarget: TglcBufferTarget);
37
+    destructor Destroy; override;
38
+  end;
39
+
40
+implementation
41
+
42
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
43
+//TglcArrayBuffer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
44
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
45
+procedure TglcArrayBuffer.BufferData(const aDataCount, aDataSize: Cardinal; const aUsage: TglcBufferUsage; const aData: Pointer);
46
+begin
47
+  glGetError(); //clear Errors
48
+  Bind;
49
+  fDataCount := aDataCount;
50
+  fDataSize  := aDataSize;
51
+  fUsage     := aUsage;
52
+  glBufferData(GLenum(fTarget), fDataCount * fDataSize, aData, GLenum(fUsage));
53
+  glcCheckAndRaiseError;
54
+end;
55
+
56
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
57
+function TglcArrayBuffer.MapBuffer(const aAccess: TglcBufferAccess): Pointer;
58
+begin
59
+  glGetError();
60
+  result := nil;
61
+  if (fDataCount * fDataSize) <= 0 then
62
+    exit;
63
+  result := glMapBuffer(GLenum(fTarget), GLenum(aAccess));
64
+  glcCheckAndRaiseError;
65
+end;
66
+
67
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
68
+procedure TglcArrayBuffer.UnmapBuffer;
69
+begin
70
+  glUnmapBuffer(GLenum(fTarget));
71
+end;
72
+
73
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
74
+procedure TglcArrayBuffer.Bind;
75
+begin
76
+  glBindBuffer(GLenum(fTarget), fID);
77
+end;
78
+
79
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
80
+procedure TglcArrayBuffer.Unbind;
81
+begin
82
+  glBindBuffer(GLenum(fTarget), 0);
83
+end;
84
+
85
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
86
+constructor TglcArrayBuffer.Create(const aTarget: TglcBufferTarget);
87
+begin
88
+  if not GL_ARB_Vertex_Buffer_Object then
89
+    raise EglcArrayBuffer.Create('Create - VertexBuffer: not supported');
90
+  inherited Create;
91
+  glGenBuffers(1, @fID);
92
+  fDataCount   := 0;
93
+  fDataSize    := 0;
94
+  fTarget      := aTarget;
95
+end;
96
+
97
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
98
+destructor TglcArrayBuffer.Destroy;
99
+begin
100
+  glDeleteBuffers(1, @fID);
101
+  inherited Destroy;
102
+end;
103
+
104
+end.
105
+

+ 254 - 0
uglcCamera.pas

@@ -0,0 +1,254 @@
1
+unit uglcCamera;
2
+
3
+{ Package:      OpenGLCore
4
+  Prefix:       glc - OpenGL Core
5
+  Beschreibung: diese Unit enthält eine Klassen-Kapselung für OpenGL Frustum und Kamera }
6
+
7
+{$mode objfpc}{$H+}
8
+
9
+interface
10
+
11
+uses
12
+  Classes, SysUtils,
13
+  ugluVector, ugluMatrix;
14
+
15
+type
16
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
17
+  TglcFrustum = class(TObject)
18
+  private
19
+    function GetWidth: Single;
20
+    function GetHeight: Single;
21
+    function GetFOVAngle: Single;
22
+    function GetAspectRatio: Single;
23
+  protected
24
+    fIsOrthogonal: Boolean;
25
+    fTop, fBottom, fLeft, fRight, fNear, fFar: Single;
26
+  public
27
+    property Top         : Single  read fTop;
28
+    property Bottom      : Single  read fBottom;
29
+    property Left        : Single  read fLeft;
30
+    property Right       : Single  read fRight;
31
+    property Near        : Single  read fNear;
32
+    property Far         : Single  read fFar;
33
+    property Width       : Single  read GetWidth;
34
+    property Height      : Single  read GetHeight;
35
+    property FOVAngle    : Single  read GetFOVAngle;
36
+    property AspectRatio : Single  read GetAspectRatio;
37
+    property IsOrthogonal: Boolean read fIsOrthogonal;
38
+
39
+    procedure Frustum(const aLeft, aRight, aBottom, aTop, aNear, aFar: Single);
40
+    procedure Perspective(const aFOVAngle, aAspectRatio, aNear, aFar: Single);
41
+    procedure Ortho(const aLeft, aRight, aBottom, aTop, aNear, aFar: Single);
42
+    procedure Activate;
43
+    procedure Render;
44
+
45
+    constructor Create;
46
+  end;
47
+
48
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
49
+  TglcCamera = class(TglcFrustum)
50
+  private
51
+    fPosition: TgluMatrix4f;
52
+  public
53
+    property Position: TgluMatrix4f read fPosition write fPosition;
54
+
55
+    procedure Move(const aVec: TgluVector3f);
56
+    procedure Tilt(const aAngle: Single);
57
+    procedure Turn(const aAngle: Single);
58
+    procedure Roll(const aAngle: Single);
59
+    procedure Activate;
60
+    function GetRay(const aPos: TgluVector2f): TgluRayf;
61
+
62
+    constructor Create;
63
+  end;
64
+
65
+implementation
66
+
67
+uses
68
+  Math, dglOpenGL;
69
+
70
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
71
+//TglcFrustum///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
72
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
73
+function TglcFrustum.GetWidth: Single;
74
+begin
75
+  result := (fRight - fLeft);
76
+end;
77
+
78
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
79
+function TglcFrustum.GetHeight: Single;
80
+begin
81
+  result := (fTop - fBottom);
82
+end;
83
+
84
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
85
+function TglcFrustum.GetFOVAngle: Single;
86
+begin
87
+  result := arctan2(Height/2, fNear)/Pi*360;
88
+end;
89
+
90
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
91
+function TglcFrustum.GetAspectRatio: Single;
92
+begin
93
+  result := Height / Width;
94
+end;
95
+
96
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
97
+procedure TglcFrustum.Frustum(const aLeft, aRight, aBottom, aTop, aNear, aFar: Single);
98
+begin
99
+  fIsOrthogonal := false;
100
+  fTop          := aRight;
101
+  fBottom       := aLeft;
102
+  fLeft         := aBottom;
103
+  fRight        := aTop;
104
+  fNear         := aNear;
105
+  fFar          := aFar;
106
+end;
107
+
108
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
109
+procedure TglcFrustum.Perspective(const aFOVAngle, aAspectRatio, aNear, aFar: Single);
110
+begin
111
+  fIsOrthogonal := false;
112
+  fNear         := aNear;
113
+  fFar          := aFar;
114
+  fTop          := fNear * tan(aFOVAngle / 360 * Pi);
115
+  fBottom       := -fTop;
116
+  fRight        := aAspectRatio * fTop;
117
+  fLeft         := -fRight;
118
+end;
119
+
120
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
121
+procedure TglcFrustum.Ortho(const aLeft, aRight, aBottom, aTop, aNear, aFar: Single);
122
+begin
123
+  fIsOrthogonal := true;
124
+  fLeft         := aLeft;
125
+  fRight        := aRight;
126
+  fTop          := aTop;
127
+  fBottom       := aBottom;
128
+  fNear         := aNear;
129
+  fFar          := aFar;
130
+end;
131
+
132
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
133
+procedure TglcFrustum.Activate;
134
+begin
135
+  glMatrixMode(GL_PROJECTION);
136
+  glLoadIdentity;
137
+  if fIsOrthogonal then
138
+    glOrtho(fLeft, fRight, fBottom, fTop, fNear, fFar)
139
+  else
140
+    glFrustum(fLeft, fRight, fBottom, fTop, fNear, fFar);
141
+  glMatrixMode(GL_MODELVIEW);
142
+end;
143
+
144
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
145
+procedure TglcFrustum.Render;
146
+var
147
+  min, max: TgluVector2f;
148
+begin
149
+  min[0] := fLeft   / fNear * fFar;
150
+  min[1] := fBottom / fNear * fFar;
151
+  max[0] := fRight  / fNear * fFar;
152
+  max[1] := fTop    / fNear * fFar;
153
+
154
+  glBegin(GL_LINE_LOOP);
155
+    glVertex3f(fLeft, fTop, -fNear);
156
+    glVertex3f(fLeft, fBottom, -fNear);
157
+    glVertex3f(fRight, fBottom, -fNear);
158
+    glVertex3f(fRight, fTop, -fNear);
159
+  glEnd;
160
+
161
+  glBegin(GL_LINE_LOOP);
162
+    glVertex3f(min[0], min[0], -fFar);
163
+    glVertex3f(min[0], max[0], -fFar);
164
+    glVertex3f(max[0], max[0], -fFar);
165
+    glVertex3f(max[0], min[0], -fFar);
166
+  glEnd;
167
+
168
+  glBegin(GL_LINES);
169
+    glVertex3f(0, 0, 0); glVertex3f(min[0], min[0], -fFar);
170
+    glVertex3f(0, 0, 0); glVertex3f(min[0], max[0], -fFar);
171
+    glVertex3f(0, 0, 0); glVertex3f(max[0], max[0], -fFar);
172
+    glVertex3f(0, 0, 0); glVertex3f(max[0], min[0], -fFar);
173
+  glEnd;
174
+end;
175
+
176
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
177
+constructor TglcFrustum.Create;
178
+begin
179
+  inherited Create;
180
+  fTop    := 0;
181
+  fBottom := 0;
182
+  fLeft   := 0;
183
+  fRight  := 0;
184
+  fNear   := 0;
185
+  fFar    := 0;
186
+end;
187
+
188
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
189
+//TglcCamera////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
190
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
191
+procedure TglcCamera.Move(const aVec: TgluVector3f);
192
+begin
193
+  fPosition := gluMatrixMult(gluMatrixTranslate(aVec), fPosition);
194
+end;
195
+
196
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
197
+procedure TglcCamera.Tilt(const aAngle: Single);
198
+begin
199
+  fPosition := gluMatrixMult(gluMatrixRotate(gluVector3f(1,0,0), aAngle), fPosition);
200
+end;
201
+
202
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
203
+procedure TglcCamera.Turn(const aAngle: Single);
204
+begin
205
+  fPosition := gluMatrixMult(gluMatrixRotate(gluVector3f(0,1,0), aAngle), fPosition);
206
+end;
207
+
208
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
209
+procedure TglcCamera.Roll(const aAngle: Single);
210
+begin
211
+  fPosition := gluMatrixMult(gluMatrixRotate(gluVector3f(0,0,1), aAngle), fPosition);
212
+end;
213
+
214
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
215
+procedure TglcCamera.Activate;
216
+begin
217
+  inherited Activate;
218
+  glLoadMatrixf(@fPosition[0, 0]);
219
+end;
220
+
221
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
222
+function TglcCamera.GetRay(const aPos: TgluVector2f): TgluRayf;
223
+var
224
+  p: TgluVector3f;
225
+begin
226
+  if (aPos[0] < 0) then
227
+    p[0] := -aPos[0] * fLeft
228
+  else
229
+    p[0] := aPos[0] * fRight;
230
+  if (aPos[1] < 0) then
231
+    p[1] := -aPos[1] * fBottom
232
+  else
233
+    p[1] := aPos[1] * fTop;
234
+  if (fIsOrthogonal) then begin
235
+    p[2] := 0;
236
+    result.p := fPosition * p;
237
+    result.v := fPosition * gluVector3f(0, 0, -1);
238
+  end else begin
239
+    p[2] := -fNear;
240
+    result.p := gluVector3f(0, 0, 0);
241
+    result.v := fPosition * p;
242
+  end;
243
+  result := gluRayNormalize(result);
244
+end;
245
+
246
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
247
+constructor TglcCamera.Create;
248
+begin
249
+  inherited Create;
250
+  fPosition := gluMatrixIdentity;
251
+end;
252
+
253
+end.
254
+

+ 622 - 0
uglcFrameBufferObject.pas

@@ -0,0 +1,622 @@
1
+unit uglcFrameBufferObject;
2
+
3
+{ Package:      OpenGLCore
4
+  Prefix:       glc - OpenGL Core
5
+  Beschreibung: diese Unit enthält eine Klassen-Kapselung der OpenGL FrameBufferObjekte }
6
+
7
+{$mode objfpc}{$H+}
8
+
9
+interface
10
+
11
+uses
12
+  Classes, SysUtils, fgl, dglOpenGl, uglcTypes;
13
+
14
+type
15
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
16
+  TglcBufferType = (btRenderBuffer, btTextureBuffer);
17
+  TglcBuffer = class(TObject)
18
+  private
19
+    fBufferType: TglcBufferType;
20
+    fWidth: Integer;
21
+    fHeight: Integer;
22
+
23
+    procedure SetWidth(const aValue: Integer);
24
+    procedure SetHeight(const aValue: Integer);
25
+  public
26
+    property Width : Integer read fWidth  write SetWidth;
27
+    property Height: Integer read fHeight write SetHeight;
28
+    property BufferType: TglcBufferType read fBufferType;
29
+
30
+    procedure SetSize(const aWidth, aHeight: Integer); virtual;
31
+  end;
32
+
33
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
34
+  EglcRenderBuffer = class(Exception);
35
+  TglcRenderBuffer = class(TglcBuffer)
36
+  private
37
+    fID: gluInt;
38
+    fFormat: TglcInternalFormat;
39
+
40
+    procedure UpdateRenderBufferStorage;
41
+    procedure SetFormat(const aValue: TglcInternalFormat);
42
+  public
43
+    property ID:     gluInt             read fID;
44
+    property Format: TglcInternalFormat read fFormat write SetFormat;
45
+
46
+    procedure SetSize(const aWidth, aHeight: Integer); override;
47
+    procedure Bind;
48
+    procedure Unbind;
49
+
50
+    constructor Create(const aFormat: TglcInternalFormat);
51
+    destructor Destroy; override;
52
+  end;
53
+
54
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
55
+  EglcTextureBuffer = class(exception);
56
+  TglcTextureBuffer = class(TglcBuffer)
57
+  private
58
+    fID: GLuint;
59
+    fFormat: TglcFormat;
60
+    fInternalFormat: TglcInternalFormat;
61
+    fBorder: Boolean;
62
+
63
+    procedure UpdateTexImage;
64
+    procedure SetFormat(const aValue: TglcFormat);
65
+    procedure SetInternalFormat(const aValue: TglcInternalFormat);
66
+    procedure SetBorder(const aValue: Boolean);
67
+  public
68
+    property ID            : GLuint             read fID;
69
+    property Border        : Boolean            read fBorder         write SetBorder;
70
+    property Format        : TglcFormat         read fFormat         write SetFormat;
71
+    property InternalFormat: TglcInternalFormat read fInternalFormat write SetInternalFormat;
72
+
73
+    procedure SetSize(const aWidth, aHeight: Integer); override;
74
+    procedure Bind(const aEnableTextureUnit: Boolean = true);
75
+    procedure Unbind(const aDisableTextureUnit: Boolean = true);
76
+
77
+    constructor Create(const aFormat: TglcFormat; const aInternalFormat: TglcInternalFormat);
78
+    destructor Destroy; override;
79
+  end;
80
+
81
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
82
+  EglcFrameBufferObject = class(Exception);
83
+  TglcFrameBufferObject = class(TObject)
84
+  private type
85
+    TglcAttachmentContainer = class(TObject)
86
+      Buffer: TglcBuffer;
87
+      Attachment: TglcAttachment;
88
+      OwnsObject: Boolean;
89
+      constructor Create(const aBuffer: TglcBuffer; const aAttachment: TglcAttachment; const aOwnsObject: Boolean = true);
90
+      destructor Destroy; override;
91
+    end;
92
+    TglcAttachmentContainerList = specialize TFPGObjectList<TglcAttachmentContainer>;
93
+  private
94
+    fID: GLuint;
95
+    fOwnsObjects: Boolean;
96
+    fWidth: Integer;
97
+    fHeight: Integer;
98
+    fBuffers: TglcAttachmentContainerList;
99
+
100
+    function GetBuffer(const aIndex: Integer): TglcBuffer;
101
+    procedure SetBuffer(const aIndex: Integer; const aValue: TglcBuffer);
102
+
103
+    function GetAttachment(const aIndex: Integer): TglcAttachment;
104
+    procedure SetAttachment(const aIndex: Integer; const aValue: TglcAttachment);
105
+
106
+    function GetBufferCount: Integer;
107
+
108
+    procedure Attach(const aIndex: Integer);
109
+    procedure Detach(const aIndex: Integer);
110
+
111
+    procedure SetWidth(const aValue: Integer);
112
+    procedure SetHeight(const aValue: Integer);
113
+    procedure CheckFrameBufferStatus;
114
+    procedure UpdateAndCheckFBO;
115
+  public
116
+    property ID         : GLuint  read fID;
117
+    property Count      : Integer read GetBufferCount;
118
+    property OwnsObjects: Boolean read fOwnsObjects;
119
+    property Width      : Integer read fWidth         write SetWidth;
120
+    property Height     : Integer read fHeight        write SetHeight;
121
+    property Attachments[const aIndex: Integer]: TglcAttachment read GetAttachment write SetAttachment;
122
+    property Buffers    [const aIndex: Integer]: TglcBuffer     read GetBuffer     write SetBuffer;
123
+
124
+    procedure AddBuffer(const aBuffer: TglcBuffer; const aAttachment: TglcAttachment; const aOwnsBuffer: Boolean = true);
125
+    procedure DelBuffer(const aIndex: Integer);
126
+    function RemBuffer(const aBuffer: TglcBuffer): Integer;
127
+    function IndexOfBuffer(const aBuffer: TglcBuffer): Integer;
128
+
129
+    procedure SetSize(const aWidth, aHeight: Integer);
130
+    function CheckAttachment(const aAttachment: TglcAttachment): Boolean;
131
+
132
+    procedure Bind(const aSetViewport: Boolean = true);
133
+    procedure Unbind(const aResetViewport: Boolean = true);
134
+
135
+    constructor Create(const aOwnBuffers: Boolean = true);
136
+    destructor Destroy; override;
137
+  end;
138
+
139
+implementation
140
+
141
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
142
+//TglcBuffer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
143
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
144
+procedure TglcBuffer.SetWidth(const aValue: Integer);
145
+begin
146
+  SetSize(aValue, fHeight);
147
+end;
148
+
149
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
150
+procedure TglcBuffer.SetHeight(const aValue: Integer);
151
+begin
152
+  SetSize(fWidth, aValue);
153
+end;
154
+
155
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
156
+procedure TglcBuffer.SetSize(const aWidth, aHeight: Integer);
157
+begin
158
+  fWidth  := aWidth;
159
+  fHeight := aHeight;
160
+end;
161
+
162
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
163
+//TglcRenderBuffer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
164
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
165
+procedure TglcRenderBuffer.UpdateRenderBufferStorage;
166
+begin
167
+  glGetError; //clear Erroros
168
+  Bind;
169
+  glRenderbufferStorage(GL_RENDERBUFFER, GLenum(fFormat), fWidth, fHeight);
170
+  Unbind;
171
+  glcCheckAndRaiseError;
172
+end;
173
+
174
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
175
+procedure TglcRenderBuffer.SetFormat(const aValue: TglcInternalFormat);
176
+begin
177
+  fFormat := aValue;
178
+  UpdateRenderBufferStorage;
179
+end;
180
+
181
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
182
+procedure TglcRenderBuffer.SetSize(const aWidth, aHeight: Integer);
183
+begin
184
+  if (aWidth <= 0) or (aHeight <= 0) then
185
+    raise EglcRenderBuffer.Create('invalid width or height');
186
+  if (aWidth <> fWidth) or (aHeight <> fHeight) then begin
187
+    inherited SetSize(aWidth, aHeight);
188
+    UpdateRenderBufferStorage;
189
+  end;
190
+end;
191
+
192
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
193
+procedure TglcRenderBuffer.Bind;
194
+begin
195
+  glBindRenderbuffer(GL_RENDERBUFFER, fID);
196
+end;
197
+
198
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
199
+procedure TglcRenderBuffer.Unbind;
200
+begin
201
+  glBindRenderbuffer(GL_RENDERBUFFER, 0);
202
+end;
203
+
204
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
205
+constructor TglcRenderBuffer.Create(const aFormat: TglcInternalFormat);
206
+begin
207
+  inherited Create;
208
+  fBufferType := btRenderBuffer;
209
+  glGenRenderbuffers(1, @fID);
210
+  fFormat := aFormat;
211
+  SetSize(64, 64);
212
+end;
213
+
214
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
215
+destructor TglcRenderBuffer.Destroy;
216
+begin
217
+  glDeleteRenderbuffers(1, @fID);
218
+  inherited Destroy;
219
+end;
220
+
221
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
222
+//TglcTextureBuffer/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
223
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
224
+procedure TglcTextureBuffer.UpdateTexImage;
225
+begin
226
+  glGetError;   //clear errors
227
+  Bind(false);
228
+  glTexImage2D(GL_TEXTURE_2D, 0, GLenum(fInternalFormat), fWidth, fHeight, GLint(Byte(fBorder) and Byte(1)), GLenum(fFormat), GL_UNSIGNED_BYTE, nil);
229
+  Unbind(false);
230
+  glcCheckAndRaiseError;
231
+end;
232
+
233
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
234
+procedure TglcTextureBuffer.SetFormat(const aValue: TglcFormat);
235
+begin
236
+  if (fFormat <> aValue) then begin
237
+    fFormat := aValue;
238
+    UpdateTexImage;
239
+  end;
240
+end;
241
+
242
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
243
+procedure TglcTextureBuffer.SetInternalFormat(const aValue: TglcInternalFormat);
244
+begin
245
+  if (fInternalFormat <> aValue) then begin
246
+    fInternalFormat := aValue;
247
+    UpdateTexImage;
248
+  end;
249
+end;
250
+
251
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
252
+procedure TglcTextureBuffer.SetBorder(const aValue: Boolean);
253
+begin
254
+  if (fBorder <> aValue) then begin
255
+    fBorder := aValue;
256
+    UpdateTexImage;
257
+  end;
258
+end;
259
+
260
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
261
+procedure TglcTextureBuffer.SetSize(const aWidth, aHeight: Integer);
262
+begin
263
+  if (aWidth <= 0) or (aHeight <= 0) then
264
+    raise EglcTextureBuffer.Create('invalid width or height');
265
+  if (aWidth <> fWidth) or (aHeight <> fHeight) then begin
266
+    inherited SetSize(aWidth, aHeight);
267
+    UpdateTexImage;
268
+  end;
269
+end;
270
+
271
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
272
+procedure TglcTextureBuffer.Bind(const aEnableTextureUnit: Boolean = true);
273
+begin
274
+  if aEnableTextureUnit then
275
+    glEnable(GL_TEXTURE_2D);
276
+  glBindTexture(GL_TEXTURE_2D, fID);
277
+end;
278
+
279
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
280
+procedure TglcTextureBuffer.Unbind(const aDisableTextureUnit: Boolean = true);
281
+begin
282
+  if aDisableTextureUnit then
283
+    glDisable(GL_TEXTURE_2D);
284
+  glBindTexture(GL_TEXTURE_2D, 0);
285
+end;
286
+
287
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
288
+constructor TglcTextureBuffer.Create(const aFormat: TglcFormat; const aInternalFormat: TglcInternalFormat);
289
+begin
290
+  inherited Create;
291
+  fBufferType := btTextureBuffer;
292
+
293
+  glGenTextures(1, @fID);
294
+  Bind(false);
295
+  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
296
+  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
297
+  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
298
+  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
299
+  Unbind(false);
300
+
301
+  fFormat := aFormat;
302
+  fInternalFormat := aInternalFormat;
303
+  SetSize(64, 64);
304
+end;
305
+
306
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
307
+destructor TglcTextureBuffer.Destroy;
308
+begin
309
+  glDeleteTextures(1, @fID);
310
+  inherited Destroy;
311
+end;
312
+
313
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
314
+//TglcAttachment////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
315
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
316
+constructor TglcFrameBufferObject.TglcAttachmentContainer.Create(const aBuffer: TglcBuffer;
317
+  const aAttachment: TglcAttachment; const aOwnsObject: Boolean);
318
+begin
319
+  inherited Create;
320
+  Buffer     := aBuffer;
321
+  Attachment := aAttachment;
322
+  OwnsObject := aOwnsObject;
323
+end;
324
+
325
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
326
+destructor TglcFrameBufferObject.TglcAttachmentContainer.Destroy;
327
+begin
328
+  if OwnsObject then
329
+    Buffer.Free;
330
+  inherited Destroy;
331
+end;
332
+
333
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
334
+//TglcFrameBufferObject/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
335
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
336
+function TglcFrameBufferObject.GetBuffer(const aIndex: Integer): TglcBuffer;
337
+begin
338
+  if (aIndex >= 0) and (aIndex < fBuffers.Count) then
339
+    result := fBuffers[aIndex].Buffer
340
+  else
341
+    raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex));
342
+end;
343
+
344
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
345
+procedure TglcFrameBufferObject.SetBuffer(const aIndex: Integer; const aValue: TglcBuffer);
346
+begin
347
+  if (aIndex < 0) or (aIndex >= fBuffers.Count) then
348
+    raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex));
349
+
350
+  if not Assigned(aValue) then
351
+    raise EglcFrameBufferObject.Create('invalid buffer');
352
+
353
+  Detach(aIndex);
354
+  fBuffers[aIndex].Buffer := aValue;
355
+  Attach(aIndex);
356
+  UpdateAndCheckFBO;
357
+end;
358
+
359
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
360
+function TglcFrameBufferObject.GetAttachment(const aIndex: Integer): TglcAttachment;
361
+begin
362
+  if (aIndex >= 0) and (aIndex < fBuffers.Count) then
363
+    result := fBuffers[aIndex].Attachment
364
+  else
365
+    raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex));
366
+end;
367
+
368
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
369
+procedure TglcFrameBufferObject.SetAttachment(const aIndex: Integer; const aValue: TglcAttachment);
370
+begin
371
+  if (aIndex < 0) or (aIndex >= fBuffers.Count) then
372
+    raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex));
373
+
374
+  if not CheckAttachment(aValue) then
375
+    raise EglcFrameBufferObject.Create('Attachment already assigned');
376
+
377
+  Detach(aIndex);
378
+  fBuffers[aIndex].Attachment := aValue;
379
+  Attach(aIndex);
380
+  UpdateAndCheckFBO;
381
+end;
382
+
383
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
384
+procedure TglcFrameBufferObject.Attach(const aIndex: Integer);
385
+var
386
+  a: TglcAttachment;
387
+  b: TglcBuffer;
388
+begin
389
+  a := Attachments[aIndex];
390
+  b := Buffers[aIndex];
391
+  Bind(false);
392
+  if (b.BufferType = btRenderBuffer) then
393
+    glFramebufferRenderbuffer(GL_FRAMEBUFFER, GLenum(a), GL_RENDERBUFFER, (b as TglcRenderBuffer).ID)
394
+  else
395
+    glFramebufferTexture2D(GL_FRAMEBUFFER, GLenum(a), GL_TEXTURE_2D, (b as TglcTextureBuffer).ID, 0);
396
+  Unbind(false);
397
+end;
398
+
399
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
400
+procedure TglcFrameBufferObject.Detach(const aIndex: Integer);
401
+var
402
+  a: TglcAttachment;
403
+  b: TglcBuffer;
404
+begin
405
+  a := Attachments[aIndex];
406
+  b := Buffers[aIndex];
407
+  Bind(false);
408
+  if (b.BufferType = btRenderBuffer) then
409
+    glFramebufferRenderbuffer(GL_FRAMEBUFFER, GLenum(a), GL_RENDERBUFFER, 0)
410
+  else
411
+    glFramebufferTexture2D(GL_FRAMEBUFFER, GLenum(a), GL_TEXTURE_2D, 0, 0);
412
+  Unbind(false);
413
+end;
414
+
415
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
416
+//legt die neue Breite fest
417
+//@Value: Breite;
418
+procedure TglcFrameBufferObject.SetWidth(const aValue: Integer);
419
+begin
420
+  SetSize(aValue, fHeight);
421
+end;
422
+
423
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
424
+//legt die neue Höhe fest
425
+//@Value: neue Höhe;
426
+procedure TglcFrameBufferObject.SetHeight(const aValue: Integer);
427
+begin
428
+  SetSize(fWidth, aValue);
429
+end;
430
+
431
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
432
+procedure TglcFrameBufferObject.CheckFrameBufferStatus;
433
+begin
434
+  case glCheckFramebufferStatus(GL_FRAMEBUFFER) of
435
+    GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT:
436
+      raise EglcFrameBufferObject.Create('Incomplete attachment');
437
+    GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT:
438
+      raise EglcFrameBufferObject.Create('Missing attachment');
439
+    GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT:
440
+      raise EglcFrameBufferObject.Create('Incomplete dimensions');
441
+    GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT:
442
+      raise EglcFrameBufferObject.Create('Incomplete formats');
443
+    GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER:
444
+      raise EglcFrameBufferObject.Create('Incomplete draw buffer');
445
+    GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER:
446
+      raise EglcFrameBufferObject.Create('Incomplete read buffer');
447
+    GL_FRAMEBUFFER_UNSUPPORTED:
448
+      raise EglcFrameBufferObject.Create('Framebufferobjects unsupported');
449
+  end;
450
+end;
451
+
452
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
453
+//prüft das FrameBufferObjekt auf Fehler
454
+procedure TglcFrameBufferObject.UpdateAndCheckFBO;
455
+
456
+  function IsColorAttachment(const a: TglcAttachment): Boolean;
457
+  begin
458
+    result := (GLenum(a) >= GL_COLOR_ATTACHMENT0) and (GLenum(a) <= GL_COLOR_ATTACHMENT15);
459
+  end;
460
+
461
+var
462
+  buff: array of GLenum;
463
+  b: GLboolean;
464
+  i: Integer;
465
+begin
466
+  if (fBuffers.Count = 0) then
467
+    exit;
468
+  Bind(false);
469
+
470
+  //find ColorBuffers
471
+  SetLength(buff, 0);
472
+  for i := 0 to fBuffers.Count-1 do
473
+    if IsColorAttachment(fBuffers[i].Attachment) then begin
474
+      SetLength(buff, Length(buff) + 1);
475
+      buff[High(buff)] := GLenum(fBuffers[i].Attachment);
476
+    end;
477
+
478
+  //set Read and Draw Buffer
479
+  if (Length(buff) = 0) then begin
480
+    glReadBuffer(GL_NONE);
481
+    glDrawBuffer(GL_NONE);
482
+  end else begin
483
+    glDrawBuffers(Length(buff), @buff[0]);
484
+    glGetBooleanv(GL_DOUBLEBUFFER, @b);
485
+    if b then
486
+      glReadBuffer(GL_BACK)
487
+    else
488
+      glReadBuffer(GL_FRONT);
489
+  end;
490
+  Unbind(false);
491
+end;
492
+
493
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
494
+function TglcFrameBufferObject.GetBufferCount: Integer;
495
+begin
496
+  result := fBuffers.Count;
497
+end;
498
+
499
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
500
+procedure TglcFrameBufferObject.AddBuffer(const aBuffer: TglcBuffer;
501
+  const aAttachment: TglcAttachment; const aOwnsBuffer: Boolean);
502
+begin
503
+  if not Assigned(aBuffer) then
504
+    raise EglcFrameBufferObject.Create('invalid buffer');
505
+  if not CheckAttachment(aAttachment) then
506
+    raise EglcFrameBufferObject.Create('attachment already assigned');
507
+
508
+  fBuffers.Add(TglcAttachmentContainer.Create(aBuffer, aAttachment, fOwnsObjects and aOwnsBuffer));
509
+  if OwnsObjects then
510
+    aBuffer.SetSize(fWidth, fHeight);
511
+  Attach(fBuffers.Count-1);
512
+
513
+  UpdateAndCheckFBO;
514
+end;
515
+
516
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
517
+procedure TglcFrameBufferObject.DelBuffer(const aIndex: Integer);
518
+begin
519
+  if (aIndex >= 0) and (aIndex < fBuffers.Count) then begin
520
+    Detach(aIndex);
521
+    fBuffers.Delete(aIndex);
522
+    UpdateAndCheckFBO;
523
+  end else
524
+    raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex));
525
+end;
526
+
527
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
528
+function TglcFrameBufferObject.RemBuffer(const aBuffer: TglcBuffer): Integer;
529
+begin
530
+  result := IndexOfBuffer(aBuffer);
531
+  if (result >= 0) then
532
+    DelBuffer(result);
533
+end;
534
+
535
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
536
+function TglcFrameBufferObject.IndexOfBuffer(const aBuffer: TglcBuffer): Integer;
537
+var
538
+  i: Integer;
539
+begin
540
+  for i := 0 to fBuffers.Count-1 do
541
+    if (fBuffers[i].Buffer = aBuffer) then begin
542
+      result := i;
543
+      exit;
544
+    end;
545
+  result := -1;
546
+end;
547
+
548
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
549
+//legt die Größe neu fest
550
+//@Width: neue Breite;
551
+//@Height: neue Höhe;
552
+procedure TglcFrameBufferObject.SetSize(const aWidth, aHeight: Integer);
553
+var
554
+  c: TglcAttachmentContainer;
555
+begin
556
+  if (aWidth <= 0) or (aHeight <= 0) then
557
+    raise EglcFrameBufferObject.Create('invalid width or height');
558
+
559
+  fWidth  := aWidth;
560
+  fHeight := aHeight;
561
+  if OwnsObjects then
562
+    for c in fBuffers do
563
+      if c.OwnsObject then
564
+        c.Buffer.SetSize(fWidth, fHeight);
565
+end;
566
+
567
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
568
+function TglcFrameBufferObject.CheckAttachment(const aAttachment: TglcAttachment): Boolean;
569
+var
570
+  i: Integer;
571
+begin
572
+  result := false;
573
+  for i := 0 to fBuffers.Count-1 do
574
+    if (fBuffers[i].Attachment = aAttachment) then
575
+      exit;
576
+  result := true;
577
+end;
578
+
579
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
580
+//Bindet das FrameBufferObjekt
581
+procedure TglcFrameBufferObject.Bind(const aSetViewport: Boolean = true);
582
+begin
583
+  glBindFramebuffer(GL_FRAMEBUFFER, fID);
584
+  if aSetViewport then begin
585
+    glPushAttrib(GL_VIEWPORT_BIT);
586
+    glViewPort(0, 0, fWidth, fHeight);
587
+  end;
588
+end;
589
+
590
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
591
+//Entbindet das FrameBufferObjekt
592
+procedure TglcFrameBufferObject.Unbind(const aResetViewport: Boolean = true);
593
+begin
594
+  if aResetViewport then
595
+    glPopAttrib;
596
+  glBindFramebuffer(GL_FRAMEBUFFER, 0);
597
+end;
598
+
599
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
600
+//erzeugt das Objekt
601
+constructor TglcFrameBufferObject.Create(const aOwnBuffers: Boolean = true);
602
+begin
603
+  inherited Create;
604
+
605
+  glGenFramebuffers(1, @fID);
606
+  fWidth       := 64;
607
+  fHeight      := 64;
608
+  fOwnsObjects := aOwnBuffers;
609
+  fBuffers     := TglcAttachmentContainerList.Create(true); //containers are always owned by this object!
610
+end;
611
+
612
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
613
+//gibt das Objekt frei
614
+destructor TglcFrameBufferObject.Destroy;
615
+begin
616
+  fBuffers.Free;
617
+  glDeleteFramebuffers(1, @fID);
618
+  inherited Destroy;
619
+end;
620
+
621
+end.
622
+

+ 424 - 0
uglcLight.pas

@@ -0,0 +1,424 @@
1
+unit uglcLight;
2
+
3
+{ Package:      OpenGLCore
4
+  Prefix:       glc - OpenGL Core
5
+  Beschreibung: diese Unit enthält eine Klassen-Kapselung der OpenGL Licht- und Material-Objekte }
6
+
7
+{$mode objfpc}{$H+}
8
+
9
+interface
10
+
11
+uses
12
+  Classes, SysUtils, dglOpenGL, ugluVector, uglcTypes;
13
+
14
+type
15
+  TglcMaterialRec = packed record
16
+    Ambient: TgluVector4f;
17
+    Diffuse: TgluVector4f;
18
+    Specular: TgluVector4f;
19
+    Emission: TgluVector4f;
20
+    Shininess: GLfloat;
21
+  end;
22
+  PglcMaterialRec = ^TglcMaterialRec;
23
+
24
+  TglcLightType = (ltGlobal, ltPoint, ltSpot);
25
+  TglcLightRec = packed record
26
+    Ambient: TgluVector4f;
27
+    Diffuse: TgluVector4f;
28
+    Specular: TgluVector4f;
29
+    Position: TgluVector4f;
30
+    SpotDirection: TgluVector3f;
31
+    SpotExponent: GLfloat;
32
+    SpotCutoff: GLfloat;
33
+    ConstantAtt: GLfloat;
34
+    LinearAtt: GLfloat;
35
+    QuadraticAtt: GLfloat;
36
+  end;
37
+  PglcLightRec = ^TglcLightRec;
38
+
39
+const
40
+  MAT_DEFAULT_AMBIENT:   TgluVector4f = (0.2, 0.2, 0.2, 1.0);
41
+  MAT_DEFAULT_DIFFUSE:   TgluVector4f = (0.8, 0.8, 0.8, 1.0);
42
+  MAT_DEFAULT_SPECULAR:  TgluVector4f = (0.5, 0.5, 0.5, 1.0);
43
+  MAT_DEFAULT_EMISSION:  TgluVector4f = (0.0, 0.0, 0.0, 1.0);
44
+  MAT_DEFAULT_SHININESS: GLfloat      =  50.0;
45
+
46
+  LIGHT_DEFAULT_AMBIENT:        TgluVector4f = (0.4, 0.4, 0.4, 1.0);
47
+  LIGHT_DEFAULT_DIFFUSE:        TgluVector4f = (0.7, 0.7, 0.7, 1.0);
48
+  LIGHT_DEFAULT_SPECULAR:       TgluVector4f = (0.9, 0.9, 0.9, 1.0);
49
+  LIGHT_DEFAULT_POSITION:       TgluVector4f = (0.0, 0.0, 1.0, 0.0);
50
+  LIGHT_DEFAULT_SPOT_DIRECTION: TgluVector3f = (0.0, 0.0, -1.0);
51
+  LIGHT_DEFAULT_SPOT_EXPONENT:  GLfloat      =   0.0;
52
+  LIGHT_DEFAULT_SPOT_CUTOFF:    GLfloat      = 180.0;
53
+  LIGHT_DEFAULT_CONSTANT_ATT:   GLfloat      =   1.0;
54
+  LIGHT_DEFAULT_LINEAR_ATT:     GLfloat      =   0.0;
55
+  LIGHT_DEFAULT_QUADRATIC_ATT:  GLfloat      =   0.0;
56
+
57
+type
58
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
59
+  TglcMaterial = class(TObject)
60
+  private
61
+    fData: TglcMaterialRec;
62
+  public
63
+    property Diffuse:   TgluVector4f      read fData.Diffuse   write fData.Diffuse;
64
+    property Ambient:   TgluVector4f      read fData.Ambient   write fData.Ambient;
65
+    property Specular:  TgluVector4f      read fData.Specular  write fData.Specular;
66
+    property Emission:  TgluVector4f      read fData.Emission  write fData.Emission;
67
+    property Shininess: GLfloat           read fData.Shininess write fData.Shininess;
68
+    property Data:      TglcMaterialRec   read fData           write fData;
69
+
70
+    procedure Bind(const aFace: TglcFace);
71
+
72
+    class procedure Bind(const aFace: TglcFace; const aMaterial: TglcMaterialRec);
73
+    class function DefaultValues: TglcMaterialRec;
74
+
75
+    constructor Create;
76
+  end;
77
+
78
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
79
+  EglcLight = class(Exception);
80
+  TglcLight = class(TObject)
81
+  private
82
+    function GetDataPtr: PglcLightRec;
83
+  protected
84
+    fData: TglcLightRec;
85
+
86
+    procedure SetAmbient      (const aValue: TgluVector4f);   virtual;
87
+    procedure SetDiffuse      (const aValue: TgluVector4f);   virtual;
88
+    procedure SetSpecular     (const aValue: TgluVector4f);   virtual;
89
+    procedure SetPosition4f   (const aValue: TgluVector4f);   virtual;
90
+    procedure SetSpotDirection(const aValue: TgluVector3f);   virtual;
91
+    procedure SetSpotExponent (const aValue: GLfloat);        virtual;
92
+    procedure SetSpotCutoff   (const aValue: GLfloat);        virtual;
93
+    procedure SetConstantAtt  (const aValue: GLfloat);        virtual;
94
+    procedure SetLinearAtt    (const aValue: GLfloat);        virtual;
95
+    procedure SetQuadraticAtt (const aValue: GLfloat);        virtual;
96
+    procedure SetData         (const aValue: TglcLightRec);   virtual;
97
+
98
+    property Ambient:       TgluVector4f   read fData.Ambient       write SetAmbient;
99
+    property Diffuse:       TgluVector4f   read fData.Diffuse       write SetDiffuse;
100
+    property Specular:      TgluVector4f   read fData.Specular      write SetSpecular;
101
+    property Position4f:    TgluVector4f   read fData.Position      write SetPosition4f;
102
+    property SpotDirection: TgluVector3f   read fData.SpotDirection write SetSpotDirection;
103
+    property SpotExponent:  GLfloat        read fData.SpotExponent  write SetSpotExponent;
104
+    property SpotCutoff:    GLfloat        read fData.SpotCutoff    write SetSpotCutoff;
105
+    property ConstantAtt:   GLfloat        read fData.ConstantAtt   write SetConstantAtt;
106
+    property LinearAtt:     GLfloat        read fData.LinearAtt     write SetLinearAtt;
107
+    property QuadraticAtt:  GLfloat        read fData.QuadraticAtt  write SetQuadraticAtt;
108
+  public
109
+    property Data:    TglcLightRec read fData write SetData;
110
+    property DataPtr: PglcLightRec read GetDataPtr;
111
+
112
+    procedure Bind(const aLightID: GLenum; const aEnableLighting: Boolean = false); virtual; abstract;
113
+
114
+    class procedure Bind(const aLightID: GLenum; const aLight: TglcLightRec;
115
+      const aEnableLighting: Boolean; const aLightType: TglcLightType);
116
+    class procedure Unbind(const aLightID: GLenum; const aDisableLighting: Boolean = true);
117
+    class function DefaultValues: TglcLightRec; virtual;
118
+
119
+    constructor Create;
120
+  end;
121
+
122
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
123
+  TglcLightGlobal = class(TglcLight)
124
+  private
125
+    function GetDirection: TgluVector3f;
126
+    procedure SetDirection(aValue: TgluVector3f);
127
+  public
128
+    property Ambient;
129
+    property Diffuse;
130
+    property Specular;
131
+    property Direction: TgluVector3f read GetDirection write SetDirection;
132
+
133
+    procedure Bind(const aLightID: GLenum; const aEnableLighting: Boolean = false); override;
134
+  end;
135
+
136
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
137
+  TglcLightPoint = class(TglcLight)
138
+  private
139
+    fMaxSize: Single;
140
+    fSizeFactor: Single;
141
+    function GetPosition: TgluVector3f;
142
+    procedure SetPosition(const aValue: TgluVector3f);
143
+  protected
144
+    procedure SetMaxSize   (const aValue: Single); virtual;
145
+    procedure SetSizeFactor(const aValue: Single); virtual;
146
+  public
147
+    property Ambient;
148
+    property Diffuse;
149
+    property Specular;
150
+    property ConstantAtt;
151
+    property LinearAtt;
152
+    property QuadraticAtt;
153
+    property MaxSize:    Single       read fMaxSize    write SetMaxSize;
154
+    property SizeFactor: Single       read fSizeFactor write SetSizeFactor;
155
+    property Position:   TgluVector3f read GetPosition write SetPosition;
156
+
157
+    procedure Bind(const aLightID: GLenum; const aEnableLighting: Boolean = false); override;
158
+
159
+    constructor Create;
160
+  end;
161
+
162
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
163
+  TglcLightSpot = class(TglcLightPoint)
164
+  public
165
+    property SpotCutoff;
166
+    property SpotDirection;
167
+    property SpotExponent;
168
+
169
+    procedure Bind(const aLightID: GLenum; const aEnableLighting: Boolean = false); override;
170
+  end;
171
+
172
+implementation
173
+
174
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
175
+//TglcMaterial//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
176
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
177
+procedure TglcMaterial.Bind(const aFace: TglcFace);
178
+begin
179
+  Bind(aFace, fData);
180
+end;
181
+
182
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
183
+class procedure TglcMaterial.Bind(const aFace: TglcFace; const aMaterial: TglcMaterialRec);
184
+begin
185
+  glMaterialfv(GLenum(aFace), GL_AMBIENT,   @aMaterial.Ambient[0]);
186
+  glMaterialfv(GLenum(aFace), GL_DIFFUSE,   @aMaterial.Diffuse[0]);
187
+  glMaterialfv(GLenum(aFace), GL_EMISSION,  @aMaterial.Emission[0]);
188
+  glMaterialfv(GLenum(aFace), GL_SPECULAR,  @aMaterial.Specular[0]);
189
+  glMaterialfv(GLenum(aFace), GL_SHININESS, @aMaterial.Shininess);
190
+end;
191
+
192
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
193
+class function TglcMaterial.DefaultValues: TglcMaterialRec;
194
+begin
195
+  result.Ambient   := MAT_DEFAULT_AMBIENT;
196
+  result.Diffuse   := MAT_DEFAULT_DIFFUSE;
197
+  result.Specular  := MAT_DEFAULT_SPECULAR;
198
+  result.Emission  := MAT_DEFAULT_EMISSION;
199
+  result.Shininess := MAT_DEFAULT_SHININESS;
200
+end;
201
+
202
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
203
+constructor TglcMaterial.Create;
204
+begin
205
+  inherited Create;
206
+  fData := DefaultValues;
207
+end;
208
+
209
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
210
+//TglcLight/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
211
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
212
+function TglcLight.GetDataPtr: PglcLightRec;
213
+begin
214
+  result := @fData;
215
+end;
216
+
217
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
218
+procedure TglcLight.SetAmbient(const aValue: TgluVector4f);
219
+begin
220
+  fData.Ambient := aValue;
221
+end;
222
+
223
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
224
+procedure TglcLight.SetDiffuse(const aValue: TgluVector4f);
225
+begin
226
+  fData.Diffuse := aValue;
227
+end;
228
+
229
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
230
+procedure TglcLight.SetSpecular(const aValue: TgluVector4f);
231
+begin
232
+  fData.Specular := aValue;
233
+end;
234
+
235
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
236
+procedure TglcLight.SetPosition4f(const aValue: TgluVector4f);
237
+begin
238
+  fData.Position := aValue;
239
+end;
240
+
241
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
242
+procedure TglcLight.SetConstantAtt(const aValue: GLfloat);
243
+begin
244
+  fData.ConstantAtt := aValue;
245
+end;
246
+
247
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
248
+procedure TglcLight.SetLinearAtt(const aValue: GLfloat);
249
+begin
250
+  fData.LinearAtt := aValue;
251
+end;
252
+
253
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
254
+procedure TglcLight.SetQuadraticAtt(const aValue: GLfloat);
255
+begin
256
+  fData.QuadraticAtt := aValue;
257
+end;
258
+
259
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
260
+procedure TglcLight.SetSpotDirection(const aValue: TgluVector3f);
261
+begin
262
+  fData.SpotDirection := aValue;
263
+end;
264
+
265
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
266
+procedure TglcLight.SetSpotExponent(const aValue: GLfloat);
267
+begin
268
+  fData.SpotExponent := aValue;
269
+end;
270
+
271
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
272
+procedure TglcLight.SetSpotCutoff(const aValue: GLfloat);
273
+begin
274
+  fData.SpotCutoff := aValue;
275
+end;
276
+
277
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
278
+procedure TglcLight.SetData(const aValue: TglcLightRec);
279
+begin
280
+  fData := aValue;
281
+end;
282
+
283
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
284
+class procedure TglcLight.Bind(const aLightID: GLenum; const aLight: TglcLightRec;
285
+  const aEnableLighting: Boolean; const aLightType: TglcLightType);
286
+begin
287
+  glEnable(aLightID);
288
+  if (aEnableLighting) then
289
+    glEnable(GL_LIGHTING);
290
+
291
+  if (aLightType in [ltGlobal, ltPoint, ltSpot]) then begin
292
+    glLightfv(aLightID, GL_AMBIENT,  @aLight.Ambient[0]);
293
+    glLightfv(aLightID, GL_DIFFUSE,  @aLight.Diffuse[0]);
294
+    glLightfv(aLightID, GL_SPECULAR, @aLight.Specular[0]);
295
+    glLightfv(aLightID, GL_POSITION, @aLight.Position[0]);
296
+  end else begin
297
+    glLightfv(aLightID, GL_AMBIENT,  @LIGHT_DEFAULT_AMBIENT[0]);
298
+    glLightfv(aLightID, GL_DIFFUSE,  @LIGHT_DEFAULT_DIFFUSE[0]);
299
+    glLightfv(aLightID, GL_SPECULAR, @LIGHT_DEFAULT_SPECULAR[0]);
300
+    glLightfv(aLightID, GL_POSITION, @LIGHT_DEFAULT_POSITION[0]);
301
+  end;
302
+
303
+  if (aLightType in [ltPoint, ltSpot]) then begin
304
+    glLightfv(aLightID, GL_CONSTANT_ATTENUATION,  @aLight.ConstantAtt);
305
+    glLightfv(aLightID, GL_LINEAR_ATTENUATION,    @aLight.LinearAtt);
306
+    glLightfv(aLightID, GL_QUADRATIC_ATTENUATION, @aLight.QuadraticAtt);
307
+  end else begin
308
+    glLightfv(aLightID, GL_CONSTANT_ATTENUATION,  @LIGHT_DEFAULT_CONSTANT_ATT);
309
+    glLightfv(aLightID, GL_LINEAR_ATTENUATION,    @LIGHT_DEFAULT_LINEAR_ATT);
310
+    glLightfv(aLightID, GL_QUADRATIC_ATTENUATION, @LIGHT_DEFAULT_QUADRATIC_ATT);
311
+  end;
312
+
313
+  if (aLightType in [ltSpot]) then begin
314
+    glLightfv(aLightID, GL_SPOT_DIRECTION, @aLight.SpotDirection[0]);
315
+    glLightfv(aLightID, GL_SPOT_EXPONENT,  @aLight.SpotExponent);
316
+    glLightfv(aLightID, GL_SPOT_CUTOFF,    @aLight.SpotCutoff);
317
+  end else begin
318
+    glLightfv(aLightID, GL_SPOT_DIRECTION, @LIGHT_DEFAULT_SPOT_DIRECTION[0]);
319
+    glLightfv(aLightID, GL_SPOT_EXPONENT,  @LIGHT_DEFAULT_SPOT_EXPONENT);
320
+    glLightfv(aLightID, GL_SPOT_CUTOFF,    @LIGHT_DEFAULT_SPOT_CUTOFF);
321
+  end;
322
+end;
323
+
324
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
325
+class procedure TglcLight.Unbind(const aLightID: GLenum; const aDisableLighting: Boolean);
326
+begin
327
+  glDisable(aLightID);
328
+  if aDisableLighting then
329
+    glDisable(GL_LIGHTING);
330
+end;
331
+
332
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
333
+class function TglcLight.DefaultValues: TglcLightRec;
334
+begin
335
+  result.Ambient       := LIGHT_DEFAULT_AMBIENT;
336
+  result.Diffuse       := LIGHT_DEFAULT_DIFFUSE;
337
+  result.Specular      := LIGHT_DEFAULT_SPECULAR;
338
+  result.Position      := LIGHT_DEFAULT_POSITION;
339
+  result.SpotDirection := LIGHT_DEFAULT_SPOT_DIRECTION;
340
+  result.SpotExponent  := LIGHT_DEFAULT_SPOT_EXPONENT;
341
+  result.SpotCutoff    := LIGHT_DEFAULT_SPOT_CUTOFF;
342
+  result.ConstantAtt   := LIGHT_DEFAULT_CONSTANT_ATT;
343
+  result.LinearAtt     := LIGHT_DEFAULT_LINEAR_ATT;
344
+  result.QuadraticAtt  := LIGHT_DEFAULT_QUADRATIC_ATT;
345
+end;
346
+
347
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
348
+constructor TglcLight.Create;
349
+begin
350
+  inherited Create;
351
+  fData  := DefaultValues;
352
+end;
353
+
354
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
355
+//TglcLightGlobal///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
356
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
357
+function TglcLightGlobal.GetDirection: TgluVector3f;
358
+begin
359
+  result := gluVector3f(Position4f);
360
+end;
361
+
362
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
363
+procedure TglcLightGlobal.SetDirection(aValue: TgluVector3f);
364
+begin
365
+  Position4f := gluVector4f(aValue, 0.0);
366
+end;
367
+
368
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
369
+procedure TglcLightGlobal.Bind(const aLightID: GLenum; const aEnableLighting: Boolean);
370
+begin
371
+  TglcLight.Bind(aLightID, fData, aEnableLighting, ltGlobal);
372
+end;
373
+
374
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
375
+//TglcLightPoint////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
376
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
377
+function TglcLightPoint.GetPosition: TgluVector3f;
378
+begin
379
+  result := gluVector3f(fData.Position);
380
+end;
381
+
382
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
383
+procedure TglcLightPoint.SetPosition(const aValue: TgluVector3f);
384
+begin
385
+  SetPosition4f(gluVector4f(aValue, 1.0));
386
+end;
387
+
388
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
389
+procedure TglcLightPoint.SetMaxSize(const aValue: Single);
390
+begin
391
+  fMaxSize := aValue;
392
+end;
393
+
394
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
395
+procedure TglcLightPoint.SetSizeFactor(const aValue: Single);
396
+begin
397
+  fSizeFactor := aValue;
398
+end;
399
+
400
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
401
+procedure TglcLightPoint.Bind(const aLightID: GLenum; const aEnableLighting: Boolean);
402
+begin
403
+  TglcLight.Bind(aLightID, fData, aEnableLighting, ltPoint);
404
+end;
405
+
406
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
407
+constructor TglcLightPoint.Create;
408
+begin
409
+  inherited Create;
410
+  Position    := gluVector3f(0.0, 0.0, 0.0);
411
+  fMaxSize    := 0;
412
+  fSizeFactor := 1.0;
413
+end;
414
+
415
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
416
+//TglcLightSpot/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
417
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
418
+procedure TglcLightSpot.Bind(const aLightID: GLenum; const aEnableLighting: Boolean);
419
+begin
420
+  TglcLight.Bind(aLightID, fData, aEnableLighting, ltSpot);
421
+end;
422
+
423
+end.
424
+

+ 931 - 0
uglcShader.pas

@@ -0,0 +1,931 @@
1
+unit uglcShader;
2
+
3
+{ Package:      OpenGLCore
4
+  Prefix:       glc - OpenGL Core
5
+  Beschreibung: diese Unit enthält eine Klassen-Kapselung der OpenGL Shader Objekte }
6
+
7
+{$mode objfpc}{$H+}
8
+
9
+interface
10
+
11
+uses
12
+  Classes, SysUtils, fgl, dglOpenGL, uglcTypes, ugluMatrix;
13
+
14
+type
15
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
16
+  EglcShader = class(Exception);
17
+  TglcShaderProgram = class;
18
+  TglcShaderLogEvent = procedure(aSender: TObject; const aMsg: String) of Object;
19
+  TglcShaderObject = class(TObject)
20
+  private
21
+    fAtachedTo: TglcShaderProgram;
22
+    fShaderObj: GLHandle;
23
+    fShaderType: TglcShaderType;
24
+    fCode: String;
25
+    fOnLog: TglcShaderLogEvent;
26
+    fAttachedTo: TglcShaderProgram;
27
+
28
+    function GetInfoLog(aObj: GLHandle): String;
29
+    function GetCompiled: Boolean;
30
+    procedure Log(const aMsg: String);
31
+    procedure CreateShaderObj;
32
+    procedure AttachTo(const aProgram: TglcShaderProgram);
33
+  public
34
+    property ShaderObj : GLHandle           read fShaderObj;
35
+    property ShaderType: TglcShaderType     read fShaderType;
36
+    property Compiled:   Boolean            read GetCompiled;
37
+    property AtachedTo:  TglcShaderProgram  read fAtachedTo;
38
+    property Code:       String             read fCode  write fCode;
39
+    property OnLog:      TglcShaderLogEvent read fOnLog write fOnLog;
40
+
41
+    procedure Compile;
42
+
43
+    constructor Create(const aShaderType: TglcShaderType; const aLogEvent: TglcShaderLogEvent = nil);
44
+    destructor Destroy; override;
45
+  end;
46
+  TglcShaderObjectList = specialize TFPGObjectList<TglcShaderObject>;
47
+
48
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
49
+  TglcShaderProgram = class(TglcShaderObjectList)
50
+  private
51
+    fProgramObj: GLHandle;
52
+    fOnLog: TglcShaderLogEvent;
53
+    fFilename: String;
54
+    fGeometryInputType: GLint;
55
+    fGeometryOutputType: GLint;
56
+    fGeometryVerticesOut: GLint;
57
+
58
+    function GetUniformLocation(const aName: String; out aPos: glInt): Boolean;
59
+    function GetInfoLog(Obj: GLHandle): String;
60
+    function GetCompiled: Boolean;
61
+    function GetLinked: Boolean;
62
+
63
+    procedure CreateProgramObj;
64
+    procedure Log(const msg: String);
65
+    procedure AttachShaderObj(const aShaderObj: TglcShaderObject);
66
+  public
67
+    property ProgramObj: glHandle           read fProgramObj;
68
+    property Filename:   String             read fFilename;
69
+    property Compiled:   Boolean            read GetCompiled;
70
+    property Linked:     Boolean            read GetLinked;
71
+    property OnLog:      TglcShaderLogEvent read fOnLog               write fOnLog;
72
+    property GeometryInputType:   GLint     read fGeometryInputType   write fGeometryInputType;
73
+    property GeometryOutputType:  GLint     read fGeometryOutputType  write fGeometryOutputType;
74
+    property GeometryVerticesOut: GLint     read fGeometryVerticesOut write fGeometryVerticesOut;
75
+
76
+    procedure Compile;
77
+    procedure Enable;
78
+    procedure Disable;
79
+
80
+    procedure Add(aShaderObj: TglcShaderObject);
81
+    procedure Delete(aID: Integer; aFreeOwnedObj: Boolean = True);
82
+    procedure Clear;
83
+
84
+    function Uniform1f(const aName: String; aP1: GLFloat): Boolean;
85
+    function Uniform2f(const aName: String; aP1, aP2: GLFloat): Boolean;
86
+    function Uniform3f(const aName: String; aP1, aP2, aP3: GLFloat): Boolean;
87
+    function Uniform4f(const aName: String; aP1, aP2, aP3, aP4: GLFloat): Boolean;
88
+    function Uniform1i(const aName: String; aP1: GLint): Boolean;
89
+    function Uniform2i(const aName: String; aP1, aP2: GLint): Boolean;
90
+    function Uniform3i(const aName: String; aP1, aP2, aP3: GLint): Boolean;
91
+    function Uniform4i(const aName: String; aP1, aP2, aP3, aP4: GLint): Boolean;
92
+    function Uniform1fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;
93
+    function Uniform2fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;
94
+    function Uniform3fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;
95
+    function Uniform4fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;
96
+    function Uniform1iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;
97
+    function Uniform2iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;
98
+    function Uniform3iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;
99
+    function Uniform4iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;
100
+    function UniformMatrix2fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix2f): Boolean;
101
+    function UniformMatrix3fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix3f): Boolean;
102
+    function UniformMatrix4fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix4f): Boolean;
103
+
104
+    function GetUniformfv(const aName: String; aP: PGLfloat): Boolean;
105
+    function GetUniformfi(const aName: String; aP: PGLint): Boolean;
106
+    function HasUniform(const aName: String): Boolean;
107
+
108
+    procedure LoadFromFile(const aFilename: String);
109
+    procedure LoadFromStream(const aStream: TStream);
110
+    procedure SaveToFile(const aFilename: String);
111
+    procedure SaveToStream(const aStream: TStream);
112
+
113
+    constructor Create(aLogEvent: TglcShaderLogEvent = nil);
114
+    destructor Destroy; override;
115
+  end;
116
+
117
+implementation
118
+
119
+uses
120
+  RegExpr;
121
+
122
+const
123
+  ERROR_STR_VAR_NAME: String = 'can''t find the variable ''%s'' in the program';
124
+
125
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
126
+//glShaderObject////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
127
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
128
+//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRI//
129
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
130
+//ließt das Log eines OpenGL-Objekts aus
131
+//@Obj: Handle des Objekts, dessen Log ausgelesen werden soll;
132
+//@result: Log des Objekts;
133
+function TglcShaderObject.GetInfoLog(aObj: GLHandle): String;
134
+var
135
+  Msg: PChar;
136
+  bLen, sLen: GLint;
137
+begin
138
+  bLen := 0;
139
+  glGetShaderiv(aObj, GL_INFO_LOG_LENGTH, @bLen);
140
+  if bLen > 1 then begin
141
+    GetMem(Msg, bLen * SizeOf(Char));
142
+    glGetShaderInfoLog(aObj, bLen, sLen{%H-}, Msg);
143
+    result := PChar(Msg);
144
+    Dispose(Msg);
145
+  end;
146
+end;
147
+
148
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
149
+//ließt aus, ob der Shader ohne Fehler kompiliert wurde
150
+//@result: TRUE wenn ohne Fehler kompiliert, sonst FALSE;
151
+function TglcShaderObject.GetCompiled: Boolean;
152
+var
153
+  value: glInt;
154
+begin
155
+  glGetShaderiv(fShaderObj, GL_COMPILE_STATUS, @value);
156
+  result := (value = GL_TRUE);
157
+end;
158
+
159
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
160
+//ruft das Log-Event auf, wenn es gesetzt ist
161
+//@msg: Nachricht die geloggt werden soll;
162
+procedure TglcShaderObject.Log(const aMsg: String);
163
+begin
164
+  if Assigned(fOnLog) then begin
165
+    fOnLog(self, aMsg);
166
+  end;
167
+end;
168
+
169
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
170
+procedure TglcShaderObject.CreateShaderObj;
171
+begin
172
+  if (fShaderObj <> 0) then
173
+    exit;
174
+  fShaderObj := glCreateShader(GLenum(fShaderType));
175
+  if fShaderObj = 0 then
176
+    raise EglcShader.Create('can''t create ShaderObject');
177
+  Log('shader object created: #'+IntToHex(fShaderObj, 4));
178
+end;
179
+
180
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
181
+procedure TglcShaderObject.AttachTo(const aProgram: TglcShaderProgram);
182
+begin
183
+  if (aProgram <> fAtachedTo) then begin
184
+    CreateShaderObj;
185
+    glAttachShader(aProgram.ProgramObj, fShaderObj);
186
+    fAttachedTo := aProgram;
187
+  end;
188
+end;
189
+
190
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
191
+//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBL//
192
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
193
+//kompiliert das Shader-Objekt
194
+procedure TglcShaderObject.Compile;
195
+var
196
+  len, i: GLint;
197
+  List: TStringList;
198
+  c: PAnsiChar;
199
+begin
200
+  CreateShaderObj;
201
+  len := Length(fCode);
202
+  if len > 0 then begin
203
+    c := PAnsiChar(fCode);
204
+    glShaderSource(fShaderObj, 1, @c, @len);
205
+    glCompileShader(fShaderObj);
206
+    List := TStringList.Create;
207
+    List.Text := GetInfoLog(fShaderObj);
208
+    for i := 0 to List.Count-1 do
209
+      Log(List[i]);
210
+    List.Free;
211
+  end else Log('error while compiling: no bound shader code');
212
+end;
213
+
214
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
215
+//erzeugt das Objekt
216
+//@ShaderType: Typ des Shader-Objekts;
217
+//@LogEvent: Event zum loggen von Fehlern und Ereignissen;
218
+//@raise: EglcShader wenn der Shadertyp unbekannt oder ungültig ist;
219
+constructor TglcShaderObject.Create(const aShaderType: TglcShaderType; const aLogEvent: TglcShaderLogEvent);
220
+begin
221
+  inherited Create;
222
+  fCode       := '';
223
+  fOnLog      := aLogEvent;
224
+  fShaderType := aShaderType;
225
+end;
226
+
227
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
228
+//gibt das Objekt frei
229
+destructor TglcShaderObject.Destroy;
230
+begin
231
+  if (fShaderObj <> 0) then
232
+    glDeleteShader(fShaderObj);
233
+  inherited Destroy;
234
+end;
235
+
236
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
237
+//glShaderProgram///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
238
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
239
+//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRI//
240
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
241
+function TglcShaderProgram.GetUniformLocation(const aName: String; out aPos: glInt): Boolean;
242
+begin
243
+  aPos := glGetUniformLocation(fProgramObj, PChar(aName));
244
+  result := (aPos <> -1);
245
+  if not result then
246
+    Log(StringReplace(ERROR_STR_VAR_NAME, '%s', aName, [rfIgnoreCase, rfReplaceAll]));
247
+end;
248
+
249
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
250
+//ließt das Log eines OpenGL-Objekts aus
251
+//@Obj: Handle des Objekts, dessen Log ausgelesen werden soll;
252
+//@result: Log des Objekts;
253
+function TglcShaderProgram.GetInfoLog(Obj: GLHandle): String;
254
+var
255
+  Msg: PChar;
256
+  bLen, sLen: GLint;
257
+begin
258
+  bLen := 0;
259
+  glGetProgramiv(Obj, GL_INFO_LOG_LENGTH, @bLen);
260
+  if bLen > 1 then begin
261
+    GetMem(Msg, bLen * SizeOf(Char));
262
+    glGetProgramInfoLog(Obj, bLen, sLen{%H-}, Msg);
263
+    result := PChar(Msg);
264
+    Dispose(Msg);
265
+  end;
266
+end;
267
+
268
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
269
+//prüft ob alle Shader ohne Fehler compiliert wurden
270
+//@result: TRUE wenn alle erfolgreich compiliert, sonst FALSE;
271
+function TglcShaderProgram.GetCompiled: Boolean;
272
+var
273
+  i: Integer;
274
+begin
275
+  result := (Count > 0);
276
+  for i := 0 to Count-1 do
277
+    result := result and Items[i].Compiled;
278
+end;
279
+
280
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
281
+//prüft ob das Programm ohne Fehler gelinkt wurde
282
+//@result: TRUE wenn linken erfolgreich, sonst FASLE;
283
+function TglcShaderProgram.GetLinked: Boolean;
284
+var
285
+  value: glInt;
286
+begin
287
+  glGetProgramiv(fProgramObj, GL_LINK_STATUS, @value);
288
+  result := (value = GL_TRUE);
289
+end;
290
+
291
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
292
+procedure TglcShaderProgram.CreateProgramObj;
293
+begin
294
+  if (fProgramObj = 0) then begin
295
+    if GL_LibHandle = nil then
296
+      raise EglcShader.Create('TglShaderProgram.Create - OpenGL not initialized');
297
+
298
+    if (wglGetCurrentContext() = 0) or (wglGetCurrentDC() = 0) then
299
+      raise EglcShader.Create('TglShaderProgram.Create - no valid render context');
300
+
301
+    fProgramObj := glCreateProgram();
302
+    Log('shader program created: #'+IntToHex(fProgramObj, 4));
303
+  end;
304
+end;
305
+
306
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
307
+//ruft das Log-Event auf, wenn es gesetzt ist
308
+//@msg: Nachricht die geloggt werden soll;
309
+procedure TglcShaderProgram.Log(const msg: String);
310
+begin
311
+  if Assigned(fOnLog) then begin
312
+    fOnLog(self, msg);
313
+  end;
314
+end;
315
+
316
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
317
+procedure TglcShaderProgram.AttachShaderObj(const aShaderObj: TglcShaderObject);
318
+begin
319
+  CreateProgramObj;
320
+  aShaderObj.AttachTo(self);
321
+end;
322
+
323
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
324
+//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBL//
325
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
326
+//Kompiliert den Shader-Code
327
+procedure TglcShaderProgram.Compile;
328
+var
329
+  i: Integer;
330
+  l: TStringList;
331
+begin
332
+  CreateProgramObj;
333
+  for i := 0 to Count-1 do begin
334
+    AttachShaderObj(Items[i]);
335
+    Items[i].Compile;
336
+  end;
337
+  glLinkProgram(fProgramObj);
338
+  l := TStringList.Create;
339
+  l.Text := GetInfoLog(fProgramObj);
340
+  for i := 0 to l.Count-1 do
341
+    Log(l[i]);
342
+  l.Free;
343
+end;
344
+
345
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
346
+//aktiviert den Shader
347
+procedure TglcShaderProgram.Enable;
348
+begin
349
+  glUseProgram(fProgramObj);
350
+end;
351
+
352
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
353
+//deaktiviert den Shader
354
+procedure TglcShaderProgram.Disable;
355
+begin
356
+  glUseProgram(0);
357
+end;
358
+
359
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
360
+//fügt der Liste einen Shader hinzu
361
+//@ShaderObj: Objekt, das hinzugefügt werden soll;
362
+procedure TglcShaderProgram.Add(aShaderObj: TglcShaderObject);
363
+begin
364
+  inherited Add(aShaderObj);
365
+  if (fProgramObj <> 0) then
366
+    AttachShaderObj(aShaderObj);
367
+end;
368
+
369
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
370
+//löscht ein ShaderObjekt aus der Liste
371
+//@ID: Index des Objekts, das gelöscht werden soll;
372
+//@FreeOwnedObj: wenn TRUE wird das gelöschte Objekt freigegeben;
373
+procedure TglcShaderProgram.Delete(aID: Integer; aFreeOwnedObj: Boolean);
374
+var
375
+  b: Boolean;
376
+begin
377
+  if (aID >= 0) and (aID < Count) and (fProgramObj <> 0) then begin
378
+    glDetachShader(fProgramObj, Items[aID].fShaderObj);
379
+    Items[aID].fAttachedTo := nil;
380
+  end;
381
+  b := FreeObjects;
382
+  FreeObjects := aFreeOwnedObj;
383
+  inherited Delete(aID);
384
+  FreeObjects := b;
385
+end;
386
+
387
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
388
+procedure TglcShaderProgram.Clear;
389
+begin
390
+  while (Count > 0) do
391
+    Delete(0);
392
+end;
393
+
394
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
395
+//übergibt einen 1-Komponenten Float-Vektoren an den Shader
396
+//!!!Der Shader muss dazu aktiviert sein!!!
397
+//@Name: Name der Variablen die gesetzt werden soll;
398
+//@p1: Wert der Variable, der gesetzt werden soll;
399
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
400
+function TglcShaderProgram.Uniform1f(const aName: String; aP1: GLFloat): Boolean;
401
+var
402
+  pos: GLint;
403
+begin
404
+  result := GetUniformLocation(aName, pos);
405
+  if result then
406
+    glUniform1f(pos, aP1);
407
+end;
408
+
409
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
410
+//übergibt einen 2-Komponenten Float-Vektoren an den Shader
411
+//!!!Der Shader muss dazu aktiviert sein!!!
412
+//@Name: Name der Variablen die gesetzt werden soll;
413
+//@p1: Wert der Variable, der gesetzt werden soll;
414
+//@p2: Wert der Variable, der gesetzt werden soll;
415
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
416
+function TglcShaderProgram.Uniform2f(const aName: String; aP1, aP2: GLFloat): Boolean;
417
+var
418
+  pos: GLint;
419
+begin
420
+  result := GetUniformLocation(aName, pos);
421
+  if result then
422
+    glUniform2f(pos, aP1, aP2);
423
+end;
424
+
425
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
426
+//übergibt einen 3-Komponenten Float-Vektoren an den Shader
427
+//!!!Der Shader muss dazu aktiviert sein!!!
428
+//@Name: Name der Variablen die gesetzt werden soll;
429
+//@p1: Wert der Variable, der gesetzt werden soll;
430
+//@p2: Wert der Variable, der gesetzt werden soll;
431
+//@p3: Wert der Variable, der gesetzt werden soll;
432
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
433
+function TglcShaderProgram.Uniform3f(const aName: String; aP1, aP2, aP3: GLFloat): Boolean;
434
+var
435
+  pos: GLint;
436
+begin
437
+  result := GetUniformLocation(aName, pos);
438
+  if result then
439
+    glUniform3f(pos, aP1, aP2, aP3);
440
+end;
441
+
442
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
443
+//übergibt einen 4-Komponenten Float-Vektoren an den Shader
444
+//!!!Der Shader muss dazu aktiviert sein!!!
445
+//@Name: Name der Variablen die gesetzt werden soll;
446
+//@p1: Wert der Variable, der gesetzt werden soll;
447
+//@p2: Wert der Variable, der gesetzt werden soll;
448
+//@p3: Wert der Variable, der gesetzt werden soll;
449
+//@p4: Wert der Variable, der gesetzt werden soll;
450
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
451
+function TglcShaderProgram.Uniform4f(const aName: String; aP1, aP2, aP3, aP4: GLFloat): Boolean;
452
+var
453
+  pos: GLint;
454
+begin
455
+  result := GetUniformLocation(aName, pos);
456
+  if result then
457
+    glUniform4f(pos, aP1, aP2, aP3, aP4);
458
+end;
459
+
460
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
461
+//übergibt einen 1-Komponenten Integer-Vektoren an den Shader
462
+//!!!Der Shader muss dazu aktiviert sein!!!
463
+//@Name: Name der Variablen die gesetzt werden soll;
464
+//@p1: Wert der Variable, der gesetzt werden soll;
465
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
466
+function TglcShaderProgram.Uniform1i(const aName: String; aP1: GLint): Boolean;
467
+var
468
+  pos: GLint;
469
+begin
470
+  result := GetUniformLocation(aName, pos);
471
+  if result then
472
+    glUniform1i(pos, aP1);
473
+end;
474
+
475
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
476
+//übergibt einen 2-Komponenten Integer-Vektoren an den Shader
477
+//!!!Der Shader muss dazu aktiviert sein!!!
478
+//@Name: Name der Variablen die gesetzt werden soll;
479
+//@p1: Wert der Variable, der gesetzt werden soll;
480
+//@p1: Wert der Variable, der gesetzt werden soll;
481
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
482
+function TglcShaderProgram.Uniform2i(const aName: String; aP1, aP2: GLint): Boolean;
483
+var
484
+  pos: GLint;
485
+begin
486
+  result := GetUniformLocation(aName, pos);
487
+  if result then
488
+    glUniform2i(pos, aP1, aP2);
489
+end;
490
+
491
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
492
+//übergibt einen 3-Komponenten Integer-Vektoren an den Shader
493
+//!!!Der Shader muss dazu aktiviert sein!!!
494
+//@Name: Name der Variablen die gesetzt werden soll;
495
+//@p1: Wert der Variable, der gesetzt werden soll;
496
+//@p2: Wert der Variable, der gesetzt werden soll;
497
+//@p3: Wert der Variable, der gesetzt werden soll;
498
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
499
+function TglcShaderProgram.Uniform3i(const aName: String; aP1, aP2, aP3: GLint): Boolean;
500
+var
501
+  pos: GLint;
502
+begin
503
+  result := GetUniformLocation(aName, pos);
504
+  if result then
505
+    glUniform3i(pos, aP1, aP2, aP3);
506
+end;
507
+
508
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
509
+//übergibt einen 4-Komponenten Integer-Vektoren an den Shader
510
+//!!!Der Shader muss dazu aktiviert sein!!!
511
+//@Name: Name der Variablen die gesetzt werden soll;
512
+//@p1: Wert der Variable, der gesetzt werden soll;
513
+//@p2: Wert der Variable, der gesetzt werden soll;
514
+//@p3: Wert der Variable, der gesetzt werden soll;
515
+//@p4: Wert der Variable, der gesetzt werden soll;
516
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
517
+function TglcShaderProgram.Uniform4i(const aName: String; aP1, aP2, aP3, aP4: GLint): Boolean;
518
+var
519
+  pos: GLint;
520
+begin
521
+  result := GetUniformLocation(aName, pos);
522
+  if result then
523
+    glUniform4i(pos, aP1, aP2, aP3, aP4);
524
+end;
525
+
526
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
527
+//übergibt einen oder mehrere 1-Komponenten Float-Vektoren an den Shader
528
+//!!!Der Shader muss dazu aktiviert sein!!!
529
+//@Name: Name der Variablen die gesetzt werden soll;
530
+//@count: Anzahl an Parametern auf die p1 zeigt;
531
+//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;
532
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
533
+function TglcShaderProgram.Uniform1fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;
534
+var
535
+  pos: GLint;
536
+begin
537
+  result := GetUniformLocation(aName, pos);
538
+  if result then
539
+    glUniform1fv(pos, aCount, aP1);
540
+end;
541
+
542
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
543
+//übergibt einen oder mehrere 2-Komponenten Float-Vektoren an den Shader
544
+//!!!Der Shader muss dazu aktiviert sein!!!
545
+//@Name: Name der Variablen die gesetzt werden soll;
546
+//@count: Anzahl an Parametern auf die p1 zeigt;
547
+//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;
548
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
549
+function TglcShaderProgram.Uniform2fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;
550
+var
551
+  pos: GLint;
552
+begin
553
+  result := GetUniformLocation(aName, pos);
554
+  if result then
555
+    glUniform2fv(pos, aCount, aP1);
556
+end;
557
+
558
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
559
+//übergibt einen oder mehrere 3-Komponenten Float-Vektoren an den Shader
560
+//!!!Der Shader muss dazu aktiviert sein!!!
561
+//@Name: Name der Variablen die gesetzt werden soll;
562
+//@count: Anzahl an Parametern auf die p1 zeigt;
563
+//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;
564
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
565
+function TglcShaderProgram.Uniform3fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;
566
+var
567
+  pos: GLint;
568
+begin
569
+  result := GetUniformLocation(aName, pos);
570
+  if result then
571
+    glUniform3fv(pos, aCount, aP1);
572
+end;
573
+
574
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
575
+//übergibt einen oder mehrere 4-Komponenten Float-Vektoren an den Shader
576
+//!!!Der Shader muss dazu aktiviert sein!!!
577
+//@Name: Name der Variablen die gesetzt werden soll;
578
+//@count: Anzahl an Parametern auf die p1 zeigt;
579
+//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;
580
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
581
+function TglcShaderProgram.Uniform4fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;
582
+var
583
+  pos: GLint;
584
+begin
585
+  result := GetUniformLocation(aName, pos);
586
+  if result then
587
+    glUniform4fv(pos, aCount, aP1);
588
+end;
589
+
590
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
591
+//übergibt einen oder mehrere 1-Komponenten Integer-Vektoren an den Shader
592
+//!!!Der Shader muss dazu aktiviert sein!!!
593
+//@Name: Name der Variablen die gesetzt werden soll;
594
+//@count: Anzahl an Parametern auf die p1 zeigt;
595
+//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;
596
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
597
+function TglcShaderProgram.Uniform1iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;
598
+var
599
+  pos: GLint;
600
+begin
601
+  result := GetUniformLocation(aName, pos);
602
+  if result then
603
+    glUniform1iv(pos, aCount, aP1);
604
+end;
605
+
606
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
607
+//übergibt einen oder mehrere 2-Komponenten Integer-Vektoren an den Shader
608
+//!!!Der Shader muss dazu aktiviert sein!!!
609
+//@Name: Name der Variablen die gesetzt werden soll;
610
+//@count: Anzahl an Parametern auf die p1 zeigt;
611
+//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;
612
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
613
+function TglcShaderProgram.Uniform2iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;
614
+var
615
+  pos: GLint;
616
+begin
617
+  result := GetUniformLocation(aName, pos);
618
+  if result then
619
+    glUniform2iv(pos, aCount, aP1);
620
+end;
621
+
622
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
623
+//übergibt einen oder mehrere 3-Komponenten Integer-Vektoren an den Shader
624
+//!!!Der Shader muss dazu aktiviert sein!!!
625
+//@Name: Name der Variablen die gesetzt werden soll;
626
+//@count: Anzahl an Parametern auf die p1 zeigt;
627
+//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;
628
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
629
+function TglcShaderProgram.Uniform3iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;
630
+var
631
+  pos: GLint;
632
+begin
633
+  result := GetUniformLocation(aName, pos);
634
+  if result then
635
+    glUniform3iv(pos, aCount, aP1);
636
+end;
637
+
638
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
639
+//übergibt einen oder mehrere 4-Komponenten Integer-Vektoren an den Shader
640
+//!!!Der Shader muss dazu aktiviert sein!!!
641
+//@Name: Name der Variablen die gesetzt werden soll;
642
+//@count: Anzahl an Parametern auf die p1 zeigt;
643
+//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;
644
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
645
+function TglcShaderProgram.Uniform4iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;
646
+var
647
+  pos: GLint;
648
+begin
649
+  result := GetUniformLocation(aName, pos);
650
+  if result then
651
+    glUniform4iv(pos, aCount, aP1) ;
652
+end;
653
+
654
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
655
+//übergibt eine oder mehrere 2x2-Matrizen an den Shader
656
+//!!!Der Shader muss dazu aktiviert sein!!!
657
+//@Name: Name der Variablen die gesetzt werden soll;
658
+//@Transpose: wenn TRUe wird die matrix vor der Übergabe transponiert;
659
+//@Count: Anzahl der zu übergebenden Elemente;
660
+//@p1: Wert der Variable, der gesetzt werden soll;
661
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
662
+function TglcShaderProgram.UniformMatrix2fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix2f): Boolean;
663
+var
664
+  pos: GLint;
665
+begin
666
+  result := GetUniformLocation(aName, pos);
667
+  if result then
668
+    glUniformMatrix2fv(pos, aCount, aTranspose, PGLfloat(aP1));
669
+end;
670
+
671
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
672
+//übergibt eine oder mehrere 3x3-Matrizen an den Shader
673
+//!!!Der Shader muss dazu aktiviert sein!!!
674
+//@Name: Name der Variablen die gesetzt werden soll;
675
+//@Transpose: wenn TRUe wird die matrix vor der Übergabe transponiert;
676
+//@Count: Anzahl der zu übergebenden Elemente;
677
+//@p1: Wert der Variable, der gesetzt werden soll;
678
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
679
+function TglcShaderProgram.UniformMatrix3fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix3f): Boolean;
680
+var
681
+  pos: GLint;
682
+begin
683
+  result := GetUniformLocation(aName, pos);
684
+  if result then
685
+    glUniformMatrix3fv(pos, aCount, aTranspose, PGLfloat(aP1));
686
+end;
687
+
688
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
689
+//übergibt eine oder mehrere 4x4-Matrizen an den Shader
690
+//!!!Der Shader muss dazu aktiviert sein!!!
691
+//@Name: Name der Variablen die gesetzt werden soll;
692
+//@Transpose: wenn TRUe wird die matrix vor der Übergabe transponiert;
693
+//@Count: Anzahl der zu übergebenden Elemente;
694
+//@p1: Wert der Variable, der gesetzt werden soll;
695
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
696
+function TglcShaderProgram.UniformMatrix4fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix4f): Boolean;
697
+var
698
+  pos: GLint;
699
+begin
700
+  result := GetUniformLocation(aName, pos);
701
+  if result then
702
+    glUniformMatrix4fv(pos, aCount, aTranspose, PGLfloat(aP1));
703
+end;
704
+
705
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
706
+//holt den Wert einer Float-Uniform-Variable aus dem Shader
707
+//!!!Der Shader muss dazu aktiviert sein!!!
708
+//@Name: Name der Variablen die gelesen werden soll;
709
+//@p: Zeiger auf die Variable, in die der gelesene Wert geschrieben werden soll;
710
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
711
+function TglcShaderProgram.GetUniformfv(const aName: String; aP: PGLfloat): Boolean;
712
+var
713
+  pos: GLint;
714
+begin
715
+  result := GetUniformLocation(aName, pos);
716
+  if result then
717
+    glGetUniformfv(fProgramObj, pos, aP);
718
+end;
719
+
720
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
721
+//holt den Wert einer Integer-Uniform-Variable aus dem Shader
722
+//!!!Der Shader muss dazu aktiviert sein!!!
723
+//@Name: Name der Variablen die gelesen werden soll;
724
+//@p: Zeiger auf die Variable, in die der gelesene Wert geschrieben werden soll;
725
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
726
+function TglcShaderProgram.GetUniformfi(const aName: String; aP: PGLint): Boolean;
727
+var
728
+  pos: GLint;
729
+begin
730
+  result := GetUniformLocation(aName, pos);
731
+  if result then
732
+    glGetUniformiv(fProgramObj, pos, aP);
733
+end;
734
+
735
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
736
+function TglcShaderProgram.HasUniform(const aName: String): Boolean;
737
+var
738
+  pos: GLint;
739
+begin
740
+  result := GetUniformLocation(aName, pos);
741
+end;
742
+
743
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
744
+//läd den Shader aus einer Datei
745
+//@Filename: Datei aus der gelesen werden soll;
746
+//@raise: EglcShader, wenn Datei nicht vorhanden ist;
747
+procedure TglcShaderProgram.LoadFromFile(const aFilename: String);
748
+var
749
+  Stream: TFileStream;
750
+begin
751
+  if FileExists(aFilename) then begin
752
+    Stream := TFileStream.Create(aFilename, fmOpenRead);
753
+    try
754
+      LoadFromStream(Stream);
755
+      fFilename := aFilename;
756
+    finally
757
+      Stream.Free;
758
+    end;
759
+  end else raise EglcShader.Create('TglShaderProgram.LoadFromFile - file not found: '+Filename);
760
+end;
761
+
762
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
763
+//läd den Shader aus einem Stream
764
+//@Stream: Stream aus dem gelesen werden soll;
765
+//@raise: EglcShader wenn kein Stream-Objekt übergeben wurde;
766
+procedure TglcShaderProgram.LoadFromStream(const aStream: TStream);
767
+
768
+  function GetShaderType(const aStr: String): TglcShaderType;
769
+  begin
770
+    if (aStr = 'GL_VERTEX_SHADER') then
771
+      result := TglcShaderType.stVertex
772
+    else if (aStr = 'GL_FRAGMENT_SHADER') then
773
+      result := TglcShaderType.stFragment
774
+    else if (aStr = 'GL_GEOMETRY_SHADER') then
775
+      result := TglcShaderType.stGeometry
776
+    else if (aStr = 'GL_TESS_CONTROL_SHADER') then
777
+      result := TglcShaderType.stTessControl
778
+    else if (aStr = 'GL_TESS_EVALUATION_SHADER') then
779
+      result := TglcShaderType.stTessEvaluation
780
+    else
781
+      raise Exception.Create('invalid shader type: ' + aStr);
782
+  end;
783
+
784
+var
785
+  sl: TStringList;
786
+  s: String;
787
+  rx: TRegExpr;
788
+  LastMatchPos: PtrInt;
789
+  st: TglcShaderType;
790
+  o: TglcShaderObject;
791
+
792
+  procedure AddObj(const aPos: Integer);
793
+  begin
794
+    if (LastMatchPos > 0) then begin
795
+      o := TglcShaderObject.Create(st, fOnLog);
796
+      o.Code := Trim(Copy(s, LastMatchPos, aPos - LastMatchPos));
797
+      Add(o);
798
+    end;
799
+  end;
800
+
801
+begin
802
+  if not Assigned(aStream) then
803
+    raise EglcShader.Create('TglShaderProgram.SaveToStream - stream is nil');
804
+
805
+  Clear;
806
+  sl := TStringList.Create;
807
+  rx := TRegExpr.Create;
808
+  try
809
+    sl.LoadFromStream(aStream);
810
+    s := sl.Text;
811
+    LastMatchPos := 0;
812
+    rx.Expression  := '/\*\s*ShaderObject\s*:\s*(GL_[A-Z_]+)\s*\*/\s*$?';
813
+    rx.InputString := s;
814
+
815
+    while rx.Exec(LastMatchPos+1) do begin
816
+      AddObj(rx.MatchPos[0]);
817
+      LastMatchPos := rx.MatchPos[0] + rx.MatchLen[0];
818
+      st := GetShaderType(rx.Match[1]);
819
+    end;
820
+    AddObj(Length(s));
821
+  finally
822
+    rx.Free;
823
+    sl.Free;
824
+  end;
825
+
826
+
827
+  {
828
+  if Assigned(aStream) then begin
829
+    Clear;
830
+    fFilename := '';
831
+    reader := TutlStreamReader.Create(aStream);
832
+    try
833
+      if reader.ReadAnsiString <> GLSL_FILE_HEADER then
834
+        raise EglcShader.Create('TglShaderProgram.SaveToStream - incompatible file');
835
+      v := reader.ReadInteger;
836
+
837
+      if v >= 100 then begin //version 1.00
838
+        c := reader.ReadInteger;
839
+        for i := 0 to c-1 do begin
840
+          Add(TglcShaderObject.Create(Cardinal(reader.ReadInteger), fOnLog));
841
+          Last.fCode := reader.ReadAnsiString;
842
+        end;
843
+      end;
844
+    finally
845
+      reader.Free;
846
+    end;
847
+  end else
848
+  }
849
+end;
850
+
851
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
852
+//speichert den Shader in einer Datei
853
+//@Filename: Datei in die geschrieben werden soll;
854
+procedure TglcShaderProgram.SaveToFile(const aFilename: String);
855
+var
856
+  Stream: TFileStream;
857
+begin
858
+  Stream := TFileStream.Create(aFilename, fmCreate);
859
+  try
860
+    SaveToStream(Stream);
861
+    fFilename := aFilename;
862
+  finally
863
+    Stream.Free;
864
+  end;
865
+end;
866
+
867
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
868
+//speichert den Shader in einen Stream
869
+//@Stream: Stream in den geschrieben werden soll;
870
+//@raise: EglcShader wenn kein Stream-Objekt übergeben wurde;
871
+//@raise: EglcShader wenn ungültige Datei;
872
+procedure TglcShaderProgram.SaveToStream(const aStream: TStream);
873
+var
874
+  i: Integer;
875
+  sl: TStringList;
876
+  sObj: TglcShaderObject;
877
+
878
+  function GetShaderTypeStr(const aShaderType: TglcShaderType): String;
879
+  begin
880
+    case aShaderType of
881
+      TglcShaderType.stVertex:          result := 'GL_VERTEX_SHADER';
882
+      TglcShaderType.stFragment:        result := 'GL_FRAGMENT_SHADER';
883
+      TglcShaderType.stGeometry:        result := 'GL_GEOMETRY_SHADER';
884
+      TglcShaderType.stTessControl:     result := 'GL_TESS_CONTROL_SHADER';
885
+      TglcShaderType.stTessEvaluation:  result := 'GL_TESS_EVALUATION_SHADER';
886
+    else
887
+      result := 'UNKNOWN';
888
+    end;
889
+  end;
890
+
891
+begin
892
+  if not Assigned(aStream) then
893
+    raise EglcShader.Create('TglShaderProgram.LoadFromStream - stream is nil');
894
+  fFilename := '';
895
+  sl := TStringList.Create;
896
+  try
897
+    for i := 0 to Count-1 do begin
898
+      sObj := Items[i];
899
+      sl.Add('/* ShaderObject: ' + GetShaderTypeStr(sObj.ShaderType) + ' */');
900
+      sl.Add(sObj.Code);
901
+    end;
902
+    sl.SaveToStream(aStream);
903
+  finally
904
+    sl.Free;
905
+  end;
906
+end;
907
+
908
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
909
+//erzeugt das Objekt
910
+//@LogEvent: Event zum loggen von Fehlern und Ereignissen;
911
+//@raise: EglcShader wenn OpenGL nicht initialisiert werden konnte;
912
+//@raise:
913
+constructor TglcShaderProgram.Create(aLogEvent: TglcShaderLogEvent);
914
+begin
915
+  inherited Create;
916
+  fOnLog      := aLogEvent;
917
+  fFilename   := '';
918
+  fProgramObj := 0;
919
+end;
920
+
921
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
922
+//gibt das Objekt frei
923
+destructor TglcShaderProgram.Destroy;
924
+begin
925
+  if (fProgramObj <> 0) then
926
+    glDeleteProgram(fProgramObj);
927
+  inherited Destroy;
928
+end;
929
+
930
+end.
931
+

+ 318 - 0
uglcTypes.pas

@@ -0,0 +1,318 @@
1
+unit uglcTypes;
2
+
3
+{ Package:      OpenGLCore
4
+  Prefix:       glc - OpenGL Core
5
+  Beschreibung: diese Unit definiert Enum-Typen die OpenGL Konstanten wrappen und stellt zusätzlich
6
+                Funktions-Wrapper zur verfügung die diese Enum-Typen als Parameter entgegen nehmen }
7
+
8
+{$mode objfpc}{$H+}
9
+{$MACRO ON}
10
+{$SCOPEDENUMS ON}
11
+
12
+interface
13
+
14
+uses
15
+  dglOpenGL, sysutils;
16
+
17
+type
18
+  TglcFace = (
19
+    faFront = GL_FRONT,
20
+    faBack  = GL_BACK,
21
+    faBoth  = GL_FRONT_AND_BACK);
22
+
23
+  TglcPolygonMode = (
24
+    pmPoint = GL_POINT,
25
+    pmLine  = GL_LINE,
26
+    pmFill  = GL_FILL);
27
+
28
+  TglcDepthFunc = (
29
+    dfNever         = GL_NEVER,
30
+    dfLess          = GL_LESS,
31
+    dfEqual         = GL_EQUAL,
32
+    dfLessEqual     = GL_LEQUAL,
33
+    dfGreater       = GL_GREATER,
34
+    dfNotEqual      = GL_NOTEQUAL,
35
+    dfGreaterEqual  = GL_GEQUAL,
36
+    dfAlways        = GL_ALWAYS);
37
+
38
+  TglcClearBuffer = (
39
+    cbDepthBuffer   = GL_DEPTH_BUFFER_BIT,
40
+    cbAccumBuffer   = GL_ACCUM_BUFFER_BIT,
41
+    cbStencilBuffer = GL_STENCIL_BUFFER_BIT,
42
+    cbColorBuffer   = GL_COLOR_BUFFER_BIT);
43
+
44
+  TglcTextureMinFilter = (
45
+    mfNearest              = GL_NEAREST,
46
+    mfLinear               = GL_LINEAR,
47
+    mfNearestMipmapNearest = GL_NEAREST_MIPMAP_NEAREST,
48
+    mfLinearMipmapNearest  = GL_LINEAR_MIPMAP_NEAREST,
49
+    mfNearestMipmapLinear  = GL_NEAREST_MIPMAP_LINEAR,
50
+    mfLinearMipmapLinear   = GL_LINEAR_MIPMAP_LINEAR);
51
+
52
+  TglcTextureMagFilter = (
53
+    mfNearest = GL_NEAREST,
54
+    mfLinear  = GL_LINEAR);
55
+
56
+  TglcTextureWrap = (
57
+    twClamp          = GL_CLAMP,
58
+    twRepeat         = GL_REPEAT,
59
+    twClampToBorder  = GL_CLAMP_TO_BORDER,
60
+    twClampToEdge    = GL_CLAMP_TO_EDGE,
61
+    twMirroredRepeat = GL_MIRRORED_REPEAT);
62
+
63
+  TglcBlendFactor = (
64
+    bfZero               = GL_ZERO,
65
+    bfOne                = GL_ONE,
66
+    bfSrcColor           = GL_SRC_COLOR,
67
+    bfOneMinusSrcColor   = GL_ONE_MINUS_SRC_COLOR,
68
+    bfSrcAlpha           = GL_SRC_ALPHA,
69
+    bfOneMinusSrcAlpha   = GL_ONE_MINUS_SRC_ALPHA,
70
+    bfDstAlpha           = GL_DST_ALPHA,
71
+    bfOneMinusDstAlpha   = GL_ONE_MINUS_DST_ALPHA,
72
+    bfDstColor           = GL_DST_COLOR,
73
+    bfOneMinusDstColor   = GL_ONE_MINUS_DST_COLOR,
74
+    bfSrcAlphaSaturate   = GL_SRC_ALPHA_SATURATE,
75
+    bgConstColor         = GL_CONSTANT_COLOR,
76
+    bfOneMinusConstColor = GL_ONE_MINUS_CONSTANT_COLOR,
77
+    bfConstAlpha         = GL_CONSTANT_ALPHA,
78
+    bfOneMinusConstAlpha = GL_ONE_MINUS_CONSTANT_ALPHA);
79
+
80
+  TglcBlendMode = (
81
+    bmNone,
82
+    bmAlphaBlend,
83
+    bmAdditiveAlphaBlend,
84
+    bmAdditiveBlend);
85
+
86
+  TglcFormat = (
87
+    fmUnknown           = 0,
88
+    fmColorIndex        = GL_COLOR_INDEX,
89
+    fmDepthComponent    = GL_DEPTH_COMPONENT,
90
+    fmRed               = GL_RED,
91
+    fmGreen             = GL_GREEN,
92
+    fmBlue              = GL_BLUE,
93
+    fmAlpha             = GL_ALPHA,
94
+    fmRGB               = GL_RGB,
95
+    fmRGBA              = GL_RGBA,
96
+    fmLuminance         = GL_LUMINANCE,
97
+    fmLuminanceAlpha    = GL_LUMINANCE_ALPHA,
98
+    fmBGR               = GL_BGR,
99
+    fmBGRA              = GL_BGRA,
100
+    fmDepthStencil      = GL_DEPTH_STENCIL);
101
+
102
+  TglcInternalFormat = (
103
+    ifUnknown                   = 0,
104
+    ifDepthComponent            = GL_DEPTH_COMPONENT,
105
+    ifAlpha                     = GL_ALPHA,
106
+    ifRGB                       = GL_RGB,
107
+    ifRGBA                      = GL_RGBA,
108
+    ifLuminance                 = GL_LUMINANCE,
109
+    ifLuminanceAlpha            = GL_LUMINANCE_ALPHA,
110
+    ifR3G3B2                    = GL_R3_G3_B2,
111
+    ifAlpha4                    = GL_ALPHA4,
112
+    ifAlpha8                    = GL_ALPHA8,
113
+    ifAlpha12                   = GL_ALPHA12,
114
+    ifAlpha16                   = GL_ALPHA16,
115
+    ifLuminance4                = GL_LUMINANCE4,
116
+    ifLuminance8                = GL_LUMINANCE8,
117
+    ifLuminance12               = GL_LUMINANCE12,
118
+    ifLuminance16               = GL_LUMINANCE16,
119
+    ifLuminance4Alpha4          = GL_LUMINANCE4_ALPHA4,
120
+    ifLuminance6Alpha2          = GL_LUMINANCE6_ALPHA2,
121
+    ifLuminance8Alpha8          = GL_LUMINANCE8_ALPHA8,
122
+    ifLuminance12Alpha4         = GL_LUMINANCE12_ALPHA4,
123
+    ifLuminance12Alpha12        = GL_LUMINANCE12_ALPHA12,
124
+    ifLuminance16Alpha16        = GL_LUMINANCE16_ALPHA16,
125
+    ifIntensity                 = GL_INTENSITY,
126
+    ifIntensity4                = GL_INTENSITY4,
127
+    ifIntensity8                = GL_INTENSITY8,
128
+    ifIntensity12               = GL_INTENSITY12,
129
+    ifIntensity16               = GL_INTENSITY16,
130
+    ifRGB4                      = GL_RGB4,
131
+    ifRGB5                      = GL_RGB5,
132
+    ifRGB8                      = GL_RGB8,
133
+    ifRGB10                     = GL_RGB10,
134
+    ifRGB12                     = GL_RGB12,
135
+    ifRGB16                     = GL_RGB16,
136
+    ifRGBA2                     = GL_RGBA2,
137
+    ifRGBA4                     = GL_RGBA4,
138
+    ifRGB5A1                    = GL_RGB5_A1,
139
+    ifRGBA8                     = GL_RGBA8,
140
+    ifRGB10A2                   = GL_RGB10_A2,
141
+    ifRGBA12                    = GL_RGBA12,
142
+    ifRGBA16                    = GL_RGBA16,
143
+    ifDepthComponent16          = GL_DEPTH_COMPONENT16,
144
+    ifDepthComponent24          = GL_DEPTH_COMPONENT24,
145
+    ifDepthComponent32          = GL_DEPTH_COMPONENT32,
146
+    ifCompressedAlpha           = GL_COMPRESSED_ALPHA,
147
+    ifCompressedLuminance       = GL_COMPRESSED_LUMINANCE,
148
+    ifCompressedLuminanceAlpha  = GL_COMPRESSED_LUMINANCE_ALPHA,
149
+    ifCompressedIntensity       = GL_COMPRESSED_INTENSITY,
150
+    ifCompressedRGB             = GL_COMPRESSED_RGB,
151
+    ifCompressedRGBA            = GL_COMPRESSED_RGBA,
152
+    ifRGBA32f                   = GL_RGBA32F,
153
+    ifRGB32f                    = GL_RGB32F,
154
+    ifRGBA16F                   = GL_RGBA16F,
155
+    ifRGB16F                    = GL_RGB16F,
156
+    ifDepth24Stencil8           = GL_DEPTH24_STENCIL8,
157
+    ifSRGB                      = GL_SRGB,
158
+    ifSRGB8                     = GL_SRGB8,
159
+    ifSRGBA                     = GL_SRGB_ALPHA,
160
+    ifSRGBA8                    = GL_SRGB8_ALPHA8,
161
+    ifSLuminanceAlpha           = GL_SLUMINANCE_ALPHA,
162
+    ifSLuminance8Alpha8         = GL_SLUMINANCE8_ALPHA8,
163
+    ifSLuminance                = GL_SLUMINANCE,
164
+    ifSLuminance8               = GL_SLUMINANCE8,
165
+    ifDepth32fStencil8          = GL_DEPTH32F_STENCIL8,
166
+    ifStencil1                  = GL_STENCIL_INDEX1,
167
+    ifStencil4                  = GL_STENCIL_INDEX4,
168
+    ifStencil8                  = GL_STENCIL_INDEX8,
169
+    ifStencil16                 = GL_STENCIL_INDEX16);
170
+
171
+  TglcAttachment = (
172
+    atDepthStencil = GL_DEPTH_STENCIL_ATTACHMENT,
173
+    atColor0       = GL_COLOR_ATTACHMENT0,
174
+    atColor1       = GL_COLOR_ATTACHMENT1,
175
+    atColor2       = GL_COLOR_ATTACHMENT2,
176
+    atColor3       = GL_COLOR_ATTACHMENT3,
177
+    atColor4       = GL_COLOR_ATTACHMENT4,
178
+    atColor5       = GL_COLOR_ATTACHMENT5,
179
+    atColor6       = GL_COLOR_ATTACHMENT6,
180
+    atColor7       = GL_COLOR_ATTACHMENT7,
181
+    atColor8       = GL_COLOR_ATTACHMENT8,
182
+    atColor9       = GL_COLOR_ATTACHMENT9,
183
+    atColor10      = GL_COLOR_ATTACHMENT10,
184
+    atColor11      = GL_COLOR_ATTACHMENT11,
185
+    atColor12      = GL_COLOR_ATTACHMENT12,
186
+    atColor13      = GL_COLOR_ATTACHMENT13,
187
+    atColor14      = GL_COLOR_ATTACHMENT14,
188
+    atColor15      = GL_COLOR_ATTACHMENT15,
189
+    atDepth        = GL_DEPTH_ATTACHMENT,
190
+    atStencil      = GL_STENCIL_ATTACHMENT);
191
+
192
+  TglcShaderType = (
193
+    stFragment        = GL_FRAGMENT_SHADER,
194
+    stVertex          = GL_VERTEX_SHADER,
195
+    stGeometry        = GL_GEOMETRY_SHADER,
196
+    stTessEvaluation  = GL_TESS_EVALUATION_SHADER,
197
+    stTessControl     = GL_TESS_CONTROL_SHADER);
198
+
199
+  TglcBufferTarget = (
200
+    btArrayBuffer        = GL_ARRAY_BUFFER,
201
+    btElementArrayBuffer = GL_ELEMENT_ARRAY_BUFFER);
202
+
203
+  TglcBufferUsage = (
204
+    buStreamDraw  = GL_STREAM_DRAW,
205
+    buStreamRead  = GL_STREAM_READ,
206
+    buStreamCopy  = GL_STREAM_COPY,
207
+    buStaticDraw  = GL_STATIC_DRAW,
208
+    buStaticRead  = GL_STATIC_READ,
209
+    buStaticCopy  = GL_STATIC_COPY,
210
+    buDynamicDraw = GL_DYNAMIC_DRAW,
211
+    buDynamicRead = GL_DYNAMIC_READ,
212
+    buDynamicCopy = GL_DYNAMIC_COPY);
213
+
214
+  TglcBufferAccess = (
215
+    baReadOnly  = GL_READ_ONLY,
216
+    baWriteOnly = GL_WRITE_ONLY,
217
+    baReadWrite = GL_READ_WRITE);
218
+
219
+  EOpenGL = class(Exception)
220
+  private
221
+    fErrorCode: GLenum;
222
+  public
223
+    property ErrorCode: GLenum read fErrorCode;
224
+    constructor Create(const aErrorCode: GLenum);
225
+    constructor Create(const aMsg: String; const aErrorCode: GLenum);
226
+  end;
227
+
228
+procedure glcRenderFace(const aValue: TglcFace); inline;
229
+procedure glcPolygonMode(const aFace: TglcFace; const aValue: TglcPolygonMode); inline;
230
+procedure glcDepthFunc(const aValue: TglcDepthFunc); inline;
231
+procedure glcBlendFunc(const aSource, aDest: TglcBlendFactor); inline; overload;
232
+procedure glcBlendFunc(const aMode: TglcBlendMode); inline; overload;
233
+procedure glcCheckAndRaiseError;
234
+
235
+implementation
236
+
237
+type
238
+  TglcBlendModeValue = packed record
239
+    src, dst: TglcBlendFactor;
240
+  end;
241
+
242
+const
243
+  BLEND_MODE_VALUES: array[TglcBlendMode] of TglcBlendModeValue = (
244
+    (src: TglcBlendFactor.bfOne;         dst: TglcBlendFactor.bfZero),                        //bmNone
245
+    (src: TglcBlendFactor.bfSrcAlpha;    dst: TglcBlendFactor.bfOneMinusSrcAlpha),            //bmAlphaBlend
246
+    (src: TglcBlendFactor.bfSrcAlpha;    dst: TglcBlendFactor.bfOne),                         //bmAdditiveAlphaBlend
247
+    (src: TglcBlendFactor.bfOne;         dst: TglcBlendFactor.bfOne));                        //bmAdditiveBlend
248
+
249
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
250
+procedure glcRenderFace(const aValue: TglcFace);
251
+begin
252
+  case aValue of
253
+    TglcFace.faBoth: begin
254
+      glDisable(GL_CULL_FACE);
255
+    end;
256
+    TglcFace.faFront: begin
257
+      glEnable(GL_CULL_FACE);
258
+      glCullFace(GL_BACK);
259
+    end;
260
+    TglcFace.faBack: begin
261
+      glEnable(GL_CULL_FACE);
262
+      glCullFace(GL_FRONT);
263
+    end;
264
+  end;
265
+end;
266
+
267
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
268
+procedure glcPolygonMode(const aFace: TglcFace; const aValue: TglcPolygonMode);
269
+begin
270
+  glPolygonMode(GLenum(aFace), GLenum(aValue));
271
+end;
272
+
273
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
274
+procedure glcDepthFunc(const aValue: TglcDepthFunc);
275
+begin
276
+  glDepthFunc(GLenum(aValue));
277
+end;
278
+
279
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
280
+procedure glcBlendFunc(const aSource, aDest: TglcBlendFactor);
281
+begin
282
+  glBlendFunc(GLenum(aSource), GLenum(aDest));
283
+end;
284
+
285
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
286
+procedure glcBlendFunc(const aMode: TglcBlendMode); overload;
287
+begin
288
+  glBlendFunc(GLenum(BLEND_MODE_VALUES[aMode].src), GLenum(BLEND_MODE_VALUES[aMode].dst));
289
+end;
290
+
291
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
292
+procedure glcCheckAndRaiseError;
293
+var
294
+  e: GLenum;
295
+begin
296
+  e := glGetError();
297
+  if (e <> GL_NO_ERROR) then
298
+    raise EOpenGL.Create(e);
299
+end;
300
+
301
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
302
+//EOpenGL///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
303
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
304
+constructor EOpenGL.Create(const aErrorCode: GLenum);
305
+begin
306
+  fErrorCode := aErrorCode;
307
+  inherited Create(gluErrorString(fErrorCode));
308
+end;
309
+
310
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
311
+constructor EOpenGL.Create(const aMsg: String; const aErrorCode: GLenum);
312
+begin
313
+  fErrorCode := aErrorCode;
314
+  inherited Create(aMsg + ': ' + gluErrorString(fErrorCode))
315
+end;
316
+
317
+end.
318
+

+ 318 - 0
ugluMatrix.pas

@@ -0,0 +1,318 @@
1
+unit ugluMatrix;
2
+
3
+{ Package:      OpenGLCore
4
+  Prefix:       glu - OpenGL Utils
5
+  Beschreibung: diese Unit enthält Matrix-Typen und Methoden um diese zu erstellen und zu manipulieren }
6
+
7
+{$mode objfpc}{$H+}
8
+
9
+interface
10
+
11
+uses
12
+  Classes, SysUtils, ugluVector;
13
+
14
+type
15
+  //Matrixtypen
16
+  TgluMatrix2ub = array[0..1] of TgluVector2ub;
17
+  TgluMatrix2i  = array[0..1] of TgluVector2i;
18
+  TgluMatrix2f  = array[0..1] of TgluVector2f;
19
+  TgluMatrix2d  = array[0..1] of TgluVector2d;
20
+
21
+  TgluMatrix3ub = array[0..2] of TgluVector3ub;
22
+  TgluMatrix3i  = array[0..2] of TgluVector3i;
23
+  TgluMatrix3f  = array[0..2] of TgluVector3f;
24
+  TgluMatrix3d  = array[0..2] of TgluVector3d;
25
+
26
+  TgluMatrix4ub = array[0..3] of TgluVector4ub;
27
+  TgluMatrix4i  = array[0..3] of TgluVector4i;
28
+  TgluMatrix4f  = array[0..3] of TgluVector4f;
29
+  TgluMatrix4d  = array[0..3] of TgluVector4d;
30
+
31
+  //MatrixPointer
32
+  PgluMatrix2ub = ^TgluMatrix2ub;
33
+  PgluMatrix2i  = ^TgluMatrix2i;
34
+  PgluMatrix2f  = ^TgluMatrix2f;
35
+  PgluMatrix2d  = ^TgluMatrix2d;
36
+
37
+  PgluMatrix3ub = ^TgluMatrix3ub;
38
+  PgluMatrix3i  = ^TgluMatrix3i;
39
+  PgluMatrix3f  = ^TgluMatrix3f;
40
+  PgluMatrix3d  = ^TgluMatrix3d;
41
+
42
+  PgluMatrix4ub = ^TgluMatrix4ub;
43
+  PgluMatrix4i  = ^TgluMatrix4i;
44
+  PgluMatrix4f  = ^TgluMatrix4f;
45
+  PgluMatrix4d  = ^TgluMatrix4d;
46
+
47
+  //Konstructoren
48
+  function gluMatrix4d(const m: TgluMatrix4f): TgluMatrix4d;
49
+
50
+  //Matrixfunktionen
51
+  function gluMatrixTranslate(const v: TgluVector3f): TgluMatrix4f;
52
+  function gluMatrixScale(const v: TgluVector3f): TgluMatrix4f; overload;
53
+  function gluMatrixScale(const s: Single): TgluMatrix4f; overload;
54
+  function gluMatrixRotate(axis: TgluVector3f; const angle: Single): TgluMatrix4f;
55
+  function gluMatrixMult(const m1, m2: TgluMatrix4f): TgluMatrix4f;
56
+  function gluMatrixMultVec(const m: TgluMatrix4f; const v: TgluVector4f): TgluVector4f;
57
+  function gluMatrixTranspose(const m: TgluMatrix3f): TgluMatrix3f; overload;
58
+  function gluMatrixTranspose(const m: TgluMatrix4f): TgluMatrix4f; overload;
59
+  function gluMatrixSubMatrix(const m:TgluMatrix4f; const s, z: Integer): TgluMatrix3f;
60
+  function gluMatrixDeterminant(const m: TgluMatrix3f): Single; overload;
61
+  function gluMatrixDeterminant(const m: TgluMatrix4f): Single; overload;
62
+  function gluMatrixAdjoint(const m: TgluMatrix4f): TgluMatrix4f;
63
+  function gluMatrixInvert(const m: TgluMatrix4f): TgluMatrix4f;
64
+
65
+  operator * (const m1, m2: TgluMatrix4f): TgluMatrix4f;
66
+  operator * (const m: TgluMatrix4f; const v: TgluVector4f): TgluVector4f;
67
+  operator * (const m: TgluMatrix4f; const v: TgluVector3f): TgluVector3f;
68
+
69
+const
70
+  maAxisX = 0;
71
+  maAxisY = 1;
72
+  maAxisZ = 2;
73
+  maPos   = 3;
74
+  gluMatrixIdentity: TgluMatrix4f = ((1,0,0,0),(0,1,0,0),(0,0,1,0),(0,0,0,1));
75
+
76
+implementation
77
+
78
+uses
79
+  Math;
80
+
81
+operator * (const m1, m2: TgluMatrix4f): TgluMatrix4f;
82
+begin
83
+  result := gluMatrixMult(m1, m2);
84
+end;
85
+
86
+operator * (const m: TgluMatrix4f; const v: TgluVector4f): TgluVector4f;
87
+begin
88
+  result := gluMatrixMultVec(m, v);
89
+end;
90
+
91
+operator * (const m: TgluMatrix4f; const v: TgluVector3f): TgluVector3f;
92
+begin
93
+  result := gluVector3f(gluMatrixMultVec(m, gluVEctor4f(v, 1.0)));
94
+end;
95
+
96
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
97
+function gluMatrix4d(const m: TgluMatrix4f): TgluMatrix4d;
98
+var
99
+  i, j: Integer;
100
+begin
101
+  for i := 0 to 3 do
102
+    for j := 0 to 3 do
103
+      result[i, j] := m[i, j];
104
+end;
105
+
106
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
107
+//erstellt eine Translationsmatrix
108
+//@v: Vektor der Translationsmatrix;
109
+function gluMatrixTranslate(const v: TgluVector3f): TgluMatrix4f;
110
+var
111
+  i: Integer;
112
+begin
113
+  result := gluMatrixIdentity;
114
+  for i := 0 to 2 do
115
+    result[3, i] := v[i];
116
+end;