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, dglOpenGL, uglcTypes, ugluMatrix, uglcContext;\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: GLHandle;\r
  71     fShaderType: TglcShaderType;\r
  72     fCode: String;\r
  73     fOnLog: TglcShaderLogEvent;\r
  74     fAttachedTo: TglcShaderProgram;\r
  75 \r
  76     function GetInfoLog(aObj: GLHandle): 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 : GLHandle           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: GLHandle;\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: GLHandle): 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: glHandle           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: GLHandle): 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: GLHandle): 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     if GL_LibHandle = nil then\r
 340       raise EglcShader.Create('TglShaderProgram.Create - OpenGL not initialized');\r
 341 \r
 342     if not TglcContext.IsAnyContextActive then\r
 343       raise EglcShader.Create('TglShaderProgram.Create - no valid render context');\r
 344 \r
 345     fProgramObj := glCreateProgram();\r
 346     Log('shader program created: #'+IntToHex(fProgramObj, 4));\r
 347   end;\r
 348 end;\r
 349 \r
 350 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 351 //ruft das Log-Event auf, wenn es gesetzt ist\r
 352 //@msg: Nachricht die geloggt werden soll;\r
 353 procedure TglcShaderProgram.Log(const msg: String);\r
 354 begin\r
 355   if Assigned(fOnLog) then begin\r
 356     fOnLog(self, msg);\r
 357   end;\r
 358 end;\r
 359 \r
 360 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 361 procedure TglcShaderProgram.AttachShaderObj(const aShaderObj: TglcShaderObject);\r
 362 begin\r
 363   CreateProgramObj;\r
 364   aShaderObj.AttachTo(self);\r
 365 end;\r
 366 \r
 367 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 368 //PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBL//\r
 369 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 370 //Kompiliert den Shader-Code\r
 371 procedure TglcShaderProgram.Compile;\r
 372 var\r
 373   i: Integer;\r
 374   l: TStringList;\r
 375 begin\r
 376   CreateProgramObj;\r
 377   for i := 0 to Count-1 do begin\r
 378     AttachShaderObj(Items[i]);\r
 379     Items[i].Compile;\r
 380   end;\r
 381   glLinkProgram(fProgramObj);\r
 382   l := TStringList.Create;\r
 383   l.Text := GetInfoLog(fProgramObj);\r
 384   for i := 0 to l.Count-1 do\r
 385     Log(l[i]);\r
 386   l.Free;\r
 387 end;\r
 388 \r
 389 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 390 //aktiviert den Shader\r
 391 procedure TglcShaderProgram.Enable;\r
 392 begin\r
 393   glUseProgram(fProgramObj);\r
 394 end;\r
 395 \r
 396 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 397 //deaktiviert den Shader\r
 398 procedure TglcShaderProgram.Disable;\r
 399 begin\r
 400   glUseProgram(0);\r
 401 end;\r
 402 \r
 403 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 404 //fügt der Liste einen Shader hinzu\r
 405 //@ShaderObj: Objekt, das hinzugefügt werden soll;\r
 406 procedure TglcShaderProgram.Add(aShaderObj: TglcShaderObject);\r
 407 begin\r
 408   inherited Add(aShaderObj);\r
 409   if (fProgramObj <> 0) then\r
 410     AttachShaderObj(aShaderObj);\r
 411 end;\r
 412 \r
 413 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 414 //löscht ein ShaderObjekt aus der Liste\r
 415 //@ID: Index des Objekts, das gelöscht werden soll;\r
 416 //@FreeOwnedObj: wenn TRUE wird das gelöschte Objekt freigegeben;\r
 417 procedure TglcShaderProgram.Delete(aID: Integer; aFreeOwnedObj: Boolean);\r
 418 var\r
 419   b: Boolean;\r
 420 begin\r
 421   if (aID >= 0) and (aID < Count) and (fProgramObj <> 0) then begin\r
 422     glDetachShader(fProgramObj, Items[aID].fShaderObj);\r
 423     Items[aID].fAttachedTo := nil;\r
 424   end;\r
 425   b := FreeObjects;\r
 426   FreeObjects := aFreeOwnedObj;\r
 427   inherited Delete(aID);\r
 428   FreeObjects := b;\r
 429 end;\r
 430 \r
 431 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 432 procedure TglcShaderProgram.Clear;\r
 433 begin\r
 434   while (Count > 0) do\r
 435     Delete(0);\r
 436 end;\r
 437 \r
 438 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 439 //übergibt einen 1-Komponenten Float-Vektoren an den Shader\r
 440 //!!!Der Shader muss dazu aktiviert sein!!!\r
 441 //@Name: Name der Variablen die gesetzt werden soll;\r
 442 //@p1: Wert der Variable, der gesetzt werden soll;\r
 443 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 444 function TglcShaderProgram.Uniform1f(const aName: String; aP1: GLFloat): Boolean;\r
 445 var\r
 446   pos: GLint;\r
 447 begin\r
 448   result := GetUniformLocation(aName, pos);\r
 449   if result then\r
 450     glUniform1f(pos, aP1);\r
 451 end;\r
 452 \r
 453 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 454 //übergibt einen 2-Komponenten Float-Vektoren an den Shader\r
 455 //!!!Der Shader muss dazu aktiviert sein!!!\r
 456 //@Name: Name der Variablen die gesetzt werden soll;\r
 457 //@p1: Wert der Variable, der gesetzt werden soll;\r
 458 //@p2: Wert der Variable, der gesetzt werden soll;\r
 459 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 460 function TglcShaderProgram.Uniform2f(const aName: String; aP1, aP2: GLFloat): Boolean;\r
 461 var\r
 462   pos: GLint;\r
 463 begin\r
 464   result := GetUniformLocation(aName, pos);\r
 465   if result then\r
 466     glUniform2f(pos, aP1, aP2);\r
 467 end;\r
 468 \r
 469 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 470 //übergibt einen 3-Komponenten Float-Vektoren an den Shader\r
 471 //!!!Der Shader muss dazu aktiviert sein!!!\r
 472 //@Name: Name der Variablen die gesetzt werden soll;\r
 473 //@p1: Wert der Variable, der gesetzt werden soll;\r
 474 //@p2: Wert der Variable, der gesetzt werden soll;\r
 475 //@p3: Wert der Variable, der gesetzt werden soll;\r
 476 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 477 function TglcShaderProgram.Uniform3f(const aName: String; aP1, aP2, aP3: GLFloat): Boolean;\r
 478 var\r
 479   pos: GLint;\r
 480 begin\r
 481   result := GetUniformLocation(aName, pos);\r
 482   if result then\r
 483     glUniform3f(pos, aP1, aP2, aP3);\r
 484 end;\r
 485 \r
 486 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 487 //übergibt einen 4-Komponenten Float-Vektoren an den Shader\r
 488 //!!!Der Shader muss dazu aktiviert sein!!!\r
 489 //@Name: Name der Variablen die gesetzt werden soll;\r
 490 //@p1: Wert der Variable, der gesetzt werden soll;\r
 491 //@p2: Wert der Variable, der gesetzt werden soll;\r
 492 //@p3: Wert der Variable, der gesetzt werden soll;\r
 493 //@p4: Wert der Variable, der gesetzt werden soll;\r
 494 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 495 function TglcShaderProgram.Uniform4f(const aName: String; aP1, aP2, aP3, aP4: GLFloat): Boolean;\r
 496 var\r
 497   pos: GLint;\r
 498 begin\r
 499   result := GetUniformLocation(aName, pos);\r
 500   if result then\r
 501     glUniform4f(pos, aP1, aP2, aP3, aP4);\r
 502 end;\r
 503 \r
 504 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 505 //übergibt einen 1-Komponenten Integer-Vektoren an den Shader\r
 506 //!!!Der Shader muss dazu aktiviert sein!!!\r
 507 //@Name: Name der Variablen die gesetzt werden soll;\r
 508 //@p1: Wert der Variable, der gesetzt werden soll;\r
 509 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 510 function TglcShaderProgram.Uniform1i(const aName: String; aP1: GLint): Boolean;\r
 511 var\r
 512   pos: GLint;\r
 513 begin\r
 514   result := GetUniformLocation(aName, pos);\r
 515   if result then\r
 516     glUniform1i(pos, aP1);\r
 517 end;\r
 518 \r
 519 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 520 //übergibt einen 2-Komponenten Integer-Vektoren an den Shader\r
 521 //!!!Der Shader muss dazu aktiviert sein!!!\r
 522 //@Name: Name der Variablen die gesetzt werden soll;\r
 523 //@p1: Wert der Variable, der gesetzt werden soll;\r
 524 //@p1: Wert der Variable, der gesetzt werden soll;\r
 525 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 526 function TglcShaderProgram.Uniform2i(const aName: String; aP1, aP2: GLint): Boolean;\r
 527 var\r
 528   pos: GLint;\r
 529 begin\r
 530   result := GetUniformLocation(aName, pos);\r
 531   if result then\r
 532     glUniform2i(pos, aP1, aP2);\r
 533 end;\r
 534 \r
 535 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 536 //übergibt einen 3-Komponenten Integer-Vektoren an den Shader\r
 537 //!!!Der Shader muss dazu aktiviert sein!!!\r
 538 //@Name: Name der Variablen die gesetzt werden soll;\r
 539 //@p1: Wert der Variable, der gesetzt werden soll;\r
 540 //@p2: Wert der Variable, der gesetzt werden soll;\r
 541 //@p3: Wert der Variable, der gesetzt werden soll;\r
 542 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 543 function TglcShaderProgram.Uniform3i(const aName: String; aP1, aP2, aP3: GLint): Boolean;\r
 544 var\r
 545   pos: GLint;\r
 546 begin\r
 547   result := GetUniformLocation(aName, pos);\r
 548   if result then\r
 549     glUniform3i(pos, aP1, aP2, aP3);\r
 550 end;\r
 551 \r
 552 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 553 //übergibt einen 4-Komponenten Integer-Vektoren an den Shader\r
 554 //!!!Der Shader muss dazu aktiviert sein!!!\r
 555 //@Name: Name der Variablen die gesetzt werden soll;\r
 556 //@p1: Wert der Variable, der gesetzt werden soll;\r
 557 //@p2: Wert der Variable, der gesetzt werden soll;\r
 558 //@p3: Wert der Variable, der gesetzt werden soll;\r
 559 //@p4: Wert der Variable, der gesetzt werden soll;\r
 560 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 561 function TglcShaderProgram.Uniform4i(const aName: String; aP1, aP2, aP3, aP4: GLint): Boolean;\r
 562 var\r
 563   pos: GLint;\r
 564 begin\r
 565   result := GetUniformLocation(aName, pos);\r
 566   if result then\r
 567     glUniform4i(pos, aP1, aP2, aP3, aP4);\r
 568 end;\r
 569 \r
 570 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 571 //übergibt einen oder mehrere 1-Komponenten Float-Vektoren an den Shader\r
 572 //!!!Der Shader muss dazu aktiviert sein!!!\r
 573 //@Name: Name der Variablen die gesetzt werden soll;\r
 574 //@count: Anzahl an Parametern auf die p1 zeigt;\r
 575 //@p1: Zeiger auf den ersten Wert der gesetzt werden soll;\r
 576 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 577 function TglcShaderProgram.Uniform1fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;\r
 578 var\r
 579   pos: GLint;\r
 580 begin\r
 581   result := GetUniformLocation(aName, pos);\r
 582   if result then\r
 583     glUniform1fv(pos, aCount, aP1);\r
 584 end;\r
 585 \r
 586 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 587 //übergibt einen oder mehrere 2-Komponenten Float-Vektoren an den Shader\r
 588 //!!!Der Shader muss dazu aktiviert sein!!!\r
 589 //@Name: Name der Variablen die gesetzt werden soll;\r
 590 //@count: Anzahl an Parametern auf die p1 zeigt;\r
 591 //@p1: Zeiger auf den ersten Wert der gesetzt werden soll;\r
 592 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 593 function TglcShaderProgram.Uniform2fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;\r
 594 var\r
 595   pos: GLint;\r
 596 begin\r
 597   result := GetUniformLocation(aName, pos);\r
 598   if result then\r
 599     glUniform2fv(pos, aCount, aP1);\r
 600 end;\r
 601 \r
 602 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 603 //übergibt einen oder mehrere 3-Komponenten Float-Vektoren an den Shader\r
 604 //!!!Der Shader muss dazu aktiviert sein!!!\r
 605 //@Name: Name der Variablen die gesetzt werden soll;\r
 606 //@count: Anzahl an Parametern auf die p1 zeigt;\r
 607 //@p1: Zeiger auf den ersten Wert der gesetzt werden soll;\r
 608 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 609 function TglcShaderProgram.Uniform3fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;\r
 610 var\r
 611   pos: GLint;\r
 612 begin\r
 613   result := GetUniformLocation(aName, pos);\r
 614   if result then\r
 615     glUniform3fv(pos, aCount, aP1);\r
 616 end;\r
 617 \r
 618 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 619 //übergibt einen oder mehrere 4-Komponenten Float-Vektoren an den Shader\r
 620 //!!!Der Shader muss dazu aktiviert sein!!!\r
 621 //@Name: Name der Variablen die gesetzt werden soll;\r
 622 //@count: Anzahl an Parametern auf die p1 zeigt;\r
 623 //@p1: Zeiger auf den ersten Wert der gesetzt werden soll;\r
 624 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 625 function TglcShaderProgram.Uniform4fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;\r
 626 var\r
 627   pos: GLint;\r
 628 begin\r
 629   result := GetUniformLocation(aName, pos);\r
 630   if result then\r
 631     glUniform4fv(pos, aCount, aP1);\r
 632 end;\r
 633 \r
 634 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 635 //übergibt einen oder mehrere 1-Komponenten Integer-Vektoren an den Shader\r
 636 //!!!Der Shader muss dazu aktiviert sein!!!\r
 637 //@Name: Name der Variablen die gesetzt werden soll;\r
 638 //@count: Anzahl an Parametern auf die p1 zeigt;\r
 639 //@p1: Zeiger auf den ersten Wert der gesetzt werden soll;\r
 640 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 641 function TglcShaderProgram.Uniform1iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;\r
 642 var\r
 643   pos: GLint;\r
 644 begin\r
 645   result := GetUniformLocation(aName, pos);\r
 646   if result then\r
 647     glUniform1iv(pos, aCount, aP1);\r
 648 end;\r
 649 \r
 650 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 651 //übergibt einen oder mehrere 2-Komponenten Integer-Vektoren an den Shader\r
 652 //!!!Der Shader muss dazu aktiviert sein!!!\r
 653 //@Name: Name der Variablen die gesetzt werden soll;\r
 654 //@count: Anzahl an Parametern auf die p1 zeigt;\r
 655 //@p1: Zeiger auf den ersten Wert der gesetzt werden soll;\r
 656 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 657 function TglcShaderProgram.Uniform2iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;\r
 658 var\r
 659   pos: GLint;\r
 660 begin\r
 661   result := GetUniformLocation(aName, pos);\r
 662   if result then\r
 663     glUniform2iv(pos, aCount, aP1);\r
 664 end;\r
 665 \r
 666 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 667 //übergibt einen oder mehrere 3-Komponenten Integer-Vektoren an den Shader\r
 668 //!!!Der Shader muss dazu aktiviert sein!!!\r
 669 //@Name: Name der Variablen die gesetzt werden soll;\r
 670 //@count: Anzahl an Parametern auf die p1 zeigt;\r
 671 //@p1: Zeiger auf den ersten Wert der gesetzt werden soll;\r
 672 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 673 function TglcShaderProgram.Uniform3iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;\r
 674 var\r
 675   pos: GLint;\r
 676 begin\r
 677   result := GetUniformLocation(aName, pos);\r
 678   if result then\r
 679     glUniform3iv(pos, aCount, aP1);\r
 680 end;\r
 681 \r
 682 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 683 //übergibt einen oder mehrere 4-Komponenten Integer-Vektoren an den Shader\r
 684 //!!!Der Shader muss dazu aktiviert sein!!!\r
 685 //@Name: Name der Variablen die gesetzt werden soll;\r
 686 //@count: Anzahl an Parametern auf die p1 zeigt;\r
 687 //@p1: Zeiger auf den ersten Wert der gesetzt werden soll;\r
 688 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 689 function TglcShaderProgram.Uniform4iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;\r
 690 var\r
 691   pos: GLint;\r
 692 begin\r
 693   result := GetUniformLocation(aName, pos);\r
 694   if result then\r
 695     glUniform4iv(pos, aCount, aP1) ;\r
 696 end;\r
 697 \r
 698 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 699 //übergibt eine oder mehrere 2x2-Matrizen an den Shader\r
 700 //!!!Der Shader muss dazu aktiviert sein!!!\r
 701 //@Name: Name der Variablen die gesetzt werden soll;\r
 702 //@Transpose: wenn TRUe wird die matrix vor der Übergabe transponiert;\r
 703 //@Count: Anzahl der zu übergebenden Elemente;\r
 704 //@p1: Wert der Variable, der gesetzt werden soll;\r
 705 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 706 function TglcShaderProgram.UniformMatrix2fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix2f): Boolean;\r
 707 var\r
 708   pos: GLint;\r
 709 begin\r
 710   result := GetUniformLocation(aName, pos);\r
 711   if result then\r
 712     glUniformMatrix2fv(pos, aCount, aTranspose, PGLfloat(aP1));\r
 713 end;\r
 714 \r
 715 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 716 //übergibt eine oder mehrere 3x3-Matrizen an den Shader\r
 717 //!!!Der Shader muss dazu aktiviert sein!!!\r
 718 //@Name: Name der Variablen die gesetzt werden soll;\r
 719 //@Transpose: wenn TRUe wird die matrix vor der Übergabe transponiert;\r
 720 //@Count: Anzahl der zu übergebenden Elemente;\r
 721 //@p1: Wert der Variable, der gesetzt werden soll;\r
 722 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 723 function TglcShaderProgram.UniformMatrix3fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix3f): Boolean;\r
 724 var\r
 725   pos: GLint;\r
 726 begin\r
 727   result := GetUniformLocation(aName, pos);\r
 728   if result then\r
 729     glUniformMatrix3fv(pos, aCount, aTranspose, PGLfloat(aP1));\r
 730 end;\r
 731 \r
 732 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 733 //übergibt eine oder mehrere 4x4-Matrizen an den Shader\r
 734 //!!!Der Shader muss dazu aktiviert sein!!!\r
 735 //@Name: Name der Variablen die gesetzt werden soll;\r
 736 //@Transpose: wenn TRUe wird die matrix vor der Übergabe transponiert;\r
 737 //@Count: Anzahl der zu übergebenden Elemente;\r
 738 //@p1: Wert der Variable, der gesetzt werden soll;\r
 739 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 740 function TglcShaderProgram.UniformMatrix4fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix4f): Boolean;\r
 741 var\r
 742   pos: GLint;\r
 743 begin\r
 744   result := GetUniformLocation(aName, pos);\r
 745   if result then\r
 746     glUniformMatrix4fv(pos, aCount, aTranspose, PGLfloat(aP1));\r
 747 end;\r
 748 \r
 749 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 750 //holt den Wert einer Float-Uniform-Variable aus dem Shader\r
 751 //!!!Der Shader muss dazu aktiviert sein!!!\r
 752 //@Name: Name der Variablen die gelesen werden soll;\r
 753 //@p: Zeiger auf die Variable, in die der gelesene Wert geschrieben werden soll;\r
 754 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 755 function TglcShaderProgram.GetUniformfv(const aName: String; aP: PGLfloat): Boolean;\r
 756 var\r
 757   pos: GLint;\r
 758 begin\r
 759   result := GetUniformLocation(aName, pos);\r
 760   if result then\r
 761     glGetUniformfv(fProgramObj, pos, aP);\r
 762 end;\r
 763 \r
 764 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 765 //holt den Wert einer Integer-Uniform-Variable aus dem Shader\r
 766 //!!!Der Shader muss dazu aktiviert sein!!!\r
 767 //@Name: Name der Variablen die gelesen werden soll;\r
 768 //@p: Zeiger auf die Variable, in die der gelesene Wert geschrieben werden soll;\r
 769 //@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
 770 function TglcShaderProgram.GetUniformfi(const aName: String; aP: PGLint): Boolean;\r
 771 var\r
 772   pos: GLint;\r
 773 begin\r
 774   result := GetUniformLocation(aName, pos);\r
 775   if result then\r
 776     glGetUniformiv(fProgramObj, pos, aP);\r
 777 end;\r
 778 \r
 779 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 780 function TglcShaderProgram.HasUniform(const aName: String): Boolean;\r
 781 var\r
 782   pos: GLint;\r
 783 begin\r
 784   result := GetUniformLocation(aName, pos);\r
 785 end;\r
 786 \r
 787 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 788 //läd den Shader aus einer Datei\r
 789 //@Filename: Datei aus der gelesen werden soll;\r
 790 //@raise: EglcShader, wenn Datei nicht vorhanden ist;\r
 791 procedure TglcShaderProgram.LoadFromFile(const aFilename: String);\r
 792 var\r
 793   Stream: TFileStream;\r
 794 begin\r
 795   if FileExists(aFilename) then begin\r
 796     Stream := TFileStream.Create(aFilename, fmOpenRead);\r
 797     try\r
 798       LoadFromStream(Stream);\r
 799       fFilename := aFilename;\r
 800     finally\r
 801       Stream.Free;\r
 802     end;\r
 803   end else raise EglcShader.Create('TglShaderProgram.LoadFromFile - file not found: '+Filename);\r
 804 end;\r
 805 \r
 806 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 807 //läd den Shader aus einem Stream\r
 808 //@Stream: Stream aus dem gelesen werden soll;\r
 809 //@raise: EglcShader wenn kein Stream-Objekt übergeben wurde;\r
 810 procedure TglcShaderProgram.LoadFromStream(const aStream: TStream);\r
 811 \r
 812   function GetShaderType(const aStr: String): TglcShaderType;\r
 813   begin\r
 814     if (aStr = 'GL_VERTEX_SHADER') then\r
 815       result := TglcShaderType.stVertex\r
 816     else if (aStr = 'GL_FRAGMENT_SHADER') then\r
 817       result := TglcShaderType.stFragment\r
 818     else if (aStr = 'GL_GEOMETRY_SHADER') then\r
 819       result := TglcShaderType.stGeometry\r
 820     else if (aStr = 'GL_TESS_CONTROL_SHADER') then\r
 821       result := TglcShaderType.stTessControl\r
 822     else if (aStr = 'GL_TESS_EVALUATION_SHADER') then\r
 823       result := TglcShaderType.stTessEvaluation\r
 824     else\r
 825       raise Exception.Create('invalid shader type: ' + aStr);\r
 826   end;\r
 827 \r
 828 var\r
 829   sl: TStringList;\r
 830   s: String;\r
 831   rx: TRegExpr;\r
 832   LastMatchPos: PtrInt;\r
 833   st: TglcShaderType;\r
 834   o: TglcShaderObject;\r
 835 \r
 836   procedure AddObj(const aPos: Integer);\r
 837   begin\r
 838     if (LastMatchPos > 0) then begin\r
 839       o := TglcShaderObject.Create(st, fOnLog);\r
 840       o.Code := Trim(Copy(s, LastMatchPos, aPos - LastMatchPos));\r
 841       Add(o);\r
 842     end;\r
 843   end;\r
 844 \r
 845 begin\r
 846   if not Assigned(aStream) then\r
 847     raise EglcShader.Create('TglShaderProgram.SaveToStream - stream is nil');\r
 848 \r
 849   Clear;\r
 850   sl := TStringList.Create;\r
 851   rx := TRegExpr.Create;\r
 852   try\r
 853     sl.LoadFromStream(aStream);\r
 854     s := sl.Text;\r
 855     LastMatchPos := 0;\r
 856     rx.Expression  := '/\*\s*ShaderObject\s*:\s*(GL_[A-Z_]+)\s*\*/\s*$?';\r
 857     rx.InputString := s;\r
 858 \r
 859     while rx.Exec(LastMatchPos+1) do begin\r
 860       AddObj(rx.MatchPos[0]);\r
 861       LastMatchPos := rx.MatchPos[0] + rx.MatchLen[0];\r
 862       st := GetShaderType(rx.Match[1]);\r
 863     end;\r
 864     AddObj(Length(s));\r
 865   finally\r
 866     rx.Free;\r
 867     sl.Free;\r
 868   end;\r
 869 \r
 870 \r
 871   {\r
 872   if Assigned(aStream) then begin\r
 873     Clear;\r
 874     fFilename := '';\r
 875     reader := TutlStreamReader.Create(aStream);\r
 876     try\r
 877       if reader.ReadAnsiString <> GLSL_FILE_HEADER then\r
 878         raise EglcShader.Create('TglShaderProgram.SaveToStream - incompatible file');\r
 879       v := reader.ReadInteger;\r
 880 \r
 881       if v >= 100 then begin //version 1.00\r
 882         c := reader.ReadInteger;\r
 883         for i := 0 to c-1 do begin\r
 884           Add(TglcShaderObject.Create(Cardinal(reader.ReadInteger), fOnLog));\r
 885           Last.fCode := reader.ReadAnsiString;\r
 886         end;\r
 887       end;\r
 888     finally\r
 889       reader.Free;\r
 890     end;\r
 891   end else\r
 892   }\r
 893 end;\r
 894 \r
 895 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 896 //speichert den Shader in einer Datei\r
 897 //@Filename: Datei in die geschrieben werden soll;\r
 898 procedure TglcShaderProgram.SaveToFile(const aFilename: String);\r
 899 var\r
 900   Stream: TFileStream;\r
 901 begin\r
 902   Stream := TFileStream.Create(aFilename, fmCreate);\r
 903   try\r
 904     SaveToStream(Stream);\r
 905     fFilename := aFilename;\r
 906   finally\r
 907     Stream.Free;\r
 908   end;\r
 909 end;\r
 910 \r
 911 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 912 //speichert den Shader in einen Stream\r
 913 //@Stream: Stream in den geschrieben werden soll;\r
 914 //@raise: EglcShader wenn kein Stream-Objekt übergeben wurde;\r
 915 //@raise: EglcShader wenn ungültige Datei;\r
 916 procedure TglcShaderProgram.SaveToStream(const aStream: TStream);\r
 917 var\r
 918   i: Integer;\r
 919   sl: TStringList;\r
 920   sObj: TglcShaderObject;\r
 921 \r
 922   function GetShaderTypeStr(const aShaderType: TglcShaderType): String;\r
 923   begin\r
 924     case aShaderType of\r
 925       TglcShaderType.stVertex:          result := 'GL_VERTEX_SHADER';\r
 926       TglcShaderType.stFragment:        result := 'GL_FRAGMENT_SHADER';\r
 927       TglcShaderType.stGeometry:        result := 'GL_GEOMETRY_SHADER';\r
 928       TglcShaderType.stTessControl:     result := 'GL_TESS_CONTROL_SHADER';\r
 929       TglcShaderType.stTessEvaluation:  result := 'GL_TESS_EVALUATION_SHADER';\r
 930     else\r
 931       result := 'UNKNOWN';\r
 932     end;\r
 933   end;\r
 934 \r
 935 begin\r
 936   if not Assigned(aStream) then\r
 937     raise EglcShader.Create('TglShaderProgram.LoadFromStream - stream is nil');\r
 938   fFilename := '';\r
 939   sl := TStringList.Create;\r
 940   try\r
 941     for i := 0 to Count-1 do begin\r
 942       sObj := Items[i];\r
 943       sl.Add('/* ShaderObject: ' + GetShaderTypeStr(sObj.ShaderType) + ' */');\r
 944       sl.Add(sObj.Code);\r
 945     end;\r
 946     sl.SaveToStream(aStream);\r
 947   finally\r
 948     sl.Free;\r
 949   end;\r
 950 end;\r
 951 \r
 952 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 953 //erzeugt das Objekt\r
 954 //@LogEvent: Event zum loggen von Fehlern und Ereignissen;\r
 955 //@raise: EglcShader wenn OpenGL nicht initialisiert werden konnte;\r
 956 //@raise:\r
 957 constructor TglcShaderProgram.Create(const aLogEvent: TglcShaderLogEvent);\r
 958 begin\r
 959   inherited Create;\r
 960   fOnLog      := aLogEvent;\r
 961   fFilename   := '';\r
 962   fProgramObj := 0;\r
 963 end;\r
 964 \r
 965 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
 966 //gibt das Objekt frei\r
 967 destructor TglcShaderProgram.Destroy;\r
 968 begin\r
 969   if (fProgramObj <> 0) then\r
 970     glDeleteProgram(fProgramObj);\r
 971   inherited Destroy;\r
 972 end;\r
 973 \r
 974 end.\r
 975 \r