// // The graphics engine GLXEngine. The unit of GXScene for Delphi // unit GXS.Skydome; (* Skydome object *) interface {$I Stage.Defines.inc} uses Winapi.OpenGL, System.Classes, System.SysUtils, System.UITypes, System.Math, FMX.Graphics, Stage.VectorTypes, Stage.VectorGeometry, GXS.Scene, GXS.Context, GXS.State, GXS.Graphics, GXS.Color, GXS.Material, GXS.RenderContextInfo; type TgxStarRecord = packed record RA: Word; // x100 builtin factor, degrees DEC: SmallInt; // x100 builtin factor, degrees BVColorIndex: Byte; // x100 builtin factor VMagnitude: Byte; // x10 builtin factor end; PgxStarRecord = ^TgxStarRecord; // ------------------------- SkyBox class ------------------------- TgxSkyBoxStyle = (sbsFull, sbsTopHalf, sbsBottomHalf, sbTopTwoThirds, sbsTopHalfClamped); TgxSkyBox = class(TgxCameraInvariantObject, IgxMaterialLibrarySupported) private FMatNameTop: string; FMatNameRight: string; FMatNameFront: string; FMatNameLeft: string; FMatNameBack: string; FMatNameBottom: string; FMatNameClouds: string; FMaterialLibrary: TgxMaterialLibrary; FCloudsPlaneOffset: Single; FCloudsPlaneSize: Single; FStyle: TgxSkyBoxStyle; //implementing IgxMaterialLibrarySupported function GetMaterialLibrary: TgxAbstractMaterialLibrary; protected procedure SetMaterialLibrary(const Value: TgxMaterialLibrary); procedure SetMatNameBack(const Value: string); procedure SetMatNameBottom(const Value: string); procedure SetMatNameFront(const Value: string); procedure SetMatNameLeft(const Value: string); procedure SetMatNameRight(const Value: string); procedure SetMatNameTop(const Value: string); procedure SetMatNameClouds(const Value: string); procedure SetCloudsPlaneOffset(const Value: single); procedure SetCloudsPlaneSize(const Value: single); procedure SetStyle(const value: TgxSkyBoxStyle); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure DoRender(var ARci: TgxRenderContextInfo; ARenderSelf, ARenderChildren: Boolean); override; procedure BuildList(var ARci: TgxRenderContextInfo); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; published property MaterialLibrary: TgxMaterialLibrary read FMaterialLibrary write SetMaterialLibrary; property MatNameTop: TgxLibMaterialName read FMatNameTop write SetMatNameTop; property MatNameBottom: TgxLibMaterialName read FMatNameBottom write SetMatNameBottom; property MatNameLeft: TgxLibMaterialName read FMatNameLeft write SetMatNameLeft; property MatNameRight: TgxLibMaterialName read FMatNameRight write SetMatNameRight; property MatNameFront: TgxLibMaterialName read FMatNameFront write SetMatNameFront; property MatNameBack: TgxLibMaterialName read FMatNameBack write SetMatNameBack; property MatNameClouds: TgxLibMaterialName read FMatNameClouds write SetMatNameClouds; property CloudsPlaneOffset: Single read FCloudsPlaneOffset write SetCloudsPlaneOffset; property CloudsPlaneSize: Single read FCloudsPlaneSize write SetCloudsPlaneSize; property Style: TgxSkyBoxStyle read FStyle write FStyle default sbsFull; end; //--------------------- SkyDome classes ----------------------------- TgxSkyDomeBand = class(TCollectionItem) private FStartAngle: Single; FStopAngle: Single; FStartColor: TgxColor; FStopColor: TgxColor; FSlices: Integer; FStacks: Integer; protected function GetDisplayName: string; override; procedure SetStartAngle(const val: Single); procedure SetStartColor(const val: TgxColor); procedure SetStopAngle(const val: Single); procedure SetStopColor(const val: TgxColor); procedure SetSlices(const val: Integer); procedure SetStacks(const val: Integer); procedure OnColorChange(sender: TObject); public constructor Create(Collection: TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure BuildList(var rci: TgxRenderContextInfo); published property StartAngle: Single read FStartAngle write SetStartAngle; property StartColor: TgxColor read FStartColor write SetStartColor; property StopAngle: Single read FStopAngle write SetStopAngle; property StopColor: TgxColor read FStopColor write SetStopColor; property Slices: Integer read FSlices write SetSlices default 12; property Stacks: Integer read FStacks write SetStacks default 1; end; TgxSkyDomeBands = class(TCollection) protected owner: TComponent; function GetOwner: TPersistent; override; procedure SetItems(index: Integer; const val: TgxSkyDomeBand); function GetItems(index: Integer): TgxSkyDomeBand; public constructor Create(AOwner: TComponent); function Add: TgxSkyDomeBand; function FindItemID(ID: Integer): TgxSkyDomeBand; property Items[index: Integer]: TgxSkyDomeBand read GetItems write SetItems; default; procedure NotifyChange; procedure BuildList(var rci: TgxRenderContextInfo); end; TgxSkyDomeStar = class(TCollectionItem) private FRA, FDec: Single; FMagnitude: Single; FColor: TColor; FCacheCoord: TAffineVector; // cached cartesian coordinates protected function GetDisplayName: string; override; public constructor Create(Collection: TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; published // Right Ascension, in degrees. property RA: Single read FRA write FRA; // Declination, in degrees. property DEC: Single read FDec write FDec; // Absolute magnitude. property Magnitude: Single read FMagnitude write FMagnitude; // Color of the star. property Color: TColor read FColor write FColor; end; TgxSkyDomeStars = class(TCollection) protected owner: TComponent; function GetOwner: TPersistent; override; procedure SetItems(index: Integer; const val: TgxSkyDomeStar); function GetItems(index: Integer): TgxSkyDomeStar; procedure PrecomputeCartesianCoordinates; public constructor Create(AOwner: TComponent); function Add: TgxSkyDomeStar; function FindItemID(ID: Integer): TgxSkyDomeStar; property Items[index: Integer]: TgxSkyDomeStar read GetItems write SetItems; default; procedure BuildList(var rci: TgxRenderContextInfo; twinkle: Boolean); (* Adds nb random stars of the given color. Stars are homogenously scattered on the complete sphere, not only the band defined or visible dome. *) procedure AddRandomStars(const nb: Integer; const Color: TColor; const limitToTopDome: Boolean = False); overload; procedure AddRandomStars(const nb: Integer; const ColorMin, ColorMax: TVector3b; const Magnitude_min, Magnitude_max: Single; const limitToTopDome: Boolean = False); overload; (* Load a 'stars' file, which is made of TGLStarRecord. Not that '.stars' files should already be sorted by magnitude and color. *) procedure LoadStarsFile(const starsFileName: string); end; TgxSkyDomeOption = (sdoEquatorialGrid, sdoEclipticGrid, sdoGalacticGrid, sdoSupergalacticGrid, sdoTwinkle); TgxSkyDomeOptions = set of TgxSkyDomeOption; (* Renders a sky dome always centered on the camera. If you use this object make sure it is rendered *first*, as it ignores depth buffering and overwrites everything. All children of a skydome are rendered in the skydome's coordinate system. The skydome is described by "bands", each "band" is an horizontal cut of a sphere, and you can have as many bands as you wish. *) TgxSkyDome = class(TgxCameraInvariantObject) private FOptions: TgxSkyDomeOptions; FBands: TgxSkyDomeBands; FStars: TgxSkyDomeStars; protected procedure SetBands(const val: TgxSkyDomeBands); procedure SetStars(const val: TgxSkyDomeStars); procedure SetOptions(const val: TgxSkyDomeOptions); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure BuildList(var rci: TgxRenderContextInfo); override; published property Bands: TgxSkyDomeBands read FBands write SetBands; property Stars: TgxSkyDomeStars read FStars write SetStars; property Options: TgxSkyDomeOptions read FOptions write SetOptions default []; end; TEarthSkydomeOption = (esoFadeStarsWithSun, esoRotateOnTwelveHours, esoDepthTest); TEarthSkydomeOptions = set of TEarthSkydomeOption; (* Render a skydome like what can be seen on earth. Color is based on sun position and turbidity, to "mimic" atmospheric Rayleigh and Mie scatterings. The colors can be adjusted to render exoplanet atmospheres too. The default slices/stacks values make for an average quality rendering, for a very clean rendering, use 64/64 (more is overkill in most cases). The complexity is quite high though, making a T&L 3D board a necessity for using TgxEarthSkyDome. *) TgxEarthSkyDome = class(TgxSkyDome) private FSunElevation: Single; FTurbidity: Single; FCurSunColor, FCurSkyColor, FCurHazeColor: TgxColorVector; FCurHazeTurbid, FCurSunSkyTurbid: Single; FSunZenithColor: TgxColor; FSunDawnColor: TgxColor; FHazeColor: TgxColor; FSkyColor: TgxColor; FNightColor: TgxColor; FDeepColor: TgxColor; FSlices, FStacks: Integer; FExtendedOptions: TEarthSkydomeOptions; FMorning: Boolean; protected procedure Loaded; override; procedure SetSunElevation(const val: Single); procedure SetTurbidity(const val: Single); procedure SetSunZenithColor(const val: TgxColor); procedure SetSunDawnColor(const val: TgxColor); procedure SetHazeColor(const val: TgxColor); procedure SetSkyColor(const val: TgxColor); procedure SetNightColor(const val: TgxColor); procedure SetDeepColor(const val: TgxColor); procedure SetSlices(const val: Integer); procedure SetStacks(const val: Integer); procedure OnColorChanged(sender: TObject); procedure PreCalculate; procedure RenderDome; function CalculateColor(const theta, cosGamma: Single): TgxColorVector; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure BuildList(var rci: TgxRenderContextInfo); override; procedure SetSunAtTime(HH, MM: Single); published // Elevation of the sun, measured in degrees property SunElevation: Single read FSunElevation write SetSunElevation; // Expresses the purity of air. Value range is from 1 (pure atmosphere) to 120 (very nebulous) property Turbidity: Single read FTurbidity write SetTurbidity; property SunZenithColor: TgxColor read FSunZenithColor write SetSunZenithColor; property SunDawnColor: TgxColor read FSunDawnColor write SetSunDawnColor; property HazeColor: TgxColor read FHazeColor write SetHazeColor; property SkyColor: TgxColor read FSkyColor write SetSkyColor; property NightColor: TgxColor read FNightColor write SetNightColor; property DeepColor: TgxColor read FDeepColor write SetDeepColor; property ExtendedOptions: TEarthSkydomeOptions read FExtendedOptions write FExtendedOptions; property Slices: Integer read FSlices write SetSlices default 24; property Stacks: Integer read FStacks write SetStacks default 48; end; // Computes position on the unit sphere of a star record (Z=up). function StarRecordPositionZUp(const starRecord: TgxStarRecord): TAffineVector; // Computes position on the unit sphere of a star record (Y=up). function StarRecordPositionYUp(const starRecord: TgxStarRecord): TAffineVector; // Computes star color from BV index (RGB) and magnitude (alpha). function StarRecordColor(const starRecord: TgxStarRecord; bias: Single): TVector4f; // ------------------------------------------------------------------ implementation // ------------------------------------------------------------------ // ------------------ // ------------------ TgxSkyBox ------------------ // ------------------ constructor TgxSkyBox.Create(AOwner: TComponent); begin inherited Create(AOwner); CamInvarianceMode := cimPosition; ObjectStyle := ObjectStyle + [osDirectDraw, osNoVisibilityCulling]; FCloudsPlaneOffset := 0.2; // this should be set far enough to avoid near plane clipping FCloudsPlaneSize := 32; // the bigger, the more this extends the clouds cap to the horizon end; destructor TgxSkyBox.Destroy; begin inherited; end; function TgxSkyBox.GetMaterialLibrary: TgxAbstractMaterialLibrary; begin Result := FMaterialLibrary; end; procedure TgxSkyBox.Notification(AComponent: TComponent; Operation: TOperation); begin if (Operation = opRemove) and (AComponent = FMaterialLibrary) then MaterialLibrary := nil; inherited; end; procedure TgxSkyBox.DoRender(var ARci: TgxRenderContextInfo; ARenderSelf, ARenderChildren: Boolean); begin Arci.gxStates.DepthWriteMask := False; Arci.ignoreDepthRequests := true; inherited; Arci.ignoreDepthRequests := False; end; procedure TgxSkyBox.BuildList(var ARci: TgxRenderContextInfo); var f, cps, cof1: Single; oldStates: TgxStates; libMat: TgxLibMaterial; begin if FMaterialLibrary = nil then Exit; with ARci.gxStates do begin oldStates := States; Disable(stDepthTest); Disable(stLighting); Disable(stFog); end; glPushMatrix; f := ARci.rcci.farClippingDistance * 0.5; glScalef(f, f, f); try case Style of sbsFull: ; sbsTopHalf, sbsTopHalfClamped: begin glTranslatef(0, 0.5, 0); glScalef(1, 0.5, 1); end; sbsBottomHalf: begin glTranslatef(0, -0.5, 0); glScalef(1, 0.5, 1); end; sbTopTwoThirds: begin glTranslatef(0, 1 / 3, 0); glScalef(1, 2 / 3, 1); end; end; // FRONT libMat := MaterialLibrary.LibMaterialByName(FMatNameFront); if libMat <> nil then begin libMat.Apply(ARci); repeat glBegin(GL_QUADS); glTexCoord2f(0.002, 0.998); glVertex3f(-1, 1, -1); glTexCoord2f(0.002, 0.002); glVertex3f(-1, -1, -1); glTexCoord2f(0.998, 0.002); glVertex3f(1, -1, -1); glTexCoord2f(0.998, 0.998); glVertex3f(1, 1, -1); if Style = sbsTopHalfClamped then begin glTexCoord2f(0.002, 0.002); glVertex3f(-1, -1, -1); glTexCoord2f(0.002, 0.002); glVertex3f(-1, -3, -1); glTexCoord2f(0.998, 0.002); glVertex3f(1, -3, -1); glTexCoord2f(0.998, 0.002); glVertex3f(1, -1, -1); end; glEnd; until not libMat.UnApply(ARci); end; // BACK libMat := MaterialLibrary.LibMaterialByName(FMatNameBack); if libMat <> nil then begin libMat.Apply(ARci); repeat glBegin(GL_QUADS); glTexCoord2f(0.002, 0.998); glVertex3f(1, 1, 1); glTexCoord2f(0.002, 0.002); glVertex3f(1, -1, 1); glTexCoord2f(0.998, 0.002); glVertex3f(-1, -1, 1); glTexCoord2f(0.998, 0.998); glVertex3f(-1, 1, 1); if Style = sbsTopHalfClamped then begin glTexCoord2f(0.002, 0.002); glVertex3f(1, -1, 1); glTexCoord2f(0.002, 0.002); glVertex3f(1, -3, 1); glTexCoord2f(0.998, 0.002); glVertex3f(-1, -3, 1); glTexCoord2f(0.998, 0.002); glVertex3f(-1, -1, 1); end; glEnd; until not libMat.UnApply(ARci); end; // TOP libMat := MaterialLibrary.LibMaterialByName(FMatNameTop); if libMat <> nil then begin libMat.Apply(ARci); repeat glBegin(GL_QUADS); glTexCoord2f(0.002, 0.998); glVertex3f(-1, 1, 1); glTexCoord2f(0.002, 0.002); glVertex3f(-1, 1, -1); glTexCoord2f(0.998, 0.002); glVertex3f(1, 1, -1); glTexCoord2f(0.998, 0.998); glVertex3f(1, 1, 1); glEnd; until not libMat.UnApply(ARci); end; // BOTTOM libMat := MaterialLibrary.LibMaterialByName(FMatNameBottom); if libMat <> nil then begin libMat.Apply(ARci); repeat glBegin(GL_QUADS); glTexCoord2f(0.002, 0.998); glVertex3f(-1, -1, -1); glTexCoord2f(0.002, 0.002); glVertex3f(-1, -1, 1); glTexCoord2f(0.998, 0.002); glVertex3f(1, -1, 1); glTexCoord2f(0.998, 0.998); glVertex3f(1, -1, -1); glEnd; until not libMat.UnApply(ARci); end; // LEFT libMat := MaterialLibrary.LibMaterialByName(FMatNameLeft); if libMat <> nil then begin libMat.Apply(ARci); repeat glBegin(GL_QUADS); glTexCoord2f(0.002, 0.998); glVertex3f(-1, 1, 1); glTexCoord2f(0.002, 0.002); glVertex3f(-1, -1, 1); glTexCoord2f(0.998, 0.002); glVertex3f(-1, -1, -1); glTexCoord2f(0.998, 0.998); glVertex3f(-1, 1, -1); if Style = sbsTopHalfClamped then begin glTexCoord2f(0.002, 0.002); glVertex3f(-1, -1, 1); glTexCoord2f(0.002, 0.002); glVertex3f(-1, -3, 1); glTexCoord2f(0.998, 0.002); glVertex3f(-1, -3, -1); glTexCoord2f(0.998, 0.002); glVertex3f(-1, -1, -1); end; glEnd; until not libMat.UnApply(ARci); end; // RIGHT libMat := MaterialLibrary.LibMaterialByName(FMatNameRight); if libMat <> nil then begin libMat.Apply(ARci); repeat glBegin(GL_QUADS); glTexCoord2f(0.002, 0.998); glVertex3f(1, 1, -1); glTexCoord2f(0.002, 0.002); glVertex3f(1, -1, -1); glTexCoord2f(0.998, 0.002); glVertex3f(1, -1, 1); glTexCoord2f(0.998, 0.998); glVertex3f(1, 1, 1); if Style = sbsTopHalfClamped then begin glTexCoord2f(0.002, 0.002); glVertex3f(1, -1, -1); glTexCoord2f(0.002, 0.002); glVertex3f(1, -3, -1); glTexCoord2f(0.998, 0.002); glVertex3f(1, -3, 1); glTexCoord2f(0.998, 0.002); glVertex3f(1, -1, 1); end; glEnd; until not libMat.UnApply(ARci); end; // CLOUDS CAP PLANE libMat := MaterialLibrary.LibMaterialByName(FMatNameClouds); if libMat <> nil then begin // pre-calculate possible values to speed up cps := FCloudsPlaneSize * 0.5; cof1 := FCloudsPlaneOffset; libMat.Apply(ARci); repeat glBegin(GL_QUADS); glTexCoord2f(0, 1); glVertex3f(-cps, cof1, cps); glTexCoord2f(0, 0); glVertex3f(-cps, cof1, -cps); glTexCoord2f(1, 0); glVertex3f(cps, cof1, -cps); glTexCoord2f(1, 1); glVertex3f(cps, cof1, cps); glEnd; until not libMat.UnApply(ARci); end; glPopMatrix; if stLighting in oldStates then ARci.gxStates.Enable(stLighting); if stFog in oldStates then ARci.gxStates.Enable(stFog); if stDepthTest in oldStates then ARci.gxStates.Enable(stDepthTest); finally end; end; procedure TgxSkyBox.SetCloudsPlaneOffset(const Value: single); begin FCloudsPlaneOffset := Value; StructureChanged; end; procedure TgxSkyBox.SetCloudsPlaneSize(const Value: single); begin FCloudsPlaneSize := Value; StructureChanged; end; procedure TgxSkyBox.SetStyle(const value: TgxSkyBoxStyle); begin FStyle := value; StructureChanged; end; procedure TgxSkyBox.SetMaterialLibrary(const value: TgxMaterialLibrary); begin FMaterialLibrary := value; StructureChanged; end; procedure TgxSkyBox.SetMatNameBack(const Value: string); begin FMatNameBack := Value; StructureChanged; end; procedure TgxSkyBox.SetMatNameBottom(const Value: string); begin FMatNameBottom := Value; StructureChanged; end; procedure TgxSkyBox.SetMatNameClouds(const Value: string); begin FMatNameClouds := Value; StructureChanged; end; procedure TgxSkyBox.SetMatNameFront(const Value: string); begin FMatNameFront := Value; StructureChanged; end; procedure TgxSkyBox.SetMatNameLeft(const Value: string); begin FMatNameLeft := Value; StructureChanged; end; procedure TgxSkyBox.SetMatNameRight(const Value: string); begin FMatNameRight := Value; StructureChanged; end; procedure TgxSkyBox.SetMatNameTop(const Value: string); begin FMatNameTop := Value; StructureChanged; end; //--------------------- SkyDome Region ------------------------------ function StarRecordPositionYUp(const starRecord: TgxStarRecord): TAffineVector; var f: Single; begin SinCosine(starRecord.DEC * (0.01 * PI / 180), Result.Y, f); SinCosine(starRecord.RA * (0.01 * PI / 180), f, Result.X, Result.Z); end; function StarRecordPositionZUp(const starRecord: TgxStarRecord): TAffineVector; var f: Single; begin SinCosine(starRecord.DEC * (0.01 * PI / 180), Result.Z, f); SinCosine(starRecord.RA * (0.01 * PI / 180), f, Result.X, Result.Y); end; function StarRecordColor(const starRecord: TgxStarRecord; bias: Single): TVector4f; const // very *rough* approximation cBVm035: TVector4f = (X: 0.7; Y: 0.8; Z: 1.0; W: 1); cBV015: TVector4f = (X: 1.0; Y: 1.0; Z: 1.0; W: 1); cBV060: TVector4f = (X: 1.0; Y: 1.0; Z: 0.7; W: 1); cBV135: TVector4f = (X: 1.0; Y: 0.8; Z: 0.7; W: 1); var bvIndex100: Integer; begin bvIndex100 := starRecord.BVColorIndex - 50; // compute RGB color for B&V index if bvIndex100 < -035 then Result := cBVm035 else if bvIndex100 < 015 then VectorLerp(cBVm035, cBV015, (bvIndex100 + 035) * (1 / (015 + 035)), Result) else if bvIndex100 < 060 then VectorLerp(cBV015, cBV060, (bvIndex100 - 015) * (1 / (060 - 015)), Result) else if bvIndex100 < 135 then VectorLerp(cBV060, cBV135, (bvIndex100 - 060) * (1 / (135 - 060)), Result) else Result := cBV135; // compute transparency for VMag // the actual factor is 2.512, and not used here Result.W := PowerSingle(1.2, -(starRecord.VMagnitude * 0.1 - bias)); end; // ------------------ // ------------------ TgxSkyDomeBand ------------------ // ------------------ constructor TgxSkyDomeBand.Create(Collection: TCollection); begin inherited Create(Collection); FStartColor := TgxColor.Create(Self); FStartColor.Initialize(clrBlue); FStartColor.OnNotifyChange := OnColorChange; FStopColor := TgxColor.Create(Self); FStopColor.Initialize(clrBlue); FStopColor.OnNotifyChange := OnColorChange; FSlices := 12; FStacks := 1; end; destructor TgxSkyDomeBand.Destroy; begin FStartColor.Free; FStopColor.Free; inherited Destroy; end; procedure TgxSkyDomeBand.Assign(Source: TPersistent); begin if Source is TgxSkyDomeBand then begin FStartAngle := TgxSkyDomeBand(Source).FStartAngle; FStopAngle := TgxSkyDomeBand(Source).FStopAngle; FStartColor.Assign(TgxSkyDomeBand(Source).FStartColor); FStopColor.Assign(TgxSkyDomeBand(Source).FStopColor); FSlices := TgxSkyDomeBand(Source).FSlices; FStacks := TgxSkyDomeBand(Source).FStacks; end; inherited Destroy; end; function TgxSkyDomeBand.GetDisplayName: string; begin Result := Format('%d: %.1f° - %.1f°', [Index, StartAngle, StopAngle]); end; procedure TgxSkyDomeBand.SetStartAngle(const val: Single); begin FStartAngle := ClampValue(val, -90, 90); if FStartAngle > FStopAngle then FStopAngle := FStartAngle; TgxSkyDomeBands(Collection).NotifyChange; end; procedure TgxSkyDomeBand.SetStartColor(const val: TgxColor); begin FStartColor.Assign(val); end; procedure TgxSkyDomeBand.SetStopAngle(const val: Single); begin FStopAngle := ClampValue(val, -90, 90); if FStopAngle < FStartAngle then FStartAngle := FStopAngle; TgxSkyDomeBands(Collection).NotifyChange; end; procedure TgxSkyDomeBand.SetStopColor(const val: TgxColor); begin FStopColor.Assign(val); end; procedure TgxSkyDomeBand.SetSlices(const val: Integer); begin if val < 3 then FSlices := 3 else FSlices := val; TgxSkyDomeBands(Collection).NotifyChange; end; procedure TgxSkyDomeBand.SetStacks(const val: Integer); begin if val < 1 then FStacks := 1 else FStacks := val; TgxSkyDomeBands(Collection).NotifyChange; end; procedure TgxSkyDomeBand.OnColorChange(sender: TObject); begin TgxSkyDomeBands(Collection).NotifyChange; end; procedure TgxSkyDomeBand.BuildList(var rci: TgxRenderContextInfo); // coordinates system note: X is forward, Y is left and Z is up // always rendered as sphere of radius 1 procedure RenderBand(start, stop: Single; const colStart, colStop: TgxColorVector); var i: Integer; f, r, r2: Single; vertex1, vertex2: TVector4f; begin vertex1.W := 1; if start = -90 then begin // triangle fan with south pole glBegin(GL_TRIANGLE_FAN); glColor4fv(@colStart); glVertex3f(0, 0, -1); f := 2 * PI / Slices; SinCosine(DegToRadian(stop), vertex1.Z, r); glColor4fv(@colStop); for i := 0 to Slices do begin SinCosine(i * f, r, vertex1.Y, vertex1.X); glVertex4fv(@vertex1); end; glEnd; end else if stop = 90 then begin // triangle fan with north pole glBegin(GL_TRIANGLE_FAN); glColor4fv(@colStop); glVertex3fv(@ZHmgPoint); f := 2 * PI / Slices; SinCosine(DegToRadian(start), vertex1.Z, r); glColor4fv(@colStart); for i := Slices downto 0 do begin SinCosine(i * f, r, vertex1.Y, vertex1.X); glVertex4fv(@vertex1); end; glEnd; end else begin vertex2.W := 1; // triangle strip glBegin(GL_TRIANGLE_STRIP); f := 2 * PI / Slices; SinCosine(DegToRadian(start), vertex1.Z, r); SinCosine(DegToRadian(stop), vertex2.Z, r2); for i := 0 to Slices do begin SinCosine(i * f, r, vertex1.Y, vertex1.X); glColor4fv(@colStart); glVertex4fv(@vertex1); SinCosine(i * f, r2, vertex2.Y, vertex2.X); glColor4fv(@colStop); glVertex4fv(@vertex2); end; glEnd; end; end; var n: Integer; t, t2: Single; begin if StartAngle = StopAngle then Exit; for n := 0 to Stacks - 1 do begin t := n / Stacks; t2 := (n + 1) / Stacks; RenderBand(Lerp(StartAngle, StopAngle, t), Lerp(StartAngle, StopAngle, t2), VectorLerp(StartColor.Color, StopColor.Color, t), VectorLerp(StartColor.Color, StopColor.Color, t2)); end; end; // ------------------ // ------------------ TgxSkyDomeBands ------------------ // ------------------ constructor TgxSkyDomeBands.Create(AOwner: TComponent); begin owner := AOwner; inherited Create(TgxSkyDomeBand); end; function TgxSkyDomeBands.GetOwner: TPersistent; begin Result := owner; end; procedure TgxSkyDomeBands.SetItems(index: Integer; const val: TgxSkyDomeBand); begin inherited Items[index] := val; end; function TgxSkyDomeBands.GetItems(index: Integer): TgxSkyDomeBand; begin Result := TgxSkyDomeBand(inherited Items[index]); end; function TgxSkyDomeBands.Add: TgxSkyDomeBand; begin Result := (inherited Add) as TgxSkyDomeBand; end; function TgxSkyDomeBands.FindItemID(ID: Integer): TgxSkyDomeBand; begin Result := (inherited FindItemID(ID)) as TgxSkyDomeBand; end; procedure TgxSkyDomeBands.NotifyChange; begin if Assigned(owner) and (owner is TgxBaseSceneObject) then TgxBaseSceneObject(owner).StructureChanged; end; procedure TgxSkyDomeBands.BuildList(var rci: TgxRenderContextInfo); var i: Integer; begin for i := 0 to Count - 1 do Items[i].BuildList(rci); end; // ------------------ // ------------------ TgxSkyDomeStar ------------------ // ------------------ constructor TgxSkyDomeStar.Create(Collection: TCollection); begin inherited Create(Collection); end; destructor TgxSkyDomeStar.Destroy; begin inherited Destroy; end; procedure TgxSkyDomeStar.Assign(Source: TPersistent); begin if Source is TgxSkyDomeStar then begin FRA := TgxSkyDomeStar(Source).FRA; FDec := TgxSkyDomeStar(Source).FDec; FMagnitude := TgxSkyDomeStar(Source).FMagnitude; FColor := TgxSkyDomeStar(Source).FColor; SetVector(FCacheCoord, TgxSkyDomeStar(Source).FCacheCoord); end; inherited Destroy; end; function TgxSkyDomeStar.GetDisplayName: string; begin Result := Format('RA: %5.1f / Dec: %5.1f', [RA, DEC]); end; // ------------------ // ------------------ TgxSkyDomeStars ------------------ // ------------------ constructor TgxSkyDomeStars.Create(AOwner: TComponent); begin owner := AOwner; inherited Create(TgxSkyDomeStar); end; function TgxSkyDomeStars.GetOwner: TPersistent; begin Result := owner; end; procedure TgxSkyDomeStars.SetItems(index: Integer; const val: TgxSkyDomeStar); begin inherited Items[index] := val; end; function TgxSkyDomeStars.GetItems(index: Integer): TgxSkyDomeStar; begin Result := TgxSkyDomeStar(inherited Items[index]); end; function TgxSkyDomeStars.Add: TgxSkyDomeStar; begin Result := (inherited Add) as TgxSkyDomeStar; end; function TgxSkyDomeStars.FindItemID(ID: Integer): TgxSkyDomeStar; begin Result := (inherited FindItemID(ID)) as TgxSkyDomeStar; end; procedure TgxSkyDomeStars.PrecomputeCartesianCoordinates; var i: Integer; star: TgxSkyDomeStar; raC, raS, decC, decS: Single; begin // to be enhanced... for i := 0 to Count - 1 do begin star := Items[i]; SinCosine(star.DEC * cPIdiv180, decS, decC); SinCosine(star.RA * cPIdiv180, decC, raS, raC); star.FCacheCoord.X := raC; star.FCacheCoord.Y := raS; star.FCacheCoord.Z := decS; end; end; procedure TgxSkyDomeStars.BuildList(var rci: TgxRenderContextInfo; twinkle: Boolean); var i, n: Integer; star: TgxSkyDomeStar; lastColor: TColor; lastPointSize10, pointSize10: Integer; Color, twinkleColor: TgxColorVector; procedure DoTwinkle; begin if (n and 63) = 0 then begin twinkleColor := VectorScale(Color, Random * 0.6 + 0.4); glColor3fv(@twinkleColor.X); n := 0; end else Inc(n); end; begin if Count = 0 then Exit; PrecomputeCartesianCoordinates; lastColor := -1; n := 0; lastPointSize10 := -1; rci.gxStates.Enable(stPointSmooth); rci.gxStates.Enable(stAlphaTest); rci.gxStates.SetAlphaFunction(cfNotEqual, 0.0); rci.gxStates.Enable(stBlend); rci.gxStates.SetBlendFunc(bfSrcAlpha, bfOne); glBegin(GL_POINTS); for i := 0 to Count - 1 do begin star := Items[i]; pointSize10 := Round((4.5 - star.Magnitude) * 10); if pointSize10 <> lastPointSize10 then begin if pointSize10 > 15 then begin glEnd; lastPointSize10 := pointSize10; rci.gxStates.PointSize := pointSize10 * 0.1; glBegin(GL_POINTS); end else if lastPointSize10 <> 15 then begin glEnd; lastPointSize10 := 15; rci.gxStates.PointSize := 1.5; glBegin(GL_POINTS); end; end; if lastColor <> star.FColor then begin Color := ConvertWinColor(star.FColor); if twinkle then begin n := 0; DoTwinkle; end else glColor3fv(@Color.X); lastColor := star.FColor; end else if twinkle then DoTwinkle; glVertex3fv(@star.FCacheCoord.X); end; glEnd; // restore default AlphaFunc rci.gxStates.SetAlphaFunction(cfGreater, 0); end; procedure TgxSkyDomeStars.AddRandomStars(const nb: Integer; const Color: TColor; const limitToTopDome: Boolean = False); var i: Integer; coord: TAffineVector; star: TgxSkyDomeStar; begin for i := 1 to nb do begin star := Add; // pick a point in the half-cube if limitToTopDome then coord.Z := Random else coord.Z := Random * 2 - 1; // calculate RA and Dec star.DEC := ArcSin(coord.Z) * c180divPI; star.RA := Random * 360 - 180; // pick a color star.Color := Color; // pick a magnitude star.Magnitude := 3; end; end; //------------------------------------------------------------ procedure TgxSkyDomeStars.AddRandomStars(const nb: Integer; const ColorMin, ColorMax: TVector3b; const Magnitude_min, Magnitude_max: Single; const limitToTopDome: Boolean = False); function RandomTT(Min, Max: Byte): Byte; begin Result := Min + Random(Max - Min); end; var i: Integer; coord: TAffineVector; star: TgxSkyDomeStar; begin for i := 1 to nb do begin star := Add; // pick a point in the half-cube if limitToTopDome then coord.Z := Random else coord.Z := Random * 2 - 1; // calculate RA and Dec star.DEC := ArcSin(coord.Z) * c180divPI; star.RA := Random * 360 - 180; // pick a color star.Color := RGB2Color(RandomTT(ColorMin.X, ColorMax.X), RandomTT(ColorMin.Y, ColorMax.Y), RandomTT(ColorMin.Z, ColorMax.Z)); // pick a magnitude star.Magnitude := Magnitude_min + Random * (Magnitude_max - Magnitude_min); end; end; procedure TgxSkyDomeStars.LoadStarsFile(const starsFileName: string); var fs: TFileStream; sr: TgxStarRecord; colorVector: TgxColorVector; begin fs := TFileStream.Create(starsFileName, fmOpenRead + fmShareDenyWrite); try while fs.Position < fs.Size do begin fs.Read(sr, SizeOf(sr)); with Add do begin RA := sr.RA * 0.01; DEC := sr.DEC * 0.01; colorVector := StarRecordColor(sr, 3); Magnitude := sr.VMagnitude * 0.1; if sr.VMagnitude > 35 then Color := ConvertColorVector(colorVector, colorVector.W) else Color := ConvertColorVector(colorVector); end; end; finally fs.Free; end; end; // ------------------ // ------------------ TgxSkyDome ------------------ // ------------------ constructor TgxSkyDome.Create(AOwner: TComponent); begin inherited Create(AOwner); CamInvarianceMode := cimPosition; ObjectStyle := ObjectStyle + [osDirectDraw, osNoVisibilityCulling]; FBands := TgxSkyDomeBands.Create(Self); with FBands.Add do begin StartAngle := 0; StartColor.Color := clrWhite; StopAngle := 15; StopColor.Color := clrBlue; end; with FBands.Add do begin StartAngle := 15; StartColor.Color := clrBlue; StopAngle := 90; Stacks := 4; StopColor.Color := clrNavy; end; FStars := TgxSkyDomeStars.Create(Self); end; destructor TgxSkyDome.Destroy; begin FStars.Free; FBands.Free; inherited Destroy; end; procedure TgxSkyDome.Assign(Source: TPersistent); begin if Source is TgxSkyDome then begin FBands.Assign(TgxSkyDome(Source).FBands); FStars.Assign(TgxSkyDome(Source).FStars); end; inherited; end; procedure TgxSkyDome.SetBands(const val: TgxSkyDomeBands); begin FBands.Assign(val); StructureChanged; end; procedure TgxSkyDome.SetStars(const val: TgxSkyDomeStars); begin FStars.Assign(val); StructureChanged; end; procedure TgxSkyDome.SetOptions(const val: TgxSkyDomeOptions); begin if val <> FOptions then begin FOptions := val; if sdoTwinkle in FOptions then ObjectStyle := ObjectStyle + [osDirectDraw] else begin ObjectStyle := ObjectStyle - [osDirectDraw]; DestroyHandle; end; StructureChanged; end; end; procedure TgxSkyDome.BuildList(var rci: TgxRenderContextInfo); var f: Single; begin // setup states rci.gxStates.Disable(stLighting); // 8 rci.gxStates.Disable(stDepthTest); rci.gxStates.Disable(stFog); rci.gxStates.Disable(stCullFace); rci.gxStates.Disable(stBlend); // 2 rci.gxStates.DepthWriteMask := False; rci.gxStates.PolygonMode := pmFill; f := rci.rcci.farClippingDistance * 0.90; glScalef(f, f, f); Bands.BuildList(rci); Stars.BuildList(rci, (sdoTwinkle in FOptions)); end; // ------------------ // ------------------ TgxEarthSkyDome ------------------ // ------------------ constructor TgxEarthSkyDome.Create(AOwner: TComponent); begin inherited Create(AOwner); FMorning := true; Bands.Clear; FSunElevation := 75; FTurbidity := 15; FSunZenithColor := TgxColor.CreateInitialized(Self, clrWhite, OnColorChanged); FSunDawnColor := TgxColor.CreateInitialized(Self, Vectormake(1, 0.5, 0, 0), OnColorChanged); FHazeColor := TgxColor.CreateInitialized(Self, Vectormake(0.9, 0.95, 1, 0), OnColorChanged); FSkyColor := TgxColor.CreateInitialized(Self, Vectormake(0.45, 0.6, 0.9, 0), OnColorChanged); FNightColor := TgxColor.CreateInitialized(Self, clrTransparent, OnColorChanged); FDeepColor := TgxColor.CreateInitialized(Self, Vectormake(0, 0.2, 0.4, 0)); FStacks := 24; FSlices := 48; PreCalculate; end; destructor TgxEarthSkyDome.Destroy; begin FSunZenithColor.Free; FSunDawnColor.Free; FHazeColor.Free; FSkyColor.Free; FNightColor.Free; FDeepColor.Free; inherited Destroy; end; procedure TgxEarthSkyDome.Assign(Source: TPersistent); begin if Source is TgxSkyDome then begin FSunElevation := TgxEarthSkyDome(Source).SunElevation; FTurbidity := TgxEarthSkyDome(Source).Turbidity; FSunZenithColor.Assign(TgxEarthSkyDome(Source).FSunZenithColor); FSunDawnColor.Assign(TgxEarthSkyDome(Source).FSunDawnColor); FHazeColor.Assign(TgxEarthSkyDome(Source).FHazeColor); FSkyColor.Assign(TgxEarthSkyDome(Source).FSkyColor); FNightColor.Assign(TgxEarthSkyDome(Source).FNightColor); FSlices := TgxEarthSkyDome(Source).FSlices; FStacks := TgxEarthSkyDome(Source).FStacks; PreCalculate; end; inherited; end; procedure TgxEarthSkyDome.Loaded; begin inherited; PreCalculate; end; procedure TgxEarthSkyDome.SetSunElevation(const val: Single); var newVal: Single; begin newVal := ClampValue(val, -90, 90); if FSunElevation <> newVal then begin FSunElevation := newVal; PreCalculate; end; end; procedure TgxEarthSkyDome.SetTurbidity(const val: Single); begin FTurbidity := ClampValue(val, 1, 120); PreCalculate; end; procedure TgxEarthSkyDome.SetSunZenithColor(const val: TgxColor); begin FSunZenithColor.Assign(val); PreCalculate; end; procedure TgxEarthSkyDome.SetSunDawnColor(const val: TgxColor); begin FSunDawnColor.Assign(val); PreCalculate; end; procedure TgxEarthSkyDome.SetHazeColor(const val: TgxColor); begin FHazeColor.Assign(val); PreCalculate; end; procedure TgxEarthSkyDome.SetSkyColor(const val: TgxColor); begin FSkyColor.Assign(val); PreCalculate; end; procedure TgxEarthSkyDome.SetNightColor(const val: TgxColor); begin FNightColor.Assign(val); PreCalculate; end; procedure TgxEarthSkyDome.SetDeepColor(const val: TgxColor); begin FDeepColor.Assign(val); PreCalculate; end; procedure TgxEarthSkyDome.SetSlices(const val: Integer); begin if val > 6 then FSlices := val else FSlices := 6; StructureChanged; end; procedure TgxEarthSkyDome.SetStacks(const val: Integer); begin if val > 1 then FStacks := val else FStacks := 1; StructureChanged; end; procedure TgxEarthSkyDome.BuildList(var rci: TgxRenderContextInfo); var f: Single; begin // setup states with rci.gxStates do begin CurrentProgram := 0; Disable(stLighting); if esoDepthTest in FExtendedOptions then begin Enable(stDepthTest); DepthFunc := cfLEqual; end else Disable(stDepthTest); Disable(stFog); Disable(stCullFace); Disable(stBlend); Disable(stAlphaTest); DepthWriteMask := False; PolygonMode := pmFill; end; f := rci.rcci.farClippingDistance * 0.95; glScalef(f, f, f); RenderDome; Bands.BuildList(rci); Stars.BuildList(rci, (sdoTwinkle in FOptions)); // restore rci.gxStates.DepthWriteMask := true; end; procedure TgxEarthSkyDome.OnColorChanged(sender: TObject); begin PreCalculate; end; procedure TgxEarthSkyDome.SetSunAtTime(HH, MM: Single); const cHourToElevation1: array [0 .. 23] of Single = (-45, -67.5, -90, -57.5, -45, -22.5, 0, 11.25, 22.5, 33.7, 45, 56.25, 67.5, 78.75, 90, 78.75, 67.5, 56.25, 45, 33.7, 22.5, 11.25, 0, -22.5); cHourToElevation2: array [0 .. 23] of Single = (-0.375, -0.375, 0.375, 0.375, 0.375, 0.375, 0.1875, 0.1875, 0.1875, 0.1875, 0.1875, 0.1875, 0.1875, 0.1875, -0.1875, -0.1875, -0.1875, -0.1875, -0.1875, -0.1875, -0.1875, -0.1875, -0.375, -0.375); var ts: Single; fts: Single; i: Integer; Color: TColor; begin HH := Round(HH); if HH < 0 then HH := 0; if HH > 23 then HH := 23; if MM < 0 then MM := 0; if MM >= 60 then begin MM := 0; HH := HH + 1; if HH > 23 then HH := 0; end; FSunElevation := cHourToElevation1[Round(HH)] + cHourToElevation2 [Round(HH)] * MM; ts := DegToRadian(90 - FSunElevation); // Mix base colors fts := exp(-6 * (PI / 2 - ts)); VectorLerp(SunZenithColor.Color, SunDawnColor.Color, fts, FCurSunColor); fts := IntPower(1 - cos(ts - 0.5), 2); VectorLerp(HazeColor.Color, NightColor.Color, fts, FCurHazeColor); VectorLerp(SkyColor.Color, NightColor.Color, fts, FCurSkyColor); // Precalculate Turbidity factors FCurHazeTurbid := -sqrt(121 - Turbidity) * 2; FCurSunSkyTurbid := -(121 - Turbidity); // fade stars if required if SunElevation > -40 then ts := PowerInteger(1 - (SunElevation + 40) / 90, 11) else ts := 1; Color := RGB2Color(Round(ts * 255), Round(ts * 255), Round(ts * 255)); if esoFadeStarsWithSun in ExtendedOptions then for i := 0 to Stars.Count - 1 do Stars[i].Color := Color; if esoRotateOnTwelveHours in ExtendedOptions then // spining around blue orb begin if (HH >= 14) and (FMorning = true) then begin roll(180); for i := 0 to Stars.Count - 1 do Stars[i].RA := Stars[i].RA + 180; FMorning := False; end; if (HH >= 2) and (HH < 14) and (FMorning = False) then begin roll(180); for i := 0 to Stars.Count - 1 do Stars[i].RA := Stars[i].RA + 180; FMorning := true; end; end; StructureChanged; end; procedure TgxEarthSkyDome.PreCalculate; var ts: Single; fts: Single; i: Integer; Color: TColor; begin ts := DegToRadian(90 - SunElevation); // Precompose base colors fts := exp(-6 * (PI / 2 - ts)); VectorLerp(SunZenithColor.Color, SunDawnColor.Color, fts, FCurSunColor); fts := PowerInteger(1 - cos(ts - 0.5), 2); VectorLerp(HazeColor.Color, NightColor.Color, fts, FCurHazeColor); VectorLerp(SkyColor.Color, NightColor.Color, fts, FCurSkyColor); // Precalculate Turbidity factors FCurHazeTurbid := -sqrt(121 - Turbidity) * 2; FCurSunSkyTurbid := -(121 - Turbidity); // fade stars if required if SunElevation > -40 then ts := PowerInteger(1 - (SunElevation + 40) / 90, 11) else ts := 1; Color := RGB2Color(Round(ts * 255), Round(ts * 255), Round(ts * 255)); if esoFadeStarsWithSun in ExtendedOptions then for i := 0 to Stars.Count - 1 do Stars[i].Color := Color; if esoRotateOnTwelveHours in ExtendedOptions then begin if SunElevation = 90 then begin roll(180); for i := 0 to Stars.Count - 1 do Stars[i].RA := Stars[i].RA + 180; end else if SunElevation = -90 then begin roll(180); for i := 0 to Stars.Count - 1 do Stars[i].RA := Stars[i].RA + 180; end; end; StructureChanged; end; function TgxEarthSkyDome.CalculateColor(const theta, cosGamma: Single) : TgxColorVector; var t: Single; begin t := PI / 2 - theta; // mix to get haze/sky VectorLerp(FCurSkyColor, FCurHazeColor, ClampValue(exp(FCurHazeTurbid * t), 0, 1), Result); // then mix sky with sun VectorLerp(Result, FCurSunColor, ClampValue(exp(FCurSunSkyTurbid * cosGamma * (1 + t)) * 1.1, 0, 1), Result); end; procedure TgxEarthSkyDome.RenderDome; var ts: Single; steps: Integer; sunPos: TAffineVector; sinTable, cosTable: PFloatArray; // coordinates system note: X is forward, Y is left and Z is up // always rendered as sphere of radius 1 function CalculateCosGamma(const p: TVector4f): Single; begin Result := 1 - VectorAngleCosine(PAffineVector(@p)^, sunPos); end; procedure RenderDeepBand(stop: Single); var i: Integer; r, thetaStart: Single; vertex1: TVector4f; Color: TgxColorVector; begin r := 0; vertex1.W := 1; // triangle fan with south pole glBegin(GL_TRIANGLE_FAN); Color := CalculateColor(0, CalculateCosGamma(ZHmgPoint)); glColor4fv(@DeepColor.AsAddress^); glVertex3f(0, 0, -1); SinCosine(DegToRadian(stop), vertex1.Z, r); thetaStart := DegToRadian(90 - stop); for i := 0 to steps - 1 do begin vertex1.X := r * cosTable[i]; vertex1.Y := r * sinTable[i]; Color := CalculateColor(thetaStart, CalculateCosGamma(vertex1)); glColor4fv(@Color); glVertex4fv(@vertex1); end; glEnd; end; procedure RenderBand(start, stop: Single); var i: Integer; r, r2, thetaStart, thetaStop: Single; vertex1, vertex2: TVector4f; Color: TgxColorVector; begin vertex1.W := 1; if stop = 90 then begin // triangle fan with north pole glBegin(GL_TRIANGLE_FAN); Color := CalculateColor(0, CalculateCosGamma(ZHmgPoint)); glColor4fv(@Color); glVertex4fv(@ZHmgPoint); SinCosine(DegToRadian(start), vertex1.Z, r); thetaStart := DegToRadian(90 - start); for i := 0 to steps - 1 do begin vertex1.X := r * cosTable[i]; vertex1.Y := r * sinTable[i]; Color := CalculateColor(thetaStart, CalculateCosGamma(vertex1)); glColor4fv(@Color); glVertex4fv(@vertex1); end; glEnd; end else begin vertex2.W := 1; // triangle strip glBegin(GL_TRIANGLE_STRIP); SinCosine(DegToRadian(start), vertex1.Z, r); SinCosine(DegToRadian(stop), vertex2.Z, r2); thetaStart := DegToRadian(90 - start); thetaStop := DegToRadian(90 - stop); for i := 0 to steps - 1 do begin vertex1.X := r * cosTable[i]; vertex1.Y := r * sinTable[i]; Color := CalculateColor(thetaStart, CalculateCosGamma(vertex1)); glColor4fv(@Color); glVertex4fv(@vertex1); vertex2.X := r2 * cosTable[i]; vertex2.Y := r2 * sinTable[i]; Color := CalculateColor(thetaStop, CalculateCosGamma(vertex2)); glColor4fv(@Color); glVertex4fv(@vertex2); end; glEnd; end; end; var n, i, sdiv2: Integer; t, t2, p, fs: Single; begin ts := DegToRadian(90 - SunElevation); SetVector(sunPos, sin(ts), 0, cos(ts)); // prepare sin/cos LUT, with a higher sampling around 0Ѝ n := Slices div 2; steps := 2 * n + 1; GetMem(sinTable, steps * SizeOf(Single)); GetMem(cosTable, steps * SizeOf(Single)); for i := 1 to n do begin p := (1 - sqrt(cos((i / n) * cPIdiv2))) * PI; SinCosine(p, sinTable[n + i], cosTable[n + i]); sinTable[n - i] := -sinTable[n + i]; cosTable[n - i] := cosTable[n + i]; end; // these are defined by hand for precision issue: the dome must wrap exactly sinTable[n] := 0; cosTable[n] := 1; sinTable[0] := 0; cosTable[0] := -1; sinTable[steps - 1] := 0; cosTable[steps - 1] := -1; fs := SunElevation / 90; // start render t := 0; sdiv2 := Stacks div 2; for n := 0 to Stacks - 1 do begin if fs > 0 then begin if n < sdiv2 then t2 := fs - fs * Sqr((sdiv2 - n) / sdiv2) else t2 := fs + Sqr((n - sdiv2) / (sdiv2 - 1)) * (1 - fs); end else t2 := (n + 1) / Stacks; RenderBand(Lerp(1, 90, t), Lerp(1, 90, t2)); t := t2; end; RenderDeepBand(1); FreeMem(sinTable); FreeMem(cosTable); end; // ------------------------------------------------------------- initialization // ------------------------------------------------------------- RegisterClasses([TgxSkyDome, TgxEarthSkyDome]); end.