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
   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