1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063 |
- //
- // The graphics rendering platform GLScene http://glscene.org
- //
- unit DWSx.Scene;
- (*
- DelphiWebScript symbol creation for base FMX classes.
- This unit is dependent on dws2Classes and dws2VectorGeometry.
- These components must be associated with the same compiler
- for the FireMonkey classes to inherit from.
- *)
- interface
- uses
- System.Classes,
- System.SysUtils,
- GXS.Scene,
- GXS.VectorGeometry,
- GXS.Coordinates,
- DWSx.HelperFunc,
- dwsExprs, // dwxExprs, ... ?
- dwsSymbols,
- dwsComp,
- dwsCompStrings,
- dwsStack,
- dwsFunctions;
- type
- TdwxGLSceneUnit = class(TdwxUnitComponent)
- private
- procedure AddClassTGLCoordinates(SymbolTable: TSymbolTable);
- procedure AddClassTGLBaseSceneObject(SymbolTable: TSymbolTable);
- protected
- procedure AddUnitSymbols(SymbolTable: TSymbolTable); override;
- public
- constructor Create(AOwner: TComponent); override;
- end;
- procedure Register;
- // --------------------------------------------------------
- implementation
- // --------------------------------------------------------
- // ----------
- // ---------- Internal class method class declarations ----------
- // ----------
- type
- // --------------------------
- // -------- TGLCoordinates
- // --------------------------
- TGLCoordinatesSetXMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesGetXMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesSetYMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesGetYMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesSetZMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesGetZMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesSetWMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesGetWMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesSetVectorMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesSetPointMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesSetToZeroMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesSetAsVectorMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesGetAsVectorMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesGetAsStringMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesTranslateMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesAddScaledVectorMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesRotateMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesNormalizeMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesInvertMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesScaleMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLCoordinatesEqualsMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- // --------------------------
- // TGLBaseSceneObject
- // --------------------------
- TGLBaseSceneObjectSetVisibleMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectGetVisibleMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectSetMatrixMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectGetMatrixMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectAbsoluteMatrixMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectInvAbsoluteMatrixMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectSetAbsolutePositionMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectGetAbsolutePositionMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectSetAbsoluteUpMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectGetAbsoluteUpMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectSetAbsoluteDirectionMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectGetAbsoluteDirectionMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectSetPositionMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectGetPositionMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectSetDirectionMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectGetDirectionMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectSetUpMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectGetUpMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectSetScaleMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectGetScaleMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectSetPitchAngleMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectGetPitchAngleMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectSetTurnAngleMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectGetTurnAngleMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectSetRollAngleMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectGetRollAngleMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectPitchMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectTurnMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectRollMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectMoveMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- TGLBaseSceneObjectAddChildMethod = class(TInternalMethod)
- public
- procedure Execute(var ExternalObject: TObject); override;
- end;
- // ----------
- // ---------- Vector/Matrix to/from IInfo helper functions ----------
- // ----------
- function GetVectorFromInfo(Info: IInfo): TGXVector;
- begin
- Result := VectorMake(Info.Element([0]).Value, Info.Element([1]).Value,
- Info.Element([2]).Value, Info.Element([3]).Value);
- end;
- procedure SetInfoFromVector(Info: IInfo; vec: TGXVector);
- var
- i: Integer;
- begin
- for i := 0 to 3 do
- Info.Element([i]).Value := vec[i];
- end;
- function GetMatrixFromInfo(Info: IInfo): TGXMatrix;
- var
- i: Integer;
- begin
- for i := 0 to 3 do
- Result[i] := VectorMake(Info.Element([i]).Element([0]).Value,
- Info.Element([i]).Element([1]).Value, Info.Element([i]).Element([2])
- .Value, Info.Element([i]).Element([3]).Value);
- end;
- procedure SetInfoFromMatrix(Info: IInfo; mat: TGXMatrix);
- var
- i, j: Integer;
- begin
- for i := 0 to 3 do
- for j := 0 to 3 do
- Info.Element([i]).Element([j]).Value := mat[i][j];
- end;
- // ----------
- // ---------- Internal class method execute procedures ----------
- // ----------
- // TGLCoordinates internal class methods
- // TGLCoordinates.X write access
- procedure TGLCoordinatesSetXMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- TGLCoordinates(ExternalObject).X := Info['Value'];
- end;
- // TGLCoordinates.X read access
- procedure TGLCoordinatesGetXMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- Info.Result := TGLCoordinates(ExternalObject).X;
- end;
- // TGLCoordinates.Y write access
- procedure TGLCoordinatesSetYMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- TGLCoordinates(ExternalObject).Y := Info['Value'];
- end;
- // TGLCoordinates.Y read access
- procedure TGLCoordinatesGetYMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- Info.Result := TGLCoordinates(ExternalObject).Y;
- end;
- // TGLCoordinates.Z write access
- procedure TGLCoordinatesSetZMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- TGLCoordinates(ExternalObject).Z := Info['Value'];
- end;
- // TGLCoordinates.Z read access
- procedure TGLCoordinatesGetZMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- Info.Result := TGLCoordinates(ExternalObject).Z;
- end;
- // TGLCoordinates.W write access
- procedure TGLCoordinatesSetWMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- TGLCoordinates(ExternalObject).W := Info['Value'];
- end;
- // TGLCoordinates.W read access
- procedure TGLCoordinatesGetWMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- Info.Result := TGLCoordinates(ExternalObject).W;
- end;
- // TGLCoordinates.SetVector
- procedure TGLCoordinatesSetVectorMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- TGLCoordinates(ExternalObject).SetVector(Info['x'], Info['y'], Info['z'],
- Info['w']);
- end;
- // TGLCoordinates.SetPoint
- procedure TGLCoordinatesSetPointMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- TGLCoordinates(ExternalObject).SetPoint(Info['x'], Info['y'], Info['z']);
- end;
- // TGLCoordinates.AsVector write access
- procedure TGLCoordinatesSetAsVectorMethod.Execute(var ExternalObject: TObject);
- var
- v: TGXVector;
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- v := GetVectorFromInfo(Info.Vars['Value']);
- TGLCoordinates(ExternalObject).AsVector := v;
- end;
- // TGLCoordinates.AsVector read access
- procedure TGLCoordinatesGetAsVectorMethod.Execute(var ExternalObject: TObject);
- var
- v: TGXVector;
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- v := TGLCoordinates(ExternalObject).AsVector;
- SetInfoFromVector(Info.Vars['Result'], v);
- end;
- // TGLCoordinates.AsString read access
- procedure TGLCoordinatesGetAsStringMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- Info.Result := TGLCoordinates(ExternalObject).AsString;
- end;
- // TGLCoordinates.Translate
- procedure TGLCoordinatesTranslateMethod.Execute(var ExternalObject: TObject);
- var
- v: TGXVector;
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- v := GetVectorFromInfo(Info.Vars['translationVector']);
- TGLCoordinates(ExternalObject).Translate(v);
- end;
- // TGLCoordinates.AddScaledVector
- procedure TGLCoordinatesAddScaledVectorMethod.Execute(var ExternalObject
- : TObject);
- var
- v: TGXVector;
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- v := GetVectorFromInfo(Info.Vars['translationVector']);
- TGLCoordinates(ExternalObject).AddScaledVector(Info['factor'], v);
- end;
- // TGLCoordinates.Rotate
- procedure TGLCoordinatesRotateMethod.Execute(var ExternalObject: TObject);
- var
- v: TGXVector;
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- v := GetVectorFromInfo(Info.Vars['anAxis']);
- TGLCoordinates(ExternalObject).Rotate(v, Info['anAngle']);
- end;
- // TGLCoordinates.Normalize
- procedure TGLCoordinatesNormalizeMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- TGLCoordinates(ExternalObject).Normalize;
- end;
- // TGLCoordinates.Invert
- procedure TGLCoordinatesInvertMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- TGLCoordinates(ExternalObject).Invert;
- end;
- // TGLCoordinates.Scale
- procedure TGLCoordinatesScaleMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- TGLCoordinates(ExternalObject).Scale(Info['factor']);
- end;
- // TGLCoordinates.Equals
- procedure TGLCoordinatesEqualsMethod.Execute(var ExternalObject: TObject);
- var
- v: TGXVector;
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- v := GetVectorFromInfo(Info.Vars['aVector']);
- Info.Result := TGLCoordinates(ExternalObject).Equals(v);
- end;
- // TGLCoordinates.SetToZero
- procedure TGLCoordinatesSetToZeroMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLCoordinates);
- TGLCoordinates(ExternalObject).SetToZero;
- end;
- // TGLBaseSceneObject internal class methods
- // TGLBaseSceneObject.SetVisible
- procedure TGLBaseSceneObjectSetVisibleMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- TGLBaseSceneObject(ExternalObject).Visible := Info.Vars['Value'].Value;
- end;
- // TGLBaseSceneObject.GetVisible
- procedure TGLBaseSceneObjectGetVisibleMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- Info.Result := TGLBaseSceneObject(ExternalObject).Visible;
- end;
- // TGLBaseSceneObject.SetMatrix
- procedure TGLBaseSceneObjectSetMatrixMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- TGLBaseSceneObject(ExternalObject).Matrix :=
- GetMatrixFromInfo(Info.Vars['Value']);
- end;
- // TGLBaseSceneObject.GetMatrix
- procedure TGLBaseSceneObjectGetMatrixMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- SetInfoFromMatrix(Info.Vars['Result'],
- TGLBaseSceneObject(ExternalObject).Matrix);
- end;
- // TGLBaseSceneObject.AbsoluteMatrix
- procedure TGLBaseSceneObjectAbsoluteMatrixMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- SetInfoFromMatrix(Info.Vars['Result'], TGLBaseSceneObject(ExternalObject)
- .AbsoluteMatrix);
- end;
- // TGLBaseSceneObject.InvAbsoluteMatrix
- procedure TGLBaseSceneObjectInvAbsoluteMatrixMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- SetInfoFromMatrix(Info.Vars['Result'], TGLBaseSceneObject(ExternalObject)
- .InvAbsoluteMatrix);
- end;
- // TGLBaseSceneObject.SetAbsolutePosition
- procedure TGLBaseSceneObjectSetAbsolutePositionMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- TGLBaseSceneObject(ExternalObject).AbsolutePosition :=
- GetVectorFromInfo(Info.Vars['Value']);
- end;
- // TGLBaseSceneObject.GetAbsolutePosition
- procedure TGLBaseSceneObjectGetAbsolutePositionMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- SetInfoFromVector(Info.Vars['Result'], TGLBaseSceneObject(ExternalObject)
- .AbsolutePosition);
- end;
- // TGLBaseSceneObject.SetAbsoluteUp
- procedure TGLBaseSceneObjectSetAbsoluteUpMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- TGLBaseSceneObject(ExternalObject).AbsoluteUp :=
- GetVectorFromInfo(Info.Vars['Value']);
- end;
- // TGLBaseSceneObject.GetAbsoluteUp
- procedure TGLBaseSceneObjectGetAbsoluteUpMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- SetInfoFromVector(Info.Vars['Result'], TGLBaseSceneObject(ExternalObject)
- .AbsoluteUp);
- end;
- // TGLBaseSceneObject.SetAbsoluteDirection
- procedure TGLBaseSceneObjectSetAbsoluteDirectionMethod.Execute
- (var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- TGLBaseSceneObject(ExternalObject).AbsoluteDirection :=
- GetVectorFromInfo(Info.Vars['Value']);
- end;
- // TGLBaseSceneObject.GetAbsoluteDirection
- procedure TGLBaseSceneObjectGetAbsoluteDirectionMethod.Execute
- (var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- SetInfoFromVector(Info.Vars['Result'], TGLBaseSceneObject(ExternalObject)
- .AbsoluteDirection);
- end;
- // TGLBaseSceneObject.Position write access
- procedure TGLBaseSceneObjectSetPositionMethod.Execute(var ExternalObject
- : TObject);
- var
- Value: TGLCoordinates;
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- Value := TGLCoordinates(Info.GetExternalObjForVar('Value'));
- TGLBaseSceneObject(ExternalObject).Position := Value;
- end;
- // TGLBaseSceneObject.Position read access
- procedure TGLBaseSceneObjectGetPositionMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- Info.Result := Info.RegisterExternalObject(TGLBaseSceneObject(ExternalObject)
- .Position);
- end;
- // TGLBaseSceneObject.Direction write access
- procedure TGLBaseSceneObjectSetDirectionMethod.Execute(var ExternalObject
- : TObject);
- var
- Value: TGLCoordinates;
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- Value := TGLCoordinates(Info.GetExternalObjForVar('Value'));
- TGLBaseSceneObject(ExternalObject).Direction := Value;
- end;
- // TGLBaseSceneObject.Direction read access
- procedure TGLBaseSceneObjectGetDirectionMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- Info.Result := Info.RegisterExternalObject(TGLBaseSceneObject(ExternalObject)
- .Direction);
- end;
- // TGLBaseSceneObject.Up write access
- procedure TGLBaseSceneObjectSetUpMethod.Execute(var ExternalObject: TObject);
- var
- Value: TGLCoordinates;
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- Value := TGLCoordinates(Info.GetExternalObjForVar('Value'));
- TGLBaseSceneObject(ExternalObject).Up := Value;
- end;
- // TGLBaseSceneObject.Up read access
- procedure TGLBaseSceneObjectGetUpMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- Info.Result := Info.RegisterExternalObject
- (TGLBaseSceneObject(ExternalObject).Up);
- end;
- // TGLBaseSceneObject.Scale write access
- procedure TGLBaseSceneObjectSetScaleMethod.Execute(var ExternalObject: TObject);
- var
- Value: TGLCoordinates;
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- Value := TGLCoordinates(Info.GetExternalObjForVar('Value'));
- TGLBaseSceneObject(ExternalObject).Scale := Value;
- end;
- // TGLBaseSceneObject.Scale read access
- procedure TGLBaseSceneObjectGetScaleMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- Info.Result := Info.RegisterExternalObject
- (TGLBaseSceneObject(ExternalObject).Scale);
- end;
- // TGLBaseSceneObject.PitchAngle write access
- procedure TGLBaseSceneObjectSetPitchAngleMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- TGLBaseSceneObject(ExternalObject).PitchAngle := Info.Vars['Value'].Value;
- end;
- // TGLBaseSceneObject.PitchAngle read access
- procedure TGLBaseSceneObjectGetPitchAngleMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- Info.Result := TGLBaseSceneObject(ExternalObject).PitchAngle;
- end;
- // TGLBaseSceneObject.TurnAngle write access
- procedure TGLBaseSceneObjectSetTurnAngleMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- TGLBaseSceneObject(ExternalObject).TurnAngle := Info.Vars['Value'].Value;
- end;
- // TGLBaseSceneObject.TurnAngle read access
- procedure TGLBaseSceneObjectGetTurnAngleMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- Info.Result := TGLBaseSceneObject(ExternalObject).TurnAngle;
- end;
- // TGLBaseSceneObject.RollAngle write access
- procedure TGLBaseSceneObjectSetRollAngleMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- TGLBaseSceneObject(ExternalObject).RollAngle := Info.Vars['Value'].Value;
- end;
- // TGLBaseSceneObject.RollAngle read access
- procedure TGLBaseSceneObjectGetRollAngleMethod.Execute(var ExternalObject
- : TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- Info.Result := TGLBaseSceneObject(ExternalObject).RollAngle;
- end;
- // TGLBaseSceneObject.Pitch
- procedure TGLBaseSceneObjectPitchMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- TGLBaseSceneObject(ExternalObject).Pitch(Info['angle']);
- end;
- // TGLBaseSceneObject.Turn
- procedure TGLBaseSceneObjectTurnMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- TGLBaseSceneObject(ExternalObject).Turn(Info['angle']);
- end;
- // TGLBaseSceneObject.Roll
- procedure TGLBaseSceneObjectRollMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- TGLBaseSceneObject(ExternalObject).Roll(Info['angle']);
- end;
- // TGLBaseSceneObject.Move
- procedure TGLBaseSceneObjectMoveMethod.Execute(var ExternalObject: TObject);
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- TGLBaseSceneObject(ExternalObject).Move(Info['ADistance']);
- end;
- // TGLBaseSceneObject.AddChild
- procedure TGLBaseSceneObjectAddChildMethod.Execute(var ExternalObject: TObject);
- var
- AChild: TObject;
- begin
- ValidateExternalObject(ExternalObject, TGLBaseSceneObject);
- AChild := Info.GetExternalObjForVar('AChild');
- if not Assigned(AChild) then
- raise Exception.Create('AChild parameter is unassigned.');
- if not(AChild is TGLBaseSceneObject) then
- Exception.Create
- ('AChild parameter is not inheriting from TGLBaseSceneObject.');
- TGLBaseSceneObject(ExternalObject).AddChild(TGLBaseSceneObject(AChild));
- end;
- // ----------
- // ---------- Global procedures/functions ----------
- // ----------
- // ----------
- // ---------- TdwsGLSceneUnit ----------
- // ----------
- constructor TdwsGLSceneUnit.Create(AOwner: TComponent);
- begin
- inherited;
- FUnitName := 'GLScene';
- with FDependencies do
- begin
- Add('Classes');
- Add('GXS.VectorGeometry');
- end;
- end;
- procedure TdwsGLSceneUnit.AddClassTGLCoordinates(SymbolTable: TSymbolTable);
- var
- ClassSym: TClassSymbol;
- begin
- ClassSym := TClassSymbol(AddClassSymbol(SymbolTable, 'TGLCoordinates',
- 'TPersistent'));
- // Methods
- if not Assigned(ClassSym.Members.FindLocal('SetX')) then
- TGLCoordinatesSetXMethod.Create(mkProcedure, [], 0, 'SetX',
- ['Value', 'Float'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetX')) then
- TGLCoordinatesGetXMethod.Create(mkFunction, [], 0, 'GetX', [], 'Float',
- ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetY')) then
- TGLCoordinatesSetYMethod.Create(mkProcedure, [], 0, 'SetY',
- ['Value', 'Float'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetY')) then
- TGLCoordinatesGetYMethod.Create(mkFunction, [], 0, 'GetY', [], 'Float',
- ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetZ')) then
- TGLCoordinatesSetZMethod.Create(mkProcedure, [], 0, 'SetZ',
- ['Value', 'Float'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetZ')) then
- TGLCoordinatesGetZMethod.Create(mkFunction, [], 0, 'GetZ', [], 'Float',
- ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetW')) then
- TGLCoordinatesSetWMethod.Create(mkProcedure, [], 0, 'SetW',
- ['Value', 'Float'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetW')) then
- TGLCoordinatesGetWMethod.Create(mkFunction, [], 0, 'GetW', [], 'Float',
- ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetVector')) then
- TGLCoordinatesSetVectorMethod.Create(mkProcedure, [], 0, 'SetVector',
- ['x', 'Float', 'y', 'Float', 'z', 'Float', 'w', 'Float'], '', ClassSym,
- SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetPoint')) then
- TGLCoordinatesSetPointMethod.Create(mkProcedure, [], 0, 'SetPoint',
- ['x', 'Float', 'y', 'Float', 'z', 'Float'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetToZero')) then
- TGLCoordinatesSetToZeroMethod.Create(mkProcedure, [], 0, 'SetToZero', [],
- '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetAsVector')) then
- TGLCoordinatesSetAsVectorMethod.Create(mkProcedure, [], 0, 'SetAsVector',
- ['Value', 'TGXVector'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetAsVector')) then
- TGLCoordinatesGetAsVectorMethod.Create(mkFunction, [], 0, 'GetAsVector', [],
- 'TGXVector', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetAsString')) then
- TGLCoordinatesGetAsStringMethod.Create(mkFunction, [], 0, 'GetAsString', [],
- 'String', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('Translate')) then
- TGLCoordinatesTranslateMethod.Create(mkProcedure, [], 0, 'Translate',
- ['translationVector', 'TGXVector'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('AddScaledVector')) then
- TGLCoordinatesAddScaledVectorMethod.Create(mkProcedure, [], 0,
- 'AddScaledVector', ['factor', 'Float', 'translationVector', 'TGXVector'],
- '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('Rotate')) then
- TGLCoordinatesRotateMethod.Create(mkProcedure, [], 0, 'Rotate',
- ['anAxis', 'TGXVector', 'anAngle', 'Float'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('Normalize')) then
- TGLCoordinatesNormalizeMethod.Create(mkProcedure, [], 0, 'Normalize', [],
- '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('Invert')) then
- TGLCoordinatesInvertMethod.Create(mkProcedure, [], 0, 'Invert', [], '',
- ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('Scale')) then
- TGLCoordinatesScaleMethod.Create(mkProcedure, [], 0, 'Scale',
- ['factor', 'Float'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('Equals')) then
- TGLCoordinatesEqualsMethod.Create(mkFunction, [], 0, 'Equals',
- ['aVector', 'TGXVector'], 'Boolean', ClassSym, SymbolTable);
- // Properties
- AddPropertyToClass('X', 'Float', 'GetX', 'SetX', '', False, ClassSym,
- SymbolTable);
- AddPropertyToClass('Y', 'Float', 'GetY', 'SetY', '', False, ClassSym,
- SymbolTable);
- AddPropertyToClass('Z', 'Float', 'GetZ', 'SetZ', '', False, ClassSym,
- SymbolTable);
- AddPropertyToClass('AsVector', 'TGXVector', 'GetAsVector', 'SetAsVector', '',
- False, ClassSym, SymbolTable);
- AddPropertyToClass('AsString', 'String', 'GetAsString', '', '', False,
- ClassSym, SymbolTable);
- end;
- procedure TdwsGLSceneUnit.AddClassTGLBaseSceneObject(SymbolTable: TSymbolTable);
- var
- ClassSym: TClassSymbol;
- begin
- ClassSym := TClassSymbol(AddClassSymbol(SymbolTable, 'TGLBaseSceneObject',
- 'TComponent'));
- // Methods
- if not Assigned(ClassSym.Members.FindLocal('SetVisible')) then
- TGLBaseSceneObjectSetVisibleMethod.Create(mkProcedure, [], 0, 'SetVisible',
- ['Value', 'Boolean'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetVisible')) then
- TGLBaseSceneObjectGetVisibleMethod.Create(mkFunction, [], 0, 'GetVisible',
- [], 'Boolean', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetMatrix')) then
- TGLBaseSceneObjectSetMatrixMethod.Create(mkProcedure, [], 0, 'SetMatrix',
- ['Value', 'TGXMatrix'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetMatrix')) then
- TGLBaseSceneObjectGetMatrixMethod.Create(mkFunction, [], 0, 'GetMatrix', [],
- 'TGXMatrix', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('AbsoluteMatrix')) then
- TGLBaseSceneObjectAbsoluteMatrixMethod.Create(mkFunction, [], 0,
- 'AbsoluteMatrix', [], 'TGXMatrix', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('InvAbsoluteMatrix')) then
- TGLBaseSceneObjectInvAbsoluteMatrixMethod.Create(mkFunction, [], 0,
- 'InvAbsoluteMatrix', [], 'TGXMatrix', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetAbsolutePosition')) then
- TGLBaseSceneObjectSetAbsolutePositionMethod.Create(mkProcedure, [], 0,
- 'SetAbsolutePosition', ['Value', 'TGXVector'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetAbsolutePosition')) then
- TGLBaseSceneObjectGetAbsolutePositionMethod.Create(mkFunction, [], 0,
- 'GetAbsolutePosition', [], 'TGXVector', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetAbsoluteUp')) then
- TGLBaseSceneObjectSetAbsoluteUpMethod.Create(mkProcedure, [], 0,
- 'SetAbsoluteUp', ['Value', 'TGXVector'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetAbsoluteUp')) then
- TGLBaseSceneObjectGetAbsoluteUpMethod.Create(mkFunction, [], 0,
- 'GetAbsoluteUp', [], 'TGXVector', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetAbsoluteDirection')) then
- TGLBaseSceneObjectSetAbsoluteDirectionMethod.Create(mkProcedure, [], 0,
- 'SetAbsoluteDirection', ['Value', 'TGXVector'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetAbsoluteDirection')) then
- TGLBaseSceneObjectGetAbsoluteDirectionMethod.Create(mkFunction, [], 0,
- 'GetAbsoluteDirection', [], 'TGXVector', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetPosition')) then
- TGLBaseSceneObjectSetPositionMethod.Create(mkProcedure, [], 0,
- 'SetPosition', ['Value', 'TGLCoordinates'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetPosition')) then
- TGLBaseSceneObjectGetPositionMethod.Create(mkFunction, [], 0, 'GetPosition',
- [], 'TGLCoordinates', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetDirection')) then
- TGLBaseSceneObjectSetDirectionMethod.Create(mkProcedure, [], 0,
- 'SetDirection', ['Value', 'TGLCoordinates'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetDirection')) then
- TGLBaseSceneObjectGetDirectionMethod.Create(mkFunction, [], 0,
- 'GetDirection', [], 'TGLCoordinates', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetUp')) then
- TGLBaseSceneObjectSetUpMethod.Create(mkProcedure, [], 0, 'SetUp',
- ['Value', 'TGLCoordinates'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetUp')) then
- TGLBaseSceneObjectGetUpMethod.Create(mkFunction, [], 0, 'GetUp', [],
- 'TGLCoordinates', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetScale')) then
- TGLBaseSceneObjectSetScaleMethod.Create(mkProcedure, [], 0, 'SetScale',
- ['Value', 'TGLCoordinates'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetScale')) then
- TGLBaseSceneObjectGetScaleMethod.Create(mkFunction, [], 0, 'GetScale', [],
- 'TGLCoordinates', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetPitchAngle')) then
- TGLBaseSceneObjectSetPitchAngleMethod.Create(mkProcedure, [], 0,
- 'SetPitchAngle', ['Value', 'Float'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetPitchAngle')) then
- TGLBaseSceneObjectGetPitchAngleMethod.Create(mkFunction, [], 0,
- 'GetPitchAngle', [], 'Float', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetTurnAngle')) then
- TGLBaseSceneObjectSetTurnAngleMethod.Create(mkProcedure, [], 0,
- 'SetTurnAngle', ['Value', 'Float'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetTurnAngle')) then
- TGLBaseSceneObjectGetTurnAngleMethod.Create(mkFunction, [], 0,
- 'GetTurnAngle', [], 'Float', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('SetRollAngle')) then
- TGLBaseSceneObjectSetRollAngleMethod.Create(mkProcedure, [], 0,
- 'SetRollAngle', ['Value', 'Float'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('GetRollAngle')) then
- TGLBaseSceneObjectGetRollAngleMethod.Create(mkFunction, [], 0,
- 'GetRollAngle', [], 'Float', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('Pitch')) then
- TGLBaseSceneObjectPitchMethod.Create(mkProcedure, [], 0, 'Pitch',
- ['angle', 'Float'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('Turn')) then
- TGLBaseSceneObjectTurnMethod.Create(mkProcedure, [], 0, 'Turn',
- ['angle', 'Float'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('Roll')) then
- TGLBaseSceneObjectRollMethod.Create(mkProcedure, [], 0, 'Roll',
- ['angle', 'Float'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('Move')) then
- TGLBaseSceneObjectMoveMethod.Create(mkProcedure, [], 0, 'Move',
- ['ADistance', 'Float'], '', ClassSym, SymbolTable);
- if not Assigned(ClassSym.Members.FindLocal('AddChild')) then
- TGLBaseSceneObjectAddChildMethod.Create(mkProcedure, [], 0, 'AddChild',
- ['AChild', 'TGLBaseSceneObject'], '', ClassSym, SymbolTable);
- // Properties
- AddPropertyToClass('Visible', 'Boolean', 'GetVisible', 'SetVisible', '',
- False, ClassSym, SymbolTable);
- AddPropertyToClass('Matrix', 'TGXMatrix', 'GetMatrix', 'SetMatrix', '', False,
- ClassSym, SymbolTable);
- AddPropertyToClass('AbsolutePosition', 'TGXVector', 'GetAbsolutePosition',
- 'SetAbsolutePosition', '', False, ClassSym, SymbolTable);
- AddPropertyToClass('AbsoluteUp', 'TGXVector', 'GetAbsoluteUp', 'SetAbsoluteUp',
- '', False, ClassSym, SymbolTable);
- AddPropertyToClass('AbsoluteDirection', 'TGXVector', 'GetAbsoluteDirection',
- 'SetAbsoluteDirection', '', False, ClassSym, SymbolTable);
- AddPropertyToClass('Position', 'TGLBaseSceneObject', 'GetPosition',
- 'SetPosition', '', False, ClassSym, SymbolTable);
- AddPropertyToClass('Direction', 'TGLBaseSceneObject', 'GetDirection',
- 'SetDirection', '', False, ClassSym, SymbolTable);
- AddPropertyToClass('Up', 'TGLBaseSceneObject', 'GetUp', 'SetUp', '', False,
- ClassSym, SymbolTable);
- AddPropertyToClass('Scale', 'TGLBaseSceneObject', 'GetScale', 'SetScale', '',
- False, ClassSym, SymbolTable);
- AddPropertyToClass('PitchAngle', 'Float', 'GetPitchAngle', 'SetPitchAngle',
- '', False, ClassSym, SymbolTable);
- AddPropertyToClass('TurnAngle', 'Float', 'GetTurnAngle', 'SetTurnAngle', '',
- False, ClassSym, SymbolTable);
- AddPropertyToClass('RollAngle', 'Float', 'GetRollAngle', 'SetRollAngle', '',
- False, ClassSym, SymbolTable);
- end;
- procedure TdwsGLSceneUnit.AddUnitSymbols(SymbolTable: TSymbolTable);
- begin
- // Forward class declaration
- AddForwardDeclaration('TGLCoordinates', SymbolTable);
- AddForwardDeclaration('TGLBaseSceneObject', SymbolTable);
- // Class types
- AddClassTGLCoordinates(SymbolTable);
- AddClassTGLBaseSceneObject(SymbolTable);
- end;
- procedure Register;
- begin
- RegisterComponents('GXScene DWX', [TdwxGLSceneUnit]);
- end;
- end.
|