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