Ignore:
Timestamp:
Dec 22, 2016, 8:49:19 PM (8 years ago)
Author:
chronos
Message:
  • Modified: Updated BGRABitmap package.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest/Packages/bgrabitmap/lightingclasses3d.inc

    r472 r494  
    11type
    2 
    3   { TBGRAMaterial3D }
    4 
    5   TBGRAMaterial3D = class(TInterfacedObject, IBGRAMaterial3D)
    6   private
    7     FName: string;
    8     FTexture: IBGRAScanner;
    9     FAutoSimpleColor,FAutoAmbiantColor,FAutoDiffuseColor,FAutoSpecularColor: boolean;
    10     FSimpleColorInt, FAmbiantColorInt, FDiffuseColorInt: TColorInt65536;
    11     FDiffuseLightness: integer;
    12     FTextureZoom: TPointF;
    13 
    14     FSpecularColorInt: TColorInt65536;
    15     FSpecularIndex: integer;
    16     FSpecularOn: boolean;
    17 
    18     FSaturationLowF: single;
    19     FSaturationHighF: single;
    20     FLightThroughFactor: single;
    21 
    22     //phong precalc
    23     FPowerTable: array of single;
    24     FPowerTableSize, FPowerTableExp2: integer;
    25     FPowerTableSizeF: single;
    26 
    27     procedure UpdateSpecular;
    28     procedure UpdateSimpleColor;
    29     procedure ComputePowerTable;
    30   public
    31     constructor Create;
    32     destructor Destroy; override;
    33 
    34     function GetAutoAmbiantColor: boolean;
    35     function GetAutoDiffuseColor: boolean;
    36     function GetAutoSpecularColor: boolean;
    37     function GetAutoSimpleColor: boolean;
    38     function GetAmbiantAlpha: byte;
    39     function GetAmbiantColor: TBGRAPixel;
    40     function GetAmbiantColorF: TColorF;
    41     function GetAmbiantColorInt: TColorInt65536;
    42     function GetDiffuseAlpha: byte;
    43     function GetDiffuseColor: TBGRAPixel;
    44     function GetDiffuseColorF: TColorF;
    45     function GetDiffuseColorInt: TColorInt65536;
    46     function GetLightThroughFactor: single;
    47     function GetSpecularColor: TBGRAPixel;
    48     function GetSpecularColorF: TColorF;
    49     function GetSpecularColorInt: TColorInt65536;
    50     function GetSpecularIndex: integer;
    51     function GetSaturationHigh: single;
    52     function GetSaturationLow: single;
    53     function GetSimpleAlpha: byte;
    54     function GetSimpleColor: TBGRAPixel;
    55     function GetSimpleColorF: TColorF;
    56     function GetSimpleColorInt: TColorInt65536;
    57     function GetTexture: IBGRAScanner;
    58     function GetTextureZoom: TPointF;
    59     procedure SetAutoAmbiantColor(const AValue: boolean);
    60     procedure SetAutoDiffuseColor(const AValue: boolean);
    61     procedure SetAutoSpecularColor(const AValue: boolean);
    62     procedure SetAmbiantAlpha(AValue: byte);
    63     procedure SetAmbiantColor(const AValue: TBGRAPixel);
    64     procedure SetAmbiantColorF(const AValue: TColorF);
    65     procedure SetAmbiantColorInt(const AValue: TColorInt65536);
    66     procedure SetDiffuseAlpha(AValue: byte);
    67     procedure SetDiffuseColor(const AValue: TBGRAPixel);
    68     procedure SetDiffuseColorF(const AValue: TColorF);
    69     procedure SetDiffuseColorInt(const AValue: TColorInt65536);
    70     procedure SetLightThroughFactor(const AValue: single);
    71     procedure SetSpecularColor(const AValue: TBGRAPixel);
    72     procedure SetSpecularColorF(const AValue: TColorF);
    73     procedure SetSpecularColorInt(const AValue: TColorInt65536);
    74     procedure SetSpecularIndex(const AValue: integer);
    75     procedure SetSaturationHigh(const AValue: single);
    76     procedure SetSaturationLow(const AValue: single);
    77     procedure SetSimpleAlpha(AValue: byte);
    78     procedure SetSimpleColor(AValue: TBGRAPixel);
    79     procedure SetSimpleColorF(AValue: TColorF);
    80     procedure SetSimpleColorInt(AValue: TColorInt65536);
    81     procedure SetTexture(AValue: IBGRAScanner);
    82     procedure SetTextureZoom(AValue: TPointF);
    83     function GetName: string;
    84     procedure SetName(const AValue: string);
    85 
    86     function GetSpecularOn: boolean;
    87     function GetAsObject: TObject;
    88     procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext; DiffuseIntensity, SpecularIntensity, SpecularCosine: single; const ALightColor: TColorInt65536);
    89     procedure ComputeDiffuseColor(Context: PSceneLightingContext; const DiffuseIntensity: single; const ALightColor: TColorInt65536);
    90     procedure ComputeDiffuseLightness(Context: PSceneLightingContext; DiffuseLightnessTerm32768: integer; ALightLightness: integer);
    91 
    92   end;
    93 
    94 { TBGRAMaterial3D }
    95 
    96 procedure TBGRAMaterial3D.UpdateSpecular;
    97 begin
    98   FAutoSpecularColor := (FSpecularColorInt.r = 65536) and (FSpecularColorInt.g = 65536) and (FSpecularColorInt.b = 65536) and (FSpecularColorInt.a = 65536);
    99   FSpecularOn := (FSpecularIndex > 0) and ((FSpecularColorInt.r <> 0) or (FSpecularColorInt.g <> 0) or (FSpecularColorInt.b <> 0) or
    100                                             FAutoSpecularColor);
    101 end;
    102 
    103 procedure TBGRAMaterial3D.UpdateSimpleColor;
    104 begin
    105   FSimpleColorInt := (FAmbiantColorInt+FDiffuseColorInt)*32768;
    106   FAutoSimpleColor := (FSimpleColorInt.r = 65536) and (FSimpleColorInt.g = 65536) and (FSimpleColorInt.b = 65536) and (FSimpleColorInt.a = 65536);
    107 end;
    108 
    109 procedure TBGRAMaterial3D.ComputePowerTable;
    110 var i: integer;
    111     Exponent: single;
    112 begin
    113   //exponent computed by squares
    114   Exponent := 1;
    115   FPowerTableExp2 := 0;
    116   While Exponent*FPowerTableSize/16 < FSpecularIndex do
    117   begin
    118     Exponent *= 2;
    119     Inc(FPowerTableExp2);
    120   end;
    121 
    122   //remaining exponent
    123   setlength(FPowerTable,FPowerTableSize+3);
    124   FPowerTable[0] := 0; //out of bound
    125   FPowerTable[1] := 0; //image of zero
    126   for i := 1 to FPowerTableSize do // ]0;1]
    127     FPowerTable[i+1] := Exp(ln(i/(FPowerTableSize-1))*FSpecularIndex/Exponent);
    128   FPowerTable[FPowerTableSize+2] := 1; //out of bound
    129 end;
    130 
    131 constructor TBGRAMaterial3D.Create;
    132 begin
    133   SetAmbiantColorInt(ColorInt65536(65536,65536,65536));
    134   SetDiffuseColorInt(ColorInt65536(65536,65536,65536));
    135   FSpecularIndex := 10;
    136   SetSpecularColorInt(ColorInt65536(0,0,0));
    137   FLightThroughFactor:= 0;
    138   SetSaturationLow(2);
    139   SetSaturationHigh(3);
    140 
    141   FTexture := nil;
    142   FTextureZoom := PointF(1,1);
    143 
    144   FPowerTableSize := 128;
    145   FPowerTableSizeF := FPowerTableSize;
    146   FPowerTable := nil;
    147 end;
    148 
    149 destructor TBGRAMaterial3D.Destroy;
    150 begin
    151   inherited Destroy;
    152 end;
    153 
    154 function TBGRAMaterial3D.GetAutoAmbiantColor: boolean;
    155 begin
    156   result := FAutoAmbiantColor;
    157 end;
    158 
    159 procedure TBGRAMaterial3D.SetDiffuseAlpha(AValue: byte);
    160 begin
    161   if AValue = 0 then
    162     FDiffuseColorInt.a := 0
    163   else
    164     FDiffuseColorInt.a := AValue*257+1;
    165   UpdateSimpleColor;
    166 end;
    167 
    168 function TBGRAMaterial3D.GetAutoDiffuseColor: boolean;
    169 begin
    170   result := FAutoDiffuseColor;
    171 end;
    172 
    173 function TBGRAMaterial3D.GetAutoSpecularColor: boolean;
    174 begin
    175   result := FAutoSpecularColor;
    176 end;
    177 
    178 function TBGRAMaterial3D.GetAutoSimpleColor: boolean;
    179 begin
    180   result := FAutoSimpleColor;
    181 end;
    182 
    183 function TBGRAMaterial3D.GetAmbiantAlpha: byte;
    184 var v: integer;
    185 begin
    186   if FAmbiantColorInt.a < 128 then
    187     result := 0
    188   else
    189   begin
    190     v := (FAmbiantColorInt.a-128) shr 8;
    191     if v > 255 then v := 255;
    192     result := v;
    193   end;
    194 end;
    195 
    196 function TBGRAMaterial3D.GetAmbiantColor: TBGRAPixel;
    197 begin
    198   result := ColorIntToBGRA(FAmbiantColorInt);
    199 end;
    200 
    201 function TBGRAMaterial3D.GetAmbiantColorF: TColorF;
    202 begin
    203   result := ColorInt65536ToColorF(FAmbiantColorInt);
    204 end;
    205 
    206 function TBGRAMaterial3D.GetAmbiantColorInt: TColorInt65536;
    207 begin
    208   result := FAmbiantColorInt;
    209 end;
    210 
    211 function TBGRAMaterial3D.GetDiffuseAlpha: byte;
    212 var v: integer;
    213 begin
    214   if FDiffuseColorInt.a < 128 then
    215     result := 0
    216   else
    217   begin
    218     v := (FDiffuseColorInt.a-128) shr 8;
    219     if v > 255 then v := 255;
    220     result := v;
    221   end;
    222 end;
    223 
    224 function TBGRAMaterial3D.GetDiffuseColor: TBGRAPixel;
    225 begin
    226   result := ColorIntToBGRA(FDiffuseColorInt);
    227 end;
    228 
    229 function TBGRAMaterial3D.GetDiffuseColorF: TColorF;
    230 begin
    231   result := ColorInt65536ToColorF(FDiffuseColorInt);
    232 end;
    233 
    234 function TBGRAMaterial3D.GetDiffuseColorInt: TColorInt65536;
    235 begin
    236   result := FDiffuseColorInt;
    237 end;
    238 
    239 function TBGRAMaterial3D.GetLightThroughFactor: single;
    240 begin
    241   result := FLightThroughFactor;
    242 end;
    243 
    244 function TBGRAMaterial3D.GetSpecularColor: TBGRAPixel;
    245 begin
    246   result := ColorIntToBGRA(FSpecularColorInt);
    247 end;
    248 
    249 function TBGRAMaterial3D.GetSpecularColorF: TColorF;
    250 begin
    251   result := ColorInt65536ToColorF(FSpecularColorInt);
    252 end;
    253 
    254 function TBGRAMaterial3D.GetSpecularColorInt: TColorInt65536;
    255 begin
    256   result := FSpecularColorInt;
    257 end;
    258 
    259 function TBGRAMaterial3D.GetSpecularIndex: integer;
    260 begin
    261   result := FSpecularIndex;
    262 end;
    263 
    264 function TBGRAMaterial3D.GetSaturationHigh: single;
    265 begin
    266   result := FSaturationHighF;
    267 end;
    268 
    269 function TBGRAMaterial3D.GetSaturationLow: single;
    270 begin
    271   result := FSaturationLowF;
    272 end;
    273 
    274 function TBGRAMaterial3D.GetSimpleAlpha: byte;
    275 begin
    276   result := (GetAmbiantAlpha + GetDiffuseAlpha) shr 1;
    277 end;
    278 
    279 function TBGRAMaterial3D.GetSimpleColor: TBGRAPixel;
    280 begin
    281   result := ColorIntToBGRA(GetSimpleColorInt);
    282 end;
    283 
    284 function TBGRAMaterial3D.GetSimpleColorF: TColorF;
    285 begin
    286   result := ColorInt65536ToColorF(GetSimpleColorInt);
    287 end;
    288 
    289 function TBGRAMaterial3D.GetSimpleColorInt: TColorInt65536;
    290 begin
    291   result := (GetAmbiantColorInt + GetDiffuseColorInt)*32768;
    292 end;
    293 
    294 function TBGRAMaterial3D.GetTexture: IBGRAScanner;
    295 begin
    296   result := FTexture;
    297 end;
    298 
    299 function TBGRAMaterial3D.GetTextureZoom: TPointF;
    300 begin
    301   result := FTextureZoom;
    302 end;
    303 
    304 procedure TBGRAMaterial3D.SetAutoAmbiantColor(const AValue: boolean);
    305 begin
    306   If AValue then
    307     SetAmbiantColorInt(ColorInt65536(65536,65536,65536));
    308 end;
    309 
    310 procedure TBGRAMaterial3D.SetAutoDiffuseColor(const AValue: boolean);
    311 begin
    312   If AValue then
    313     SetDiffuseColorInt(ColorInt65536(65536,65536,65536));
    314 end;
    315 
    316 procedure TBGRAMaterial3D.SetAutoSpecularColor(const AValue: boolean);
    317 begin
    318   If AValue then
    319     SetSpecularColorInt(ColorInt65536(65536,65536,65536));
    320 end;
    321 
    322 procedure TBGRAMaterial3D.SetAmbiantAlpha(AValue: byte);
    323 begin
    324   if AValue = 0 then
    325     FAmbiantColorInt.a := 0
    326   else
    327     FAmbiantColorInt.a := AValue*257+1;
    328   UpdateSimpleColor;
    329 end;
    330 
    331 procedure TBGRAMaterial3D.SetAmbiantColor(const AValue: TBGRAPixel);
    332 begin
    333   FAmbiantColorInt := BGRAToColorInt(AValue);
    334   FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536);
    335   UpdateSimpleColor;
    336 end;
    337 
    338 procedure TBGRAMaterial3D.SetAmbiantColorF(const AValue: TColorF);
    339 begin
    340   FAmbiantColorInt := ColorFToColorInt65536(AValue);
    341   FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536);
    342   UpdateSimpleColor;
    343 end;
    344 
    345 procedure TBGRAMaterial3D.SetAmbiantColorInt(const AValue: TColorInt65536);
    346 begin
    347   FAmbiantColorInt := AValue;
    348   FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536);
    349   UpdateSimpleColor;
    350 end;
    351 
    352 procedure TBGRAMaterial3D.SetDiffuseColor(const AValue: TBGRAPixel);
    353 begin
    354   FDiffuseColorInt := BGRAToColorInt(AValue);
    355   FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6;
    356   FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536);
    357   UpdateSimpleColor;
    358 end;
    359 
    360 procedure TBGRAMaterial3D.SetDiffuseColorF(const AValue: TColorF);
    361 begin
    362   FDiffuseColorInt := ColorFToColorInt65536(AValue);
    363   FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6;
    364   FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536);
    365   UpdateSimpleColor;
    366 end;
    367 
    368 procedure TBGRAMaterial3D.SetDiffuseColorInt(const AValue: TColorInt65536);
    369 begin
    370   FDiffuseColorInt := AValue;
    371   FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6;
    372   FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536);
    373   UpdateSimpleColor;
    374 end;
    375 
    376 procedure TBGRAMaterial3D.SetLightThroughFactor(const AValue: single);
    377 begin
    378   FLightThroughFactor:= AValue;
    379 end;
    380 
    381 procedure TBGRAMaterial3D.SetSpecularColor(const AValue: TBGRAPixel);
    382 begin
    383   FSpecularColorInt := BGRAToColorInt(AValue);
    384   UpdateSpecular;
    385 end;
    386 
    387 procedure TBGRAMaterial3D.SetSpecularColorF(const AValue: TColorF);
    388 begin
    389   FSpecularColorInt := ColorFToColorInt65536(AValue);
    390   UpdateSpecular;
    391 end;
    392 
    393 procedure TBGRAMaterial3D.SetSpecularColorInt(const AValue: TColorInt65536);
    394 begin
    395   FSpecularColorInt := AValue;
    396   UpdateSpecular;
    397 end;
    398 
    399 procedure TBGRAMaterial3D.SetSpecularIndex(const AValue: integer);
    400 begin
    401   FSpecularIndex := AValue;
    402   FPowerTable := nil;
    403   UpdateSpecular;
    404 end;
    405 
    406 procedure TBGRAMaterial3D.SetSaturationHigh(const AValue: single);
    407 begin
    408   FSaturationHighF:= AValue;
    409 end;
    410 
    411 procedure TBGRAMaterial3D.SetSaturationLow(const AValue: single);
    412 begin
    413   FSaturationLowF:= AValue;
    414 end;
    415 
    416 procedure TBGRAMaterial3D.SetSimpleAlpha(AValue: byte);
    417 begin
    418   SetAmbiantAlpha(AValue);
    419   SetDiffuseAlpha(AValue);
    420 end;
    421 
    422 procedure TBGRAMaterial3D.SetSimpleColor(AValue: TBGRAPixel);
    423 begin
    424   SetAmbiantColor(AValue);
    425   SetDiffuseColor(AValue);
    426 end;
    427 
    428 procedure TBGRAMaterial3D.SetSimpleColorF(AValue: TColorF);
    429 begin
    430   SetAmbiantColorF(AValue);
    431   SetDiffuseColorF(AValue);
    432 end;
    433 
    434 procedure TBGRAMaterial3D.SetSimpleColorInt(AValue: TColorInt65536);
    435 begin
    436   SetAmbiantColorInt(AValue);
    437   SetDiffuseColorInt(AValue);
    438 end;
    439 
    440 procedure TBGRAMaterial3D.SetTexture(AValue: IBGRAScanner);
    441 begin
    442   FTexture := AValue;
    443 end;
    444 
    445 procedure TBGRAMaterial3D.SetTextureZoom(AValue: TPointF);
    446 begin
    447   FTextureZoom := AValue;
    448 end;
    449 
    450 function TBGRAMaterial3D.GetName: string;
    451 begin
    452   result := FName;
    453 end;
    454 
    455 procedure TBGRAMaterial3D.SetName(const AValue: string);
    456 begin
    457   FName := AValue;
    458 end;
    459 
    460 function TBGRAMaterial3D.GetSpecularOn: boolean;
    461 begin
    462   result := FSpecularOn;
    463 end;
    464 
    465 function TBGRAMaterial3D.GetAsObject: TObject;
    466 begin
    467   result := self;
    468 end;
    469 
    470 procedure TBGRAMaterial3D.ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext; DiffuseIntensity, SpecularIntensity, SpecularCosine: single; const ALightColor: TColorInt65536);
    471 var
    472   NH,PowerTablePos: single; //keep first for asm
    473 
    474   NnH: single;
    475   PowerTableFPos: single;
    476   PowerTableIPos,i: integer;
    477 begin
    478   if SpecularCosine <= 0 then
    479     NnH := 0
    480   else
    481   if SpecularCosine >= 1 then
    482     NnH := 1 else
    483   begin
    484     NH := SpecularCosine;
    485     if FPowerTable = nil then ComputePowerTable;
    486     {$IFDEF CPUI386} {$asmmode intel}
    487     i := FPowerTableExp2;
    488     if i > 0 then
    489     begin
    490       PowerTablePos := FPowerTableSize;
    491       asm
    492         db $d9,$45,$f0  //flds NH
    493         mov ecx,i
    494       @loop:
    495         db $dc,$c8      //fmul st,st(0)
    496         dec ecx
    497         jnz @loop
    498         db $d8,$4d,$ec  //fmuls PowerTablePos
    499         db $d9,$5d,$ec  //fstps PowerTablePos
    500       end;
    501     end
    502     else
    503       PowerTablePos := NH*FPowerTableSize;
    504     {$ELSE}
    505     PowerTablePos := NH;
    506     for i := FPowerTableExp2-1 downto 0 do
    507       PowerTablePos := PowerTablePos*PowerTablePos;
    508     PowerTablePos *= FPowerTableSize;
    509     {$ENDIF}
    510     PowerTableIPos := round(PowerTablePos+0.5);
    511     PowerTableFPos := PowerTablePos-PowerTableIPos;
    512     NnH := FPowerTable[PowerTableIPos]*(1-PowerTableFPos)+FPowerTable[PowerTableIPos+1]*PowerTableFPos;
    513   end; //faster than NnH := exp(FSpecularIndex*ln(NH)); !
    514 
    515   if FAutoDiffuseColor then
    516     Context^.diffuseColor += ALightColor*round(DiffuseIntensity*65536)
    517   else
    518     Context^.diffuseColor += ALightColor*FDiffuseColorInt*round(DiffuseIntensity*65536);
    519 
    520   if FAutoSpecularColor then
    521     Context^.specularColor += ALightColor*round(SpecularIntensity* NnH*65536)
    522   else
    523     Context^.specularColor += ALightColor*FSpecularColorInt*round(SpecularIntensity* NnH*65536);
    524 end;
    525 
    526 procedure TBGRAMaterial3D.ComputeDiffuseColor(Context: PSceneLightingContext;
    527   const DiffuseIntensity: single; const ALightColor: TColorInt65536);
    528 begin
    529   if FAutoDiffuseColor then
    530     Context^.diffuseColor += ALightColor*round(DiffuseIntensity*65536)
    531   else
    532     Context^.diffuseColor += ALightColor*FDiffuseColorInt*round(DiffuseIntensity*65536);
    533 end;
    534 
    535 procedure TBGRAMaterial3D.ComputeDiffuseLightness(
    536   Context: PSceneLightingContext; DiffuseLightnessTerm32768: integer; ALightLightness: integer);
    537 begin
    538   if FAutoDiffuseColor then
    539   begin
    540     if ALightLightness <> 32768 then
    541       Context^.lightness += CombineLightness(DiffuseLightnessTerm32768,ALightLightness)
    542     else
    543       Context^.lightness += DiffuseLightnessTerm32768;
    544   end else
    545   begin
    546     if FDiffuseLightness <> 32768 then
    547       Context^.lightness += CombineLightness(DiffuseLightnessTerm32768,CombineLightness(FDiffuseLightness,ALightLightness))
    548     else
    549       Context^.lightness += CombineLightness(DiffuseLightnessTerm32768,ALightLightness);
    550   end;
    551 end;
    552 
    553 type
    554 
    555   { TBGRALight3D }
    556 
    557   TBGRALight3D = class(TInterfacedObject,IBGRALight3D)
    558   protected
    559     FMinIntensity: single;
    560     FColorInt: TColorInt65536;
    561     FViewVector : TPoint3D_128;
    562     FLightness: integer;
    563   public
    564     constructor Create;
    565     destructor Destroy; override;
    566 
    567     procedure ComputeDiffuseLightness(Context: PSceneLightingContext); virtual; abstract;
    568     procedure ComputeDiffuseColor(Context: PSceneLightingContext); virtual; abstract;
    569     procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); virtual; abstract;
    570 
    571     function GetLightnessF: single;
    572     function GetColor: TBGRAPixel;
    573     function GetColorF: TColorF;
    574     function GetColorInt: TColorInt65536;
    575     function GetAsObject: TObject;
    576     procedure SetColor(const AValue: TBGRAPixel);
    577     procedure SetColorF(const AValue: TColorF);
    578     procedure SetColorInt(const AValue: TColorInt65536);
    579     function GetColoredLight: boolean;
    580 
    581     function GetMinIntensity: single;
    582     procedure SetMinIntensity(const AValue: single);
    583     function IsDirectional: boolean; virtual; abstract;
    584   end;
    585 
    5862  { TBGRADirectionalLight3D }
    5873
    … …  
    5917  public
    5928    constructor Create(ADirection: TPoint3D);
    593     function GetDirection: TPoint3D;
     9    function GetDirection: TPoint3D; override;
    59410    procedure SetDirection(const AValue: TPoint3D);
    59511
    … …  
    60824  public
    60925    constructor Create(AVertex: IBGRAVertex3D; AIntensity: single);
    610     function GetIntensity: single;
     26    function GetIntensity: single; override;
    61127    procedure SetIntensity(const AValue: single);
    61228
    61329    function GetVertex: IBGRAVertex3D;
    61430    procedure SetVertex(const AValue: IBGRAVertex3D);
     31    function GetPosition: TPoint3D; override;
    61532
    61633    procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); override;
    … …  
    61936    function IsDirectional: boolean; override;
    62037  end;
    621 
    622 { TBGRALight3D }
    623 
    624 constructor TBGRALight3D.Create;
    625 begin
    626   SetColorF(ColorF(1,1,1,1));
    627   FViewVector := Point3D_128(0,0,-1);
    628   FMinIntensity:= 0;
    629 end;
    630 
    631 destructor TBGRALight3D.Destroy;
    632 begin
    633   inherited Destroy;
    634 end;
    635 
    636 function TBGRALight3D.GetLightnessF: single;
    637 begin
    638   result := FLightness/32768;
    639 end;
    640 
    641 function TBGRALight3D.GetColor: TBGRAPixel;
    642 begin
    643   result := ColorIntToBGRA(FColorInt);
    644 end;
    645 
    646 function TBGRALight3D.GetColorF: TColorF;
    647 begin
    648   result := ColorInt65536ToColorF(FColorInt);
    649 end;
    650 
    651 function TBGRALight3D.GetColorInt: TColorInt65536;
    652 begin
    653   result := FColorInt;
    654 end;
    655 
    656 function TBGRALight3D.GetAsObject: TObject;
    657 begin
    658   result := self;
    659 end;
    660 
    661 procedure TBGRALight3D.SetColor(const AValue: TBGRAPixel);
    662 begin
    663   SetColorInt(BGRAToColorInt(AValue));
    664 end;
    665 
    666 procedure TBGRALight3D.SetColorF(const AValue: TColorF);
    667 begin
    668   SetColorInt(ColorFToColorInt65536(AValue));
    669 end;
    670 
    671 procedure TBGRALight3D.SetColorInt(const AValue: TColorInt65536);
    672 begin
    673   FColorInt := AValue;
    674   FLightness:= (AValue.r+AValue.g+AValue.b) div 6;
    675 end;
    676 
    677 function TBGRALight3D.GetColoredLight: boolean;
    678 begin
    679   result := (FColorInt.r <> FColorInt.g) or (FColorInt.g <> FColorInt.b);
    680 end;
    681 
    682 function TBGRALight3D.GetMinIntensity: single;
    683 begin
    684   result := FMinIntensity;
    685 end;
    686 
    687 procedure TBGRALight3D.SetMinIntensity(const AValue: single);
    688 begin
    689   FMinIntensity := AValue;
    690 end;
    69138
    69239{ TBGRAPointLight3D }
    … …  
    71966end;
    72067
     68function TBGRAPointLight3D.GetPosition: TPoint3D;
     69begin
     70  Result:= FVertex.GetViewCoord;
     71end;
     72
    72173procedure TBGRAPointLight3D.ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext);
    72274  {$DEFINE PARAM_POINTLIGHT}
    … …  
    73587  else
    73688  begin
    737     intensity := (DotProduct3D_128(vect, Context^.basic.Normal))/(dist2*sqrt(dist2))*FIntensity;
     89    intensity := DotProduct3D_128(vect, Context^.basic.Normal)/(dist2*sqrt(dist2))*FIntensity;
    73890    if Context^.LightThrough and (intensity < 0) then intensity := -intensity*Context^.LightThroughFactor;
    73991    if intensity > 100 then intensity := 100;
    … …  
    74395end;
    74496
    745 procedure TBGRAPointLight3D.ComputeDiffuseColor(Context: PSceneLightingContext
    746   );
     97procedure TBGRAPointLight3D.ComputeDiffuseColor(Context: PSceneLightingContext);
    74798var
    74899  vect: TPoint3D_128;
    … …  
    755106  else
    756107  begin
    757     intensity := (DotProduct3D_128(vect, Context^.basic.Normal))/(dist2*sqrt(dist2))*FIntensity;
     108    intensity := DotProduct3D_128(vect, Context^.basic.Normal)/(dist2*sqrt(dist2))*FIntensity;
    758109    if Context^.LightThrough and (intensity < 0) then intensity := -intensity*Context^.LightThroughFactor;
    759110    if intensity > 100 then intensity := 100;
Note: See TracChangeset for help on using the changeset viewer.