uglcShader.pas

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