123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809 |
- //
- // The graphics engine GLScene
- //
- unit GLS.EParticleMasksManager;
- (*
- A pretty particle mask effect manager.
- This unit is part of GLE - GLScene Game Utilities Engine set by Kenneth Poulter [email protected]
- Module Number: 37
- Description: This is merely an addon to GLS.Scene, since i don't want to edit GLScene's source code directly
- and make changes (since GLScene's source code constantly changes). What the manager does
- is to provide a basic tool for newly created particles to be modified (their position currently).
- Their position is set from 3 different masks, which create a "virtual" 3d object... meaning,
- an actual 3d object is not created, but an outline for particles or any other objects are positioned.
- ActualUsage: Create the component, create a new ParticleMask, set the material library, set the materials,
- and use the procedures provided in the managers root. positioning and scaling applicable aswell.
- The images should be
- Licenses: Removed. Donated to GLScene's Code Base as long as the author (Kenneth Poulter) is not altered in this file.
- Theft of code also is not allowed, although alterations are allowed.
- *)
- interface
- {$I Stage.Defines.inc}
- uses
- System.Types,
- System.SysUtils,
- System.Classes,
- System.Math,
- VCL.Graphics,
- Stage.VectorGeometry,
- Stage.VectorTypes,
- GLS.Texture,
- GLS.Material,
- GLS.Scene,
- GLS.ParticleFX,
- GLS.Coordinates;
- type
- TGLEProjectedParticleMask = (pptXMask, pptYMask, pptZMask);
- TGLEParticleMask = class;
- TGLEParticleMasks = class;
- TGLEParticleMask = class(TCollectionItem, IGLMaterialLibrarySupported)
- private
- FName: string;
- FScale: TGLCoordinates;
- FPosition: TGLCoordinates;
- FYMask: TGLLibMaterialName;
- FZMask: TGLLibMaterialName;
- FXMask: TGLLibMaterialName;
- FMaterialLibrary: TGLMaterialLibrary;
- FBackgroundColor: TColor;
- FMaskColor: TColor;
- FMaxX, FMaxY, FMaxZ, FMinX, FMinY, FMinZ: Integer;
- IXW, IXH, IYW, IYH, IZW, IZH: Integer;
- LX, LY, LZ: Integer;
- MX, MY: Integer;
- BogusMask, BogusMaskX, BogusMaskY, BogusMaskZ: Boolean;
- // we might have a pitch mask
- FRollAngle: Single;
- FPitchAngle: Single;
- FTurnAngle: Single;
- procedure SetName(const Value: string);
- procedure SetXMask(const Value: TGLLibMaterialName);
- procedure SetYMask(const Value: TGLLibMaterialName);
- procedure SetZMask(const Value: TGLLibMaterialName);
- procedure SetMaterialLibrary(const Value: TGLMaterialLibrary);
- function XCan: TBitmap;
- function YCan: TBitmap;
- function ZCan: TBitmap;
- //implementing IGLMaterialLibrarySupported
- function GetMaterialLibrary: TGLAbstractMaterialLibrary;
- //implementing IInterface
- function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
- function _AddRef: Integer; stdcall;
- function _Release: Integer; stdcall;
- protected
- function GetDisplayName: string; override;
- public
- constructor Create(Collection: TCollection); override;
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- procedure UpdateExtents;
- procedure Roll(Angle: Single);
- procedure Turn(Angle: Single);
- procedure Pitch(Angle: Single);
- // this generates a xmask from another mask just to fill gaps,
- // depth is dependant on frommask width and height
- procedure GenerateMaskFromProjection(FromMask, ToMask:
- TGLEProjectedParticleMask; Depth: Integer);
- published
- // scales and positions
- property Scale: TGLCoordinates read FScale write FScale;
- property Position: TGLCoordinates read FPosition write FPosition;
- // the reference name of the particle mask
- property Name: string read FName write SetName;
- property MaterialLibrary: TGLMaterialLibrary read FMaterialLibrary write SetMaterialLibrary;
- // mask images, make sure materiallibrary is assigned
- property XMask: TGLLibMaterialName read FXMask write SetXMask;
- property YMask: TGLLibMaterialName read FYMask write SetYMask;
- property ZMask: TGLLibMaterialName read FZMask write SetZMask;
- // background color is the color that prevents particles from being positioned there
- property BackgroundColor: TColor read FBackgroundColor write FBackgroundColor;
- // maskcolor is where particles are allowed to be positioned
- property MaskColor: TColor read FMaskColor write FMaskColor;
- // just the average angles for orientation
- property RollAngle: Single read FRollAngle write FRollAngle;
- property PitchAngle: Single read FPitchAngle write FPitchAngle;
- property TurnAngle: Single read FTurnAngle write FTurnAngle;
- end;
- TGLEParticleMasks = class(TCollection)
- protected
- Owner: TComponent;
- function GetOwner: TPersistent; override;
- procedure SetItems(Index: Integer; const Val: TGLEParticleMask);
- function GetItems(Index: Integer): TGLEParticleMask;
- public
- function Add: TGLEParticleMask;
- constructor Create(AOwner: TComponent);
- property Items[Index: Integer]: TGLEParticleMask read GetItems write SetItems; default;
- end;
- TGLEParticleMasksManager = class(TComponent)
- private
- FParticleMasks: TGLEParticleMasks;
- protected
- procedure ApplyOrthoGraphic(var Vec: TVector3f; Mask: TGLEParticleMask);
- procedure ApplyRotation(var Vec: TVector3f; Mask: TGLEParticleMask);
- procedure ApplyRotationTarget(var Vec: TVector3f; Mask: TGLEParticleMask;
- TargetObject: TGLBaseSceneObject);
- procedure ApplyScaleAndPosition(var Vec: TVector3f; Mask: TGLEParticleMask);
- procedure ApplyScaleAndPositionTarget(var Vec: TVector3f; Mask:
- TGLEParticleMask; TargetObject: TGLBaseSceneObject);
- procedure FindParticlePosition(var Vec: TVector3f; Mask: TGLEParticleMask);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function CreateParticlePositionFromMask(MaskName: string): TVector3f;
- function TargetParticlePositionFromMask(TargetObject: TGLBaseSceneObject; MaskName: string): TVector3f;
- procedure SetParticlePositionFromMask(Particle: TGLParticle; MaskName: string);
- procedure SetParticlePositionFromMaskTarget(Particle: TGLParticle; MaskName:
- string; TargetObject: TGLBaseSceneObject);
- function ParticleMaskByName(MaskName: string): TGLEParticleMask;
- published
- property ParticleMasks: TGLEParticleMasks read FParticleMasks write
- FParticleMasks;
- end;
- //--------------------------------------------------------------------------
- implementation
- //--------------------------------------------------------------------------
- { TGLEParticleMasks }
- function TGLEParticleMasks.Add: TGLEParticleMask;
- begin
- Result := (inherited Add) as TGLEParticleMask;
- end;
- constructor TGLEParticleMasks.Create(AOwner: TComponent);
- begin
- inherited Create(TGLEParticleMask);
- Owner := AOwner;
- end;
- function TGLEParticleMasks.GetItems(Index: Integer): TGLEParticleMask;
- begin
- Result := TGLEParticleMask(inherited Items[Index]);
- end;
- function TGLEParticleMasks.GetOwner: TPersistent;
- begin
- Result := Owner;
- end;
- procedure TGLEParticleMasks.SetItems(Index: Integer; const Val:
- TGLEParticleMask);
- begin
- inherited Items[Index] := Val;
- end;
- { TGLEParticleMask }
- procedure TGLEParticleMask.Assign(Source: TPersistent);
- begin
- if Source is TGLEParticleMask then
- begin
- FScale.Assign(TGLEParticleMask(Source).FScale);
- FPosition.Assign(TGLEParticleMask(Source).FPosition);
- FMaterialLibrary := TGLEParticleMask(Source).FMaterialLibrary;
- FXMask := TGLEParticleMask(Source).FXMask;
- FYMask := TGLEParticleMask(Source).FYMask;
- FZMask := TGLEParticleMask(Source).FZMask;
- end
- else
- inherited Assign(Source);
- end;
- constructor TGLEParticleMask.Create(Collection: TCollection);
- begin
- inherited Create(Collection);
- FName := 'ParticleMask' + IntToStr(ID);
- FScale := TGLCoordinates.CreateInitialized(Self, XYZHMGVector, csPoint);
- FPosition := TGLCoordinates.CreateInitialized(Self, NullHmgPoint, csPoint);
- FMaterialLibrary := nil;
- FMaskColor := clWhite;
- FBackGroundColor := clBlack;
- FTurnAngle := 0;
- FRollAngle := 0;
- FPitchAngle := 0;
- FXMask := '';
- FYMask := '';
- FZMask := '';
- UpdateExtents;
- end;
- destructor TGLEParticleMask.Destroy;
- begin
- FScale.Free;
- FPosition.Free;
- FMaterialLibrary := nil;
- FBackgroundColor := clBlack;
- FMaskColor := clWhite;
- FXMask := '';
- FYMask := '';
- FZMask := '';
- inherited Destroy;
- end;
- procedure TGLEParticleMask.GenerateMaskFromProjection(FromMask,
- ToMask: TGLEProjectedParticleMask; Depth: Integer);
- var
- FromBitMap: TBitmap;
- ToBitMap: TBitmap;
- X, Y: Integer;
- Rect: TRect;
- begin
- FromBitMap := nil;
- ToBitMap := nil;
- if not assigned(FMaterialLibrary) then
- Exit;
- if FromMask = ToMask then
- Exit; // we can't project to the same mask
- if Depth < 0 then
- Exit;
- case FromMask of
- pptXMask: FromBitMap := XCan;
- pptYMask: FromBitMap := YCan;
- pptZMask: FromBitMap := ZCan;
- end;
- if (FromBitMap.Width = 0) and (FromBitMap.Height = 0) then
- Exit; // we can't use something that has no image
- case ToMask of
- pptXMask: ToBitMap := XCan;
- pptYMask: ToBitMap := YCan;
- pptZMask: ToBitMap := ZCan;
- end;
- ToBitMap.Width := FromBitMap.Width;
- ToBitMap.Height := FromBitMap.Height;
- ToBitMap.Canvas.Pen.Color := FBackgroundColor;
- ToBitMap.Canvas.Pen.Style := psSolid;
- ToBitMap.Canvas.Brush.Color := FBackgroundColor;
- ToBitMap.Canvas.Brush.Style := bsSolid;
- Rect.Left := 0;
- Rect.Top := 0;
- Rect.Right := ToBitMap.Width;
- Rect.Bottom := ToBitMap.Height;
- ToBitMap.Canvas.FillRect(Rect);
- ToBitMap.Canvas.Pen.Color := FMaskColor;
- ToBitMap.Canvas.Brush.Color := FMaskColor;
- for X := 0 to ToBitMap.Width do
- for Y := 0 to ToBitMap.Height do
- begin
- // from x mask
- if (FromMask = pptXMask) and (ToMask = pptYMask) then
- if FromBitMap.Canvas.Pixels[X, Y] = FMaskColor then
- begin
- ToBitMap.Canvas.MoveTo(((FromBitmap.Width - Depth) div 2), X);
- ToBitMap.Canvas.LineTo(((FromBitmap.Width + Depth) div 2), X);
- end;
- if (FromMask = pptXMask) and (ToMask = pptZMask) then
- if FromBitMap.Canvas.Pixels[X, Y] = FMaskColor then
- begin
- ToBitMap.Canvas.MoveTo(((FromBitmap.Width - Depth) div 2), Y);
- ToBitMap.Canvas.LineTo(((FromBitmap.Width + Depth) div 2), Y);
- end;
- // from y mask
- if (FromMask = pptYMask) and (ToMask = pptXMask) then
- if FromBitMap.Canvas.Pixels[X, Y] = FMaskColor then
- begin
- ToBitMap.Canvas.MoveTo(Y, ((FromBitmap.Height - Depth) div 2));
- ToBitMap.Canvas.LineTo(Y, ((FromBitmap.Height + Depth) div 2));
- end;
- if (FromMask = pptYMask) and (ToMask = pptZMask) then
- if FromBitMap.Canvas.Pixels[X, Y] = FMaskColor then
- begin
- ToBitMap.Canvas.MoveTo(X, ((FromBitmap.Height - Depth) div 2));
- ToBitMap.Canvas.LineTo(X, ((FromBitmap.Height + Depth) div 2));
- end;
- // from z mask
- if (FromMask = pptZMask) and (ToMask = pptXMask) then
- if FromBitMap.Canvas.Pixels[X, Y] = FMaskColor then
- begin
- ToBitMap.Canvas.MoveTo(((FromBitmap.Width - Depth) div 2), Y);
- ToBitMap.Canvas.LineTo(((FromBitmap.Width + Depth) div 2), Y);
- end;
- if (FromMask = pptZMask) and (ToMask = pptYMask) then
- if FromBitMap.Canvas.Pixels[X, Y] = FMaskColor then
- begin
- ToBitMap.Canvas.MoveTo(X, ((FromBitmap.Height - Depth) div 2));
- ToBitMap.Canvas.LineTo(X, ((FromBitmap.Height + Depth) div 2));
- end;
- end;
- UpdateExtents;
- end;
- function TGLEParticleMask.GetDisplayName: string;
- begin
- Result := '';
- if FName <> '' then
- Result := FName
- else
- Result := 'TGLEParticleMask';
- end;
- function TGLEParticleMask.GetMaterialLibrary: TGLAbstractMaterialLibrary;
- begin
- Result := FMaterialLibrary;
- end;
- procedure TGLEParticleMask.Pitch(Angle: Single);
- begin
- FPitchAngle := FPitchAngle + Angle;
- end;
- procedure TGLEParticleMask.Roll(Angle: Single);
- begin
- FRollAngle := FRollAngle + Angle;
- end;
- procedure TGLEParticleMask.SetMaterialLibrary(const Value: TGLMaterialLibrary);
- begin
- FMaterialLibrary := Value;
- UpdateExtents;
- end;
- procedure TGLEParticleMask.SetName(const Value: string);
- var
- I: Integer;
- begin
- for I := 1 to Length(Value) do
- if Value[I] = ' ' then
- begin
- raise Exception.Create('Cannot contain spaces or special characters.');
- Exit;
- end;
- FName := Value;
- end;
- procedure TGLEParticleMask.SetXMask(const Value: TGLLibMaterialName);
- begin
- FXMask := Value;
- if assigned(FMaterialLibrary) then
- if not assigned(FMaterialLibrary.LibMaterialByName(FXMask)) then
- begin
- XCan.Width := 0;
- XCan.Height := 0;
- end;
- UpdateExtents;
- end;
- procedure TGLEParticleMask.SetYMask(const Value: TGLLibMaterialName);
- begin
- FYMask := Value;
- if assigned(FMaterialLibrary) then
- if not assigned(FMaterialLibrary.LibMaterialByName(FYMask)) then
- begin
- YCan.Width := 0;
- YCan.Height := 0;
- end;
- UpdateExtents;
- end;
- procedure TGLEParticleMask.SetZMask(const Value: TGLLibMaterialName);
- begin
- FZMask := Value;
- if assigned(FMaterialLibrary) then
- if not assigned(FMaterialLibrary.LibMaterialByName(FZMask)) then
- begin
- ZCan.Width := 0;
- ZCan.Height := 0;
- end;
- UpdateExtents;
- end;
- procedure TGLEParticleMask.Turn(Angle: Single);
- begin
- FTurnAngle := FTurnAngle + Angle;
- end;
- procedure TGLEParticleMask.UpdateExtents;
- var
- MinXX, MinXY, MinYX, MinYY, MinZX, MinZY: Integer;
- MaxXX, MaxXY, MaxYX, MaxYY, MaxZX, MaxZY: Integer;
- X, Y: Integer;
- begin
- FMinX := 0; // min extents
- FMinY := 0;
- FMinZ := 0;
- FMaxX := 0; // max extents
- FMaxY := 0;
- FMaxZ := 0;
- IXW := 0; // widths
- IYW := 0;
- IZW := 0;
- IXH := 0; // heights
- IYH := 0;
- IZH := 0;
- MinXX := 0; // min plane mask extents
- MinXY := 0;
- MinYX := 0;
- MinYY := 0;
- MinZX := 0;
- MinZY := 0;
- MaxXX := 0; // max plane mask extents
- MaxXY := 0;
- MaxYX := 0;
- MaxYY := 0;
- MaxZX := 0;
- MaxZY := 0;
- BogusMask := True; // prevents system locks
- BogusMaskX := True;
- BogusMaskY := True;
- BogusMaskZ := True;
- // we don't find it? no point in continuing
- if not assigned(FMaterialLibrary) then
- Exit;
- // it is recommended to have 3 different masks
- // if there is only 2, the 3rd image will just take the largest extents and use them...
- // creating not a very good effect
- if XCan <> nil then
- begin
- IXW := XCan.Width;
- IXH := XCan.Height;
- end;
- if YCan <> nil then
- begin
- IYW := YCan.Width;
- IYH := YCan.Height;
- end;
- if ZCan <> nil then
- begin
- IZW := ZCan.Width;
- IZH := ZCan.Height;
- end;
- // we find the largest dimensions of each image and give them to min mask extents so we work backwards
- MX := MaxInteger(MaxInteger(IXW, IYW), IZW);
- MY := MaxInteger(MaxInteger(IXH, IYH), IZH);
- if XCan <> nil then
- begin
- MinXX := MX;
- MinXY := MY;
- end;
- if YCan <> nil then
- begin
- MinYX := MX;
- MinYY := MY;
- end;
- if ZCan <> nil then
- begin
- MinZX := MX;
- MinZY := MY;
- end;
- // this is where we work backwards from to find the max size of the dimensions...
- // in a sense, this provides information for the randomizing, and speeds up the code
- for X := 0 to MX do
- for Y := 0 to MY do
- begin
- if XCan <> nil then
- if (X <= XCan.Width) and (Y <= XCan.Height) then
- if (XCan.Canvas.Pixels[X, Y] = FMaskColor) then
- begin
- if X > MaxXX then
- MaxXX := X;
- if Y > MaxXY then
- MaxXY := Y;
- if X < MinXX then
- MinXX := X;
- if X < MinXY then
- MinXY := Y;
- BogusMaskX := False;
- end;
- if YCan <> nil then
- if (X <= YCan.Width) and (Y <= YCan.Height) then
- if (YCan.Canvas.Pixels[X, Y] = FMaskColor) then
- begin
- if X > MaxYX then
- MaxYX := X;
- if Y > MaxYY then
- MaxYY := Y;
- if X < MinYX then
- MinYX := X;
- if X < MinYY then
- MinYY := Y;
- BogusMaskY := False;
- end;
- if ZCan <> nil then
- if (X <= ZCan.Width) and (Y <= ZCan.Height) then
- if (ZCan.Canvas.Pixels[X, Y] = FMaskColor) then
- begin
- if X > MaxZX then
- MaxZX := X;
- if Y > MaxZY then
- MaxZY := Y;
- if X < MinZX then
- MinZX := X;
- if X < MinZY then
- MinZY := Y;
- BogusMaskZ := False;
- end;
- end;
- BogusMask := (BogusMaskX or BogusMaskY or BogusMaskZ);
- // here we find our 3d extents from a 1st angle orthographic shape
- FMinX := MinInteger(MinZX, MinYX);
- FMinY := MinInteger(MinXY, MinZY);
- FMinZ := MinInteger(MinXX, MinYY);
- FMaxX := MaxInteger(MaxZX, MaxYX);
- FMaxY := MaxInteger(MaxXY, MaxZY);
- FMaxZ := MaxInteger(MaxXX, MaxYY);
- // this is the largest mask image sizes converted to orthographic and extents... used later on
- LX := MaxInteger(IZW, IYW);
- LY := MaxInteger(IXH, IZH);
- LZ := MaxInteger(IXW, IYH);
- end;
- function TGLEParticleMask.XCan: TBitmap;
- begin
- Result := nil;
- if not assigned(FMaterialLibrary) then
- Exit;
- if not assigned(FMaterialLibrary.LibMaterialByName(FXMask)) then
- Exit;
- if FMaterialLibrary.LibMaterialByName(FXMask).Material.Texture.ImageClassName
- <> TGLPersistentImage.ClassName then
- Exit;
- Result :=
- TBitmap((FMaterialLibrary.LibMaterialByName(FXMask).Material.Texture.Image as
- TGLPersistentImage).Picture.Bitmap);
- end;
- function TGLEParticleMask.YCan: TBitmap;
- begin
- Result := nil;
- if not assigned(FMaterialLibrary) then
- Exit;
- if not assigned(FMaterialLibrary.LibMaterialByName(FYMask)) then
- Exit;
- if FMaterialLibrary.LibMaterialByName(FYMask).Material.Texture.ImageClassName
- <> TGLPersistentImage.ClassName then
- Exit;
- Result :=
- TBitmap((FMaterialLibrary.LibMaterialByName(FYMask).Material.Texture.Image as
- TGLPersistentImage).Picture.Bitmap);
- end;
- function TGLEParticleMask.ZCan: TBitmap;
- begin
- Result := nil;
- if not assigned(FMaterialLibrary) then
- Exit;
- if not assigned(FMaterialLibrary.LibMaterialByName(FZMask)) then
- Exit;
- if FMaterialLibrary.LibMaterialByName(FZMask).Material.Texture.ImageClassName
- <> TGLPersistentImage.ClassName then
- Exit;
- Result :=
- TBitmap((FMaterialLibrary.LibMaterialByName(FZMask).Material.Texture.Image as
- TGLPersistentImage).Picture.Bitmap);
- end;
- function TGLEParticleMask.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
- begin
- if GetInterface(IID, Obj) then
- Result := S_OK
- else
- Result := E_NOINTERFACE;
- end;
- function TGLEParticleMask._AddRef: Integer; stdcall;
- begin
- Result := -1; //ignore
- end;
- function TGLEParticleMask._Release: Integer; stdcall;
- begin
- Result := -1; //ignore
- end;
- { TGLEParticleMasksManager }
- procedure TGLEParticleMasksManager.ApplyOrthoGraphic(var Vec: TVector3f; Mask:
- TGLEParticleMask);
- begin
- Vec.X := (Mask.LX / 2 - Vec.X) / Mask.LX;
- Vec.Y := (Mask.LY / 2 - Vec.Y) / Mask.LY;
- Vec.Z := (Mask.LZ / 2 - Vec.Z) / Mask.LZ;
- end;
- procedure TGLEParticleMasksManager.ApplyRotation(var Vec: TVector3f; Mask:
- TGLEParticleMask);
- begin
- Vec := VectorRotateAroundX(Vec, DegToRad(Mask.FPitchAngle));
- Vec := VectorRotateAroundY(Vec, DegToRad(Mask.FTurnAngle));
- Vec := VectorRotateAroundZ(Vec, DegToRad(Mask.FRollAngle));
- end;
- procedure TGLEParticleMasksManager.ApplyRotationTarget(var Vec: TVector3f; Mask:
- TGLEParticleMask; TargetObject: TGLBaseSceneObject);
- begin
- Vec := VectorRotateAroundX(Vec, DegToRad(Mask.FPitchAngle +
- TargetObject.Rotation.X));
- Vec := VectorRotateAroundY(Vec, DegToRad(Mask.FTurnAngle +
- TargetObject.Rotation.Y));
- Vec := VectorRotateAroundZ(Vec, DegToRad(Mask.FRollAngle +
- TargetObject.Rotation.Z));
- end;
- procedure TGLEParticleMasksManager.ApplyScaleAndPosition(var Vec: TVector3f;
- Mask: TGLEParticleMask);
- begin
- Vec.X := Vec.X * Mask.FScale.DirectX + Mask.FPosition.DirectX;
- Vec.Y := Vec.Y * Mask.FScale.DirectY + Mask.FPosition.DirectY;
- Vec.Z := Vec.Z * Mask.FScale.DirectZ + Mask.FPosition.DirectZ;
- end;
- procedure TGLEParticleMasksManager.ApplyScaleAndPositionTarget(var Vec:
- TVector3f; Mask: TGLEParticleMask; TargetObject: TGLBaseSceneObject);
- begin
- Vec.X := Vec.X * Mask.FScale.DirectX * TargetObject.Scale.DirectX +
- Mask.FPosition.DirectX + TargetObject.AbsolutePosition.X;
- Vec.Y := Vec.Y * Mask.FScale.DirectY * TargetObject.Scale.DirectY +
- Mask.FPosition.DirectY + TargetObject.AbsolutePosition.Y;
- Vec.Z := Vec.Z * Mask.FScale.DirectZ * TargetObject.Scale.DirectZ +
- Mask.FPosition.DirectZ + TargetObject.AbsolutePosition.Z;
- end;
- constructor TGLEParticleMasksManager.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FParticleMasks := TGLEParticleMasks.Create(Self);
- end;
- function TGLEParticleMasksManager.CreateParticlePositionFromMask(MaskName:
- string): TVector3f;
- var
- Mask: TGLEParticleMask;
- begin
- Result := NullVector;
- Mask := ParticleMaskByName(MaskName);
- if not assigned(Mask) then
- Exit;
- if Mask.BogusMask then
- Exit;
- // finds the particle position on the masks
- FindParticlePosition(Result, Mask);
- // this converts 1st angle orthographic to 3rd angle orthograhic
- ApplyOrthoGraphic(Result, Mask);
- // this just turns it accordingly
- ApplyRotation(Result, Mask);
- // this applies the scales and positioning
- ApplyScaleAndPosition(Result, Mask);
- end;
- destructor TGLEParticleMasksManager.Destroy;
- begin
- FParticleMasks.Destroy;
- inherited Destroy;
- end;
- procedure TGLEParticleMasksManager.FindParticlePosition(var Vec: TVector3f;
- Mask: TGLEParticleMask);
- var
- X, Y, Z: Integer;
- begin
- repeat
- X := Random(Mask.FMaxX - Mask.FMinX) + Mask.FMinX;
- Y := Random(Mask.FMaxY - Mask.FMinY) + Mask.FMinY;
- Z := Random(Mask.FMaxZ - Mask.FMinZ) + Mask.FMinZ;
- until (Mask.XCan.Canvas.Pixels[Z, Y] = Mask.FMaskColor) and
- (Mask.YCan.Canvas.Pixels[X, Z] = Mask.FMaskColor) and
- (Mask.ZCan.Canvas.Pixels[X, Y] = Mask.FMaskColor);
- MakeVector(Vec, X, Y, Z);
- end;
- function TGLEParticleMasksManager.ParticleMaskByName(MaskName: string):
- TGLEParticleMask;
- var
- I: Integer;
- begin
- Result := nil;
- if FParticleMasks.Count > 0 then
- for I := 0 to FParticleMasks.Count - 1 do
- if FParticleMasks.Items[I].FName = MaskName then
- Result := FParticleMasks.Items[I];
- end;
- procedure TGLEParticleMasksManager.SetParticlePositionFromMask(
- Particle: TGLParticle; MaskName: string);
- begin
- if not assigned(Particle) then
- Exit;
- Particle.Position := CreateParticlePositionFromMask(MaskName);
- end;
- procedure TGLEParticleMasksManager.SetParticlePositionFromMaskTarget(
- Particle: TGLParticle; MaskName: string; TargetObject: TGLBaseSceneObject);
- begin
- if not assigned(Particle) then
- Exit;
- Particle.Position := TargetParticlePositionFromMask(TargetObject, MaskName);
- end;
- function TGLEParticleMasksManager.TargetParticlePositionFromMask(
- TargetObject: TGLBaseSceneObject; MaskName: string): TVector3f;
- var
- Mask: TGLEParticleMask;
- begin
- Result := NullVector;
- if not assigned(TargetObject) then
- Exit;
- Mask := ParticleMaskByName(MaskName);
- if not assigned(Mask) then
- Exit;
- if Mask.BogusMask then
- Exit;
- // finds the particle position on the masks
- FindParticlePosition(Result, Mask);
- // this converts 1st angle orthographic to 3rd angle orthograhic
- ApplyOrthoGraphic(Result, Mask);
- // this just turns it accordingly
- ApplyRotationTarget(Result, Mask, TargetObject);
- // this applies the scales and positioning
- ApplyScaleAndPositionTarget(Result, Mask, TargetObject);
- end;
- end.
|