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