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