uglcLight.pas

   1 unit uglcLight;
   2
   3 { Package:      OpenGLCore
   4   Prefix:       glc - OpenGL Core
   5   Beschreibung: diese Unit enthält eine Klassen-Kapselung der OpenGL Licht- und Material-Objekte }
   6
   7 {$mode objfpc}{$H+}
   8
   9 interface
  10
  11 uses
  12   Classes, SysUtils, dglOpenGL, ugluVector, uglcTypes;
  13
  14 type
  15   TglcMaterialRec = packed record
  16     Ambient: TgluVector4f;
  17     Diffuse: TgluVector4f;
  18     Specular: TgluVector4f;
  19     Emission: TgluVector4f;
  20     Shininess: GLfloat;
  21   end;
  22   PglcMaterialRec = ^TglcMaterialRec;
  23
  24   TglcLightType = (ltGlobal, ltPoint, ltSpot);
  25   TglcLightRec = packed record
  26     Ambient: TgluVector4f;
  27     Diffuse: TgluVector4f;
  28     Specular: TgluVector4f;
  29     Position: TgluVector4f;
  30     SpotDirection: TgluVector3f;
  31     SpotExponent: GLfloat;
  32     SpotCutoff: GLfloat;
  33     ConstantAtt: GLfloat;
  34     LinearAtt: GLfloat;
  35     QuadraticAtt: GLfloat;
  36   end;
  37   PglcLightRec = ^TglcLightRec;
  38
  39 const
  40   MAT_DEFAULT_AMBIENT:   TgluVector4f = (0.2, 0.2, 0.2, 1.0);
  41   MAT_DEFAULT_DIFFUSE:   TgluVector4f = (0.8, 0.8, 0.8, 1.0);
  42   MAT_DEFAULT_SPECULAR:  TgluVector4f = (0.5, 0.5, 0.5, 1.0);
  43   MAT_DEFAULT_EMISSION:  TgluVector4f = (0.0, 0.0, 0.0, 1.0);
  44   MAT_DEFAULT_SHININESS: GLfloat      =  50.0;
  45
  46   LIGHT_DEFAULT_AMBIENT:        TgluVector4f = (0.4, 0.4, 0.4, 1.0);
  47   LIGHT_DEFAULT_DIFFUSE:        TgluVector4f = (0.7, 0.7, 0.7, 1.0);
  48   LIGHT_DEFAULT_SPECULAR:       TgluVector4f = (0.9, 0.9, 0.9, 1.0);
  49   LIGHT_DEFAULT_POSITION:       TgluVector4f = (0.0, 0.0, 1.0, 0.0);
  50   LIGHT_DEFAULT_SPOT_DIRECTION: TgluVector3f = (0.0, 0.0, -1.0);
  51   LIGHT_DEFAULT_SPOT_EXPONENT:  GLfloat      =   0.0;
  52   LIGHT_DEFAULT_SPOT_CUTOFF:    GLfloat      = 180.0;
  53   LIGHT_DEFAULT_CONSTANT_ATT:   GLfloat      =   1.0;
  54   LIGHT_DEFAULT_LINEAR_ATT:     GLfloat      =   0.0;
  55   LIGHT_DEFAULT_QUADRATIC_ATT:  GLfloat      =   0.0;
  56
  57 type
  58 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  59   TglcMaterial = class(TObject)
  60   private
  61     fData: TglcMaterialRec;
  62   public
  63     property Diffuse:   TgluVector4f      read fData.Diffuse   write fData.Diffuse;
  64     property Ambient:   TgluVector4f      read fData.Ambient   write fData.Ambient;
  65     property Specular:  TgluVector4f      read fData.Specular  write fData.Specular;
  66     property Emission:  TgluVector4f      read fData.Emission  write fData.Emission;
  67     property Shininess: GLfloat           read fData.Shininess write fData.Shininess;
  68     property Data:      TglcMaterialRec   read fData           write fData;
  69
  70     procedure Bind(const aFace: TglcFace);
  71
  72     class procedure Bind(const aFace: TglcFace; const aMaterial: TglcMaterialRec);
  73     class function DefaultValues: TglcMaterialRec;
  74
  75     constructor Create;
  76   end;
  77
  78 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  79   EglcLight = class(Exception);
  80   TglcLight = class(TObject)
  81   private
  82     function GetDataPtr: PglcLightRec;
  83   protected
  84     fData: TglcLightRec;
  85
  86     procedure SetAmbient      (const aValue: TgluVector4f);   virtual;
  87     procedure SetDiffuse      (const aValue: TgluVector4f);   virtual;
  88     procedure SetSpecular     (const aValue: TgluVector4f);   virtual;
  89     procedure SetPosition4f   (const aValue: TgluVector4f);   virtual;
  90     procedure SetSpotDirection(const aValue: TgluVector3f);   virtual;
  91     procedure SetSpotExponent (const aValue: GLfloat);        virtual;
  92     procedure SetSpotCutoff   (const aValue: GLfloat);        virtual;
  93     procedure SetConstantAtt  (const aValue: GLfloat);        virtual;
  94     procedure SetLinearAtt    (const aValue: GLfloat);        virtual;
  95     procedure SetQuadraticAtt (const aValue: GLfloat);        virtual;
  96     procedure SetData         (const aValue: TglcLightRec);   virtual;
  97
  98     property Ambient:       TgluVector4f   read fData.Ambient       write SetAmbient;
  99     property Diffuse:       TgluVector4f   read fData.Diffuse       write SetDiffuse;
 100     property Specular:      TgluVector4f   read fData.Specular      write SetSpecular;
 101     property Position4f:    TgluVector4f   read fData.Position      write SetPosition4f;
 102     property SpotDirection: TgluVector3f   read fData.SpotDirection write SetSpotDirection;
 103     property SpotExponent:  GLfloat        read fData.SpotExponent  write SetSpotExponent;
 104     property SpotCutoff:    GLfloat        read fData.SpotCutoff    write SetSpotCutoff;
 105     property ConstantAtt:   GLfloat        read fData.ConstantAtt   write SetConstantAtt;
 106     property LinearAtt:     GLfloat        read fData.LinearAtt     write SetLinearAtt;
 107     property QuadraticAtt:  GLfloat        read fData.QuadraticAtt  write SetQuadraticAtt;
 108   public
 109     property Data:    TglcLightRec read fData write SetData;
 110     property DataPtr: PglcLightRec read GetDataPtr;
 111
 112     procedure Bind(const aLightID: GLenum; const aEnableLighting: Boolean = false); virtual; abstract;
 113
 114     class procedure Bind(const aLightID: GLenum; const aLight: TglcLightRec;
 115       const aEnableLighting: Boolean; const aLightType: TglcLightType);
 116     class procedure Unbind(const aLightID: GLenum; const aDisableLighting: Boolean = true);
 117     class function DefaultValues: TglcLightRec; virtual;
 118
 119     constructor Create;
 120   end;
 121
 122 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 123   TglcLightGlobal = class(TglcLight)
 124   private
 125     function GetDirection: TgluVector3f;
 126     procedure SetDirection(aValue: TgluVector3f);
 127   public
 128     property Ambient;
 129     property Diffuse;
 130     property Specular;
 131     property Direction: TgluVector3f read GetDirection write SetDirection;
 132
 133     procedure Bind(const aLightID: GLenum; const aEnableLighting: Boolean = false); override;
 134   end;
 135
 136 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 137   TglcLightPoint = class(TglcLight)
 138   private
 139     fMaxSize: Single;
 140     fSizeFactor: Single;
 141     function GetPosition: TgluVector3f;
 142     procedure SetPosition(const aValue: TgluVector3f);
 143   protected
 144     procedure SetMaxSize   (const aValue: Single); virtual;
 145     procedure SetSizeFactor(const aValue: Single); virtual;
 146   public
 147     property Ambient;
 148     property Diffuse;
 149     property Specular;
 150     property ConstantAtt;
 151     property LinearAtt;
 152     property QuadraticAtt;
 153     property MaxSize:    Single       read fMaxSize    write SetMaxSize;
 154     property SizeFactor: Single       read fSizeFactor write SetSizeFactor;
 155     property Position:   TgluVector3f read GetPosition write SetPosition;
 156
 157     procedure Bind(const aLightID: GLenum; const aEnableLighting: Boolean = false); override;
 158
 159     constructor Create;
 160   end;
 161
 162 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 163   TglcLightSpot = class(TglcLightPoint)
 164   public
 165     property SpotCutoff;
 166     property SpotDirection;
 167     property SpotExponent;
 168
 169     procedure Bind(const aLightID: GLenum; const aEnableLighting: Boolean = false); override;
 170   end;
 171
 172 implementation
 173
 174 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 175 //TglcMaterial//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 176 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 177 procedure TglcMaterial.Bind(const aFace: TglcFace);
 178 begin
 179   Bind(aFace, fData);
 180 end;
 181
 182 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 183 class procedure TglcMaterial.Bind(const aFace: TglcFace; const aMaterial: TglcMaterialRec);
 184 begin
 185   glMaterialfv(GLenum(aFace), GL_AMBIENT,   @aMaterial.Ambient[0]);
 186   glMaterialfv(GLenum(aFace), GL_DIFFUSE,   @aMaterial.Diffuse[0]);
 187   glMaterialfv(GLenum(aFace), GL_EMISSION,  @aMaterial.Emission[0]);
 188   glMaterialfv(GLenum(aFace), GL_SPECULAR,  @aMaterial.Specular[0]);
 189   glMaterialfv(GLenum(aFace), GL_SHININESS, @aMaterial.Shininess);
 190 end;
 191
 192 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 193 class function TglcMaterial.DefaultValues: TglcMaterialRec;
 194 begin
 195   result.Ambient   := MAT_DEFAULT_AMBIENT;
 196   result.Diffuse   := MAT_DEFAULT_DIFFUSE;
 197   result.Specular  := MAT_DEFAULT_SPECULAR;
 198   result.Emission  := MAT_DEFAULT_EMISSION;
 199   result.Shininess := MAT_DEFAULT_SHININESS;
 200 end;
 201
 202 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 203 constructor TglcMaterial.Create;
 204 begin
 205   inherited Create;
 206   fData := DefaultValues;
 207 end;
 208
 209 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 210 //TglcLight/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 211 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 212 function TglcLight.GetDataPtr: PglcLightRec;
 213 begin
 214   result := @fData;
 215 end;
 216
 217 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 218 procedure TglcLight.SetAmbient(const aValue: TgluVector4f);
 219 begin
 220   fData.Ambient := aValue;
 221 end;
 222
 223 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 224 procedure TglcLight.SetDiffuse(const aValue: TgluVector4f);
 225 begin
 226   fData.Diffuse := aValue;
 227 end;
 228
 229 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 230 procedure TglcLight.SetSpecular(const aValue: TgluVector4f);
 231 begin
 232   fData.Specular := aValue;
 233 end;
 234
 235 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 236 procedure TglcLight.SetPosition4f(const aValue: TgluVector4f);
 237 begin
 238   fData.Position := aValue;
 239 end;
 240
 241 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 242 procedure TglcLight.SetConstantAtt(const aValue: GLfloat);
 243 begin
 244   fData.ConstantAtt := aValue;
 245 end;
 246
 247 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 248 procedure TglcLight.SetLinearAtt(const aValue: GLfloat);
 249 begin
 250   fData.LinearAtt := aValue;
 251 end;
 252
 253 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 254 procedure TglcLight.SetQuadraticAtt(const aValue: GLfloat);
 255 begin
 256   fData.QuadraticAtt := aValue;
 257 end;
 258
 259 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 260 procedure TglcLight.SetSpotDirection(const aValue: TgluVector3f);
 261 begin
 262   fData.SpotDirection := aValue;
 263 end;
 264
 265 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 266 procedure TglcLight.SetSpotExponent(const aValue: GLfloat);
 267 begin
 268   fData.SpotExponent := aValue;
 269 end;
 270
 271 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 272 procedure TglcLight.SetSpotCutoff(const aValue: GLfloat);
 273 begin
 274   fData.SpotCutoff := aValue;
 275 end;
 276
 277 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 278 procedure TglcLight.SetData(const aValue: TglcLightRec);
 279 begin
 280   fData := aValue;
 281 end;
 282
 283 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 284 class procedure TglcLight.Bind(const aLightID: GLenum; const aLight: TglcLightRec;
 285   const aEnableLighting: Boolean; const aLightType: TglcLightType);
 286 begin
 287   glEnable(aLightID);
 288   if (aEnableLighting) then
 289     glEnable(GL_LIGHTING);
 290
 291   if (aLightType in [ltGlobal, ltPoint, ltSpot]) then begin
 292     glLightfv(aLightID, GL_AMBIENT,  @aLight.Ambient[0]);
 293     glLightfv(aLightID, GL_DIFFUSE,  @aLight.Diffuse[0]);
 294     glLightfv(aLightID, GL_SPECULAR, @aLight.Specular[0]);
 295     glLightfv(aLightID, GL_POSITION, @aLight.Position[0]);
 296   end else begin
 297     glLightfv(aLightID, GL_AMBIENT,  @LIGHT_DEFAULT_AMBIENT[0]);
 298     glLightfv(aLightID, GL_DIFFUSE,  @LIGHT_DEFAULT_DIFFUSE[0]);
 299     glLightfv(aLightID, GL_SPECULAR, @LIGHT_DEFAULT_SPECULAR[0]);
 300     glLightfv(aLightID, GL_POSITION, @LIGHT_DEFAULT_POSITION[0]);
 301   end;
 302
 303   if (aLightType in [ltPoint, ltSpot]) then begin
 304     glLightfv(aLightID, GL_CONSTANT_ATTENUATION,  @aLight.ConstantAtt);
 305     glLightfv(aLightID, GL_LINEAR_ATTENUATION,    @aLight.LinearAtt);
 306     glLightfv(aLightID, GL_QUADRATIC_ATTENUATION, @aLight.QuadraticAtt);
 307   end else begin
 308     glLightfv(aLightID, GL_CONSTANT_ATTENUATION,  @LIGHT_DEFAULT_CONSTANT_ATT);
 309     glLightfv(aLightID, GL_LINEAR_ATTENUATION,    @LIGHT_DEFAULT_LINEAR_ATT);
 310     glLightfv(aLightID, GL_QUADRATIC_ATTENUATION, @LIGHT_DEFAULT_QUADRATIC_ATT);
 311   end;
 312
 313   if (aLightType in [ltSpot]) then begin
 314     glLightfv(aLightID, GL_SPOT_DIRECTION, @aLight.SpotDirection[0]);
 315     glLightfv(aLightID, GL_SPOT_EXPONENT,  @aLight.SpotExponent);
 316     glLightfv(aLightID, GL_SPOT_CUTOFF,    @aLight.SpotCutoff);
 317   end else begin
 318     glLightfv(aLightID, GL_SPOT_DIRECTION, @LIGHT_DEFAULT_SPOT_DIRECTION[0]);
 319     glLightfv(aLightID, GL_SPOT_EXPONENT,  @LIGHT_DEFAULT_SPOT_EXPONENT);
 320     glLightfv(aLightID, GL_SPOT_CUTOFF,    @LIGHT_DEFAULT_SPOT_CUTOFF);
 321   end;
 322 end;
 323
 324 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 325 class procedure TglcLight.Unbind(const aLightID: GLenum; const aDisableLighting: Boolean);
 326 begin
 327   glDisable(aLightID);
 328   if aDisableLighting then
 329     glDisable(GL_LIGHTING);
 330 end;
 331
 332 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 333 class function TglcLight.DefaultValues: TglcLightRec;
 334 begin
 335   result.Ambient       := LIGHT_DEFAULT_AMBIENT;
 336   result.Diffuse       := LIGHT_DEFAULT_DIFFUSE;
 337   result.Specular      := LIGHT_DEFAULT_SPECULAR;
 338   result.Position      := LIGHT_DEFAULT_POSITION;
 339   result.SpotDirection := LIGHT_DEFAULT_SPOT_DIRECTION;
 340   result.SpotExponent  := LIGHT_DEFAULT_SPOT_EXPONENT;
 341   result.SpotCutoff    := LIGHT_DEFAULT_SPOT_CUTOFF;
 342   result.ConstantAtt   := LIGHT_DEFAULT_CONSTANT_ATT;
 343   result.LinearAtt     := LIGHT_DEFAULT_LINEAR_ATT;
 344   result.QuadraticAtt  := LIGHT_DEFAULT_QUADRATIC_ATT;
 345 end;
 346
 347 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 348 constructor TglcLight.Create;
 349 begin
 350   inherited Create;
 351   fData  := DefaultValues;
 352 end;
 353
 354 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 355 //TglcLightGlobal///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 356 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 357 function TglcLightGlobal.GetDirection: TgluVector3f;
 358 begin
 359   result := gluVector3f(Position4f);
 360 end;
 361
 362 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 363 procedure TglcLightGlobal.SetDirection(aValue: TgluVector3f);
 364 begin
 365   Position4f := gluVector4f(aValue, 0.0);
 366 end;
 367
 368 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 369 procedure TglcLightGlobal.Bind(const aLightID: GLenum; const aEnableLighting: Boolean);
 370 begin
 371   TglcLight.Bind(aLightID, fData, aEnableLighting, ltGlobal);
 372 end;
 373
 374 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 375 //TglcLightPoint////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 376 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 377 function TglcLightPoint.GetPosition: TgluVector3f;
 378 begin
 379   result := gluVector3f(fData.Position);
 380 end;
 381
 382 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 383 procedure TglcLightPoint.SetPosition(const aValue: TgluVector3f);
 384 begin
 385   SetPosition4f(gluVector4f(aValue, 1.0));
 386 end;
 387
 388 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 389 procedure TglcLightPoint.SetMaxSize(const aValue: Single);
 390 begin
 391   fMaxSize := aValue;
 392 end;
 393
 394 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 395 procedure TglcLightPoint.SetSizeFactor(const aValue: Single);
 396 begin
 397   fSizeFactor := aValue;
 398 end;
 399
 400 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 401 procedure TglcLightPoint.Bind(const aLightID: GLenum; const aEnableLighting: Boolean);
 402 begin
 403   TglcLight.Bind(aLightID, fData, aEnableLighting, ltPoint);
 404 end;
 405
 406 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 407 constructor TglcLightPoint.Create;
 408 begin
 409   inherited Create;
 410   Position    := gluVector3f(0.0, 0.0, 0.0);
 411   fMaxSize    := 0;
 412   fSizeFactor := 1.0;
 413 end;
 414
 415 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 416 //TglcLightSpot/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 417 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 418 procedure TglcLightSpot.Bind(const aLightID: GLenum; const aEnableLighting: Boolean);
 419 begin
 420   TglcLight.Bind(aLightID, fData, aEnableLighting, ltSpot);
 421 end;
 422
 423 end.
 424