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