uglcShader.pas

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