From fcc298544eb439da25b46e64ca1c10bef495c5a2 Mon Sep 17 00:00:00 2001 From: Michalis Kamburelis Date: Sun, 21 Jul 2019 01:31:20 +0200 Subject: [PATCH] Camera and Navigation are split into 2 properties and 2 classes Camera holds the viewer position/dir/up. It is automatically created with each viewport. Navigation reacts to user input, changing camera. It may be, but doesn't have to be, assigned to a viewport. It's more-or-less a normal TCastleUserInterface descendant. --- src/3d/castlecameras.pas | 1977 +++++++++++++---------- src/3d/castletransform.pas | 8 +- src/3d/castletransform_renderparams.inc | 8 +- src/game/castle2dscenemanager.pas | 28 +- src/game/castlelevels.pas | 4 +- src/game/castlescenemanager.pas | 676 ++++---- src/lcl/castlecontrol.pas | 4 +- src/x3d/castlescenecore.pas | 6 +- src/x3d/opengl/castlescene.pas | 4 +- src/x3d/opengl/castlescreeneffects.pas | 4 +- 10 files changed, 1489 insertions(+), 1230 deletions(-) diff --git a/src/3d/castlecameras.pas b/src/3d/castlecameras.pas index 21cdb32b5b..72813df13d 100644 --- a/src/3d/castlecameras.pas +++ b/src/3d/castlecameras.pas @@ -13,7 +13,7 @@ ---------------------------------------------------------------------------- } -{ Cameras to navigate in 3D space (TExamineCamera, TWalkCamera). } +{ Cameras to navigate in 3D space (TCastleExamineNavigation, TCastleWalkNavigation). } unit CastleCameras; {$I castleconf.inc} @@ -38,12 +38,12 @@ interface shortcuts. } ciNormal, - { Mouse and touch dragging. Both TExamineCamera and TWalkCamera implement their own, + { Mouse and touch dragging. Both TCastleExamineNavigation and TCastleWalkNavigation implement their own, special reactions to mouse dragging, that allows to navigate / rotate while pressing specific mouse buttons. Note that mouse dragging is automatically disabled when - @link(TWalkCamera.MouseLook) is used. } + @link(TCastleWalkNavigation.MouseLook) is used. } ciMouseDragging, { Touch gestures, like multi-touch pinch or pan gesture. } @@ -57,61 +57,225 @@ interface used by @link(TCastleAbstractViewport.NavigationType). } TNavigationType = ( { Examine mode, comfortable to rotate the scene like an item held in your hand. - Uses TExamineCamera. } + Uses TCastleExamineNavigation. } ntExamine, { Turntable mode, similar to examine mode, but with a bit different interpretation of moves. - Uses TExamineCamera. } + Uses TCastleExamineNavigation. } ntTurntable, { Walk mode, comfortable to walk around the scene with gravity. - Uses TWalkCamera. } + Uses TCastleWalkNavigation. } ntWalk, { Fly mode, comfortable to move around around the scene without gravity. - Uses TWalkCamera. } + Uses TCastleWalkNavigation. } ntFly, { Disable user navigation on the scene. - Uses TWalkCamera. } + Uses TCastleWalkNavigation. } ntNone ); - { Handle user navigation in 3D scene. - You control camera parameters and provide user input - to this class by various methods and properties. - You can investigate the current camera configuration by many methods, - the most final is the @link(Matrix) method that - generates a simple 4x4 camera matrix. + EViewportNotAssigned = class(Exception); - This class is not tied to any OpenGL specifics, any VRML specifics, - and CastleWindow etc. --- this class is fully flexible and may be used - in any 3D program, whether using CastleWindow, OpenGL etc. or not. + { Camera determines viewer position and orientation in a 3D or 2D world. - Various TCamera descendants implement various navigation - methods, for example TExamineCamera allows the user to rotate + An instance of this class is automatically available + in @link(TCastleAbstractViewport.Camera). + In practice this means that you access @code(Camera) as a property of + @link(TCastleSceneManager) (when it acts as a viewport, which is @true by default) + or @link(TCastleViewport). + @italic(Do not instantiate this class yourself.) + + Note that this class does not handle any user input to modify the camera. + For this, see TCastleNavigation descendants. } + TCastleCamera = class(TComponent) + strict private + FPosition, FDirection, FUp, FGravityUp: TVector3; + VisibleChangeSchedule: Cardinal; + IsVisibleChangeScheduled: boolean; + FProjectionMatrix: TMatrix4; + + FFrustum: TFrustum; + + procedure RecalculateFrustum; + + { Mechanism to schedule Viewport.VisibleChange calls. + + This mechanism allows to defer calling Viewport.VisibleChange. + Idea: BeginVisibleChangeSchedule increases internal VisibleChangeSchedule + counter, EndVisibleChangeSchedule decreases it and calls + actual Viewport.VisibleChange if counter is zero and some + ScheduleVisibleChange was called in between. + + When ScheduleVisibleChange is called when counter is zero, + Viewport.VisibleChange is called immediately, so it's safe to always + use ScheduleVisibleChange instead of direct Viewport.VisibleChange + in this class. } + procedure BeginVisibleChangeSchedule; + procedure ScheduleVisibleChange; + procedure EndVisibleChangeSchedule; + + procedure SetPosition(const Value: TVector3); + procedure SetDirection(const Value: TVector3); + procedure SetUp(const Value: TVector3); + procedure SetGravityUp(const Value: TVector3); + + { Setter of the @link(ProjectionMatrix) property. + TODO: We should actually manage projection properties here. } + procedure SetProjectionMatrix(const Value: TMatrix4); + public + Viewport: TCastleUserInterface; + + constructor Create(AOwner: TComponent); override; + + { Express current view as camera vectors: position, direction, up. + + Returned Dir and Up must be orthogonal. + Returned Dir and Up and GravityUp are already normalized. } + procedure GetView(out APos, ADir, AUp: TVector3); overload; + procedure GetView(out APos, ADir, AUp, AGravityUp: TVector3); overload; + + { Set camera view from vectors: position, direction, up. + + Direction, Up and GravityUp do not have to be normalized, + we will normalize them internally if necessary. + But make sure they are non-zero. + + We will automatically fix Direction and Up to be orthogonal, if necessary: + when AdjustUp = @true (the default) we will adjust the up vector + (preserving the given direction value), + otherwise we will adjust the direction (preserving the given up value). } + procedure SetView(const ADir, AUp: TVector3; + const AdjustUp: boolean = true); + procedure SetView(const APos, ADir, AUp: TVector3; + const AdjustUp: boolean = true); overload; + procedure SetView(const APos, ADir, AUp, AGravityUp: TVector3; + const AdjustUp: boolean = true); overload; + + { Camera position, looking direction and up vector. + + Initially (after creating this object) they are equal to + InitialPosition, InitialDirection, InitialUp. + Also @link(Init) and @link(GoToInitial) methods reset them to these + initial values. + + The @link(Direction) and @link(Up) vectors should always be normalized + (have length 1). When setting them by these properties, we will normalize + them automatically, so their given length is actually ignored. + + When setting @link(Direction), @link(Up) will always be automatically + adjusted to be orthogonal to @link(Direction). And vice versa --- + when setting @link(Up), @link(Direction) will be adjusted. + + @groupBegin } + property Position : TVector3 read FPosition write SetPosition; + property Direction: TVector3 read FDirection write SetDirection; + property Up : TVector3 read FUp write SetUp; + { @groupEnd } + + { Change up vector, keeping the direction unchanged. + If necessary, the up vector provided here will be fixed to be orthogonal + to direction. + See TCastleTransform.UpPrefer for detailed documentation what this does. } + procedure UpPrefer(const AUp: TVector3); + + { "Up" direction of the world in which player moves. + Always normalized (when setting this property, we take + care to normalize the provided vector). + + This determines in which direction @link(TCastleWalkNavigation.Gravity) works. + + This is also the "normal" value for both @link(TCastleWalkNavigation.Up) and + @link(InitialUp) --- one that means that player is looking + straight foward. This is used for features like PreferGravityUpForRotations + and/or PreferGravityUpForMoving. + + The default value of this vector is (0, 1, 0) (same as the default + @link(TCastleWalkNavigation.Up) and + @link(InitialUp) vectors). } + property GravityUp: TVector3 read FGravityUp write SetGravityUp; + + { Camera matrix, transforming from world space into camera space. } + function Matrix: TMatrix4; + + { Inverse of @link(Matrix), transforming from camera space into world space. } + function MatrixInverse: TMatrix4; + + { Extract only rotation from your current camera @link(Matrix). + This is useful for rendering skybox in 3D programs + (e.g. for VRML/X3D Background node) and generally to transform + directions between world and camera space. + + It's guaranteed that this is actually only 3x3 matrix, + the 4th row and 4th column are all zero except the lowest right item + which is 1.0. } + function RotationMatrix: TMatrix4; + + { The current camera (viewing frustum, based on + @link(ProjectionMatrix) (set by you) and @link(Matrix) (calculated here). + This is recalculated whenever one of these two properties change. + Be sure to set @link(ProjectionMatrix) before using this. } + property Frustum: TFrustum read FFrustum; + + { Projection matrix of the camera. + Camera needs to know this to calculate @link(Frustum), + which in turn allows rendering code to use frustum culling. + + In normal circumstances, if you use our @italic(scene manager) + and viewport (@link(TCastleAbstractViewport)) for rendering, + this is automatically correctly set for you. + + TODO: We should actually manage projection params here. } + property ProjectionMatrix: TMatrix4 + read FProjectionMatrix write SetProjectionMatrix; + + { Calculate a ray picked by WindowPosition position on the viewport, + assuming current viewport dimensions are as given. + This doesn't look at our container sizes at all. + + Projection (read-only here) describe projection, + required for calculating the ray properly. + + Resulting RayDirection is always normalized. + + WindowPosition is given in the same style as TUIContainer.MousePosition: + (0, 0) is bottom-left. } + procedure CustomRay( + const ViewportRect: TFloatRectangle; + const WindowPosition: TVector2; + const Projection: TProjection; + out RayOrigin, RayDirection: TVector3); + end; + + TCameraClass = class of TCamera; + + T3BoolInputs = array [0..2, boolean] of TInputShortcut; + + { Handle user input to modify viewport camera. + + You will usually set it using @link(TCastleAbstractViewport.Navigation). + But really it's a normal @link(TCastleUserInterface) descendant, + you can add it as a child of any other UI control, + and just assign @link(Viewport) to any @link(TCastleAbstractViewport). + You can always treat it as a normal @link(TCastleUserInterface) descendant, + e.g. you can use @link(Exists) property and so on. + + The only purpose of the class @link(TCastleNavigation) + is to allow to remove other @link(TCastleNavigation) children when assigning + @link(TCastleAbstractViewport.Navigation). + Otherwise, it's really a completely normal @link(TCastleUserInterface), + i.e. it receives input events and reacts to them as all other UI controls. + + Various TCastleNavigation descendants implement various navigation + methods, for example TCastleExamineNavigation allows the user to rotate and scale the model (imagine that you're holding a 3D model in your - hands and you look at it from various sides) and TWalkCamera + hands and you look at it from various sides) and TCastleWalkNavigation implements typical navigation in the style of first-person shooter - games. - - The most comfortable way to use a camera is with a scene manager - (TCastleSceneManager). You can create your camera instance, - call it's @code(Init) method (this is initializes most important properties), - and assign it to TCastleSceneManager.Camera property. - This way SceneManager will pass all necessary window events to the camera, - and when drawing SceneManager will load camera matrix like - @code(glLoadMatrix(Camera.Matrix);). - In fact, if you do not assign anything to TCastleSceneManager.Camera property, - then the default camera will be created for you. So @italic(when - using TCastleSceneManager, you do not have to do anything to use a camera) - --- default camera will be created and automatically used for you. } - TCamera = class(TInputListener) + games. } + TCastleNavigation = class(TCastleUserInterface) private - VisibleChangeSchedule: Cardinal; - IsVisibleChangeScheduled: boolean; FInput: TCameraInputs; FInitialPosition, FInitialDirection, FInitialUp: TVector3; - FProjectionMatrix: TMatrix4; FRadius: Single; - FEnableDragging: boolean; FPreferredHeight: Single; FMoveHorizontalSpeed, FMoveVerticalSpeed, FMoveSpeed: Single; FHeadBobbing: Single; @@ -119,7 +283,6 @@ TCamera = class(TInputListener) FClimbHeight: Single; FModelBox: TBox3D; FCrouchHeight: Single; - FGravityUp: TVector3; FAnimation: boolean; AnimationEndTime: TFloatTime; @@ -132,10 +295,17 @@ TCamera = class(TInputListener) AnimationEndDirection: TVector3; AnimationEndUp: TVector3; - FFrustum: TFrustum; - - procedure RecalculateFrustum; + function GetPosition: TVector3; + function GetDirection: TVector3; + function GetUp: TVector3; + function GetGravityUp: TVector3; + procedure SetPosition(const Value: TVector3); + procedure SetDirection(const Value: TVector3); + procedure SetUp(const Value: TVector3); procedure SetGravityUp(const Value: TVector3); + function GetProjectionMatrix: TMatrix4; + procedure SetProjectionMatrix(const Value: TMatrix4); + function GetFrustum: TFrustum; protected { Needed for ciMouseDragging navigation. Checking MouseDraggingStarted means that we handle only dragging that @@ -145,36 +315,11 @@ TCamera = class(TInputListener) MouseDraggingStarted: Integer; MouseDraggingStart: TVector2; - { Mechanism to schedule VisibleChange calls. - - This mechanism allows to defer calling VisibleChange. - Idea: BeginVisibleChangeSchedule increases internal VisibleChangeSchedule - counter, EndVisibleChangeSchedule decreases it and calls - actual VisibleChange if counter is zero and some - ScheduleVisibleChange was called in between. - - When ScheduleVisibleChange is called when counter is zero, - VisibleChange is called immediately, so it's safe to always - use ScheduleVisibleChange instead of direct VisibleChange - in this class. } - procedure BeginVisibleChangeSchedule; - procedure ScheduleVisibleChange; - procedure EndVisibleChangeSchedule; - procedure SetInput(const Value: TCameraInputs); virtual; - procedure SetEnableDragging(const Value: boolean); virtual; function GetIgnoreAllInputs: boolean; procedure SetIgnoreAllInputs(const Value: boolean); - { Setter of the @link(ProjectionMatrix) property. - TCamera descendants may override this. - In normal circumstances, you should not call it anywhere (it's automatically - called by the scene manager). } - procedure SetProjectionMatrix(const Value: TMatrix4); virtual; procedure SetRadius(const Value: Single); virtual; - function GetPositionInternal: TVector3; virtual; abstract; - procedure SetPosition(const Value: TVector3); virtual; abstract; - function ReallyEnableMouseDragging: boolean; virtual; procedure SetModelBox(const B: TBox3D); @@ -188,17 +333,20 @@ TCamera = class(TInputListener) DefaultHeadBobbing = 0.02; DefaultCrouchHeight = 0.5; + var + Viewport: TCastleUserInterface; + constructor Create(AOwner: TComponent); override; procedure Assign(Source: TPersistent); override; - procedure VisibleChange(const Changes: TCastleUserInterfaceChanges; - const ChangeInitiatedByChildren: boolean = false); override; + // By default this captures events from whole parent, which should be whole Viewport. + property FullSize default true; { Camera matrix, transforming from world space into camera space. } - function Matrix: TMatrix4; virtual; abstract; + function Matrix: TMatrix4; deprecated 'use Viewport.Camera.Matrix'; { Inverse of @link(Matrix), transforming from camera space into world space. } - function MatrixInverse: TMatrix4; virtual; + function MatrixInverse: TMatrix4; deprecated 'use Viewport.Camera.MatrixInverse'; { Extract only rotation from your current camera @link(Matrix). This is useful for rendering skybox in 3D programs @@ -208,7 +356,7 @@ TCamera = class(TInputListener) It's guaranteed that this is actually only 3x3 matrix, the 4th row and 4th column are all zero except the lowest right item which is 1.0. } - function RotationMatrix: TMatrix4; virtual; abstract; + function RotationMatrix: TMatrix4; deprecated 'use Viewport.Camera.RotationMatrix'; { Deprecated, use more flexible @link(Input) instead. @code(IgnoreAllInputs := true) is equivalent to @code(Input := []), @@ -223,7 +371,7 @@ TCamera = class(TInputListener) @link(ProjectionMatrix) (set by you) and @link(Matrix) (calculated here). This is recalculated whenever one of these two properties change. Be sure to set @link(ProjectionMatrix) before using this. } - property Frustum: TFrustum read FFrustum; + property Frustum: TFrustum read GetFrustum; deprecated 'use Viewport.Camera.Frustum'; { Projection matrix of the camera. Camera needs to know this to calculate @link(Frustum), @@ -233,7 +381,7 @@ TCamera = class(TInputListener) and viewport (@link(TCastleAbstractViewport)) for rendering, this is automatically correctly set for you. } property ProjectionMatrix: TMatrix4 - read FProjectionMatrix write SetProjectionMatrix; + read GetProjectionMatrix write SetProjectionMatrix; deprecated 'use Viewport.Camera.ProjectionMatrix'; { The radius of a sphere around the camera that makes collisions with the world. @@ -263,8 +411,10 @@ TCamera = class(TInputListener) Returned Dir and Up must be orthogonal. Returned Dir and Up and GravityUp are already normalized. } - procedure GetView(out APos, ADir, AUp: TVector3); overload; virtual; abstract; + procedure GetView(out APos, ADir, AUp: TVector3); overload; + deprecated 'use Viewport.Camera.GetView'; procedure GetView(out APos, ADir, AUp, AGravityUp: TVector3); overload; + deprecated 'use Viewport.Camera.GetView'; { Set camera view from vectors: position, direction, up. @@ -277,28 +427,48 @@ TCamera = class(TInputListener) (preserving the given direction value), otherwise we will adjust the direction (preserving the given up value). } procedure SetView(const APos, ADir, AUp: TVector3; - const AdjustUp: boolean = true); overload; virtual; abstract; + const AdjustUp: boolean = true); overload; + deprecated 'use Viewport.Camera.SetView'; procedure SetView(const APos, ADir, AUp, AGravityUp: TVector3; const AdjustUp: boolean = true); overload; + deprecated 'use Viewport.Camera.SetView'; + + { Camera position, looking direction and up vector. + + Initially (after creating this object) they are equal to + InitialPosition, InitialDirection, InitialUp. + Also @link(Init) and @link(GoToInitial) methods reset them to these + initial values. + + The @link(Direction) and @link(Up) vectors should always be normalized + (have length 1). When setting them by these properties, we will normalize + them automatically, so their given length is actually ignored. - property Position: TVector3 read GetPositionInternal write SetPosition; - function GetPosition: TVector3; deprecated 'use Position property'; + When setting @link(Direction), @link(Up) will always be automatically + adjusted to be orthogonal to @link(Direction). And vice versa --- + when setting @link(Up), @link(Direction) will be adjusted. + + @groupBegin } + property Position : TVector3 read GetPosition write SetPosition; deprecated 'use Viewport.Camera.Position'; + property Direction: TVector3 read GetDirection write SetDirection; deprecated 'use Viewport.Camera.Direction'; + property Up : TVector3 read GetUp write SetUp; deprecated 'use Viewport.Camera.Up'; + { @groupEnd } { "Up" direction of the world in which player moves. Always normalized (when setting this property, we take care to normalize the provided vector). - This determines in which direction @link(TWalkCamera.Gravity) works. + This determines in which direction @link(TCastleWalkNavigation.Gravity) works. - This is also the "normal" value for both @link(TWalkCamera.Up) and + This is also the "normal" value for both @link(TCastleWalkNavigation.Up) and @link(InitialUp) --- one that means that player is looking straight foward. This is used for features like PreferGravityUpForRotations and/or PreferGravityUpForMoving. The default value of this vector is (0, 1, 0) (same as the default - @link(TWalkCamera.Up) and + @link(TCastleWalkNavigation.Up) and @link(InitialUp) vectors). } - property GravityUp: TVector3 read FGravityUp write SetGravityUp; + property GravityUp: TVector3 read GetGravityUp write SetGravityUp; deprecated 'use Viewport.Camera.GravityUp'; { Calculate a 3D ray picked by the WindowX, WindowY position on the window. Uses current Container, which means that you have to add this camera @@ -313,7 +483,7 @@ TCamera = class(TInputListener) (0, 0) is bottom-left. } procedure Ray(const WindowPosition: TVector2; const Projection: TProjection; - out RayOrigin, RayDirection: TVector3); deprecated 'use CustomRay with proper viewport sizes, or use higher-level utilities like SceneManager.MouseRayHit instead'; + out RayOrigin, RayDirection: TVector3); deprecated 'use Viewport.Camera.CustomRay with proper viewport sizes, or use higher-level utilities like SceneManager.MouseRayHit instead'; { Calculate a ray picked by current mouse position on the window. Uses current Container (both to get it's size and to get current @@ -325,7 +495,7 @@ TCamera = class(TInputListener) @seealso CustomRay } procedure MouseRay( const Projection: TProjection; - out RayOrigin, RayDirection: TVector3); deprecated 'use CustomRay with proper viewport sizes, or use higher-level utilities like SceneManager.MouseRayHit instead'; + out RayOrigin, RayDirection: TVector3); deprecated 'use Viewport.Camera.CustomRay with proper viewport sizes, or use higher-level utilities like SceneManager.MouseRayHit instead'; { Calculate a ray picked by WindowPosition position on the viewport, assuming current viewport dimensions are as given. @@ -339,16 +509,16 @@ TCamera = class(TInputListener) WindowPosition is given in the same style as TUIContainer.MousePosition: (0, 0) is bottom-left. } procedure CustomRay( - const Viewport: TRectangle; + const ViewportRect: TRectangle; const WindowPosition: TVector2; const Projection: TProjection; out RayOrigin, RayDirection: TVector3); overload; - deprecated 'use the overloaded version of CustomRay with TFloatRectangle'; + deprecated 'use Viewport.Camera.CustomRay'; procedure CustomRay( - const Viewport: TFloatRectangle; + const ViewportRect: TFloatRectangle; const WindowPosition: TVector2; const Projection: TProjection; - out RayOrigin, RayDirection: TVector3); overload; + out RayOrigin, RayDirection: TVector3); overload; deprecated 'use Viewport.Camera.CustomRay'; procedure Update(const SecondsPassed: Single; var HandleInput: boolean); override; @@ -364,14 +534,14 @@ TCamera = class(TInputListener) So you can even free OtherCamera instance immediately after calling this. When we're during camera animation, @link(Update) doesn't do other stuff - (e.g. gravity for TWalkCamera doesn't work, rotating for TExamineCamera + (e.g. gravity for TCastleWalkNavigation doesn't work, rotating for TCastleExamineNavigation doesn't work). This also means that the key/mouse controls of the camera do not work. Instead, we remember the source and target position (at the time AnimateTo was called) of the camera, and smoothly interpolate camera parameters to match the target. Once the animation stops, @link(Update) goes back to normal: gravity - in TWalkCamera works again, rotating in TExamineCamera works again etc. + in TCastleWalkNavigation works again, rotating in TCastleExamineNavigation works again etc. Calling AnimateTo while the previous animation didn't finish yet is OK. This simply cancels the previous animation, @@ -386,8 +556,9 @@ TCamera = class(TInputListener) how often Update will be called.) @groupBegin } - procedure AnimateTo(OtherCamera: TCamera; const Time: TFloatTime); - procedure AnimateTo(const Pos, Dir, Up: TVector3; const Time: TFloatTime); + procedure AnimateTo(OtherCamera: TCastleCamera; const Time: TFloatTime); + procedure AnimateTo(OtherCamera: TCastleNavigation; const Time: TFloatTime); deprecated 'use AnimateTo with TCastleCamera, not TCastleNavigation'; + procedure AnimateTo(const APos, ADir, AUp: TVector3; const Time: TFloatTime); { @groupEnd } function Animation: boolean; virtual; @@ -397,9 +568,9 @@ TCamera = class(TInputListener) InitialDirection and InitialUp must be always normalized, and orthogonal. - Default value of InitialPosition is (0, 0, 0), InitialDirection is - DefaultCameraDirection = (0, -1, 0), InitialUp is - DefaultCameraUp = (0, 1, 0). + Default value of InitialPosition is (0, 0, 0), + InitialDirection is DefaultCameraDirection = (0, -1, 0), + InitialUp is DefaultCameraUp = (0, 1, 0). @groupBegin } property InitialPosition : TVector3 read FInitialPosition; @@ -435,22 +606,15 @@ TCamera = class(TInputListener) function GetNavigationType: TNavigationType; virtual; abstract; - { Is mouse dragging allowed by scene manager. - This is an additional condition to enable mouse dragging, - above the existing ciMouseDragging in Input. - It is set internally by scene manager, to prevent camera navigation by - dragging when we already drag a 3D item (like X3D TouchSensor). } - property EnableDragging: boolean read FEnableDragging write SetEnableDragging; - - { Height above the ground, only used by @link(TWalkCamera) descendant - when @link(TWalkCamera.Gravity) is @true. + { Height above the ground, only used by @link(TCastleWalkNavigation) descendant + when @link(TCastleWalkNavigation.Gravity) is @true. The @link(Position) tries to stay PreferredHeight above the ground. Temporarily it may still be lower (e.g. player can shortly "duck" when he falls from high). This must always be >= 0. You should set this to something greater than zero to get sensible - behavior of some things related to @link(TWalkCamera.Gravity), + behavior of some things related to @link(TCastleWalkNavigation.Gravity), and also you should set OnHeight. See CorrectPreferredHeight for important property @@ -505,7 +669,7 @@ TCamera = class(TInputListener) property CrouchHeight: Single read FCrouchHeight write FCrouchHeight default DefaultCrouchHeight; - { When @link(TWalkCamera) moves, it may make a "head bobbing" effect, + { When @link(TCastleWalkNavigation) moves, it may make a "head bobbing" effect, by moving the camera a bit up and down. This property mutiplied by PreferredHeight @@ -514,7 +678,7 @@ TCamera = class(TInputListener) This must always be < 1.0. For sensible effects, this should be rather close to 0.0, for example 0.02. - This is meaningfull only when @link(TWalkCamera.Gravity) works. } + This is meaningfull only when @link(TCastleWalkNavigation.Gravity) works. } property HeadBobbing: Single read FHeadBobbing write FHeadBobbing default DefaultHeadBobbing; @@ -534,7 +698,7 @@ TCamera = class(TInputListener) read FHeadBobbingTime write FHeadBobbingTime default DefaultHeadBobbingTime; - { Moving speeds, only used by @link(TWalkCamera) descendant. + { Moving speeds, only used by @link(TCastleWalkNavigation) descendant. MoveHorizontalSpeed is only for horizontal movement, MoveVerticalSpeed is only for vertical, and MoveSpeed simply affects both types of movement. Effectively, we always scale the speed @@ -558,9 +722,9 @@ TCamera = class(TInputListener) { @groupEnd } { The tallest height that you can climb, - only used by @link(TWalkCamera) descendant - when @link(TWalkCamera.Gravity) is @true. - This is checked in each single horizontal move when @link(TWalkCamera.Gravity) works. + only used by @link(TCastleWalkNavigation) descendant + when @link(TCastleWalkNavigation.Gravity) is @true. + This is checked in each single horizontal move when @link(TCastleWalkNavigation.Gravity) works. Must be >= 0. Value 0 means there is no limit (and makes a small speedup). This is reliable to prevent user from climbing stairs and such, @@ -576,7 +740,7 @@ TCamera = class(TInputListener) or CastleControl.LimitFPS is zero). Remember that user can still try jumping to climb on high obstactes. - See @link(TWalkCamera.JumpMaxHeight) for a way to control jumping. + See @link(TCastleWalkNavigation.JumpMaxHeight) for a way to control jumping. For a 100% reliable way to prevent user from reaching some point, that does not rely on specific camera/gravity settings, @@ -584,9 +748,9 @@ TCamera = class(TInputListener) can be created by Collision.proxy in VRML/X3D). } property ClimbHeight: Single read FClimbHeight write FClimbHeight; - { Approximate size of 3D world that is viewed, used by @link(TExamineCamera) + { Approximate size of 3D world that is viewed, used by @link(TCastleExamineNavigation) descendant. - It is crucial to set this to make @link(TExamineCamera) behave OK. + It is crucial to set this to make @link(TCastleExamineNavigation) behave OK. Initially this is TBox3D.Empty. } property ModelBox: TBox3D read FModelBox write SetModelBox; @@ -599,56 +763,62 @@ TCamera = class(TInputListener) property Input: TCameraInputs read FInput write SetInput default DefaultInput; end; - TCameraClass = class of TCamera; - - T3BoolInputs = array [0..2, boolean] of TInputShortcut; - { Navigate the 3D model in examine mode, like you would hold a box with the model inside. The model is moved by @link(Translation), rotated by @link(Rotations) and scaled by @link(ScaleFactor). } - TExamineCamera = class(TCamera) + TCastleExamineNavigation = class(TCastleNavigation) private - FMoveEnabled: Boolean; - FRotationEnabled: Boolean; - FZoomEnabled: Boolean; - FTranslation: TVector3; - FRotations: TQuaternion; - FDragMoveSpeed, FKeysMoveSpeed: Single; - { Speed of rotations. Always zero when RotationAccelerate = false. - - This could be implemented as a quaternion, - it even was implemented like this (and working!) for a couple - of minutes. But this caused one problem: in Update, I want to - apply FRotationsAnim to Rotations *scaled by SecondsPassed*. - There's no efficient way with quaternions to say "take only SecondsPassed - fraction of angle encoded in FRotationsAnim", AFAIK. - The only way would be to convert FRotationsAnim back to AxisAngle, - then scale angle, then convert back to quaternion... which makes - the whole exercise useless. } - FRotationsAnim: TVector3; - FScaleFactor, FScaleFactorMin, FScaleFactorMax: Single; - FRotationAccelerate: boolean; - FRotationAccelerationSpeed: Single; - FRotationSpeed: Single; - FPosition, FDirection, FUp: TVector3; - FTurntable: boolean; - FPinchGestureRecognizer: TCastlePinchPanGestureRecognizer; - - FInputs_Move: T3BoolInputs; - FInputs_Rotate: T3BoolInputs; - FInput_ScaleLarger: TInputShortcut; - FInput_ScaleSmaller: TInputShortcut; - FInput_Home: TInputShortcut; - FInput_StopRotating: TInputShortcut; - - FMouseButtonRotate, FMouseButtonMove, FMouseButtonZoom: TMouseButton; + type + { Camera pos/dir/up expressed as vectors more comfortable + for Examine methods. } + TExamineVectors = record + Translation: TVector3; + Rotations: TQuaternion; + ScaleFactor: Single; + end; + + var + FMoveEnabled: Boolean; + FRotationEnabled: Boolean; + FZoomEnabled: Boolean; + FDragMoveSpeed, FKeysMoveSpeed: Single; + { Speed of rotations. Always zero when RotationAccelerate = false. + + This could be implemented as a quaternion, + it even was implemented like this (and working!) for a couple + of minutes. But this caused one problem: in Update, I want to + apply FRotationsAnim to Rotations *scaled by SecondsPassed*. + There's no efficient way with quaternions to say "take only SecondsPassed + fraction of angle encoded in FRotationsAnim", AFAIK. + The only way would be to convert FRotationsAnim back to AxisAngle, + then scale angle, then convert back to quaternion... which makes + the whole exercise useless. } + FRotationsAnim: TVector3; + FScaleFactorMin, FScaleFactorMax: Single; + FRotationAccelerate: boolean; + FRotationAccelerationSpeed: Single; + FRotationSpeed: Single; + FTurntable: boolean; + FPinchGestureRecognizer: TCastlePinchPanGestureRecognizer; + + FInputs_Move: T3BoolInputs; + FInputs_Rotate: T3BoolInputs; + FInput_ScaleLarger: TInputShortcut; + FInput_ScaleSmaller: TInputShortcut; + FInput_Home: TInputShortcut; + FInput_StopRotating: TInputShortcut; + + FMouseButtonRotate, FMouseButtonMove, FMouseButtonZoom: TMouseButton; procedure SetRotationsAnim(const Value: TVector3); + function GetRotations: TQuaternion; procedure SetRotations(const Value: TQuaternion); + function GetScaleFactor: Single; procedure SetScaleFactor(const Value: Single); procedure SetScaleFactorMin(const Value: Single); procedure SetScaleFactorMax(const Value: Single); + function GetTranslation: TVector3; procedure SetTranslation(const Value: TVector3); function Zoom(const Factor: Single): boolean; procedure SetRotationAccelerate(const Value: boolean); @@ -674,9 +844,10 @@ TExamineCamera = class(TCamera) Zero if @link(ModelBox) empty, otherwise @link(ModelBox) middle. } function CenterOfRotation: TVector3; - protected - function GetPositionInternal: TVector3; override; - procedure SetPosition(const Value: TVector3); override; + + function GetExamineVectors: TExamineVectors; + procedure SetExamineVectors(const Value: TExamineVectors); + property ExamineVectors: TExamineVectors read GetExamineVectors write SetExamineVectors; public const DefaultRotationAccelerationSpeed = 5.0; @@ -685,10 +856,6 @@ TExamineCamera = class(TCamera) constructor Create(AOwner: TComponent); override; destructor Destroy; override; - function Matrix: TMatrix4; override; - function MatrixInverse: TMatrix4; override; - - function RotationMatrix: TMatrix4; override; procedure Update(const SecondsPassed: Single; var HandleInput: boolean); override; function AllowSuspendForInput: boolean; override; @@ -749,7 +916,7 @@ TExamineCamera = class(TCamera) { Current rotation of the model. Rotation is done around ModelBox middle (with @link(Translation) added). } - property Rotations: TQuaternion read FRotations write SetRotations; + property Rotations: TQuaternion read GetRotations write SetRotations; { Continuous rotation animation, applied each Update to Rotations. } property RotationsAnim: TVector3 read FRotationsAnim write SetRotationsAnim; @@ -760,11 +927,11 @@ TExamineCamera = class(TCamera) { How fast user moves the scene by pressing keys. } property KeysMoveSpeed: Single read FKeysMoveSpeed write FKeysMoveSpeed default 1.0; - property MoveAmount: TVector3 read FTranslation write SetTranslation; + property MoveAmount: TVector3 read GetTranslation write SetTranslation; deprecated 'use Translation'; { How much to move the model. By default, zero. } - property Translation: TVector3 read FTranslation write SetTranslation; + property Translation: TVector3 read GetTranslation write SetTranslation; { Turntable rotates the scene around its Y axis instead of current camera axis. } property Turntable: boolean @@ -772,7 +939,7 @@ TExamineCamera = class(TCamera) { Scale of the model. } property ScaleFactor: Single - read FScaleFactor write SetScaleFactor default 1; + read GetScaleFactor write SetScaleFactor default 1; property ScaleFactorMin: Single read FScaleFactorMin write SetScaleFactorMin default 0.01; property ScaleFactorMax: Single @@ -805,12 +972,6 @@ TExamineCamera = class(TCamera) property Inputs_Rotate: T3BoolInputs read FInputs_Rotate; { @groupEnd } - procedure GetView(out APos, ADir, AUp: TVector3); override; - procedure SetView(const APos, ADir, AUp: TVector3; - const AdjustUp: boolean = true); override; - - procedure VisibleChange(const Changes: TCastleUserInterfaceChanges; - const ChangeInitiatedByChildren: boolean = false); override; function GetNavigationType: TNavigationType; override; { TODO: Input_Xxx not published, although setting them in object inspector @@ -870,39 +1031,38 @@ TExamineCamera = class(TCamera) default DefaultRotationSpeed; end; - TWalkCamera = class; + TCastleWalkNavigation = class; - { What mouse dragging does in TWalkCamera. } + { What mouse dragging does in TCastleWalkNavigation. } TMouseDragMode = ( { Moves avatar continuously in the direction of mouse drag - (default for TWalkCamera.MouseDragMode). } + (default for TCastleWalkNavigation.MouseDragMode). } mdWalk, { Rotates the head when mouse is moved. } mdRotate, { Ignores the dragging. } mdNone); - { See @link(TWalkCamera.DoMoveAllowed) and - @link(TWalkCamera.OnMoveAllowed) } - TMoveAllowedFunc = function(Camera: TWalkCamera; + { See @link(TCastleWalkNavigation.DoMoveAllowed) and + @link(TCastleWalkNavigation.OnMoveAllowed) } + TMoveAllowedFunc = function(Camera: TCastleWalkNavigation; const ProposedNewPos: TVector3; out NewPos: TVector3; const BecauseOfGravity: boolean): boolean of object; - { See @link(TWalkCamera.OnFall). } - TFallNotifyFunc = procedure (Camera: TWalkCamera; + { See @link(TCastleWalkNavigation.OnFall). } + TFallNotifyFunc = procedure (Camera: TCastleWalkNavigation; const FallHeight: Single) of object; - THeightEvent = function (Camera: TWalkCamera; + THeightEvent = function (Camera: TCastleWalkNavigation; const Position: TVector3; out AboveHeight: Single; out AboveGround: PTriangle): boolean of object; { Navigation by walking (first-person-shooter-like moving) in 3D scene. Camera is defined by it's position, looking direction and up vector, user can rotate and move camera using various keys. } - TWalkCamera = class(TCamera) + TCastleWalkNavigation = class(TCastleNavigation) private - FPosition, FDirection, FUp: TVector3; FRotationHorizontalSpeed, FRotationVerticalSpeed: Single; FRotationHorizontalPivot: Single; FPreferGravityUpForRotations: boolean; @@ -912,9 +1072,6 @@ TWalkCamera = class(TCamera) FAboveGround: PTriangle; FMouseLook: boolean; FMouseDragMode: TMouseDragMode; - - procedure SetDirection(const Value: TVector3); - procedure SetUp(const Value: TVector3); procedure SetMouseLook(const Value: boolean); private FInput_Forward: TInputShortcut; @@ -994,9 +1151,10 @@ TWalkCamera = class(TCamera) And so everything works. } procedure RotateHorizontalForStrafeMove(const AngleDeg: Single); - { Call always after horizontal rotation (but before ScheduleVisibleChange). - This will eventually adjust FPosition for RotationHorizontalPivot <> 0. } - procedure AdjustForRotationHorizontalPivot(const OldDirection: TVector3); + { Call always after horizontal rotation change. + This will return new Position, applying effect of RotationHorizontalPivot. } + function AdjustPositionForRotationHorizontalPivot( + const OldDirection, NewDirection: TVector3): TVector3; { Jump. @@ -1053,9 +1211,6 @@ TWalkCamera = class(TCamera) out AIsAbove: boolean; out AnAboveHeight: Single; out AnAboveGround: PTriangle); virtual; - function GetPositionInternal: TVector3; override; - procedure SetPosition(const Value: TVector3); override; - function ReallyEnableMouseDragging: boolean; override; public const @@ -1076,8 +1231,6 @@ TWalkCamera = class(TCamera) constructor Create(AOwner: TComponent); override; destructor Destroy; override; - function Matrix: TMatrix4; override; - function RotationMatrix: TMatrix4; override; procedure Update(const SecondsPassed: Single; var HandleInput: boolean); override; function AllowSuspendForInput: boolean; override; @@ -1137,32 +1290,6 @@ TWalkCamera = class(TCamera) out NewPos: TVector3; const BecauseOfGravity: boolean): boolean; virtual; - { Camera position, looking direction and up vector. - - Initially (after creating this object) they are equal to - InitialPosition, InitialDirection, InitialUp. - Also @link(Init) and @link(GoToInitial) methods reset them to these - initial values. - - The @link(Direction) and @link(Up) vectors should always be normalized - (have length 1). When setting them by these properties, we will normalize - them automatically. - - Note that since engine >= 2.2.0 the @link(Direction) vector - should always be normalized (length 1), and so you cannot change - move speed by scaling this vector. - Use MoveSpeed, MoveHorizontalSpeed, MoveVerticalSpeed instead. - - When setting @link(Direction), @link(Up) will always be automatically - adjusted to be orthogonal to @link(Direction). And vice versa --- - when setting @link(Up), @link(Direction) will be adjusted. - - @groupBegin } - property Position : TVector3 read FPosition write SetPosition; - property Direction: TVector3 read FDirection write SetDirection; - property Up : TVector3 read FUp write SetUp; - { @groupEnd } - { If PreferGravityUpForRotations or PreferGravityUpForMoving then various operations are done with respect to GravityUp, otherwise they are done with @@ -1538,18 +1665,13 @@ TWalkCamera = class(TCamera) some "footsteps" sound for the player. } property IsWalkingOnTheGround: boolean read FIsWalkingOnTheGround; - procedure GetView(out APos, ADir, AUp: TVector3); override; - procedure SetView(const ADir, AUp: TVector3; - const AdjustUp: boolean = true); - procedure SetView(const APos, ADir, AUp: TVector3; - const AdjustUp: boolean = true); override; function GetNavigationType: TNavigationType; override; { Change up vector, keeping the direction unchanged. If necessary, the up vector provided here will be fixed to be orthogonal to direction. See TCastleTransform.UpPrefer for detailed documentation what this does. } - procedure UpPrefer(const AUp: TVector3); + procedure UpPrefer(const AUp: TVector3); deprecated 'use Viewport.Camera.UpPrefer'; { Last known information about whether camera is over the ground. Updated by using @link(Height) call. For normal TCamera descendants, @@ -1573,7 +1695,7 @@ TWalkCamera = class(TCamera) property AboveGround: PTriangle read FAboveGround write FAboveGround; { @groupEnd } - { TODO: Input_Xxx not published. See TExamineCamera Input_Xxx notes + { TODO: Input_Xxx not published. See TCastleExamineNavigation Input_Xxx notes for reasoning. } { } property Input_Forward: TInputShortcut read FInput_Forward; @@ -1668,9 +1790,13 @@ TWalkCamera = class(TCamera) read FRotationHorizontalPivot write FRotationHorizontalPivot default 0; end; - TUniversalCamera = TCamera deprecated 'complicated TUniversalCamera class is removed; use TCamera as base class, or TWalkCamera or TExamineCamera for particular type, and SceneManager.NavigationType to switch type'; + TUniversalCamera = TCastleNavigation deprecated 'complicated TUniversalCamera class is removed; use TCastleNavigation as base class, or TCastleWalkNavigation or TCastleExamineNavigation for particular type, and SceneManager.NavigationType to switch type'; + + TCamera = TCastleNavigation deprecated 'use TCastleNavigation'; + TExamineCamera = TCastleExamineNavigation deprecated 'use TCastleExamineNavigation'; + TWalkCamera = TCastleWalkNavigation deprecated 'use TCastleWalkNavigation'; -{ See TWalkCamera.CorrectPreferredHeight. +{ See TCastleWalkNavigation.CorrectPreferredHeight. This is a global version, sometimes may be useful. } procedure CorrectPreferredHeight(var PreferredHeight: Single; const Radius: Single; const CrouchHeight, HeadBobbing: Single); @@ -1779,54 +1905,102 @@ procedure Register; implementation -uses Math, CastleStringUtils, CastleLog; +uses Math, + CastleStringUtils, CastleLog, CastleSceneManager; procedure Register; begin {$ifdef CASTLE_REGISTER_ALL_COMPONENTS_IN_LAZARUS} - RegisterComponents('Castle', [TExamineCamera, TWalkCamera]); + RegisterComponents('Castle', [TCastleExamineNavigation, TCastleWalkNavigation]); {$endif} end; -{ TCamera ------------------------------------------------------------ } +{ TCastleCamera -------------------------------------------------------------- } -constructor TCamera.Create(AOwner: TComponent); +constructor TCastleCamera.Create(AOwner: TComponent); begin inherited; + FPosition := TVector3.Zero; + FDirection := DefaultCameraDirection; + FUp := DefaultCameraUp; + FGravityUp := DefaultCameraUp; FProjectionMatrix := TMatrix4.Identity; // any sensible initial value FFrustum.Init(TMatrix4.Identity); // any sensible initial value - FInitialPosition := Vector3(0, 0, 0); - FInitialDirection := DefaultCameraDirection; - FInitialUp := DefaultCameraUp; - FRadius := DefaultRadius; - FInput := DefaultInput; - FModelBox := TBox3D.Empty; - FHeadBobbing := DefaultHeadBobbing; - FHeadBobbingTime := DefaultHeadBobbingTime; - FMoveHorizontalSpeed := 1; - FMoveVerticalSpeed := 1; - FMoveSpeed := 1; - FCrouchHeight := DefaultCrouchHeight; - FGravityUp := DefaultCameraUp; +end; - // interaction state - MouseDraggingStarted := -1; +procedure TCastleCamera.GetView(out APos, ADir, AUp: TVector3); +begin + APos := FPosition; + ADir := FDirection; + AUp := FUp; end; -procedure TCamera.VisibleChange(const Changes: TCastleUserInterfaceChanges; - const ChangeInitiatedByChildren: boolean); +procedure TCastleCamera.GetView(out APos, ADir, AUp, AGravityUp: TVector3); begin - RecalculateFrustum; - inherited; + GetView(APos, ADir, AUp); + AGravityUp := FGravityUp; end; -function TCamera.MatrixInverse: TMatrix4; +procedure TCastleCamera.SetView(const ADir, AUp: TVector3; + const AdjustUp: boolean); begin - if not Matrix.TryInverse(Result) then - raise Exception.Create('Cannot invert camera matrix, possibly it contains scaling to zero'); + FDirection := ADir.Normalize; + FUp := AUp.Normalize; + if AdjustUp then + MakeVectorsOrthoOnTheirPlane(FUp, FDirection) + else + MakeVectorsOrthoOnTheirPlane(FDirection, FUp); + + ScheduleVisibleChange; +end; + +procedure TCastleCamera.SetView(const APos, ADir, AUp: TVector3; + const AdjustUp: boolean); +begin + FPosition := APos; + SetView(ADir, AUp, AdjustUp); // calls ScheduleVisibleChange at the end +end; + +procedure TCastleCamera.SetView(const APos, ADir, AUp, AGravityUp: TVector3; + const AdjustUp: boolean = true); +begin + GravityUp := AGravityUp; + SetView(APos, ADir, AUp, AdjustUp); +end; + +procedure TCastleCamera.SetGravityUp(const Value: TVector3); +begin + FGravityUp := Value.Normalize; +end; + +procedure TCastleCamera.SetPosition(const Value: TVector3); +begin + FPosition := Value; + ScheduleVisibleChange; +end; + +procedure TCastleCamera.SetDirection(const Value: TVector3); +begin + FDirection := Value.Normalize; + MakeVectorsOrthoOnTheirPlane(FUp, FDirection); + ScheduleVisibleChange; +end; + +procedure TCastleCamera.SetUp(const Value: TVector3); +begin + FUp := Value.Normalize; + MakeVectorsOrthoOnTheirPlane(FDirection, FUp); + ScheduleVisibleChange; end; -procedure TCamera.BeginVisibleChangeSchedule; +procedure TCastleCamera.UpPrefer(const AUp: TVector3); +begin + FUp := AUp.Normalize; + MakeVectorsOrthoOnTheirPlane(FUp, FDirection); + ScheduleVisibleChange; +end; + +procedure TCastleCamera.BeginVisibleChangeSchedule; begin { IsVisibleChangeScheduled = false always when VisibleChangeSchedule = 0. } Assert((VisibleChangeSchedule <> 0) or (not IsVisibleChangeScheduled)); @@ -1834,15 +2008,16 @@ procedure TCamera.BeginVisibleChangeSchedule; Inc(VisibleChangeSchedule); end; -procedure TCamera.ScheduleVisibleChange; +procedure TCastleCamera.ScheduleVisibleChange; begin if VisibleChangeSchedule = 0 then - VisibleChange([chCamera]) + Viewport.VisibleChange([chCamera]) else IsVisibleChangeScheduled := true; + RecalculateFrustum; end; -procedure TCamera.EndVisibleChangeSchedule; +procedure TCastleCamera.EndVisibleChangeSchedule; begin Dec(VisibleChangeSchedule); if (VisibleChangeSchedule = 0) and IsVisibleChangeScheduled then @@ -1853,93 +2028,139 @@ procedure TCamera.EndVisibleChangeSchedule; BeginVisibleChangeSchedule. And BeginVisibleChangeSchedule must start with good state, see assertion there. } IsVisibleChangeScheduled := false; - VisibleChange([chCamera]); + Viewport.VisibleChange([chCamera]); end; end; -procedure TCamera.SetInput(const Value: TCameraInputs); +function TCastleCamera.Matrix: TMatrix4; begin - FInput := Value; + Result := LookDirMatrix(FPosition, FDirection, FUp); +end; + +function TCastleCamera.RotationMatrix: TMatrix4; +begin + Result := FastLookDirMatrix(FDirection, FUp); end; -procedure TCamera.SetEnableDragging(const Value: boolean); +function TCastleCamera.MatrixInverse: TMatrix4; begin - FEnableDragging := Value; + if not Matrix.TryInverse(Result) then + raise Exception.Create('Cannot invert camera matrix, possibly it contains scaling to zero'); end; -procedure TCamera.RecalculateFrustum; +procedure TCastleCamera.RecalculateFrustum; begin FFrustum.Init(ProjectionMatrix, Matrix); end; -procedure TCamera.SetProjectionMatrix(const Value: TMatrix4); +procedure TCastleCamera.SetProjectionMatrix(const Value: TMatrix4); begin FProjectionMatrix := Value; RecalculateFrustum; end; -procedure TCamera.SetRadius(const Value: Single); +procedure TCastleCamera.CustomRay( + const ViewportRect: TFloatRectangle; + const WindowPosition: TVector2; + const Projection: TProjection; + out RayOrigin, RayDirection: TVector3); +var + APos, ADir, AUp: TVector3; +begin + GetView(APos, ADir, AUp); + + PrimaryRay( + WindowPosition[0] - ViewportRect.Left, + WindowPosition[1] - ViewportRect.Bottom, + ViewportRect.Width, ViewportRect.Height, + APos, ADir, AUp, + Projection, + RayOrigin, RayDirection); +end; + +{ TCastleNavigation ------------------------------------------------------------ } + +constructor TCastleNavigation.Create(AOwner: TComponent); +begin + inherited; + FInitialPosition := Vector3(0, 0, 0); + FInitialDirection := DefaultCameraDirection; + FInitialUp := DefaultCameraUp; + FRadius := DefaultRadius; + FInput := DefaultInput; + FModelBox := TBox3D.Empty; + FHeadBobbing := DefaultHeadBobbing; + FHeadBobbingTime := DefaultHeadBobbingTime; + FMoveHorizontalSpeed := 1; + FMoveVerticalSpeed := 1; + FMoveSpeed := 1; + FCrouchHeight := DefaultCrouchHeight; + + // interaction state + MouseDraggingStarted := -1; + + FullSize := true; +end; + +procedure TCastleNavigation.SetInput(const Value: TCameraInputs); +begin + FInput := Value; +end; + +procedure TCastleNavigation.SetRadius(const Value: Single); begin FRadius := Value; end; -procedure TCamera.SetModelBox(const B: TBox3D); +procedure TCastleNavigation.SetModelBox(const B: TBox3D); var P, D, U: TVector3; begin - { since changing ModelBox changes also CenterOfRotation for TExamineCamera, + { since changing ModelBox changes also CenterOfRotation for TCastleExamineNavigation, explicitly make sure that camera view stays the same. } GetView(P, D, U); FModelBox := B; SetView(P, D, U); end; -procedure TCamera.Ray(const WindowPosition: TVector2; +procedure TCastleNavigation.Ray(const WindowPosition: TVector2; const Projection: TProjection; out RayOrigin, RayDirection: TVector3); begin - Assert(ContainerSizeKnown, 'Camera container size not known yet (probably camera not added to Controls list), cannot use TCamera.Ray'); + Assert(ContainerSizeKnown, 'Camera container size not known yet (probably camera not added to Controls list), cannot use TCastleNavigation.Ray'); CustomRay(FloatRectangle(ContainerRect), WindowPosition, Projection, RayOrigin, RayDirection); end; -procedure TCamera.MouseRay( +procedure TCastleNavigation.MouseRay( const Projection: TProjection; out RayOrigin, RayDirection: TVector3); begin - Assert(ContainerSizeKnown, 'Camera container size not known yet (probably camera not added to Controls list), cannot use TCamera.MouseRay'); + Assert(ContainerSizeKnown, 'Camera container size not known yet (probably camera not added to Controls list), cannot use TCastleNavigation.MouseRay'); CustomRay(FloatRectangle(ContainerRect), Container.MousePosition, Projection, RayOrigin, RayDirection); end; -procedure TCamera.CustomRay( - const Viewport: TFloatRectangle; +procedure TCastleNavigation.CustomRay( + const ViewportRect: TFloatRectangle; const WindowPosition: TVector2; const Projection: TProjection; out RayOrigin, RayDirection: TVector3); -var - Pos, Dir, Up: TVector3; begin - GetView(Pos, Dir, Up); - - PrimaryRay( - WindowPosition[0] - Viewport.Left, - WindowPosition[1] - Viewport.Bottom, - Viewport.Width, Viewport.Height, - Pos, Dir, Up, - Projection, - RayOrigin, RayDirection); + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling CustomRay'); + (Viewport as TCastleAbstractViewport).Camera.CustomRay(ViewportRect, WindowPosition, Projection, RayOrigin, RayDirection); end; -procedure TCamera.CustomRay( - const Viewport: TRectangle; +procedure TCastleNavigation.CustomRay( + const ViewportRect: TRectangle; const WindowPosition: TVector2; const Projection: TProjection; out RayOrigin, RayDirection: TVector3); begin - CustomRay(FloatRectangle(Viewport), + CustomRay(FloatRectangle(ViewportRect), WindowPosition, Projection, RayOrigin, RayDirection); end; -procedure TCamera.Update(const SecondsPassed: Single; +procedure TCastleNavigation.Update(const SecondsPassed: Single; var HandleInput: boolean); begin inherited; @@ -1961,16 +2182,16 @@ procedure TCamera.Update(const SecondsPassed: Single; end; end; -procedure TCamera.AnimateTo(const Pos, Dir, Up: TVector3; const Time: TFloatTime); +procedure TCastleNavigation.AnimateTo(const APos, ADir, AUp: TVector3; const Time: TFloatTime); begin GetView( AnimationBeginPosition, AnimationBeginDirection, AnimationBeginUp); - AnimationEndPosition := Pos; - AnimationEndDirection := Dir; - AnimationEndUp := Up; + AnimationEndPosition := APos; + AnimationEndDirection := ADir; + AnimationEndUp := AUp; AnimationEndTime := Time; AnimationCurrentTime := 0; @@ -1982,26 +2203,34 @@ procedure TCamera.AnimateTo(const Pos, Dir, Up: TVector3; const Time: TFloatTime TVector3.Equals(AnimationBeginUp , AnimationEndUp)); end; -procedure TCamera.AnimateTo(OtherCamera: TCamera; const Time: TFloatTime); +procedure TCastleNavigation.AnimateTo(OtherCamera: TCastleNavigation; const Time: TFloatTime); +var + APos, ADir, AUp: TVector3; +begin + OtherCamera.GetView(APos, ADir, AUp); + AnimateTo(APos, ADir, AUp, Time); +end; + +procedure TCastleNavigation.AnimateTo(OtherCamera: TCastleCamera; const Time: TFloatTime); var - Pos, Dir, Up: TVector3; + APos, ADir, AUp: TVector3; begin - OtherCamera.GetView(Pos, Dir, Up); - AnimateTo(Pos, Dir, Up, Time); + OtherCamera.GetView(APos, ADir, AUp); + AnimateTo(APos, ADir, AUp, Time); end; -function TCamera.Animation: boolean; +function TCastleNavigation.Animation: boolean; begin Result := FAnimation; end; -procedure TCamera.SetInitialView( +procedure TCastleNavigation.SetInitialView( const AInitialPosition: TVector3; AInitialDirection, AInitialUp: TVector3; const TransformCurrentCamera: boolean); var OldInitialOrientation, NewInitialOrientation, Orientation: TQuaternion; - Pos, Dir, Up: TVector3; + APos, ADir, AUp: TVector3; begin AInitialDirection.NormalizeMe; AInitialUp.NormalizeMe; @@ -2009,16 +2238,16 @@ procedure TCamera.SetInitialView( if TransformCurrentCamera then begin - GetView(Pos, Dir, Up); + GetView(APos, ADir, AUp); - Pos := Pos + AInitialPosition - FInitialPosition; + APos := APos + AInitialPosition - FInitialPosition; if not (TVector3.PerfectlyEquals(FInitialDirection, AInitialDirection) and TVector3.PerfectlyEquals(FInitialUp , AInitialUp ) ) then begin OldInitialOrientation := OrientationQuaternionFromDirectionUp(FInitialDirection, FInitialUp); NewInitialOrientation := OrientationQuaternionFromDirectionUp(AInitialDirection, AInitialUp); - Orientation := OrientationQuaternionFromDirectionUp(Dir, Up); + Orientation := OrientationQuaternionFromDirectionUp(ADir, AUp); { I want new Orientation := (Orientation - OldInitialOrientation) + NewInitialOrientation. } @@ -2026,12 +2255,11 @@ procedure TCamera.SetInitialView( Orientation := NewInitialOrientation * Orientation; { Now that we have Orientation, transform it into new Dir/Up. } - Dir := Orientation.Rotate(DefaultCameraDirection); - Up := Orientation.Rotate(DefaultCameraUp); + ADir := Orientation.Rotate(DefaultCameraDirection); + AUp := Orientation.Rotate(DefaultCameraUp); end; - { This will do ScheduleVisibleChange } - SetView(Pos, Dir, Up); + SetView(APos, ADir, AUp); end; FInitialPosition := AInitialPosition; @@ -2039,29 +2267,36 @@ procedure TCamera.SetInitialView( FInitialUp := AInitialUp; end; -procedure TCamera.GoToInitial; +procedure TCastleNavigation.GoToInitial; begin SetView(FInitialPosition, FInitialDirection, FInitialUp); end; -function TCamera.GetIgnoreAllInputs: boolean; +function TCastleNavigation.GetIgnoreAllInputs: boolean; begin Result := Input = []; end; -procedure TCamera.SetIgnoreAllInputs(const Value: boolean); +procedure TCastleNavigation.SetIgnoreAllInputs(const Value: boolean); begin if Value then Input := [] else Input := DefaultInput; end; -function TCamera.ReallyEnableMouseDragging: boolean; +function TCastleNavigation.ReallyEnableMouseDragging: boolean; begin - Result := (ciMouseDragging in Input) and EnableDragging; + Result := (ciMouseDragging in Input) and + { Is mouse dragging allowed by scene manager. + This is an additional condition to enable mouse dragging, + above the existing ciMouseDragging in Input. + It is used to prevent camera navigation by + dragging when we already drag a 3D item (like X3D TouchSensor). } + ( (Viewport = nil) or + (Viewport as TCastleAbstractViewport).NavigationEnableDragging ); end; -function TCamera.Press(const Event: TInputPressRelease): boolean; +function TCastleNavigation.Press(const Event: TInputPressRelease): boolean; begin Result := inherited; if Result then Exit; @@ -2074,38 +2309,31 @@ function TCamera.Press(const Event: TInputPressRelease): boolean; end; end; -function TCamera.Release(const Event: TInputPressRelease): boolean; +function TCastleNavigation.Release(const Event: TInputPressRelease): boolean; begin if Event.EventType = itMouseButton then MouseDraggingStarted := -1; Result := inherited; end; -function TCamera.GetPosition: TVector3; -begin - Result := GetPositionInternal; -end; - -procedure TCamera.CorrectPreferredHeight; +procedure TCastleNavigation.CorrectPreferredHeight; begin CastleCameras.CorrectPreferredHeight( FPreferredHeight, Radius, CrouchHeight, HeadBobbing); end; -procedure TCamera.Assign(Source: TPersistent); +procedure TCastleNavigation.Assign(Source: TPersistent); var - SourceCamera: TCamera; + SourceCamera: TCastleNavigation; APos, ADir, AUp, AGravityUp: TVector3; begin - if Source is TCamera then + if Source is TCastleNavigation then begin - SourceCamera := TCamera(Source); + SourceCamera := TCastleNavigation(Source); Radius := SourceCamera.Radius ; Input := SourceCamera.Input ; - EnableDragging := SourceCamera.EnableDragging ; - ProjectionMatrix := SourceCamera.ProjectionMatrix ; - { The Cursor should be synchronized with TWalkCamera.MouseLook, - do not blindly copy it from TWalkCamera to TExamineCamera. } + { The Cursor should be synchronized with TCastleWalkNavigation.MouseLook, + do not blindly copy it from TCastleWalkNavigation to TCastleExamineNavigation. } // Cursor := SourceCamera.Cursor ; PreferredHeight := SourceCamera.PreferredHeight ; MoveHorizontalSpeed := SourceCamera.MoveHorizontalSpeed; @@ -2135,27 +2363,137 @@ procedure TCamera.Assign(Source: TPersistent); inherited Assign(Source); end; -procedure TCamera.GetView(out APos, ADir, AUp, AGravityUp: TVector3); +procedure TCastleNavigation.GetView(out APos, ADir, AUp: TVector3); begin - GetView(APos, ADir, AUp); - AGravityUp := GravityUp; + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling GetView'); + (Viewport as TCastleAbstractViewport).Camera.GetView(APos, ADir, AUp); +end; + +procedure TCastleNavigation.GetView(out APos, ADir, AUp, AGravityUp: TVector3); +begin + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling GetView'); + (Viewport as TCastleAbstractViewport).Camera.GetView(APos, ADir, AUp, AGravityUp); end; -procedure TCamera.SetView(const APos, ADir, AUp, AGravityUp: TVector3; +procedure TCastleNavigation.SetView(const APos, ADir, AUp: TVector3; const AdjustUp: boolean); begin - GravityUp := AGravityUp; - SetView(APos, ADir, AUp, AdjustUp); + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling SetView'); + (Viewport as TCastleAbstractViewport).Camera.SetView(APos, ADir, AUp, AdjustUp); end; -procedure TCamera.SetGravityUp(const Value: TVector3); +procedure TCastleNavigation.SetView(const APos, ADir, AUp, AGravityUp: TVector3; + const AdjustUp: boolean); begin - FGravityUp := Value.Normalize; + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling SetView'); + (Viewport as TCastleAbstractViewport).Camera.SetView(APos, ADir, AUp, AGravityUp, AdjustUp); end; -{ TExamineCamera ------------------------------------------------------------ } +function TCastleNavigation.GetPosition: TVector3; +begin + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling GetPosition'); + Result := (Viewport as TCastleAbstractViewport).Camera.Position; +end; -constructor TExamineCamera.Create(AOwner: TComponent); +function TCastleNavigation.GetDirection: TVector3; +begin + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling GetDirection'); + Result := (Viewport as TCastleAbstractViewport).Camera.Direction; +end; + +function TCastleNavigation.GetUp: TVector3; +begin + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling GetUp'); + Result := (Viewport as TCastleAbstractViewport).Camera.Up; +end; + +function TCastleNavigation.GetGravityUp: TVector3; +begin + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling GetGravityUp'); + Result := (Viewport as TCastleAbstractViewport).Camera.GravityUp; +end; + +procedure TCastleNavigation.SetPosition(const Value: TVector3); +begin + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling SetPosition'); + (Viewport as TCastleAbstractViewport).Camera.Position := Value; +end; + +procedure TCastleNavigation.SetDirection(const Value: TVector3); +begin + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling SetDirection'); + (Viewport as TCastleAbstractViewport).Camera.Direction := Value; +end; + +procedure TCastleNavigation.SetUp(const Value: TVector3); +begin + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling SetUp'); + (Viewport as TCastleAbstractViewport).Camera.Up := Value; +end; + +procedure TCastleNavigation.SetGravityUp(const Value: TVector3); +begin + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling SetGravityUp'); + (Viewport as TCastleAbstractViewport).Camera.GravityUp := Value; +end; + +function TCastleNavigation.Matrix: TMatrix4; +begin + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling Matrix'); + Result := (Viewport as TCastleAbstractViewport).Camera.Matrix; +end; + +function TCastleNavigation.RotationMatrix: TMatrix4; +begin + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling RotationMatrix'); + Result := (Viewport as TCastleAbstractViewport).Camera.RotationMatrix; +end; + +function TCastleNavigation.MatrixInverse: TMatrix4; +begin + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling MatrixInverse'); + Result := (Viewport as TCastleAbstractViewport).Camera.MatrixInverse; +end; + +function TCastleNavigation.GetProjectionMatrix: TMatrix4; +begin + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling GetProjectionMatrix'); + Result := (Viewport as TCastleAbstractViewport).Camera.ProjectionMatrix; +end; + +procedure TCastleNavigation.SetProjectionMatrix(const Value: TMatrix4); +begin + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling SetProjectionMatrix'); + (Viewport as TCastleAbstractViewport).Camera.ProjectionMatrix := Value; +end; + +function TCastleNavigation.GetFrustum: TFrustum; +begin + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling GetFrustum'); + Result := (Viewport as TCastleAbstractViewport).Camera.Frustum; +end; + +{ TCastleExamineNavigation ------------------------------------------------------------ } + +constructor TCastleExamineNavigation.Create(AOwner: TComponent); type T3BoolKeys = array [0..2, boolean] of TKey; const @@ -2174,10 +2512,7 @@ constructor TExamineCamera.Create(AOwner: TComponent); FRotationEnabled := true; FMoveEnabled := true; FZoomEnabled := true; - FTranslation := TVector3.Zero; - FRotations := TQuaternion.ZeroRotation; FRotationsAnim := TVector3.Zero; - FScaleFactor := 1; FDragMoveSpeed := 1; FKeysMoveSpeed := 1; FScaleFactorMin := 0.01; @@ -2229,7 +2564,7 @@ constructor TExamineCamera.Create(AOwner: TComponent); Input_StopRotating.Assign(K_Space, K_None, '', true, mbLeft); end; -destructor TExamineCamera.Destroy; +destructor TCastleExamineNavigation.Destroy; var I: Integer; B: boolean; @@ -2248,33 +2583,66 @@ destructor TExamineCamera.Destroy; inherited; end; -function TExamineCamera.Matrix: TMatrix4; +function TCastleExamineNavigation.GetExamineVectors: TExamineVectors; +var + APos, ADir, AUp: TVector3; begin - Result := - TranslationMatrix(Translation + CenterOfRotation) * - Rotations.ToRotationMatrix * - ScalingMatrix(Vector3(ScaleFactor, ScaleFactor, ScaleFactor)) * - TranslationMatrix(-CenterOfRotation); + GetView(APos, ADir, AUp); + + Result.Translation := -APos; + + Result.Rotations := OrientationQuaternionFromDirectionUp(ADir, AUp).Conjugate; + + { We have to fix our Translation, since our TCastleExamineNavigation.Matrix + applies our move *first* before applying rotation + (and this is good, as it allows rotating around object center, + not around camera). + + Alternative implementation of this would call QuatToRotationMatrix and + then simulate multiplying this rotation matrix * translation matrix + of Translation. But we can do this directly. + + We also note at this point that rotation is done around + (Translation + CenterOfRotation). But CenterOfRotation is not + included in Translation. } + Result.Translation := Result.Rotations.Rotate(Result.Translation + CenterOfRotation) + - CenterOfRotation; + + { Reset ScaleFactor to 1, this way the camera view corresponds + exactly to the wanted SetView view. } + // TODO this always resets ScaleFactor, effectively e.g. ScaleFactorMin/Max will not work. + // Can we instead recover scale, assuming it was set by SetExamineVectors? + Result.ScaleFactor := 1; end; -function TExamineCamera.MatrixInverse: TMatrix4; +procedure TCastleExamineNavigation.SetExamineVectors(const Value: TExamineVectors); +var + MInverse: TMatrix4; begin { This inverse always exists, assuming ScaleFactor is <> 0. } - - Result := + MInverse := TranslationMatrix(CenterOfRotation) * - ScalingMatrix(Vector3(1/ScaleFactor, 1/ScaleFactor, 1/ScaleFactor)) * - Rotations.Conjugate.ToRotationMatrix * - TranslationMatrix(-(Translation + CenterOfRotation)); -end; + ScalingMatrix(Vector3(1/Value.ScaleFactor, 1/Value.ScaleFactor, 1/Value.ScaleFactor)) * + Value.Rotations.Conjugate.ToRotationMatrix * + TranslationMatrix(-(Value.Translation + CenterOfRotation)); -function TExamineCamera.RotationMatrix: TMatrix4; -begin - Result := Rotations.ToRotationMatrix; + { These MultPoint/Direction should never fail with ETransformedResultInvalid. + That's because M is composed from translations, rotations, scaling, + which preserve points/directions (4th component in homogeneous coordinates) + nicely. } + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling SetView'); + (Viewport as TCastleAbstractViewport).Camera.SetView( + MInverse.MultPoint(TVector3.Zero), + MInverse.MultDirection(DefaultCameraDirection), + MInverse.MultDirection(DefaultCameraUp) + ); end; -procedure TExamineCamera.Update(const SecondsPassed: Single; +procedure TCastleExamineNavigation.Update(const SecondsPassed: Single; var HandleInput: boolean); +var + V: TExamineVectors; { Increase speed of rotating, or just rotation angle (depending on RotationAccelerate). Direction must be -1 or +1. } @@ -2288,10 +2656,10 @@ procedure TExamineCamera.Update(const SecondsPassed: Single; FRotationsAnim[coord] := Clamped(FRotationsAnim[coord] + RotationAccelerationSpeed * SecondsPassed * Direction, - -MaxRotationSpeed, MaxRotationSpeed) else - FRotations := QuatFromAxisAngle(TVector3.One[Coord], - RotationSpeed * SecondsPassed * Direction) * FRotations; - ScheduleVisibleChange; + -MaxRotationSpeed, MaxRotationSpeed) + else + V.Rotations := QuatFromAxisAngle(TVector3.One[Coord], + RotationSpeed * SecondsPassed * Direction) * V.Rotations; end; var @@ -2306,6 +2674,8 @@ procedure TExamineCamera.Update(const SecondsPassed: Single; { Do not handle keys or rotations etc. } if Animation then Exit; + V := ExamineVectors; + { If given RotationsAnim component is zero, no need to change current Rotations. What's more important, this avoids the need to call VisibleChange, so things like Invalidate will not be continuously called when @@ -2316,30 +2686,30 @@ procedure TExamineCamera.Update(const SecondsPassed: Single; keys (that increase RotationsAnim). Exact equality is Ok check to detect this. } + + if RotationEnabled and (not FRotationsAnim.IsPerfectlyZero) then begin RotChange := SecondsPassed; if FRotationsAnim[0] <> 0 then - FRotations := QuatFromAxisAngle(TVector3.One[0], - FRotationsAnim[0] * RotChange) * FRotations; + V.Rotations := QuatFromAxisAngle(TVector3.One[0], + FRotationsAnim[0] * RotChange) * V.Rotations; if FRotationsAnim[1] <> 0 then begin if Turntable then - FRotations := FRotations * QuatFromAxisAngle(TVector3.One[1], + V.Rotations := V.Rotations * QuatFromAxisAngle(TVector3.One[1], FRotationsAnim[1] * RotChange) else - FRotations := QuatFromAxisAngle(TVector3.One[1], - FRotationsAnim[1] * RotChange) * FRotations; + V.Rotations := QuatFromAxisAngle(TVector3.One[1], + FRotationsAnim[1] * RotChange) * V.Rotations; end; if FRotationsAnim[2] <> 0 then - FRotations := QuatFromAxisAngle(TVector3.One[2], - FRotationsAnim[2] * RotChange) * FRotations; + V.Rotations := QuatFromAxisAngle(TVector3.One[2], + FRotationsAnim[2] * RotChange) * V.Rotations; - FRotations.LazyNormalizeMe; - - ScheduleVisibleChange; + V.Rotations.LazyNormalizeMe; end; if HandleInput and (ciNormal in Input) then @@ -2361,7 +2731,7 @@ procedure TExamineCamera.Update(const SecondsPassed: Single; begin MoveChangeVector := TVector3.Zero; MoveChangeVector[I] := MoveChange; - Translation := Translation + MoveChangeVector; + V.Translation := V.Translation + MoveChangeVector; HandleInput := not ExclusiveEvents; end; @@ -2369,7 +2739,7 @@ procedure TExamineCamera.Update(const SecondsPassed: Single; begin MoveChangeVector := TVector3.Zero; MoveChangeVector[I] := -MoveChange; - Translation := Translation + MoveChangeVector; + V.Translation := V.Translation + MoveChangeVector; HandleInput := not ExclusiveEvents; end; @@ -2394,23 +2764,25 @@ procedure TExamineCamera.Update(const SecondsPassed: Single; if Input_ScaleLarger.IsPressed(Container) then begin - ScaleFactor := ScaleFactor * Power(ScaleChange, SecondsPassed); + V.ScaleFactor := V.ScaleFactor * Power(ScaleChange, SecondsPassed); HandleInput := not ExclusiveEvents; end; if Input_ScaleSmaller.IsPressed(Container) then begin - ScaleFactor := ScaleFactor * Power(1 / ScaleChange, SecondsPassed); + V.ScaleFactor := V.ScaleFactor * Power(1 / ScaleChange, SecondsPassed); HandleInput := not ExclusiveEvents; end; end; + + ExamineVectors := V; end; -function TExamineCamera.AllowSuspendForInput: boolean; +function TCastleExamineNavigation.AllowSuspendForInput: boolean; begin Result := false; end; -procedure TExamineCamera.SetRotationAccelerate(const Value: boolean); +procedure TCastleExamineNavigation.SetRotationAccelerate(const Value: boolean); begin if FRotationAccelerate <> Value then begin @@ -2419,33 +2791,31 @@ procedure TExamineCamera.SetRotationAccelerate(const Value: boolean); end; end; -function TExamineCamera.StopRotating: boolean; +function TCastleExamineNavigation.StopRotating: boolean; begin Result := not FRotationsAnim.IsPerfectlyZero; if Result then - begin FRotationsAnim := TVector3.Zero; - ScheduleVisibleChange; - end; end; -procedure TExamineCamera.Scale(const ScaleBy: Single); +procedure TCastleExamineNavigation.Scale(const ScaleBy: Single); begin - FScaleFactor := FScaleFactor * ScaleBy; - ScheduleVisibleChange; + ScaleFactor := ScaleFactor * ScaleBy; end; -procedure TExamineCamera.Move(coord: integer; const MoveDistance: Single); +procedure TCastleExamineNavigation.Move(coord: integer; const MoveDistance: Single); +var + V: TVector3; begin - FTranslation.Data[coord] := FTranslation.Data[coord] + MoveDistance; - ScheduleVisibleChange; + V := TVector3.Zero; + V[Coord] := MoveDistance; + Translation := Translation + V; end; -function TExamineCamera.SensorTranslation(const X, Y, Z, Length: Double; +function TCastleExamineNavigation.SensorTranslation(const X, Y, Z, Length: Double; const SecondsPassed: Single): boolean; var Size: Single; - Moved: boolean; MoveSize: Double; begin if not (ci3dMouse in Input) then Exit(false); @@ -2453,35 +2823,25 @@ function TExamineCamera.SensorTranslation(const X, Y, Z, Length: Double; if FModelBox.IsEmptyOrZero then Exit(false); Result := true; - Moved := false; Size := FModelBox.AverageSize; MoveSize := Length * SecondsPassed / 5000; - if Abs(X)>5 then { left / right } - begin - FTranslation.Data[0] := FTranslation.Data[0] + (Size * X * MoveSize); - Moved := true; - end; - - if Abs(Y)>5 then { up / down } - begin - FTranslation.Data[1] := FTranslation.Data[1] + (Size * Y * MoveSize); - Moved := true; - end; + if Abs(X) > 5 then { left / right } + Translation := Translation + Vector3(Size * X * MoveSize, 0, 0); - if Moved then - ScheduleVisibleChange; + if Abs(Y) > 5 then { up / down } + Translation := Translation + Vector3(0, Size * Y * MoveSize, 0); - if Abs(Z)>5 then { backward / forward } + if Abs(Z) > 5 then { backward / forward } Zoom(Z * MoveSize / 2); end; -function TExamineCamera.SensorRotation(const X, Y, Z, Angle: Double; +function TCastleExamineNavigation.SensorRotation(const X, Y, Z, Angle: Double; const SecondsPassed: Single): boolean; var - NewRotation: TQuaternion; Moved: boolean; RotationSize: Double; + V: TExamineVectors; begin if not (ci3dMouse in Input) then Exit(false); if not RotationEnabled then Exit(false); @@ -2489,94 +2849,119 @@ function TExamineCamera.SensorRotation(const X, Y, Z, Angle: Double; Moved := false; RotationSize := SecondsPassed * Angle / 50; - NewRotation := FRotations; + V := ExamineVectors; if Abs(X) > 0.4 then { tilt forward / backward} begin - NewRotation := QuatFromAxisAngle(Vector3(1, 0, 0), X * RotationSize) * NewRotation; + V.Rotations := QuatFromAxisAngle(Vector3(1, 0, 0), X * RotationSize) * V.Rotations; Moved := true; end; if Abs(Y) > 0.4 then { rotate } begin if Turntable then - NewRotation := NewRotation * + V.Rotations := V.Rotations * QuatFromAxisAngle(Vector3(0, 1, 0), Y * RotationSize) else - NewRotation := QuatFromAxisAngle(Vector3(0, 1, 0), Y * RotationSize) * - NewRotation; + V.Rotations := QuatFromAxisAngle(Vector3(0, 1, 0), Y * RotationSize) * + V.Rotations; Moved := true; end; if (Abs(Z) > 0.4) and (not Turntable) then { tilt sidewards } begin - NewRotation := QuatFromAxisAngle(Vector3(0, 0, 1), Z * RotationSize) * NewRotation; + V.Rotations := QuatFromAxisAngle(Vector3(0, 0, 1), Z * RotationSize) * V.Rotations; Moved := true; end; + { Assign ExamineVectors only if some change occurred } if Moved then - begin - FRotations := NewRotation; - ScheduleVisibleChange; - end; + ExamineVectors := V; end; -procedure TExamineCamera.Init(const AModelBox: TBox3D; const ARadius: Single); +procedure TCastleExamineNavigation.Init(const AModelBox: TBox3D; const ARadius: Single); var - Pos, Dir, Up, NewGravityUp: TVector3; + APos, ADir, AUp, NewGravityUp: TVector3; begin FModelBox := AModelBox; // set using FModelBox, as there's no need to preserve view Radius := ARadius; CameraViewpointForWholeScene(ModelBox, 2, 1, false, true, - Pos, Dir, Up, NewGravityUp); + APos, ADir, AUp, NewGravityUp); GravityUp := NewGravityUp; - SetInitialView(Pos, Dir, Up, false); + SetInitialView(APos, ADir, AUp, false); GoToInitial; end; -{ TExamineCamera.Set* properties } +{ TCastleExamineNavigation.Set* properties } + +procedure TCastleExamineNavigation.SetRotationsAnim(const Value: TVector3); +begin + FRotationsAnim := Value; +end; + +function TCastleExamineNavigation.GetRotations: TQuaternion; +begin + Result := ExamineVectors.Rotations; +end; -procedure TExamineCamera.SetRotationsAnim(const Value: TVector3); -begin FRotationsAnim := Value; ScheduleVisibleChange; end; +procedure TCastleExamineNavigation.SetRotations(const Value: TQuaternion); +var + V: TExamineVectors; +begin + V := ExamineVectors; + V.Rotations := Value; + ExamineVectors := V; +end; -procedure TExamineCamera.SetRotations(const Value: TQuaternion); -begin FRotations := Value; ScheduleVisibleChange; end; +function TCastleExamineNavigation.GetScaleFactor: Single; +begin + Result := ExamineVectors.ScaleFactor; +end; -procedure TExamineCamera.SetScaleFactor(const Value: Single); +procedure TCastleExamineNavigation.SetScaleFactor(const Value: Single); +var + V: TExamineVectors; begin - if FScaleFactor <> Value then - begin - FScaleFactor := Clamped(Value, FScaleFactorMin, FScaleFactorMax); - ScheduleVisibleChange; - end; + V := ExamineVectors; + V.ScaleFactor := Value; + ExamineVectors := V; end; -procedure TExamineCamera.SetScaleFactorMin(const Value: Single); +procedure TCastleExamineNavigation.SetScaleFactorMin(const Value: Single); begin if FScaleFactorMin <> Value then begin FScaleFactorMin := Value; - { Correct ScaleFactor now. - Using a property, so it causes ScheduleVisibleChange if changed. } + { Correct ScaleFactor now } ScaleFactor := Clamped(ScaleFactor, FScaleFactorMin, FScaleFactorMax); end; end; -procedure TExamineCamera.SetScaleFactorMax(const Value: Single); +procedure TCastleExamineNavigation.SetScaleFactorMax(const Value: Single); begin if FScaleFactorMax <> Value then begin FScaleFactorMax := Value; - { Correct ScaleFactor now. - Using a property, so it causes ScheduleVisibleChange if changed. } + { Correct ScaleFactor now } ScaleFactor := Clamped(ScaleFactor, FScaleFactorMin, FScaleFactorMax); end; end; -procedure TExamineCamera.SetTranslation(const Value: TVector3); -begin FTranslation := Value; ScheduleVisibleChange; end; +function TCastleExamineNavigation.GetTranslation: TVector3; +begin + Result := ExamineVectors.Translation; +end; + +procedure TCastleExamineNavigation.SetTranslation(const Value: TVector3); +var + V: TExamineVectors; +begin + V := ExamineVectors; + V.Translation := Value; + ExamineVectors := V; +end; -function TExamineCamera.CenterOfRotation: TVector3; +function TCastleExamineNavigation.CenterOfRotation: TVector3; begin if FModelBox.IsEmpty then Result := Vector3(0, 0, 0) { any dummy value } @@ -2584,7 +2969,7 @@ function TExamineCamera.CenterOfRotation: TVector3; Result := FModelBox.Center; end; -function TExamineCamera.Press(const Event: TInputPressRelease): boolean; +function TCastleExamineNavigation.Press(const Event: TInputPressRelease): boolean; var ZoomScale: Single; begin @@ -2629,7 +3014,7 @@ function TExamineCamera.Press(const Event: TInputPressRelease): boolean; end; end; -function TExamineCamera.Release(const Event: TInputPressRelease): boolean; +function TCastleExamineNavigation.Release(const Event: TInputPressRelease): boolean; begin Result := inherited; if Result then Exit; @@ -2638,13 +3023,13 @@ function TExamineCamera.Release(const Event: TInputPressRelease): boolean; Exit(ExclusiveEvents); end; -function TExamineCamera.Zoom(const Factor: Single): boolean; +function TCastleExamineNavigation.Zoom(const Factor: Single): boolean; function OrthographicProjection: Boolean; begin { See how perspective (and more flexible frustum) projection matrices look like in CastleProjection, they have always -1 in this field. } - Result := FProjectionMatrix.Data[2, 3] = 0; + Result := ProjectionMatrix.Data[2, 3] = 0; end; var @@ -2664,10 +3049,10 @@ function TExamineCamera.Zoom(const Factor: Single): boolean; { zoom by changing Translation } Size := FModelBox.AverageSize; - OldTranslation := FTranslation; + OldTranslation := Translation; OldPosition := Position; - FTranslation.Data[2] := FTranslation.Data[2] + (Size * Factor); + Translation := Translation + Vector3(0, 0, Size * Factor); { Cancel zoom in, don't allow to go to the other side of the model too far. Note that TBox3D.PointDistance = 0 when you're inside the box, @@ -2677,23 +3062,23 @@ function TExamineCamera.Zoom(const Factor: Single): boolean; (FModelBox.PointDistance(Position) > FModelBox.PointDistance(OldPosition)) then begin - FTranslation := OldTranslation; + Translation := OldTranslation; Exit(false); end; end; - - ScheduleVisibleChange; end; end; -function TExamineCamera.Motion(const Event: TInputMotion): boolean; +function TCastleExamineNavigation.Motion(const Event: TInputMotion): boolean; var Size: Single; ModsDown: TModifierKeys; MoveDivConst: Single; Dpi: Single; - function DragRotation: TQuaternion; + procedure DragRotation; + var + V: TExamineVectors; { Returns new rotation } function XYRotation(const Scale: Single): TQuaternion; @@ -2701,25 +3086,30 @@ function TExamineCamera.Motion(const Event: TInputMotion): boolean; if Turntable then Result := QuatFromAxisAngle(Vector3(1, 0, 0), Scale * (Event.OldPosition[1] - Event.Position[1]) / MoveDivConst) * - FRotations * - QuatFromAxisAngle(Vector3(0, 1, 0), Scale * (Event.Position[0] - Event.OldPosition[0]) / MoveDivConst) else + V.Rotations * + QuatFromAxisAngle(Vector3(0, 1, 0), Scale * (Event.Position[0] - Event.OldPosition[0]) / MoveDivConst) + else Result := QuatFromAxisAngle(Vector3(1, 0, 0), Scale * (Event.OldPosition[1] - Event.Position[1]) / MoveDivConst) * - QuatFromAxisAngle(Vector3(0, 1, 0), Scale * (Event.Position[0] - Event.OldPosition[0]) / MoveDivConst); + QuatFromAxisAngle(Vector3(0, 1, 0), Scale * (Event.Position[0] - Event.OldPosition[0]) / MoveDivConst) * + V.Rotations; end; var W2, H2, AvgX, AvgY, ZRotAngle, ZRotRatio: Single; begin + V := ExamineVectors; + if (not ContainerSizeKnown) then begin - Result := XYRotation(1); - end else if Turntable then + V.Rotations := XYRotation(1); + end else + if Turntable then begin //Result := XYRotation(0.5); // this matches the rotation speed of ntExamine { Do one turn around Y axis by dragging from one viewport side to another (so it does not depend on viewport size) } - Result := XYRotation(2 * Pi * MoveDivConst / Container.Width); + V.Rotations := XYRotation(2 * Pi * MoveDivConst / Container.Width); end else begin { When the cursor is close to the window edge, make rotation around Z axis. @@ -2744,10 +3134,12 @@ function TExamineCamera.Motion(const Event: TInputMotion): boolean; { how much do we want Z rotation, i.e. how far are we from window middle, in 0..1 } ZRotRatio := Min(1.0, Sqrt(Sqr((AvgX - W2) / W2) + Sqr((AvgY - H2) / H2))); - Result := + V.Rotations := QuatFromAxisAngle(Vector3(0, 0, -1), ZRotRatio * ZRotAngle) * XYRotation(1 - ZRotRatio); end; + + ExamineVectors := V; end; var @@ -2795,11 +3187,7 @@ function TExamineCamera.Motion(const Event: TInputMotion): boolean; if RotationEnabled and (MouseButtonRotate = DraggingMouseButton) then begin - if Turntable then - FRotations := DragRotation {old FRotations already included in XYRotation} - else - FRotations := DragRotation * FRotations; - ScheduleVisibleChange; + DragRotation; Result := ExclusiveEvents; end; @@ -2816,14 +3204,15 @@ function TExamineCamera.Motion(const Event: TInputMotion): boolean; (MouseButtonMove = DraggingMouseButton) then begin Size := FModelBox.AverageSize; - FTranslation.Data[0] := FTranslation.Data[0] - (DragMoveSpeed * Size * (Event.OldPosition[0] - Event.Position[0]) / (2*MoveDivConst)); - FTranslation.Data[1] := FTranslation.Data[1] - (DragMoveSpeed * Size * (Event.OldPosition[1] - Event.Position[1]) / (2*MoveDivConst)); - ScheduleVisibleChange; + Translation := Translation - Vector3( + DragMoveSpeed * Size * (Event.OldPosition[0] - Event.Position[0]) / (2*MoveDivConst), + DragMoveSpeed * Size * (Event.OldPosition[1] - Event.Position[1]) / (2*MoveDivConst), + 0); Result := ExclusiveEvents; end; end; -procedure TExamineCamera.OnGestureRecognized(Sender: TObject); +procedure TCastleExamineNavigation.OnGestureRecognized(Sender: TObject); var Recognizer: TCastlePinchPanGestureRecognizer; Factor, Size, MoveDivConst, ZoomScale: Single; @@ -2851,148 +3240,39 @@ procedure TExamineCamera.OnGestureRecognized(Sender: TObject); if MoveEnabled and (Recognizer.Gesture = gtPan) then begin Size := FModelBox.AverageSize; - FTranslation.Data[0] := FTranslation.Data[0] - (DragMoveSpeed * Size * (Recognizer.PanOldOffset.X - Recognizer.PanOffset.X) / (2*MoveDivConst)); - FTranslation.Data[1] := FTranslation.Data[1] - (DragMoveSpeed * Size * (Recognizer.PanOldOffset.Y - Recognizer.PanOffset.Y) / (2*MoveDivConst)); - ScheduleVisibleChange; - end; -end; - -procedure TExamineCamera.GetView(out APos, ADir, AUp: TVector3); -begin - APos := FPosition; - ADir := FDirection; - AUp := FUp; -end; - -procedure TExamineCamera.VisibleChange(const Changes: TCastleUserInterfaceChanges; - const ChangeInitiatedByChildren: boolean); -var - M: TMatrix4; -begin - { calculate our pos/dir/up vectors here. - This allows our GetView to work immediately fast, at the expense of doing - the below calculations always. In practice, this is good, - as e.g. TCastleSceneManager.CameraVisibleChange calls GetView *always*. - So assume that GetView is called very often, and make it instant. } - M := MatrixInverse; - - { These MultPoint/Direction should never fail with ETransformedResultInvalid. - That's because M is composed from translations, rotations, scaling, - which preserve points/directions (4th component in homogeneous coordinates) - nicely. } - FPosition := M.MultPoint(TVector3.Zero); - FDirection := M.MultDirection(DefaultCameraDirection); - FUp := M.MultDirection(DefaultCameraUp); - - { In case of ScaleFactor, it is possible that M is such that dir/up - are not normalized. Fix them now, GetView guarantees normalized vectors. } - if ScaleFactor <> 1 then - begin - FDirection.NormalizeMe; - FUp.NormalizeMe; - end; - - inherited; -end; - -function TExamineCamera.GetPositionInternal: TVector3; -begin - Result := MatrixInverse.MultPoint(TVector3.Zero); -end; - -procedure TExamineCamera.SetPosition(const Value: TVector3); -begin - { a subset of what SetView does } - FTranslation := -Value; - FTranslation := FRotations.Rotate(FTranslation + CenterOfRotation) - - CenterOfRotation; - ScheduleVisibleChange; -end; - -procedure TExamineCamera.SetView(const APos, ADir, AUp: TVector3; - const AdjustUp: boolean); -var - Dir, Up: TVector3; -begin - FTranslation := -APos; - - { Make vectors orthogonal, OrientationQuaternionFromDirectionUp requires this } - Dir := ADir; - Up := AUp; - if AdjustUp then - MakeVectorsOrthoOnTheirPlane(Up, Dir) - else - MakeVectorsOrthoOnTheirPlane(Dir, Up); - - FRotations := OrientationQuaternionFromDirectionUp(Dir, Up).Conjugate; - -{ Testing of "hard case" in OrientationQuaternionFromDirectionUp. - This should always succeed now, many cases tested automatically - by TTestCastleCameras.TestOrientationFromBasicAxes. - - if not TVector3.Equals(QuatRotate(FRotations, Dir.Normalize), DefaultCameraDirection, 0.01) then - begin - Writeln('oh yes, dir wrong: ', QuatRotate(FRotations, Dir.Normalize).ToString); - Writeln(' q: ', FRotations.Vector4.ToString); + Translation := Translation - Vector3( + DragMoveSpeed * Size * (Recognizer.PanOldOffset.X - Recognizer.PanOffset.X) / (2*MoveDivConst), + DragMoveSpeed * Size * (Recognizer.PanOldOffset.Y - Recognizer.PanOffset.Y) / (2*MoveDivConst), + 0); end; - - if not TVector3.Equals(QuatRotate(FRotations, Up.Normalize), DefaultCameraUp, 0.01) then - Writeln('oh yes, up wrong: ', QuatRotate(FRotations, Up.Normalize).ToString); -} - - { We have to fix our FTranslation, since our TExamineCamera.Matrix - applies our move *first* before applying rotation - (and this is good, as it allows rotating around object center, - not around camera). - - Alternative implementation of this would call QuatToRotationMatrix and - then simulate multiplying this rotation matrix * translation matrix - of FTranslation. But we can do this directly. - - We also note at this point that rotation is done around - (FTranslation + CenterOfRotation). But CenterOfRotation is not - included in Translation. } - FTranslation := FRotations.Rotate(FTranslation + CenterOfRotation) - - CenterOfRotation; - - { Reset ScaleFactor to 1, this way the camera view corresponds - exactly to the wanted SetView view. } - FScaleFactor := 1; - - { Stopping the rotation animation wasn't really promised in SetView - interface. But this is nice for user, otherwise after e.g. jumping - to viewpoint you may find yourself still rotating --- usually distracting. } - FRotationsAnim := TVector3.Zero; - - ScheduleVisibleChange; end; -function TExamineCamera.GetInput_MoveXInc: TInputShortcut; begin Result := Inputs_Move[0, true ] end; -function TExamineCamera.GetInput_MoveXDec: TInputShortcut; begin Result := Inputs_Move[0, false] end; -function TExamineCamera.GetInput_MoveYInc: TInputShortcut; begin Result := Inputs_Move[1, true ] end; -function TExamineCamera.GetInput_MoveYDec: TInputShortcut; begin Result := Inputs_Move[1, false] end; -function TExamineCamera.GetInput_MoveZInc: TInputShortcut; begin Result := Inputs_Move[2, true ] end; -function TExamineCamera.GetInput_MoveZDec: TInputShortcut; begin Result := Inputs_Move[2, false] end; -function TExamineCamera.GetInput_RotateXInc: TInputShortcut; begin Result := Inputs_Rotate[0, true ] end; -function TExamineCamera.GetInput_RotateXDec: TInputShortcut; begin Result := Inputs_Rotate[0, false] end; -function TExamineCamera.GetInput_RotateYInc: TInputShortcut; begin Result := Inputs_Rotate[1, true ] end; -function TExamineCamera.GetInput_RotateYDec: TInputShortcut; begin Result := Inputs_Rotate[1, false] end; -function TExamineCamera.GetInput_RotateZInc: TInputShortcut; begin Result := Inputs_Rotate[2, true ] end; -function TExamineCamera.GetInput_RotateZDec: TInputShortcut; begin Result := Inputs_Rotate[2, false] end; - -function TExamineCamera.GetMouseNavigation: boolean; +function TCastleExamineNavigation.GetInput_MoveXInc: TInputShortcut; begin Result := Inputs_Move[0, true ] end; +function TCastleExamineNavigation.GetInput_MoveXDec: TInputShortcut; begin Result := Inputs_Move[0, false] end; +function TCastleExamineNavigation.GetInput_MoveYInc: TInputShortcut; begin Result := Inputs_Move[1, true ] end; +function TCastleExamineNavigation.GetInput_MoveYDec: TInputShortcut; begin Result := Inputs_Move[1, false] end; +function TCastleExamineNavigation.GetInput_MoveZInc: TInputShortcut; begin Result := Inputs_Move[2, true ] end; +function TCastleExamineNavigation.GetInput_MoveZDec: TInputShortcut; begin Result := Inputs_Move[2, false] end; +function TCastleExamineNavigation.GetInput_RotateXInc: TInputShortcut; begin Result := Inputs_Rotate[0, true ] end; +function TCastleExamineNavigation.GetInput_RotateXDec: TInputShortcut; begin Result := Inputs_Rotate[0, false] end; +function TCastleExamineNavigation.GetInput_RotateYInc: TInputShortcut; begin Result := Inputs_Rotate[1, true ] end; +function TCastleExamineNavigation.GetInput_RotateYDec: TInputShortcut; begin Result := Inputs_Rotate[1, false] end; +function TCastleExamineNavigation.GetInput_RotateZInc: TInputShortcut; begin Result := Inputs_Rotate[2, true ] end; +function TCastleExamineNavigation.GetInput_RotateZDec: TInputShortcut; begin Result := Inputs_Rotate[2, false] end; + +function TCastleExamineNavigation.GetMouseNavigation: boolean; begin Result := ciMouseDragging in Input; end; -procedure TExamineCamera.SetMouseNavigation(const Value: boolean); +procedure TCastleExamineNavigation.SetMouseNavigation(const Value: boolean); begin if Value then Input := Input + [ciMouseDragging] else Input := Input - [ciMouseDragging]; end; -function TExamineCamera.GetNavigationType: TNavigationType; +function TCastleExamineNavigation.GetNavigationType: TNavigationType; begin if Input = [] then Result := ntNone @@ -3003,14 +3283,19 @@ function TExamineCamera.GetNavigationType: TNavigationType; Result := ntExamine; end; -{ TWalkCamera ---------------------------------------------------------------- } +{ TCastleWalkNavigation ---------------------------------------------------------------- } -constructor TWalkCamera.Create(AOwner: TComponent); +constructor TCastleWalkNavigation.Create(AOwner: TComponent); begin inherited; + + { TODO: this means walk camera is initialized from InitialXxx, how to replicate? + move InitialXxx to TCastleCamera too? + FPosition := InitialPosition; FDirection := InitialDirection; FUp := InitialUp; + } FRotationHorizontalSpeed := DefaultRotationHorizontalSpeed; FRotationVerticalSpeed := DefaultRotationVerticalSpeed; @@ -3105,29 +3390,12 @@ constructor TWalkCamera.Create(AOwner: TComponent); Input_Run .Name := 'Input_Run'; end; -destructor TWalkCamera.Destroy; +destructor TCastleWalkNavigation.Destroy; begin inherited; end; -function TWalkCamera.Matrix: TMatrix4; -begin - { Yes, below we compare Fde_UpRotate with 0.0 using normal - (precise) <> operator. Don't worry --- Fde_Stabilize in Update - will take care of eventually setting Fde_UpRotate to - a precise 0.0. } - if Fde_UpRotate <> 0.0 then - Result := LookDirMatrix(Position, Direction, - RotatePointAroundAxisDeg(Fde_UpRotate, Up, Direction)) else - Result := LookDirMatrix(Position, Direction, Up); -end; - -function TWalkCamera.RotationMatrix: TMatrix4; -begin - result := FastLookDirMatrix(Direction, Up); -end; - -function TWalkCamera.DoMoveAllowed(const ProposedNewPos: TVector3; +function TCastleWalkNavigation.DoMoveAllowed(const ProposedNewPos: TVector3; out NewPos: TVector3; const BecauseOfGravity: boolean): boolean; begin if Assigned(OnMoveAllowed) then @@ -3138,7 +3406,7 @@ function TWalkCamera.DoMoveAllowed(const ProposedNewPos: TVector3; end; end; -procedure TWalkCamera.Height(const APosition: TVector3; +procedure TCastleWalkNavigation.Height(const APosition: TVector3; out AIsAbove: boolean; out AnAboveHeight: Single; out AnAboveGround: PTriangle); begin @@ -3151,12 +3419,12 @@ procedure TWalkCamera.Height(const APosition: TVector3; end; end; -function TWalkCamera.UseHeadBobbing: boolean; +function TCastleWalkNavigation.UseHeadBobbing: boolean; begin Result := Gravity and (HeadBobbing <> 0.0); end; -function TWalkCamera.RealPreferredHeightNoHeadBobbing: Single; +function TCastleWalkNavigation.RealPreferredHeightNoHeadBobbing: Single; begin Result := PreferredHeight; @@ -3164,7 +3432,7 @@ function TWalkCamera.RealPreferredHeightNoHeadBobbing: Single; Result := Result * CrouchHeight; end; -function TWalkCamera.RealPreferredHeight: Single; +function TCastleWalkNavigation.RealPreferredHeight: Single; var BobbingModifier: Single; begin @@ -3204,37 +3472,42 @@ function TWalkCamera.RealPreferredHeight: Single; end; end; -function TWalkCamera.RealPreferredHeightMargin: Single; +function TCastleWalkNavigation.RealPreferredHeightMargin: Single; begin { I tried using here something smaller like SingleEpsilon, but this was not good. } Result := RealPreferredHeight * 0.01; end; -procedure TWalkCamera.AdjustForRotationHorizontalPivot(const OldDirection: TVector3); +function TCastleWalkNavigation.AdjustPositionForRotationHorizontalPivot( + const OldDirection, NewDirection: TVector3): TVector3; var - Pivot, OldDirectionInGravityPlane: TVector3; + Pivot, OldDirectionInGravityPlane, NewDirectionInGravityPlane: TVector3; begin + Result := Position; if RotationHorizontalPivot <> 0 then begin if PreferGravityUpForRotations then begin - Pivot := Position + OldDirection * RotationHorizontalPivot; - FPosition := Pivot - Direction * RotationHorizontalPivot; + Pivot := Position + OldDirection * RotationHorizontalPivot; + Result := Pivot - NewDirection * RotationHorizontalPivot; end else begin - OldDirectionInGravityPlane := Direction; + OldDirectionInGravityPlane := OldDirection; if not VectorsParallel(OldDirectionInGravityPlane, GravityUp) then MakeVectorsOrthoOnTheirPlane(OldDirectionInGravityPlane, GravityUp); - Pivot := Position + OldDirectionInGravityPlane * RotationHorizontalPivot; - FPosition := Pivot - DirectionInGravityPlane * RotationHorizontalPivot; + NewDirectionInGravityPlane := NewDirection; + if not VectorsParallel(NewDirectionInGravityPlane, GravityUp) then + MakeVectorsOrthoOnTheirPlane(NewDirectionInGravityPlane, GravityUp); + Pivot := Position + OldDirectionInGravityPlane * RotationHorizontalPivot; + Result := Pivot - NewDirectionInGravityPlane * RotationHorizontalPivot; end; end; end; -procedure TWalkCamera.RotateAroundGravityUp(const AngleDeg: Single); +procedure TCastleWalkNavigation.RotateAroundGravityUp(const AngleDeg: Single); var - Axis, OldDirection: TVector3; + Axis, OldDirection, NewPosition, NewDirection, NewUp: TVector3; begin { nie obracamy Direction wokol Up, takie obroty w polaczeniu z obrotami vertical moglyby sprawic ze kamera staje sie przechylona w @@ -3254,46 +3527,51 @@ procedure TWalkCamera.RotateAroundGravityUp(const AngleDeg: Single); else Axis := GravityUp; - FUp := RotatePointAroundAxisDeg(AngleDeg, Up, Axis); + NewUp := RotatePointAroundAxisDeg(AngleDeg, Up, Axis); + OldDirection := Direction; - FDirection := RotatePointAroundAxisDeg(AngleDeg, Direction, Axis); - AdjustForRotationHorizontalPivot(OldDirection); + NewDirection := RotatePointAroundAxisDeg(AngleDeg, Direction, Axis); - ScheduleVisibleChange; + NewPosition := AdjustPositionForRotationHorizontalPivot(OldDirection, NewDirection); + + SetView(NewPosition, NewDirection, NewUp); end; -procedure TWalkCamera.RotateAroundUp(const AngleDeg: Single); +procedure TCastleWalkNavigation.RotateAroundUp(const AngleDeg: Single); var - OldDirection: TVector3; + OldDirection, NewPosition, NewDirection: TVector3; begin { We know that RotatePointAroundAxisDeg below doesn't change the length of the Direction (so it will remain normalized) and it will keep Direction and Up vectors orthogonal. } OldDirection := Direction; - FDirection := RotatePointAroundAxisDeg(AngleDeg, FDirection, FUp); - AdjustForRotationHorizontalPivot(OldDirection); + NewDirection := RotatePointAroundAxisDeg(AngleDeg, Direction, Up); - ScheduleVisibleChange; + NewPosition := AdjustPositionForRotationHorizontalPivot(OldDirection, NewDirection); + + SetView(NewPosition, NewDirection, Up); end; -procedure TWalkCamera.RotateHorizontal(const AngleDeg: Single); +procedure TCastleWalkNavigation.RotateHorizontal(const AngleDeg: Single); begin if PreferGravityUpForRotations then - RotateAroundGravityUp(AngleDeg) else + RotateAroundGravityUp(AngleDeg) + else RotateAroundUp(AngleDeg); end; -procedure TWalkCamera.RotateVertical(const AngleDeg: Single); +procedure TCastleWalkNavigation.RotateVertical(const AngleDeg: Single); var Side: TVector3; AngleRad: Single; + NewDirection, NewUp: TVector3; procedure DoRealRotate; begin { Rotate Up around Side } - FUp := RotatePointAroundAxisRad(AngleRad, Up, Side); + NewUp := RotatePointAroundAxisRad(AngleRad, Up, Side); { Rotate Direction around Side } - FDirection := RotatePointAroundAxisRad(AngleRad, Direction, Side); + NewDirection := RotatePointAroundAxisRad(AngleRad, Direction, Side); end; var @@ -3313,13 +3591,13 @@ procedure TWalkCamera.RotateVertical(const AngleDeg: Single); and then you set PreferGravityUpForRotations to @true and MinAngleRadFromGravityUp to > 0 --- and suddenly we find that Up can be temporarily bad. } - FDirection := InitialDirection; - FUp := InitialUp; + NewDirection := InitialDirection; + NewUp := InitialUp; { Now check Side again. If it's still bad, this means that the InitialDirection is parallel to GravityUp. This shouldn't happen if you correctly set InitialDirection and GravityUp. - So just pick any sensible FDirection to satisfy MinAngleRadFromGravityUp + So just pick any sensible NewDirection to satisfy MinAngleRadFromGravityUp for sure. This is a common problem on some VRML models: @@ -3334,8 +3612,8 @@ procedure TWalkCamera.RotateVertical(const AngleDeg: Single); Side := TVector3.CrossProduct(Direction, GravityUp); if Side.IsZero then begin - FDirection := AnyOrthogonalVector(GravityUp); - FUp := GravityUp; + NewDirection := AnyOrthogonalVector(GravityUp); + NewUp := GravityUp; end; end else begin @@ -3354,10 +3632,10 @@ procedure TWalkCamera.RotateVertical(const AngleDeg: Single); DoRealRotate; end; - ScheduleVisibleChange; + (Viewport as TCastleAbstractViewport).Camera.SetView(NewDirection, NewUp); end; -function TWalkCamera.MoveTo(const ProposedNewPos: TVector3; +function TCastleWalkNavigation.MoveTo(const ProposedNewPos: TVector3; const BecauseOfGravity, CheckClimbHeight: boolean): boolean; var NewPos: TVector3; @@ -3390,17 +3668,16 @@ function TWalkCamera.MoveTo(const ProposedNewPos: TVector3; end; if Result then - { Note that setting Position automatically calls ScheduleVisibleChange } Position := NewPos; end; -function TWalkCamera.Move(const MoveVector: TVector3; +function TCastleWalkNavigation.Move(const MoveVector: TVector3; const BecauseOfGravity, CheckClimbHeight: boolean): boolean; begin Result := MoveTo(Position + MoveVector, BecauseOfGravity, CheckClimbHeight); end; -procedure TWalkCamera.MoveHorizontal(const SecondsPassed: Single; const Multiply: Integer = 1); +procedure TCastleWalkNavigation.MoveHorizontal(const SecondsPassed: Single; const Multiply: Integer = 1); var Dir: TVector3; Multiplier: Single; @@ -3427,7 +3704,7 @@ procedure TWalkCamera.MoveHorizontal(const SecondsPassed: Single; const Multiply Move(Dir * Multiplier, false, true); end; -procedure TWalkCamera.MoveVertical(const SecondsPassed: Single; const Multiply: Integer); +procedure TCastleWalkNavigation.MoveVertical(const SecondsPassed: Single; const Multiply: Integer); { Provided PreferredUpVector must be already normalized. } procedure MoveVerticalCore(const PreferredUpVector: TVector3); @@ -3450,7 +3727,7 @@ procedure TWalkCamera.MoveVertical(const SecondsPassed: Single; const Multiply: end; end; -procedure TWalkCamera.RotateHorizontalForStrafeMove(const AngleDeg: Single); +procedure TCastleWalkNavigation.RotateHorizontalForStrafeMove(const AngleDeg: Single); begin if PreferGravityUpForMoving then RotateAroundGravityUp(AngleDeg) @@ -3458,12 +3735,12 @@ procedure TWalkCamera.RotateHorizontalForStrafeMove(const AngleDeg: Single); RotateAroundUp(AngleDeg); end; -function TWalkCamera.ReallyEnableMouseDragging: boolean; +function TCastleWalkNavigation.ReallyEnableMouseDragging: boolean; begin Result := (inherited ReallyEnableMouseDragging) and not MouseLook; end; -procedure TWalkCamera.Update(const SecondsPassed: Single; +procedure TCastleWalkNavigation.Update(const SecondsPassed: Single; var HandleInput: boolean); { Check are keys for left/right/down/up rotations are pressed, and handle them. @@ -3637,7 +3914,7 @@ procedure TWalkCamera.Update(const SecondsPassed: Single; Answer: Because Move above called MoveTo, that set Position that actually called ScheduleVisibleChange that possibly called OnVisibleChange. - And OnVisibleChange is used callback and user could do there + And OnVisibleChange is user callback and user could do there things like - Changing FallSpeedStart (but still it's unspecified whether we have to apply this change, right ?) @@ -3645,7 +3922,11 @@ procedure TWalkCamera.Update(const SecondsPassed: Single; And in this case, we *must* honour it, because here user expects that we will use FallSpeedStart if we want to fall down. (of course, one call to "Move" with old - "FallSpeedStart" was already done, that's unavoidable...). } + "FallSpeedStart" was already done, that's unavoidable...). + + TODO: Is the above reasoning still valid? Now only TCastleCamera + calls ScheduleVisibleChange. + } FFallSpeed := FallSpeedStart; FFalling := true; @@ -3736,8 +4017,6 @@ procedure TWalkCamera.Update(const SecondsPassed: Single; Fde_UpRotate := Fde_UpRotate + (Fde_VerticalRotateDeviation * SecondsPassed) else Fde_UpRotate := RandomPlusMinus * Fde_VerticalRotateDeviation * SecondsPassed; - - ScheduleVisibleChange; end; { Note that when changing FFallSpeed below I'm using SecondsPassed * 50. @@ -3776,10 +4055,9 @@ procedure TWalkCamera.Update(const SecondsPassed: Single; Fde_VerticalRotateNormalization * SecondsPassed; if Fde_UpRotate < 0 then - Fde_UpRotate := Min(Fde_UpRotate + Change, 0.0) else + Fde_UpRotate := Min(Fde_UpRotate + Change, 0.0) + else Fde_UpRotate := Max(Fde_UpRotate - Change, 0.0); - - ScheduleVisibleChange; end; end; @@ -3998,10 +4276,6 @@ procedure TWalkCamera.Update(const SecondsPassed: Single; Increase * MoveSpeed * SecondsPassed * 0.2; CorrectPreferredHeight; - - { Why ScheduleVisibleChange here? Reasoning the same as for - MoveSpeedInc/Dec changes. } - ScheduleVisibleChange; end; procedure PositionMouseLook; @@ -4024,12 +4298,12 @@ procedure TWalkCamera.Update(const SecondsPassed: Single; 2. Later approach: just not reposition mouse at all just because MoseLook = true. Only reposition from - TWalkCamera.Motion. + TCastleWalkNavigation.Motion. This requires the Motion handler to only work when initial mouse position is at the screen middle, otherwise initial mouse look would generate large move. - But in fact TWalkCamera.Motion already does this, so it's all Ok. + But in fact TCastleWalkNavigation.Motion already does this, so it's all Ok. Unfortunately, this isn't so nice: sometimes you really want your mouse repositioned even before you move it: @@ -4114,125 +4388,109 @@ procedure TWalkCamera.Update(const SecondsPassed: Single; HeadBobbingAlreadyDone := false; MoveHorizontalDone := false; - BeginVisibleChangeSchedule; - try - if HandleInput then + if HandleInput then + begin + if ciNormal in Input then begin - if ciNormal in Input then - begin - HandleInput := not ExclusiveEvents; - FIsCrouching := Gravity and Input_Crouch.IsPressed(Container); + HandleInput := not ExclusiveEvents; + FIsCrouching := Gravity and Input_Crouch.IsPressed(Container); - if (not CheckModsDown) or - (ModsDown - Input_Run.Modifiers = []) then - begin - CheckRotates(1.0); + if (not CheckModsDown) or + (ModsDown - Input_Run.Modifiers = []) then + begin + CheckRotates(1.0); - if Input_Forward.IsPressed(Container) or MoveForward then - MoveHorizontal(SecondsPassed, 1); - if Input_Backward.IsPressed(Container) or MoveBackward then - MoveHorizontal(SecondsPassed, -1); + if Input_Forward.IsPressed(Container) or MoveForward then + MoveHorizontal(SecondsPassed, 1); + if Input_Backward.IsPressed(Container) or MoveBackward then + MoveHorizontal(SecondsPassed, -1); - if Input_RightStrafe.IsPressed(Container) then - begin - RotateHorizontalForStrafeMove(-90); - MoveHorizontal(SecondsPassed, 1); - RotateHorizontalForStrafeMove(90); - end; + if Input_RightStrafe.IsPressed(Container) then + begin + RotateHorizontalForStrafeMove(-90); + MoveHorizontal(SecondsPassed, 1); + RotateHorizontalForStrafeMove(90); + end; - if Input_LeftStrafe.IsPressed(Container) then - begin - RotateHorizontalForStrafeMove(90); - MoveHorizontal(SecondsPassed, 1); - RotateHorizontalForStrafeMove(-90); - end; + if Input_LeftStrafe.IsPressed(Container) then + begin + RotateHorizontalForStrafeMove(90); + MoveHorizontal(SecondsPassed, 1); + RotateHorizontalForStrafeMove(-90); + end; - { A simple implementation of Input_Jump was - RotateVertical(90); Move(MoveVerticalSpeed * MoveSpeed * SecondsPassed); RotateVertical(-90) - Similarly, simple implementation of Input_Crouch was - RotateVertical(-90); Move(MoveVerticalSpeed * MoveSpeed * SecondsPassed); RotateVertical(90) - But this is not good, because when PreferGravityUp, we want to move - along the GravityUp. (Also later note: RotateVertical is now bounded by - MinAngleRadFromGravityUp). } - - if Input_Jump.IsPressed(Container) then - MoveVertical(SecondsPassed, 1); - if Input_Crouch.IsPressed(Container) then - MoveVertical(SecondsPassed, -1); - - { zmiana szybkosci nie wplywa na Matrix (nie od razu). Ale wywolujemy - ScheduleVisibleChange - zmienilismy swoje wlasciwosci, moze sa one np. gdzies - wypisywane w oknie na statusie i okno potrzebuje miec Invalidate po zmianie - Move*Speed ?. - - How to apply SecondsPassed here ? - I can't just ignore SecondsPassed, but I can't also write - FMoveSpeed := FMoveSpeed * (10 * SecondsPassed); - What I want is such continuous function that e.g. - F(FMoveSpeed, 10) = F(F(FMoveSpeed, 1), 1) - I.e. SecondsPassed = 10 should work just like doing the same change twice. - So F is FMoveSpeed * Power(10, SecondsPassed) - Easy! - } - if Input_MoveSpeedInc.IsPressed(Container) then - begin - MoveSpeed := MoveSpeed * Power(10, SecondsPassed); - ScheduleVisibleChange; - end; + { A simple implementation of Input_Jump was + RotateVertical(90); Move(MoveVerticalSpeed * MoveSpeed * SecondsPassed); RotateVertical(-90) + Similarly, simple implementation of Input_Crouch was + RotateVertical(-90); Move(MoveVerticalSpeed * MoveSpeed * SecondsPassed); RotateVertical(90) + But this is not good, because when PreferGravityUp, we want to move + along the GravityUp. (Also later note: RotateVertical is now bounded by + MinAngleRadFromGravityUp). } + + if Input_Jump.IsPressed(Container) then + MoveVertical(SecondsPassed, 1); + if Input_Crouch.IsPressed(Container) then + MoveVertical(SecondsPassed, -1); + + { How to apply SecondsPassed here ? + I can't just ignore SecondsPassed, but I can't also write + FMoveSpeed := FMoveSpeed * (10 * SecondsPassed); + What I want is such continuous function that e.g. + F(FMoveSpeed, 10) = F(F(FMoveSpeed, 1), 1) + I.e. SecondsPassed = 10 should work just like doing the same change twice. + So F is FMoveSpeed * Power(10, SecondsPassed) + Easy! + } + if Input_MoveSpeedInc.IsPressed(Container) then + MoveSpeed := MoveSpeed * Power(10, SecondsPassed); + + if Input_MoveSpeedDec.IsPressed(Container) then + MoveSpeed := MoveSpeed / Power(10, SecondsPassed); + end else + if ModsDown = [mkCtrl] then + begin + if AllowSlowerRotations then + CheckRotates(0.1); - if Input_MoveSpeedDec.IsPressed(Container) then - begin - MoveSpeed := MoveSpeed / Power(10, SecondsPassed); - ScheduleVisibleChange; - end; - end else + { Either MoveSpeedInc/Dec work, or Increase/DecreasePreferredHeight, + as they by default have the same shortcuts, so should not work + together. } if ModsDown = [mkCtrl] then begin - if AllowSlowerRotations then - CheckRotates(0.1); - - { Either MoveSpeedInc/Dec work, or Increase/DecreasePreferredHeight, - as they by default have the same shortcuts, so should not work - together. } - if ModsDown = [mkCtrl] then - begin - if Input_IncreasePreferredHeight.IsPressed(Container) then - ChangePreferredHeight(+1); - if Input_DecreasePreferredHeight.IsPressed(Container) then - ChangePreferredHeight(-1); - end; + if Input_IncreasePreferredHeight.IsPressed(Container) then + ChangePreferredHeight(+1); + if Input_DecreasePreferredHeight.IsPressed(Container) then + ChangePreferredHeight(-1); end; end; + end; - { mouse dragging navigation } - if (MouseDraggingStarted <> -1) and - ReallyEnableMouseDragging and - ((mbLeft in Container.MousePressed) or (mbRight in Container.MousePressed)) and - { Enable dragging only when no modifiers (except Input_Run, - which must be allowed to enable running) are pressed. - This allows application to handle e.g. ctrl + dragging - in some custom ways (like view3dscene selecting a triangle). } - (Container.Pressed.Modifiers - Input_Run.Modifiers = []) and - (MouseDragMode = mdWalk) then - begin - HandleInput := not ExclusiveEvents; - MoveViaMouseDragging(Container.MousePosition - MouseDraggingStart); - end; + { mouse dragging navigation } + if (MouseDraggingStarted <> -1) and + ReallyEnableMouseDragging and + ((mbLeft in Container.MousePressed) or (mbRight in Container.MousePressed)) and + { Enable dragging only when no modifiers (except Input_Run, + which must be allowed to enable running) are pressed. + This allows application to handle e.g. ctrl + dragging + in some custom ways (like view3dscene selecting a triangle). } + (Container.Pressed.Modifiers - Input_Run.Modifiers = []) and + (MouseDragMode = mdWalk) then + begin + HandleInput := not ExclusiveEvents; + MoveViaMouseDragging(Container.MousePosition - MouseDraggingStart); end; + end; - PreferGravityUpForRotationsUpdate; + PreferGravityUpForRotationsUpdate; - { These may be set to @true only inside GravityUpdate } - FIsWalkingOnTheGround := false; - FIsOnTheGround := false; + { These may be set to @true only inside GravityUpdate } + FIsWalkingOnTheGround := false; + FIsOnTheGround := false; - GravityUpdate; - finally - EndVisibleChangeSchedule; - end; + GravityUpdate; end; -function TWalkCamera.Jump: boolean; +function TCastleWalkNavigation.Jump: boolean; begin Result := false; @@ -4259,12 +4517,34 @@ function TWalkCamera.Jump: boolean; Result := true; end; -function TWalkCamera.AllowSuspendForInput: boolean; +function TCastleWalkNavigation.AllowSuspendForInput: boolean; begin Result := false; end; -function TWalkCamera.Press(const Event: TInputPressRelease): boolean; +function TCastleWalkNavigation.Press(const Event: TInputPressRelease): boolean; + + procedure SetUpToGravityUp; + var + NewDirection, NewUp: TVector3; + begin + if VectorsParallel(Direction, GravityUp) then + begin + { We can't carelessly set Up to something parallel to GravityUp + in this case. + + Yes, this situation can happen: for example open a model with + no viewpoint in VRML in view3dscene (so default viewpoint, + both gravity and Up = +Y is used). Then change GravityUp + by menu and press Home (Input_GravityUp). } + + NewUp := GravityUp; + NewDirection := AnyOrthogonalVector(NewUp); + (Viewport as TCastleAbstractViewport).Camera.SetView(NewDirection, NewUp); + end else + Up := GravityUp; + end; + begin Result := inherited; if Result then Exit; @@ -4297,21 +4577,7 @@ function TWalkCamera.Press(const Event: TInputPressRelease): boolean; if Input_GravityUp.IsEvent(Event) then begin - if VectorsParallel(Direction, GravityUp) then - begin - { We can't carelessly set Up to something parallel to GravityUp - in this case. - - Yes, this situation can happen: for example open a model with - no viewpoint in VRML in view3dscene (so default viewpoint, - both gravity and Up = +Y is used). Then change GravityUp - by menu and press Home (Input_GravityUp). } - - FUp := GravityUp; - FDirection := AnyOrthogonalVector(FUp); - ScheduleVisibleChange; - end else - Up := GravityUp; + SetUpToGravityUp; Result := ExclusiveEvents; end else if Input_Jump.IsEvent(Event) then @@ -4321,7 +4587,7 @@ function TWalkCamera.Press(const Event: TInputPressRelease): boolean; Result := false; end; -function TWalkCamera.SensorTranslation(const X, Y, Z, Length: Double; +function TCastleWalkNavigation.SensorTranslation(const X, Y, Z, Length: Double; const SecondsPassed: Single): boolean; var MoveSize: Double; @@ -4355,7 +4621,7 @@ function TWalkCamera.SensorTranslation(const X, Y, Z, Length: Double; MoveVertical(-Y * MoveSize, -1); { down } end; -function TWalkCamera.SensorRotation(const X, Y, Z, Angle: Double; +function TCastleWalkNavigation.SensorRotation(const X, Y, Z, Angle: Double; const SecondsPassed: Single): boolean; begin if not (ci3dMouse in Input) then Exit(false); @@ -4368,7 +4634,7 @@ function TWalkCamera.SensorRotation(const X, Y, Z, Angle: Double; {if Abs(Z) > 0.4 then ?} { tilt sidewards } end; -procedure TWalkCamera.Init( +procedure TCastleWalkNavigation.Init( const AInitialPosition, AInitialDirection, AInitialUp: TVector3; const AGravityUp: TVector3; const APreferredHeight: Single; @@ -4382,67 +4648,45 @@ procedure TWalkCamera.Init( GoToInitial; end; -procedure TWalkCamera.Init(const Box: TBox3D; const ARadius: Single); -var Pos: TVector3; - AvgSize: Single; -begin - if Box.IsEmptyOrZero then - Init(Vector3(0, 0, 0), - DefaultCameraDirection, - DefaultCameraUp, - Vector3(0, 1, 0) { GravityUp is the same as InitialUp }, - 0 { whatever }, ARadius) else - begin - AvgSize := Box.AverageSize; - Pos[0] := Box.Data[0].Data[0] - AvgSize; - Pos[1] := (Box.Data[0].Data[1] + Box.Data[1].Data[1]) / 2; - Pos[2] := (Box.Data[0].Data[2] + Box.Data[1].Data[2]) / 2; - Init(Pos, - TVector3.One[0], - TVector3.One[2], - TVector3.One[2] { GravityUp is the same as InitialUp }, - AvgSize * 5, ARadius); - end; -end; - -function TWalkCamera.GetPositionInternal: TVector3; -begin - Result := FPosition; -end; - -procedure TWalkCamera.SetPosition(const Value: TVector3); -begin - FPosition := Value; - ScheduleVisibleChange; -end; - -procedure TWalkCamera.SetDirection(const Value: TVector3); -begin - FDirection := Value.Normalize; - MakeVectorsOrthoOnTheirPlane(FUp, FDirection); - ScheduleVisibleChange; -end; - -procedure TWalkCamera.SetUp(const Value: TVector3); +procedure TCastleWalkNavigation.Init(const Box: TBox3D; const ARadius: Single); +var + Pos: TVector3; + AvgSize: Single; begin - FUp := Value.Normalize; - MakeVectorsOrthoOnTheirPlane(FDirection, FUp); - ScheduleVisibleChange; + if Box.IsEmptyOrZero then + begin + Init(Vector3(0, 0, 0), + DefaultCameraDirection, + DefaultCameraUp, + Vector3(0, 1, 0) { GravityUp is the same as InitialUp }, + 0 { whatever }, ARadius); + end else + begin + AvgSize := Box.AverageSize; + Pos[0] := Box.Data[0].Data[0] - AvgSize; + Pos[1] := (Box.Data[0].Data[1] + Box.Data[1].Data[1]) / 2; + Pos[2] := (Box.Data[0].Data[2] + Box.Data[1].Data[2]) / 2; + Init(Pos, + TVector3.One[0], + TVector3.One[2], + TVector3.One[2] { GravityUp is the same as InitialUp }, + AvgSize * 5, ARadius); + end; end; -procedure TWalkCamera.UpPrefer(const AUp: TVector3); +procedure TCastleWalkNavigation.UpPrefer(const AUp: TVector3); begin - FUp := AUp.Normalize; - MakeVectorsOrthoOnTheirPlane(FUp, FDirection); - ScheduleVisibleChange; + if Viewport = nil then + raise EViewportNotAssigned.Create('TCastleNavigation.Viewport not assigned when calling UpPrefer'); + (Viewport as TCastleAbstractViewport).Camera.UpPrefer(AUp); end; -function TWalkCamera.MaxJumpDistance: Single; +function TCastleWalkNavigation.MaxJumpDistance: Single; begin Result := JumpMaxHeight * PreferredHeight; end; -function TWalkCamera.DirectionInGravityPlane: TVector3; +function TCastleWalkNavigation.DirectionInGravityPlane: TVector3; begin Result := Direction; @@ -4450,7 +4694,7 @@ function TWalkCamera.DirectionInGravityPlane: TVector3; MakeVectorsOrthoOnTheirPlane(Result, GravityUp); end; -procedure TWalkCamera.FallOnTheGround; +procedure TCastleWalkNavigation.FallOnTheGround; begin FFallingOnTheGround := true; @@ -4467,13 +4711,13 @@ procedure TWalkCamera.FallOnTheGround; FFallingOnTheGroundAngleIncrease := RandomBoolean; end; -procedure TWalkCamera.CancelFalling; +procedure TCastleWalkNavigation.CancelFalling; begin { Fortunately implementation of this is brutally simple right now. } FFalling := false; end; -procedure TWalkCamera.SetMouseLook(const Value: boolean); +procedure TCastleWalkNavigation.SetMouseLook(const Value: boolean); begin if FMouseLook <> Value then begin @@ -4488,7 +4732,7 @@ procedure TWalkCamera.SetMouseLook(const Value: boolean); end; end; -function TWalkCamera.Motion(const Event: TInputMotion): boolean; +function TCastleWalkNavigation.Motion(const Event: TInputMotion): boolean; procedure HandleMouseLook; var @@ -4593,40 +4837,7 @@ function TWalkCamera.Motion(const Event: TInputMotion): boolean; end; end; -procedure TWalkCamera.GetView( - out APos, ADir, AUp: TVector3); -begin - APos := FPosition; - ADir := FDirection; - AUp := FUp; -end; - -procedure TWalkCamera.SetView(const ADir, AUp: TVector3; - const AdjustUp: boolean); -begin - FDirection := ADir.Normalize; - FUp := AUp.Normalize; - if AdjustUp then - MakeVectorsOrthoOnTheirPlane(FUp, FDirection) else - MakeVectorsOrthoOnTheirPlane(FDirection, FUp); - - ScheduleVisibleChange; -end; - -procedure TWalkCamera.SetView(const APos, ADir, AUp: TVector3; - const AdjustUp: boolean); -begin - FPosition := APos; - FDirection := ADir.Normalize; - FUp := AUp.Normalize; - if AdjustUp then - MakeVectorsOrthoOnTheirPlane(FUp, FDirection) else - MakeVectorsOrthoOnTheirPlane(FDirection, FUp); - - ScheduleVisibleChange; -end; - -function TWalkCamera.GetNavigationType: TNavigationType; +function TCastleWalkNavigation.GetNavigationType: TNavigationType; begin if Input = [] then Result := ntNone diff --git a/src/3d/castletransform.pas b/src/3d/castletransform.pas index 404cc70086..69a449577b 100644 --- a/src/3d/castletransform.pas +++ b/src/3d/castletransform.pas @@ -1009,7 +1009,7 @@ TCastleTransform = class(TCastleComponent) { Main camera observing this 3D object changed. This is usually called by our container (like TCastleSceneManager) to notify that camera changed. } - procedure CameraChanged(ACamera: TCamera); virtual; + procedure CameraChanged(const ACamera: TCastleCamera); virtual; { Mouse cursor over this object. } property Cursor: TMouseCursor read FCursor write SetCursor default mcDefault; @@ -1864,7 +1864,7 @@ TSceneManagerWorld = class(TCastleTransform) property CameraKnown: boolean read FCameraKnown; { @groupEnd } - procedure CameraChanged(ACamera: TCamera); override; + procedure CameraChanged(const ACamera: TCastleCamera); override; { Yoo can temporarily disable physics (no transformations will be updated by the physics engine) by setting this property to @false. } @@ -2605,7 +2605,7 @@ procedure TCastleTransform.VisibleChangeNotification(const Changes: TVisibleChan List[I].VisibleChangeNotification(Changes); end; -procedure TCastleTransform.CameraChanged(ACamera: TCamera); +procedure TCastleTransform.CameraChanged(const ACamera: TCastleCamera); var I: Integer; begin @@ -3393,7 +3393,7 @@ function TSceneManagerWorld.WorldPointCollision2D(const Point: TVector2): boolea Result := PointCollision2D(Point, nil); end; -procedure TSceneManagerWorld.CameraChanged(ACamera: TCamera); +procedure TSceneManagerWorld.CameraChanged(const ACamera: TCastleCamera); begin ACamera.GetView(FCameraPosition, FCameraDirection, FCameraUp); FCameraKnown := true; diff --git a/src/3d/castletransform_renderparams.inc b/src/3d/castletransform_renderparams.inc index 207f187de2..c8ab997926 100644 --- a/src/3d/castletransform_renderparams.inc +++ b/src/3d/castletransform_renderparams.inc @@ -90,7 +90,7 @@ This is interesting to you only if you write custom rendering code. - In normal applications, you shoud only get/set camera using TCamera + In normal applications, you shoud only get/set camera using TCastleCamera descendants, through TCastleAbstractViewport.Camera and related properties. Do not use the TRenderingCamera class in normal applications. } TRenderingCamera = class @@ -147,11 +147,11 @@ function RotationMatrix3: TMatrix3; function RotationInverseMatrix3: TMatrix3; - { Set all properties (except Target) from TCamera instance in ACamera. + { Set all properties (except Target) from TCastleCamera instance in ACamera. See @link(FromMatrix) for comments about @link(Target) property. The IgnoredViewpoint parameter is only for backward compatibility, it is ignored. } - procedure FromCameraObject(const ACamera: TCamera; + procedure FromCameraObject(const ACamera: TCastleCamera; const IgnoredViewpoint: TObject = nil); { Set all properties (except Target) from explict matrices. @@ -290,7 +290,7 @@ begin Move(RotationInverseMatrix.Data[2], Result.Data[2], SizeOf(Single) * 3); end; -procedure TRenderingCamera.FromCameraObject(const ACamera: TCamera; +procedure TRenderingCamera.FromCameraObject(const ACamera: TCastleCamera; const IgnoredViewpoint: TObject = nil); begin Matrix := ACamera.Matrix; diff --git a/src/game/castle2dscenemanager.pas b/src/game/castle2dscenemanager.pas index f7bf0b2e88..27f66f08ea 100644 --- a/src/game/castle2dscenemanager.pas +++ b/src/game/castle2dscenemanager.pas @@ -83,7 +83,7 @@ TCastle2DSceneManager = class(TCastleSceneManager) DefaultCameraZ = DefaultProjectionSpan / 2; constructor Create(AOwner: TComponent); override; - procedure AssignDefaultCamera; override; + procedure AssignDefaultNavigation; override; property CurrentProjectionWidth: Single read FCurrentProjectionWidth; property CurrentProjectionHeight: Single read FCurrentProjectionHeight; @@ -221,24 +221,24 @@ constructor TCastle2DSceneManager.Create(AOwner: TComponent); FProjectionWidth := 0; { Make camera already existing, so WalkCamera returns it, - instead of using AssignDefaultCamera and then switching to ntWalk. } - AssignDefaultCamera; + instead of using AssignDefaultNavigation and then switching to ntWalk. } + AssignDefaultNavigation; end; -procedure TCastle2DSceneManager.AssignDefaultCamera; +procedure TCastle2DSceneManager.AssignDefaultNavigation; begin { Set Camera explicitly, otherwise SetNavigationType below could call - ExamineCamera / WalkCamera that call AssignDefaultCamera when Camera = nil, - and we would have infinite AssignDefaultCamera calls loop. } - Camera := InternalWalkCamera; + ExamineCamera / WalkCamera that call AssignDefaultNavigation when Camera = nil, + and we would have infinite AssignDefaultNavigation calls loop. } + Navigation := InternalWalkNavigation; NavigationType := ntNone; - Camera.SetInitialView( + Navigation.SetInitialView( { pos } Vector3(0, 0, DefaultCameraZ), { dir } Vector3(0, 0, -1), { up } Vector3(0, 1, 0), false); - Camera.GoToInitial; - Camera.Radius := 0.01; { will not be used for anything, but set to something sensible just in case } + Navigation.GoToInitial; + Navigation.Radius := 0.01; { will not be used for anything, but set to something sensible just in case } end; function TCastle2DSceneManager.PositionTo2DWorld(const Position: TVector2; @@ -262,8 +262,8 @@ function TCastle2DSceneManager.PositionTo2DWorld(const Position: TVector2; raise Exception.Create('TCastle2DSceneManager.PositionTo2DWorld assumes an orthographic projection, like the one set by TCastle2DSceneManager.CalculateProjection'); ProjRect := Proj.Dimensions; - if Camera <> nil then - ProjRect := ProjRect.Translate(Camera.Position.XY); + if Navigation <> nil then + ProjRect := ProjRect.Translate(Navigation.Position.XY); Result := Vector2( MapRange(P.X, 0, EffectiveWidth , ProjRect.Left , ProjRect.Right), @@ -285,7 +285,7 @@ function TCastle2DSceneManager.PositionTo2DWorld(const Position: TVector2; P := Position * UIScale + RenderRect.LeftBottom else P := Position; - RequiredCamera.CustomRay(RenderRect, P, Projection, RayOrigin, RayDirection); + RequiredNavigation.CustomRay(RenderRect, P, Projection, RayOrigin, RayDirection); Result := RayOrigin.XY; end; } @@ -300,7 +300,7 @@ function TCastle2DSceneManager.PositionTo2DWorld(const Position: TVector2; ScreenToWorldMatrix: TMatrix4; P: TVector2; begin - WorldToScreenMatrix := RequiredCamera.ProjectionMatrix * RequiredCamera.Matrix; + WorldToScreenMatrix := RequiredNavigation.ProjectionMatrix * RequiredNavigation.Matrix; if not WorldToScreenMatrix.TryInverse(ScreenToWorldMatrix) then raise Exception.Create('Cannot invert projection * camera matrix. Possibly one of them was not initialized, or camera contains scale to zero.'); diff --git a/src/game/castlelevels.pas b/src/game/castlelevels.pas index 7f8b4cc149..4d5c72692f 100644 --- a/src/game/castlelevels.pas +++ b/src/game/castlelevels.pas @@ -841,7 +841,7 @@ procedure TGameSceneManager.LoadLevelCore(const AInfo: TLevelInfo); WalkCamera.MoveVerticalSpeed := 20; end; - Camera := WalkCamera; + Navigation := WalkCamera; WalkCamera.Init(InitialPosition, InitialDirection, InitialUp, GravityUp, PreferredHeight, CameraRadius); @@ -875,7 +875,7 @@ procedure TGameSceneManager.LoadLevelCore(const AInfo: TLevelInfo); Otherwise, it would be updated by MainScene loading binding new NavigationInfo (with it's speed) and Viewpoint. We prefer to do it ourselves in InitializeCamera. } - Camera := nil; + Navigation := nil; MainScene := TCastleScene.Create(Self); Inc(MainScene.InternalDirty); diff --git a/src/game/castlescenemanager.pas b/src/game/castlescenemanager.pas index 59326961f3..e78abb6113 100644 --- a/src/game/castlescenemanager.pas +++ b/src/game/castlescenemanager.pas @@ -105,7 +105,8 @@ TCastleAbstractViewport = class(TCastleScreenEffects) TexCoord: TVector2; end; var - FCamera: TCamera; + FNavigation: TCastleNavigation; + FCamera: TCastleCamera; FPaused: boolean; FRenderParams: TManagerRenderParams; FPrepareParams: TPrepareParams; @@ -118,8 +119,8 @@ TCastleAbstractViewport = class(TCastleScreenEffects) FDefaultVisibilityLimit: Single; FTransparent, FClearDepth: boolean; FProjection: TProjection; - FInternalExamineCamera: TExamineCamera; - FInternalWalkCamera: TWalkCamera; + FInternalExamineNavigation: TCastleExamineNavigation; + FInternalWalkNavigation: TCastleWalkNavigation; FWithinSetNavigationType: boolean; LastPressEvent: TInputPressRelease; FOnProjection: TProjectionEvent; @@ -173,7 +174,7 @@ TCastleAbstractViewport = class(TCastleScreenEffects) Always call ApplyProjection right before this, to set correct projection matrix. And before ApplyProjection you should also call UpdateGeneratedTexturesIfNeeded. } - procedure RenderOnScreen(ACamera: TCamera); + procedure RenderOnScreen(ACamera: TCastleCamera); procedure RenderWithScreenEffectsCore; function RenderWithScreenEffects(const RenderingCamera: TRenderingCamera): boolean; @@ -182,12 +183,14 @@ TCastleAbstractViewport = class(TCastleScreenEffects) Used by our Render method. This cooperates closely with current @link(Camera) definition. + + TODO: update below. Viewport's @link(Camera), if not assigned, is automatically created here, - see @link(Camera) and AssignDefaultCamera. + see @link(Camera) and AssignDefaultNavigation. This takes care to always update Camera.ProjectionMatrix, Projection, GetMainScene.BackgroundSkySphereRadius. In turn, this expects Camera.Radius to be already properly set - (usually by AssignDefaultCamera). } + (usually by AssignDefaultNavigation). } procedure ApplyProjection; procedure SetPaused(const Value: boolean); @@ -287,9 +290,8 @@ TCastleAbstractViewport = class(TCastleScreenEffects) function MainLightForShadows( out AMainLightPosition: TVector4): boolean; virtual; - procedure SetCamera(const Value: TCamera); virtual; + procedure SetNavigation(const Value: TCastleNavigation); virtual; procedure Notification(AComponent: TComponent; Operation: TOperation); override; - procedure SetContainer(const Value: TUIContainer); override; { Information about the 3D world. For scene maager, these methods simply return it's own properties. @@ -299,7 +301,7 @@ TCastleAbstractViewport = class(TCastleScreenEffects) function GetMainScene: TCastleScene; virtual; abstract; function GetShadowVolumeRenderer: TGLShadowVolumeRenderer; virtual; abstract; function GetMouseRayHit: TRayCollision; virtual; abstract; - function GetHeadlightCamera: TCamera; virtual; abstract; + function GetHeadlightCamera: TCastleCamera; virtual; abstract; function GetPlayer: TPlayer; virtual; abstract; function GetTimeScale: Single; virtual; abstract; { @groupEnd } @@ -309,35 +311,35 @@ TCastleAbstractViewport = class(TCastleScreenEffects) { Pass pointing device (mouse) activation/deactivation event to 3D world. } function PointingDeviceActivate(const Active: boolean): boolean; virtual; abstract; - { Handle camera events. + { Handle navigation events. Scene manager implements collisions by looking at 3D scene, custom viewports implements collisions by calling their scene manager. @groupBegin } - function CameraMoveAllowed(ACamera: TWalkCamera; + function NavigationMoveAllowed(ANavigation: TCastleWalkNavigation; const ProposedNewPos: TVector3; out NewPos: TVector3; const BecauseOfGravity: boolean): boolean; virtual; abstract; - function CameraHeight(ACamera: TWalkCamera; const Position: TVector3; + function NavigationHeight(ANavigation: TCastleWalkNavigation; const Position: TVector3; out AboveHeight: Single; out AboveGround: PTriangle): boolean; virtual; abstract; function CameraRayCollision(const RayOrigin, RayDirection: TVector3): TRayCollision; virtual; abstract; - procedure CameraVisibleChange(const Sender: TInputListener; + procedure NavigationVisibleChange(const Sender: TInputListener; const Changes: TCastleUserInterfaceChanges; const ChangeInitiatedByChildren: boolean); virtual; abstract; { @groupEnd } function GetScreenEffects(const Index: Integer): TGLSLProgram; virtual; - { Assign Camera to a default TCamera suitable for navigating in this scene. - The newly created camera owned should be Self. - This is automatically used when @link(Camera) is @nil at various places, - and implementation may assume that @link(Camera) is @nil at entry. + { Assign Navigation to a default TCastleNavigation suitable for navigating in this scene. + The newly created navigation owned should be Self. + This is automatically used when @link(Navigation) is @nil at various places, + and implementation may assume that @link(Navigation) is @nil at entry. The implementation in base TCastleAbstractViewport uses MainScene.NavigationTypeFromNavigationInfo (so it will follow your VRML/X3D scene Viewpoint, NavigationInfo and such). If MainScene is not assigned, we create a simple - camera in Examine mode. } - procedure AssignDefaultCamera; virtual; + navigation in Examine mode. } + procedure AssignDefaultNavigation; virtual; public const DefaultScreenSpaceAmbientOcclusion = false; @@ -358,14 +360,10 @@ TCastleAbstractViewport = class(TCastleScreenEffects) constructor Create(AOwner: TComponent); override; destructor Destroy; override; - procedure Resize; override; - function AllowSuspendForInput: boolean; override; function Press(const Event: TInputPressRelease): boolean; override; function Release(const Event: TInputPressRelease): boolean; override; function Motion(const Event: TInputMotion): boolean; override; - function SensorRotation(const X, Y, Z, Angle: Double; const SecondsPassed: Single): boolean; override; - function SensorTranslation(const X, Y, Z, Length: Double; const SecondsPassed: Single): boolean; override; procedure Update(const SecondsPassed: Single; var HandleInput: boolean); override; @@ -381,67 +379,70 @@ TCastleAbstractViewport = class(TCastleScreenEffects) override @link(CalculateProjection) or handle event @link(OnProjection). } property Projection: TProjection read FProjection; - { Return current camera. Automatically creates it if missing. } - function RequiredCamera: TCamera; + { Return current navigation. Automatically creates it if missing. } + function RequiredNavigation: TCastleNavigation; + function RequiredCamera: TCastleNavigation; deprecated 'use Camera to set camera properties. it is always <> nil; if you require Navigation to be <> nil, just assign it explicitly or use ExamineNavigation or WalkNavigation'; - { Return the currently used camera as TWalkCamera, making sure that current - NavigationType is something using TWalkCamera. + { Return the currently used camera as TCastleWalkNavigation, making sure that current + NavigationType is something using TCastleWalkNavigation. @unorderedList( @item( When SwitchNavigationTypeIfNeeded is @true (the default), this method makes sure that the @link(NavigationType) corresponds to a type - handled by TWalkCamera, creating and adjusting the camera if necessary. + handled by TCastleWalkNavigation, creating and adjusting the camera if necessary. - If the current NavigationType does not use TWalkCamera + If the current NavigationType does not use TCastleWalkNavigation (see @link(TNavigationType) documentation for information which - navigation types use which TCamera descendants), + navigation types use which TCastleNavigation descendants), then it's switched to ntWalk. ) @item( When SwitchNavigationTypeIfNeeded is @false, then we return @nil if the current camera is not already - a TWalkCamera instance. + a TCastleWalkNavigation instance. We @italic(never) create a new camera in this case (even if the NavigatinInfo node in MainScene would indicate - that the new camera would be a TWalkCamera). + that the new camera would be a TCastleWalkNavigation). ) ) } - function WalkCamera(const SwitchNavigationTypeIfNeeded: boolean = true): TWalkCamera; + function WalkNavigation(const SwitchNavigationTypeIfNeeded: boolean = true): TCastleWalkNavigation; + function WalkCamera(const SwitchNavigationTypeIfNeeded: boolean = true): TCastleWalkNavigation; deprecated 'use WalkNavigation'; - { Return the currently used camera as TExamineCamera, making sure that current - NavigationType is something using TExamineCamera. + { Return the currently used camera as TCastleExamineNavigation, making sure that current + NavigationType is something using TCastleExamineNavigation. @unorderedList( @item( When SwitchNavigationTypeIfNeeded is @true (the default), this method makes sure that the @link(NavigationType) corresponds to a type - handled by TExamineCamera, creating and adjusting the camera if necessary. + handled by TCastleExamineNavigation, creating and adjusting the camera if necessary. - If the current NavigationType does not use TExamineCamera + If the current NavigationType does not use TCastleExamineNavigation (see @link(TNavigationType) documentation for information which - navigation types use which TCamera descendants), + navigation types use which TCastleNavigation descendants), then it's switched to ntExamine. ) @item( When SwitchNavigationTypeIfNeeded is @false, then we return @nil if the current camera is not already - a TExamineCamera instance. + a TCastleExamineNavigation instance. We @italic(never) create a new camera in this case (even if the NavigatinInfo node in MainScene would indicate - that the new camera would be a TExamineCamera). + that the new camera would be a TCastleExamineNavigation). ) ) } - function ExamineCamera(const SwitchNavigationTypeIfNeeded: boolean = true): TExamineCamera; + function ExamineNavigation(const SwitchNavigationTypeIfNeeded: boolean = true): TCastleExamineNavigation; + function ExamineCamera(const SwitchNavigationTypeIfNeeded: boolean = true): TCastleExamineNavigation; deprecated 'use ExamineNavigation'; { Choose navigation method by creating and adjusting the camera, - and various camera properies (like TWalkCamera.Gravity and so on). + and various camera properies (like TCastleWalkNavigation.Gravity and so on). This is automatically determined from the currently bound NavigatinInfo X3D node in the @link(GetMainScene). You can also set this manually, thus overriding the NavigatinInfo node. @@ -451,19 +452,20 @@ TCastleAbstractViewport = class(TCastleScreenEffects) and adjusting a couple of camera properties. Note that you can also affect the current NavigationType by directly changing the camera properties, - e.g. you can directly change @link(TWalkCamera.Gravity) from @false to @true, + e.g. you can directly change @link(TCastleWalkNavigation.Gravity) from @false to @true, and thus you effectively switch from ntFly to ntWalk navigation types. When you read the NavigationType property, we determine the current navigation type from current camera properties. + TODO: update below comment. When the camera is created for the first time, it's parameters are determined from the current NavigationInfo and Viewpoint nodes in @link(GetMainScene), and from bounding box of the world. When the camera class is switched later, the common camera properties - (defined at TCamera, like @link(TCamera.Radius) and view vectors + (defined at TCastleNavigation, like @link(TCastleNavigation.Radius) and view vectors -- position, direction, up) are copied, so they are preserved. - The other camera properties (those defined only at TWalkCamera or TExamineCamera - descendants, e.g. @link(TWalkCamera.MouseLook) and various inputs + The other camera properties (those defined only at TCastleWalkNavigation or TCastleExamineNavigation + descendants, e.g. @link(TCastleWalkNavigation.MouseLook) and various inputs of cameras) are also preserved within InternalExamineCamera and InternalWalkCamera. @@ -479,11 +481,11 @@ TCastleAbstractViewport = class(TCastleScreenEffects) Setting this sets: @unorderedList( @itemSpacing compact - @item @link(TCamera.Input) - @item @link(TExamineCamera.Turntable), only in case of @link(TExamineCamera) - @item @link(TWalkCamera.Gravity), only in case of @link(TWalkCamera) - @item @link(TWalkCamera.PreferGravityUpForRotations), only in case of @link(TWalkCamera) - @item @link(TWalkCamera.PreferGravityUpForMoving), only in case of @link(TWalkCamera) + @item @link(TCastleNavigation.Input) + @item @link(TCastleExamineNavigation.Turntable), only in case of @link(TCastleExamineNavigation) + @item @link(TCastleWalkNavigation.Gravity), only in case of @link(TCastleWalkNavigation) + @item @link(TCastleWalkNavigation.PreferGravityUpForRotations), only in case of @link(TCastleWalkNavigation) + @item @link(TCastleWalkNavigation.PreferGravityUpForMoving), only in case of @link(TCastleWalkNavigation) ) If you write to NavigationType, then you @italic(should not) touch the @@ -495,15 +497,15 @@ TCastleAbstractViewport = class(TCastleScreenEffects) property NavigationType: TNavigationType read GetNavigationType write SetNavigationType; - { Make @link(Camera) @nil, and force creating a completely new camera instance - when needed. The actual creation may be caused by calling + { Make @link(Navigation) @nil. + The actual creation may be caused by calling @link(ExamineCamera), @link(WalkCamera), @link(InternalExamineCamera), @link(InternalWalkCamera), or by setting @link(NavigationType). In all cases, these methods will create a new camera instance after a @name call. No previous cached camera instance will be used. } - procedure ClearCameras; + procedure ClearCameras; deprecated 'just set Navigation to nil instead of using this method; to avoid reusing previous instance, do not use WalkNavigation/ExamineNavigation methods, instead create and destroy your own TCastleWalkNavigation/TCastleExamineNavigation whenever you want'; { Camera instances used by this scene manager. Using these methods automatically creates these instances @@ -518,11 +520,13 @@ TCastleAbstractViewport = class(TCastleScreenEffects) the scene manager keeps using these instances of cameras, instead of creating new camera instances. This way all the camera properties - (not only those copied by TCamera.Assign) are preserved when you switch + (not only those copied by TCastleNavigation.Assign) are preserved when you switch e.g. NavigationType from ntWalk to ntExamine to ntWalk again. @groupBegin } - function InternalExamineCamera: TExamineCamera; - function InternalWalkCamera: TWalkCamera; + function InternalExamineNavigation: TCastleExamineNavigation; + function InternalWalkNavigation: TCastleWalkNavigation; + function InternalExamineCamera: TCastleExamineNavigation; deprecated 'use InternalExamineNavigation'; + function InternalWalkCamera: TCastleWalkNavigation; deprecated 'use InternalWalkNavigation'; { @groupEnd } { Screen effects are shaders that post-process the rendered screen. @@ -578,10 +582,18 @@ TCastleAbstractViewport = class(TCastleScreenEffects) Updated in every mouse move. May be @nil. } function TriangleHit: PTriangle; - { Camera used to render this viewport. + { Camera determines the viewer position and orientation. + The given camera instance is always available and connected with this viewport. } + property Camera: TCastleCamera read FCamera; + + { Navigation method is an optional component that handles + the user input to control the camera. + + TODO: update description below. Do we really create navigation + always? Maybe sometimes we leave it nil? Note this property may be @nil before rendering. - If you don't assign anything here, we'll create a default camera + If you don't assign anything here, we'll create a default navigation when necessary (usually at the ApplyProjection which happens before the rendering). Use @link(RequiredCamera) instead of this property to get a camera @@ -591,11 +603,11 @@ TCastleAbstractViewport = class(TCastleScreenEffects) Or set @link(NavigationType) first, this also sets the camera always. For many purposes, you can directly operate on this camera, - for example you can change it's @link(TCamera.Position Position). + for example you can change it's @link(TCastleNavigation.Position Position). An exception to this is assigning events to the camera instance. The scene manager or viewport will "hijack" some Camera events: - TCamera.OnVisibleChange, TWalkCamera.OnMoveAllowed, - TWalkCamera.OnHeight. + TCastleNavigation.OnVisibleChange, TCastleWalkNavigation.OnMoveAllowed, + TCastleWalkNavigation.OnHeight. We will handle them in a proper way. Do not assign them yourself. @italic(Comments for TCastleViewport only:) @@ -609,7 +621,7 @@ TCastleAbstractViewport = class(TCastleScreenEffects) TCastleSceneManager.Camera. @seealso TCastleSceneManager.OnCameraChanged } - property Camera: TCamera read FCamera write SetCamera; + property Navigation: TCastleNavigation read FNavigation write SetNavigation; { Instance for headlight that should be used for this scene. Uses @link(Headlight) method, applies appropriate camera position/direction. @@ -625,6 +637,10 @@ TCastleAbstractViewport = class(TCastleScreenEffects) property ScreenSpaceAmbientOcclusion: boolean read FScreenSpaceAmbientOcclusion write SetScreenSpaceAmbientOcclusion default DefaultScreenSpaceAmbientOcclusion; + + { TCastleNavigation should check it in Motion overrides. + TODO: should be private. } + function NavigationEnableDragging: Boolean; published { For scene manager: you can pause everything inside your 3D world, for viewport: you can make the camera of this viewpoint paused @@ -662,7 +678,7 @@ TCastleAbstractViewport = class(TCastleScreenEffects) may still run, for example MovieTexture will still animate, if only TCastleScene.TimePlaying.) - @item(For cameras, you can set @code(TCamera.Input := []) to ignore + @item(For cameras, you can set @code(TCastleNavigation.Input := []) to ignore key / mouse clicks.) ) } property Paused: boolean read FPaused write SetPaused default false; @@ -807,7 +823,7 @@ TCastleAbstractViewport = class(TCastleScreenEffects) PointingDeviceActivate. If there's nothing interesting under mouse, we will retry a couple of other positions arount the current mouse. - This should be usually used when you use TWalkCamera.MouseLook, + This should be usually used when you use TCastleWalkNavigation.MouseLook, or other navigation when mouse cursor is hidden. It allows user to only approximately look at interesting item and hit interaction button or key. @@ -966,7 +982,7 @@ TCastleSceneManager = class(TCastleAbstractViewport) FSectors: TSectorList; Waypoints: TWaypointList; - procedure SetCamera(const Value: TCamera); override; + procedure SetNavigation(const Value: TCastleNavigation); override; { Triangles to ignore by all collision detection in scene manager. The default implementation in this class resturns always @false, @@ -978,20 +994,20 @@ TCastleSceneManager = class(TCastleAbstractViewport) procedure Notification(AComponent: TComponent; Operation: TOperation); override; - function CameraMoveAllowed(ACamera: TWalkCamera; + function NavigationMoveAllowed(ANavigation: TCastleWalkNavigation; const ProposedNewPos: TVector3; out NewPos: TVector3; const BecauseOfGravity: boolean): boolean; override; - function CameraHeight(ACamera: TWalkCamera; const Position: TVector3; + function NavigationHeight(ANavigation: TCastleWalkNavigation; const Position: TVector3; out AboveHeight: Single; out AboveGround: PTriangle): boolean; override; function CameraRayCollision(const RayOrigin, RayDirection: TVector3): TRayCollision; override; - procedure CameraVisibleChange(const Sender: TInputListener; + procedure NavigationVisibleChange(const Sender: TInputListener; const Changes: TCastleUserInterfaceChanges; const ChangeInitiatedByChildren: boolean); override; function GetItems: TSceneManagerWorld; override; function GetMainScene: TCastleScene; override; function GetShadowVolumeRenderer: TGLShadowVolumeRenderer; override; function GetMouseRayHit: TRayCollision; override; - function GetHeadlightCamera: TCamera; override; + function GetHeadlightCamera: TCastleCamera; override; function GetPlayer: TPlayer; override; function GetTimeScale: Single; override; function PointingDeviceActivate(const Active: boolean): boolean; override; @@ -1108,7 +1124,7 @@ TCastleSceneManager = class(TCastleAbstractViewport) property Viewports: TCastleAbstractViewportList read FViewports; { Up vector, according to gravity. Gravity force pulls in -GravityUp direction. } - function GravityUp: TVector3; + function GravityUp: TVector3; deprecated 'use Camera.GravityUp'; { Sectors and waypoints of this world, for AI in 3D. Initialized by TGameSceneManager.LoadLevel. @@ -1410,19 +1426,19 @@ TCastleViewport = class(TCastleAbstractViewport) function GetMainScene: TCastleScene; override; function GetShadowVolumeRenderer: TGLShadowVolumeRenderer; override; function GetMouseRayHit: TRayCollision; override; - function GetHeadlightCamera: TCamera; override; + function GetHeadlightCamera: TCastleCamera; override; function GetPlayer: TPlayer; override; function GetTimeScale: Single; override; function PointingDeviceActivate(const Active: boolean): boolean; override; function PointingDeviceMove(const RayOrigin, RayDirection: TVector3): boolean; override; - function CameraMoveAllowed(ACamera: TWalkCamera; + function NavigationMoveAllowed(ANavigation: TCastleWalkNavigation; const ProposedNewPos: TVector3; out NewPos: TVector3; const BecauseOfGravity: boolean): boolean; override; - function CameraHeight(ACamera: TWalkCamera; const Position: TVector3; + function NavigationHeight(ANavigation: TCastleWalkNavigation; const Position: TVector3; out AboveHeight: Single; out AboveGround: PTriangle): boolean; override; function CameraRayCollision(const RayOrigin, RayDirection: TVector3): TRayCollision; override; - procedure CameraVisibleChange(const Sender: TInputListener; + procedure NavigationVisibleChange(const Sender: TInputListener; const Changes: TCastleUserInterfaceChanges; const ChangeInitiatedByChildren: boolean); override; function Headlight: TAbstractLightNode; override; public @@ -1453,7 +1469,7 @@ procedure Register; inputs must be satisfied, of course (TCastleAbstractViewport must exist, according to TCastleAbstractViewport.GetExists, and not be paused, see TCastleAbstractViewport.Paused). The event must also not be handled - first by something else, like camera. + first by something else, like navigation. @groupBegin } Input_Attack: TInputShortcut; Input_InventoryShow: TInputShortcut; //< No key/mouse associated by default. @@ -1524,6 +1540,11 @@ constructor TCastleAbstractViewport.Create(AOwner: TComponent); DistortViewAspect := 1; FullSize := true; + FCamera := TCastleCamera.Create(Self); + FCamera.Viewport := Self; + FCamera.SetSubComponent(true); + FCamera.Name := 'Camera'; + {$define read_implementation_constructor} {$I auto_generated_persistent_vectors/tcastleabstractviewport_persistent_vectors.inc} {$undef read_implementation_constructor} @@ -1531,25 +1552,25 @@ constructor TCastleAbstractViewport.Create(AOwner: TComponent); destructor TCastleAbstractViewport.Destroy; begin - { unregister self from Camera callbacs, etc. + { unregister self from Navigation callbacs, etc. - This includes setting FCamera to nil. - Yes, this setting FCamera to nil is needed, it's not just paranoia. + This includes setting FNavigation to nil. + Yes, this setting FNavigation to nil is needed, it's not just paranoia. - Consider e.g. when our Camera is owned by Self. - This means that this camera will be freed in "inherited" destructor call - below. Since we just did FCamera.RemoveFreeNotification, we would have - no way to set FCamera to nil, and FCamera would then remain as invalid + Consider e.g. when our Navigation is owned by Self. + This means that this navigation will be freed in "inherited" destructor call + below. Since we just did FNavigation.RemoveFreeNotification, we would have + no way to set FNavigation to nil, and FNavigation would then remain as invalid pointer. And when SceneManager is freed it sends a free notification (this is also done in "inherited" destructor) to TCastleWindowBase instance, which causes removing us from TCastleWindowBase.Controls list, - which causes SetContainer(nil) call that tries to access Camera. + which causes SetContainer(nil) call that tries to access Navigation. - This scenario would cause segfault, as FCamera pointer is invalid + This scenario would cause segfault, as FNavigation pointer is invalid at this time. } - Camera := nil; + Navigation := nil; FreeAndNil(FRenderParams); FreeAndNil(FPrepareParams); @@ -1568,7 +1589,7 @@ function TCastleAbstractViewport.FillsWholeContainer: boolean; Result := RenderRect.Round.Equals(Container.Rect); end; -procedure TCastleAbstractViewport.SetCamera(const Value: TCamera); +procedure TCastleAbstractViewport.SetNavigation(const Value: TCastleNavigation); begin { Scene manager / viewport will handle passing events to their camera, and will also pass our own Container to Camera.Container. @@ -1585,83 +1606,71 @@ procedure TCastleAbstractViewport.SetCamera(const Value: TCamera); For now, it doesn't work (last viewport/scene manager will hijack some camera events making it not working in other ones). } - if FCamera <> Value then + if FNavigation <> Value then begin { Check csDestroying, as this may be called from Notification, - which may be called by camera destructor *after* TCamera + which may be called by navigation destructor *after* TCastleNavigation after freed it's fields. } - if (FCamera <> nil) and not (csDestroying in FCamera.ComponentState) then + if (FNavigation <> nil) and not (csDestroying in FNavigation.ComponentState) then begin - FCamera.OnVisibleChange := nil; - if FCamera is TWalkCamera then + FNavigation.OnVisibleChange := nil; + if FNavigation is TCastleWalkNavigation then begin - TWalkCamera(FCamera).OnMoveAllowed := nil; - TWalkCamera(FCamera).OnHeight := nil; + TCastleWalkNavigation(FNavigation).OnMoveAllowed := nil; + TCastleWalkNavigation(FNavigation).OnHeight := nil; end; - FCamera.RemoveFreeNotification(Self); - FCamera.Container := nil; + FNavigation.RemoveFreeNotification(Self); + { For easy backward-compatibility, leave Viewport assigned on + FInternalWalkNavigation and FInternalExamineNavigation. } + if (FNavigation <> FInternalWalkNavigation) and + (FNavigation <> FInternalExamineNavigation) then + // TODO: Make Viewport Internal (private in this unit), or protect from SetViewport being called recursively + FNavigation.Viewport := nil; + RemoveControl(FNavigation); end; - FCamera := Value; + FNavigation := Value; - if FCamera <> nil then + if FNavigation <> nil then begin - { Unconditionally change FCamera.OnVisibleChange callback, + { Unconditionally change FNavigation.OnVisibleChange callback, to override TCastleWindowBase / TCastleControlBase that also try - to "hijack" this camera's event. } - FCamera.OnVisibleChange := @CameraVisibleChange; - if FCamera is TWalkCamera then + to "hijack" this navigation's event. } + FNavigation.OnVisibleChange := @NavigationVisibleChange; + if FNavigation is TCastleWalkNavigation then begin - TWalkCamera(FCamera).OnMoveAllowed := @CameraMoveAllowed; - TWalkCamera(FCamera).OnHeight := @CameraHeight; + TCastleWalkNavigation(FNavigation).OnMoveAllowed := @NavigationMoveAllowed; + TCastleWalkNavigation(FNavigation).OnHeight := @NavigationHeight; end; - FCamera.FreeNotification(Self); - FCamera.Container := Container; - if ContainerSizeKnown then - FCamera.Resize; + FNavigation.FreeNotification(Self); + FNavigation.Viewport := Self; + InsertControl(0, FNavigation); end; end; end; -procedure TCastleAbstractViewport.SetContainer(const Value: TUIContainer); -begin - inherited; - - { Keep Camera.Container always the same as our Container } - if Camera <> nil then - Camera.Container := Container; -end; - procedure TCastleAbstractViewport.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if Operation = opRemove then begin - if AComponent = FCamera then + if AComponent = FNavigation then begin - { set to nil by SetCamera, to clean nicely } - Camera := nil; + { set to nil by SetNavigation, to clean nicely } + Navigation := nil; end; - // Note that we don't register on FInternalExamine/WalkCamera destruction + // Note that we don't register on FInternalExamine/WalkNavigation destruction // when they are not current, so they should never be freed in that case. - if AComponent = FInternalWalkCamera then - FInternalWalkCamera := nil; - if AComponent = FInternalExamineCamera then - FInternalExamineCamera := nil; + if AComponent = FInternalWalkNavigation then + FInternalWalkNavigation := nil; + if AComponent = FInternalExamineNavigation then + FInternalExamineNavigation := nil; end; end; -procedure TCastleAbstractViewport.Resize; -begin - inherited; - - if Camera <> nil then - Camera.Resize; -end; - function TCastleAbstractViewport.PlayerNotBlocked: boolean; var P: TPlayer; @@ -1744,9 +1753,10 @@ function TCastleAbstractViewport.Press(const Event: TInputPressRelease): boolean { Let Camera only work after PointingDeviceActivate, to let pointing device sensors under camera work, even when camera allows to navigate by dragging. } - if (Camera <> nil) and - Camera.Press(Event) then - Exit(ExclusiveEvents); + // TODO: will below work Ok now? or should we use PreviewPress? + // if (Camera <> nil) and + // Camera.Press(Event) then + // Exit(ExclusiveEvents); end; function TCastleAbstractViewport.Release(const Event: TInputPressRelease): boolean; @@ -1766,9 +1776,10 @@ function TCastleAbstractViewport.Release(const Event: TInputPressRelease): boole { Let Camera only work after PointingDeviceActivate, to let pointing device sensors under camera work, even when camera allows to navigate by dragging. } - if (Camera <> nil) and - Camera.Release(Event) then - Exit(ExclusiveEvents); + // TODO: will below work Ok now? or should we use PreviewRelease? + // if (Camera <> nil) and + // Camera.Release(Event) then + // Exit(ExclusiveEvents); end; function TCastleAbstractViewport.Motion(const Event: TInputMotion): boolean; @@ -1795,44 +1806,41 @@ function TCastleAbstractViewport.Motion(const Event: TInputMotion): boolean; TopMostScene: TCastleTransform; begin Result := inherited; - if (not Result) and (not Paused) and GetExists and (Camera <> nil) then + if (not Result) and (not Paused) and GetExists then begin - if (GetMouseRayHit <> nil) and - (GetMouseRayHit.Count <> 0) then - TopMostScene := GetMouseRayHit.First.Item - else - TopMostScene := nil; - - { Test if dragging TTouchSensorNode. In that case cancel its dragging - and let camera move instead. } - if (TopMostScene <> nil) and - IsTouchSensorActiveInScene(TopMostScene) and - (PointsDistance(LastPressEvent.Position, Event.Position) > - DistanceToHijackDragging / Container.Dpi) then - begin - TopMostScene.PointingDeviceActivate(false, 0, true); - - if EnableParentDragging then - begin - { Without ReleaseCapture, the parent (like TCastleScrollView) would still - not receive the following motion events. } - Container.ReleaseCapture(Self); - end; - - Camera.Press(LastPressEvent); - end; - - Camera.EnableDragging := (GetItems = nil) or (not GetItems.Dragging); - { Do not navigate by dragging (regardless of ciMouseDragging in Camera.Input) - when we're already dragging a 3D item. - This means that if you drag X3D sensors like TouchSensor, then your - dragging will not simultaneously also affect the camera (which would be very - disorienting). } - if Camera.Motion(Event) then - Result := ExclusiveEvents; - - { Do PointingDeviceMove, which updates MouseRayHit, even when Camera.Motion - is true. On Windows 10 with MouseLook, Camera.Motion is always true. } + // TODO: Navigation.Motion now happens automatically, make sure below cases are covered. + + // if Navigation <> nil then + // begin + // if (GetMouseRayHit <> nil) and + // (GetMouseRayHit.Count <> 0) then + // TopMostScene := GetMouseRayHit.First.Item + // else + // TopMostScene := nil; + + // { Test if dragging TTouchSensorNode. In that case cancel its dragging + // and let navigation move instead. } + // if (TopMostScene <> nil) and + // IsTouchSensorActiveInScene(TopMostScene) and + // (PointsDistance(LastPressEvent.Position, Event.Position) > + // DistanceToHijackDragging / Container.Dpi) then + // begin + // TopMostScene.PointingDeviceActivate(false, 0, true); + + // if EnableParentDragging then + // begin + // { Without ReleaseCapture, the parent (like TCastleScrollView) would still + // not receive the following motion events. } + // Container.ReleaseCapture(Self); + // end; + + // Navigation.Press(LastPressEvent); + // end; + + // end; + + { Do PointingDeviceMove, which updates MouseRayHit, even when Navigation.Motion + is true. On Windows 10 with MouseLook, Navigation.Motion is always true. } //if not Result then UpdateMouseRayHit; @@ -1854,15 +1862,23 @@ function TCastleAbstractViewport.Motion(const Event: TInputMotion): boolean; RecalculateCursor(Self); end; +function TCastleAbstractViewport.NavigationEnableDragging: Boolean; +begin + { Do not navigate by dragging (regardless of ciMouseDragging in Navigation.Input) + when we're already dragging a 3D item. + This means that if you drag X3D sensors like TouchSensor, then your + dragging will not simultaneously also affect the navigation (which would be very + disorienting). } + + Result := (GetItems = nil) or (not GetItems.Dragging); +end; + procedure TCastleAbstractViewport.UpdateMouseRayHit; var RayOrigin, RayDirection: TVector3; begin - if Camera <> nil then - begin - Camera.CustomRay(RenderRect, Container.MousePosition, FProjection, RayOrigin, RayDirection); - PointingDeviceMove(RayOrigin, RayDirection); - end; + Camera.CustomRay(RenderRect, Container.MousePosition, FProjection, RayOrigin, RayDirection); + PointingDeviceMove(RayOrigin, RayDirection); end; procedure TCastleAbstractViewport.SetPaused(const Value: boolean); @@ -1884,10 +1900,10 @@ procedure TCastleAbstractViewport.RecalculateCursor(Sender: TObject); stuff, in particular during our own destructor when FItems is freed and we're in half-destructed state. } (csDestroying in GetItems.ComponentState) or - { When Paused, then Press and Motion events are not passed to Camera, + { When Paused, then Press and Motion events are not passed to Navigation, or to Items inside. So it's sensible that they also don't control the cursor anymore. - In particular, it means cursor is no longer hidden by Camera.MouseLook + In particular, it means cursor is no longer hidden by Navigation.MouseLook when the Paused is switched to true. } Paused then begin @@ -1895,15 +1911,16 @@ procedure TCastleAbstractViewport.RecalculateCursor(Sender: TObject); Exit; end; - { We have to treat Camera.Cursor specially: + { We have to treat Navigation.Cursor specially: - mcForceNone because of mouse look means result is unconditionally mcForceNone. Other Items.Cursor, MainScene.Cursor etc. is ignored then. - - otherwise, Camera.Cursor is ignored, show 3D objects cursor. } - if (Camera <> nil) and (Camera.Cursor = mcForceNone) then - begin - Cursor := mcForceNone; - Exit; - end; + - otherwise, Navigation.Cursor is ignored, show 3D objects cursor. } + // TODO: will this still work automatically ok? cursor over touchSensor will be ok? + // if (Navigation <> nil) and (Camera.Cursor = mcForceNone) then + // begin + // Cursor := mcForceNone; + // Exit; + // end; { We show mouse cursor from top-most 3D object. This is sensible, if multiple 3D scenes obscure each other at the same @@ -1961,8 +1978,9 @@ procedure TCastleAbstractViewport.Update(const SecondsPassed: Single; get Pressed information (which keys/mouse buttons are pressed) at all, so they could not process keys/mouse anyway. } - if Camera <> nil then - Camera.Update(SecondsPassedScaled, HandleInput); + // TODO: will this still work ok? + // if Camera <> nil then + // Camera.Update(SecondsPassedScaled, HandleInput); DistortFieldOfViewY := 1; DistortViewAspect := 1; @@ -1978,7 +1996,7 @@ procedure TCastleAbstractViewport.Update(const SecondsPassed: Single; function TCastleAbstractViewport.AllowSuspendForInput: boolean; begin - Result := (Camera = nil) or Paused or (not GetExists) or Camera.AllowSuspendForInput; + Result := Paused; end; procedure TCastleAbstractViewport.ApplyProjection; @@ -1987,7 +2005,8 @@ procedure TCastleAbstractViewport.ApplyProjection; AspectRatio: Single; M: TMatrix4; begin - RequiredCamera; // create Camera if necessary + // TODO: this should be removed, at least when AutoDetectNavigation = false + RequiredNavigation; // create Navigation if necessary { We need to know container size now. } Check(ContainerSizeKnown, ClassName + ' did not receive "Resize" event yet, cannnot apply projection. This usually means you try to call "Render" method with a container that does not yet have an open context.'); @@ -2108,8 +2127,9 @@ function TCastleAbstractViewport.CalculateProjection: TProjection; { Tests: Writeln(Format('Angle of view: x %f, y %f', [PerspectiveAngles[0], PerspectiveAngles[1]])); } - Assert(Camera.Radius > 0, 'Camera.Radius must be > 0 when using TCastleAbstractViewport.ApplyProjection'); - Result.ProjectionNear := Camera.Radius * 0.6; + // TODO: this should not read Navigation.Radius, it should look at scene, like ProjectionFar + Assert(Navigation.Radius > 0, 'Navigation.Radius must be > 0 when using TCastleAbstractViewport.ApplyProjection'); + Result.ProjectionNear := Navigation.Radius * 0.6; { calculate Result.ProjectionFar, algorithm documented at DefaultVisibilityLimit } Result.ProjectionFar := 0; @@ -2127,7 +2147,7 @@ function TCastleAbstractViewport.CalculateProjection: TProjection; Result.ProjectionNear) * 20.0; { At some point, I was using here larger projection near when - (ACamera is TExamineCamera). Reasoning: you do not get so close + (Navigation is TCastleExamineNavigation). Reasoning: you do not get so close to the model with Examine view, and you do not need collision detection. Both arguments are wrong now, you can switch between Examine/Walk in view3dscene and easily get close to the model, and collision detection @@ -2195,7 +2215,7 @@ procedure TCastleAbstractViewport.InitializeLights(const Lights: TLightInstances function TCastleAbstractViewport.HeadlightInstance(out Instance: TLightInstance): boolean; var Node: TAbstractLightNode; - HC: TCamera; + HC: TCastleCamera; procedure PrepareInstance; var @@ -2778,7 +2798,7 @@ function TCastleAbstractViewport.RenderWithScreenEffects(const RenderingCamera: end; end; -procedure TCastleAbstractViewport.RenderOnScreen(ACamera: TCamera); +procedure TCastleAbstractViewport.RenderOnScreen(ACamera: TCastleCamera); begin RenderingCamera.Target := rtScreen; RenderingCamera.FromCameraObject(ACamera); @@ -2896,77 +2916,116 @@ procedure TCastleAbstractViewport.SetScreenSpaceAmbientOcclusion(const Value: bo end; end; -function TCastleAbstractViewport.RequiredCamera: TCamera; +function TCastleAbstractViewport.RequiredCamera: TCastleNavigation; begin - if Camera = nil then - AssignDefaultCamera; - Result := Camera; + Result := RequiredNavigation; +end; + +function TCastleAbstractViewport.RequiredNavigation: TCastleNavigation; +begin + if Navigation = nil then + AssignDefaultNavigation; + Result := Navigation; +end; + +function TCastleAbstractViewport.InternalExamineCamera: TCastleExamineNavigation; +begin + Result := InternalExamineNavigation; +end; + +function TCastleAbstractViewport.InternalWalkCamera: TCastleWalkNavigation; +begin + Result := InternalWalkNavigation; end; -function TCastleAbstractViewport.InternalExamineCamera: TExamineCamera; +function TCastleAbstractViewport.InternalExamineNavigation: TCastleExamineNavigation; begin - if FInternalExamineCamera = nil then - FInternalExamineCamera := TExamineCamera.Create(Self); - Result := FInternalExamineCamera; + if FInternalExamineNavigation = nil then + begin + FInternalExamineNavigation := TCastleExamineNavigation.Create(Self); + FInternalExamineNavigation.SetTransient; + { TODO: For easy backward-compatibility, Viewport is assigned here for the + entire lifetime of FInternalExamineNavigation instance, + even before calling SetNavigation on it. } + FInternalExamineNavigation.Viewport := Self; + end; + Result := FInternalExamineNavigation; end; -function TCastleAbstractViewport.InternalWalkCamera: TWalkCamera; +function TCastleAbstractViewport.InternalWalkNavigation: TCastleWalkNavigation; begin - if FInternalWalkCamera = nil then - FInternalWalkCamera := TWalkCamera.Create(Self); - Result := FInternalWalkCamera; + if FInternalWalkNavigation = nil then + begin + FInternalWalkNavigation := TCastleWalkNavigation.Create(Self); + FInternalWalkNavigation.SetTransient; + { TODO: For easy backward-compatibility, Viewport is assigned here for the + entire lifetime of FInternalExamineNavigation instance, + even before calling SetNavigation on it. } + FInternalWalkNavigation.Viewport := Self; + end; + Result := FInternalWalkNavigation; end; -function TCastleAbstractViewport.ExamineCamera(const SwitchNavigationTypeIfNeeded: boolean): TExamineCamera; +function TCastleAbstractViewport.ExamineNavigation(const SwitchNavigationTypeIfNeeded: boolean): TCastleExamineNavigation; var - NewCamera: TExamineCamera; + NewNavigation: TCastleExamineNavigation; begin - if not (Camera is TExamineCamera) then + if not (Navigation is TCastleExamineNavigation) then begin if not SwitchNavigationTypeIfNeeded then Exit(nil); - NewCamera := InternalExamineCamera; - if Camera = nil then - AssignDefaultCamera; // initialize defaults from MainScene - NewCamera.Assign(Camera); - Camera := NewCamera; - { make sure it's in ntExamine mode (as we possibly reuse old camera, - by reusing InternalExamineCamera, so we're not sure what state it's in. } + NewNavigation := InternalExamineNavigation; + if Navigation = nil then + AssignDefaultNavigation; // initialize defaults from MainScene + NewNavigation.Assign(Navigation); + Navigation := NewNavigation; + { make sure it's in ntExamine mode (as we possibly reuse old navigation, + by reusing InternalExamineNavigation, so we're not sure what state it's in. } NavigationType := ntExamine; end; - Result := Camera as TExamineCamera; + Result := Navigation as TCastleExamineNavigation; +end; + +function TCastleAbstractViewport.ExamineCamera(const SwitchNavigationTypeIfNeeded: boolean): TCastleExamineNavigation; +begin + Result := ExamineNavigation(SwitchNavigationTypeIfNeeded); end; -function TCastleAbstractViewport.WalkCamera(const SwitchNavigationTypeIfNeeded: boolean): TWalkCamera; +function TCastleAbstractViewport.WalkNavigation(const SwitchNavigationTypeIfNeeded: boolean): TCastleWalkNavigation; var - NewCamera: TWalkCamera; + NewNavigation: TCastleWalkNavigation; begin - if not (Camera is TWalkCamera) then + if not (Navigation is TCastleWalkNavigation) then begin if not SwitchNavigationTypeIfNeeded then Exit(nil); - NewCamera := InternalWalkCamera; - if Camera = nil then - AssignDefaultCamera; // initialize defaults from MainScene - NewCamera.Assign(Camera); - Camera := NewCamera; - { make sure it's in ntWalk mode (as we possibly reuse old camera, - by reusing InternalWalkCamera, so we're not sure what state it's in. } + NewNavigation := InternalWalkNavigation; + if Navigation = nil then + AssignDefaultNavigation; // initialize defaults from MainScene + NewNavigation.Assign(Navigation); + Navigation := NewNavigation; + { make sure it's in ntWalk mode (as we possibly reuse old navigation, + by reusing InternalWalkNavigation, so we're not sure what state it's in. } NavigationType := ntWalk; end; - Result := Camera as TWalkCamera; + Result := Navigation as TCastleWalkNavigation; +end; + +function TCastleAbstractViewport.WalkCamera(const SwitchNavigationTypeIfNeeded: boolean): TCastleWalkNavigation; +begin + Result := WalkNavigation(SwitchNavigationTypeIfNeeded); end; function TCastleAbstractViewport.GetNavigationType: TNavigationType; var - C: TCamera; + C: TCastleNavigation; begin - C := Camera; - { We are using here Camera, not RequiredCamera, as automatically - creating Camera could have surprising consequences. - E.g. it means that SetCamera(nil) may recreate the camera, + C := Navigation; + { We are using here Navigation, not RequiredNavigation, as automatically + creating Navigation could have surprising consequences. + E.g. it means that SetNavigation(nil) may recreate the navigation, as BoundNavigationInfoChanged calls something that checks NavigationType. } if C = nil then @@ -2977,19 +3036,19 @@ function TCastleAbstractViewport.GetNavigationType: TNavigationType; procedure TCastleAbstractViewport.SetNavigationType(const Value: TNavigationType); var - E: TExamineCamera; - W: TWalkCamera; + E: TCastleExamineNavigation; + W: TCastleWalkNavigation; begin { Do this even if "Value = GetNavigationType". This makes sense, in case you set some weird values. On the other hand, it makes "NavigationType := NavigationType" sometimes a sensible operation that changes something. - It also avoids recursive loop when first assigning camera - in AssignDefaultCamera. } + It also avoids recursive loop when first assigning navigation + in AssignDefaultNavigation. } { do not change NavigationType when - SetNavigationType is called from ExamineCamera or WalkCamera + SetNavigationType is called from ExamineNavigation or WalkNavigation that were already called by NavigationType. It's actually harmless, but still useless. } if FWithinSetNavigationType then @@ -2999,35 +3058,35 @@ procedure TCastleAbstractViewport.SetNavigationType(const Value: TNavigationType case Value of ntExamine: begin - E := ExamineCamera; - E.Input := TCamera.DefaultInput; + E := ExamineNavigation; + E.Input := TCastleNavigation.DefaultInput; E.Turntable := false; end; ntTurntable: begin - E := ExamineCamera; - E.Input := TCamera.DefaultInput; + E := ExamineNavigation; + E.Input := TCastleNavigation.DefaultInput; E.Turntable := true; end; ntWalk: begin - W := WalkCamera; - W.Input := TCamera.DefaultInput; + W := WalkNavigation; + W.Input := TCastleNavigation.DefaultInput; W.PreferGravityUpForRotations := true; W.PreferGravityUpForMoving := true; W.Gravity := true; end; ntFly: begin - W := WalkCamera; - W.Input := TCamera.DefaultInput; + W := WalkNavigation; + W.Input := TCastleNavigation.DefaultInput; W.PreferGravityUpForRotations := true; W.PreferGravityUpForMoving := false; W.Gravity := false; end; ntNone: begin - W := WalkCamera; + W := WalkNavigation; W.Input := []; // gravity stuff set like for ntFly W.PreferGravityUpForRotations := true; @@ -3047,16 +3106,16 @@ procedure TCastleAbstractViewport.SetNavigationType(const Value: TNavigationType procedure TCastleAbstractViewport.ClearCameras; begin - Camera := nil; - FreeAndNil(FInternalExamineCamera); - FreeAndNil(FInternalWalkCamera); + Navigation := nil; + FreeAndNil(FInternalExamineNavigation); + FreeAndNil(FInternalWalkNavigation); end; -procedure TCastleAbstractViewport.AssignDefaultCamera; +procedure TCastleAbstractViewport.AssignDefaultNavigation; var Box: TBox3D; Scene: TCastleScene; - C: TExamineCamera; + C: TCastleExamineNavigation; Nav: TNavigationType; begin if GetItems <> nil then @@ -3068,22 +3127,22 @@ procedure TCastleAbstractViewport.AssignDefaultCamera; begin Nav := Scene.NavigationTypeFromNavigationInfo; - { Set Camera explicitly, otherwise SetNavigationType below could call - ExamineCamera / WalkCamera that call AssignDefaultCamera when Camera = nil, - and we would have infinite AssignDefaultCamera calls loop. } + { Set Navigation explicitly, otherwise SetNavigationType below could call + ExamineNavigation / WalkNavigation that call AssignDefaultNavigation when Navigation = nil, + and we would have infinite AssignDefaultNavigation calls loop. } if Nav in [ntExamine, ntTurntable] then - Camera := InternalExamineCamera + Navigation := InternalExamineNavigation else - Camera := InternalWalkCamera; + Navigation := InternalWalkNavigation; NavigationType := Nav; - Scene.CameraFromNavigationInfo(Camera, Box); - Scene.CameraFromViewpoint(Camera, false, false); + Scene.CameraFromNavigationInfo(Navigation, Box); + Scene.CameraFromViewpoint(Navigation, false, false); end else begin C := InternalExamineCamera; C.Init(Box, Box.AverageSize(false, 1.0) * 0.005); - Camera := C; + Navigation := C; end; end; @@ -3092,16 +3151,6 @@ function TCastleAbstractViewport.Statistics: TRenderStatistics; Result := FRenderParams.Statistics; end; -function TCastleAbstractViewport.SensorRotation(const X, Y, Z, Angle: Double; const SecondsPassed: Single): boolean; -begin - Result := (Camera <> nil) and Camera.SensorRotation(X, Y, Z, Angle, SecondsPassed * GetTimeScale); -end; - -function TCastleAbstractViewport.SensorTranslation(const X, Y, Z, Length: Double; const SecondsPassed: Single): boolean; -begin - Result := (Camera <> nil) and Camera.SensorTranslation(X, Y, Z, Length, SecondsPassed * GetTimeScale); -end; - {$define read_implementation_methods} {$I auto_generated_persistent_vectors/tcastleabstractviewport_persistent_vectors.inc} {$undef read_implementation_methods} @@ -3400,11 +3449,8 @@ procedure TCastleSceneManager.SetMainScene(const Value: TCastleScene); for non-MainScene scenes, as in trees_blending/CW_demo.lpr testcase from Eugene. } - if Camera <> nil then - begin - MainScene.CameraChanged(Camera); - ItemsVisibleChange(MainScene, CameraToChanges); - end; + MainScene.CameraChanged(Camera); + ItemsVisibleChange(MainScene, CameraToChanges); end; end; end; @@ -3461,13 +3507,14 @@ procedure TCastleSceneManager.SetPlayer(const Value: TPlayer); end; end; -procedure TCastleSceneManager.SetCamera(const Value: TCamera); +procedure TCastleSceneManager.SetNavigation(const Value: TCastleNavigation); begin - if FCamera <> Value then + if FNavigation <> Value then begin inherited; - if FCamera <> nil then + // TODO: this should be removed? + if FNavigation <> nil then begin { Call initial CameraChanged (this allows ProximitySensors to work as soon as ProcessEvents becomes true). } @@ -3475,6 +3522,7 @@ procedure TCastleSceneManager.SetCamera(const Value: TCamera); ItemsVisibleChange(Items, CameraToChanges); end; + // TODO: this should be removed? { Changing camera changes also the view rapidly. } if MainScene <> nil then MainScene.ViewChangedSuddenly; @@ -3665,7 +3713,7 @@ function TCastleSceneManager.PointingDeviceActivate(const Active: boolean): bool { Try PointingDeviceActivate on 3D stuff hit by ray moved by given number of screen pixels from current mouse position. - Call only if Camera and MousePosition already assigned. } + Call only if MousePosition already assigned. } function TryActivateAround(const Change: TVector2): boolean; var RayOrigin, RayDirection: TVector3; @@ -3714,7 +3762,7 @@ function TCastleSceneManager.PointingDeviceActivate(const Active: boolean): bool Result := TryActivate(MouseRayHit); if not Result then begin - if ApproximateActivation and (Camera <> nil) and GetMousePosition then + if ApproximateActivation and GetMousePosition then Result := TryActivateAroundSquare(25) or TryActivateAroundSquare(50) or TryActivateAroundSquare(100) or @@ -3823,14 +3871,17 @@ procedure TCastleSceneManager.Update(const SecondsPassed: Single; DoScheduledVisibleChangeNotification; end; -procedure TCastleSceneManager.CameraVisibleChange(const Sender: TInputListener; +procedure TCastleSceneManager.NavigationVisibleChange(const Sender: TInputListener; const Changes: TCastleUserInterfaceChanges; const ChangeInitiatedByChildren: boolean); var Pos, Dir, Up: TVector3; begin + // TODO: this should be called directly by TCastleCamera + // (now it just calls Viewport.VisibleChange), + // and it should be unrelated to Navigation if chCamera in Changes then begin - if Sender = Camera then + if Sender = Navigation then begin { Call CameraChanged for all Items, not just MainScene. This allows ProximitySensor and Billboard and such nodes @@ -3841,7 +3892,7 @@ procedure TCastleSceneManager.CameraVisibleChange(const Sender: TInputListener; end else VisibleChange(Changes, true); - (Sender as TCamera).GetView(Pos, Dir, Up); + Camera.GetView(Pos, Dir, Up); SoundEngine.UpdateListener(Pos, Dir, Up); if Assigned(OnCameraChanged) then @@ -3858,23 +3909,23 @@ function TCastleSceneManager.CollisionIgnoreItem(const Sender: TObject; Result := false; end; -function TCastleSceneManager.CameraMoveAllowed(ACamera: TWalkCamera; +function TCastleSceneManager.NavigationMoveAllowed(ANavigation: TCastleWalkNavigation; const ProposedNewPos: TVector3; out NewPos: TVector3; const BecauseOfGravity: boolean): boolean; begin { Both version result in calling WorldMoveAllowed. Player version adds Player.Disable/Enable around, so don't collide with self. } if Player <> nil then - Result := Player.MoveAllowed(ACamera.Position, ProposedNewPos, NewPos, BecauseOfGravity) else - Result := Items.WorldMoveAllowed(ACamera.Position, ProposedNewPos, NewPos, - true, ACamera.Radius, - { We prefer to resolve collisions with camera using sphere. + Result := Player.MoveAllowed(ANavigation.Position, ProposedNewPos, NewPos, BecauseOfGravity) else + Result := Items.WorldMoveAllowed(ANavigation.Position, ProposedNewPos, NewPos, + true, ANavigation.Radius, + { We prefer to resolve collisions with navigation using sphere. But for TCastleTransform implementations that can't use sphere, we can construct box. } - Box3DAroundPoint(ACamera.Position, ACamera.Radius * 2), - Box3DAroundPoint(ProposedNewPos, ACamera.Radius * 2), BecauseOfGravity); + Box3DAroundPoint(ANavigation.Position, ANavigation.Radius * 2), + Box3DAroundPoint(ProposedNewPos, ANavigation.Radius * 2), BecauseOfGravity); end; -function TCastleSceneManager.CameraHeight(ACamera: TWalkCamera; +function TCastleSceneManager.NavigationHeight(ANavigation: TCastleWalkNavigation; const Position: TVector3; out AboveHeight: Single; out AboveGround: PTriangle): boolean; begin @@ -3908,25 +3959,25 @@ procedure TCastleSceneManager.BoundNavigationInfoChanged; procedure TCastleSceneManager.SceneBoundViewpointChanged(Scene: TCastleSceneCore); begin - if Camera <> nil then - Scene.CameraFromViewpoint(Camera, false); + if Navigation <> nil then + Scene.CameraFromViewpoint(Navigation, false); BoundViewpointChanged; end; procedure TCastleSceneManager.SceneBoundNavigationInfoChanged(Scene: TCastleSceneCore); begin - if Camera <> nil then + if Navigation <> nil then begin NavigationType := Scene.NavigationTypeFromNavigationInfo; - Scene.CameraFromNavigationInfo(Camera, Items.BoundingBox); + Scene.CameraFromNavigationInfo(Navigation, Items.BoundingBox); end; BoundNavigationInfoChanged; end; procedure TCastleSceneManager.SceneBoundViewpointVectorsChanged(Scene: TCastleSceneCore); begin - if Camera <> nil then - Scene.CameraFromViewpoint(Camera, true); + if Navigation <> nil then + Scene.CameraFromViewpoint(Navigation, true); end; function TCastleSceneManager.GetItems: TSceneManagerWorld; @@ -3949,7 +4000,7 @@ function TCastleSceneManager.GetMouseRayHit: TRayCollision; Result := MouseRayHit; end; -function TCastleSceneManager.GetHeadlightCamera: TCamera; +function TCastleSceneManager.GetHeadlightCamera: TCastleCamera; begin Result := Camera; end; @@ -3977,10 +4028,7 @@ procedure TCastleSceneManager.SetDefaultViewport(const Value: boolean); function TCastleSceneManager.GravityUp: TVector3; begin - if Camera <> nil then - Result := Camera.GravityUp - else - Result := DefaultCameraUp; + Result := Camera.GravityUp; end; function TCastleSceneManager.MoveAllowed(const OldPosition, NewPosition: TVector3; @@ -4076,31 +4124,31 @@ procedure TCastleViewport.CheckSceneManagerAssigned; raise EViewportSceneManagerMissing.Create('TCastleViewport.SceneManager is required, but not assigned yet'); end; -procedure TCastleViewport.CameraVisibleChange(const Sender: TInputListener; +procedure TCastleViewport.NavigationVisibleChange(const Sender: TInputListener; const Changes: TCastleUserInterfaceChanges; const ChangeInitiatedByChildren: boolean); begin VisibleChange(Changes, true); end; -function TCastleViewport.CameraMoveAllowed(ACamera: TWalkCamera; +function TCastleViewport.NavigationMoveAllowed(ANavigation: TCastleWalkNavigation; const ProposedNewPos: TVector3; out NewPos: TVector3; const BecauseOfGravity: boolean): boolean; begin if SceneManager <> nil then - Result := SceneManager.CameraMoveAllowed( - ACamera, ProposedNewPos, NewPos, BecauseOfGravity) else + Result := SceneManager.NavigationMoveAllowed( + ANavigation, ProposedNewPos, NewPos, BecauseOfGravity) else begin Result := true; NewPos := ProposedNewPos; end; end; -function TCastleViewport.CameraHeight(ACamera: TWalkCamera; +function TCastleViewport.NavigationHeight(ANavigation: TCastleWalkNavigation; const Position: TVector3; out AboveHeight: Single; out AboveGround: PTriangle): boolean; begin if SceneManager <> nil then - Result := SceneManager.CameraHeight(ACamera, Position, AboveHeight, AboveGround) else + Result := SceneManager.NavigationHeight(ANavigation, Position, AboveHeight, AboveGround) else begin Result := false; AboveHeight := MaxSingle; @@ -4141,7 +4189,7 @@ function TCastleViewport.GetMouseRayHit: TRayCollision; Result := SceneManager.MouseRayHit; end; -function TCastleViewport.GetHeadlightCamera: TCamera; +function TCastleViewport.GetHeadlightCamera: TCastleCamera; begin CheckSceneManagerAssigned; Result := SceneManager.Camera; diff --git a/src/lcl/castlecontrol.pas b/src/lcl/castlecontrol.pas index c4d3d28e83..e1d0e37a92 100644 --- a/src/lcl/castlecontrol.pas +++ b/src/lcl/castlecontrol.pas @@ -531,7 +531,7 @@ TCastleControl = class(TCastleControlBase) procedure Load(ARootNode: TX3DRootNode; const OwnsRootNode: boolean); function MainScene: TCastleScene; - function Camera: TCamera; + function Camera: TCastleCamera; deprecated 'use SceneManger.Camera or SceneManger.Navigation'; published property SceneManager: TControlGameSceneManager read FSceneManager; @@ -1326,7 +1326,7 @@ function TCastleControl.MainScene: TCastleScene; Result := SceneManager.MainScene; end; -function TCastleControl.Camera: TCamera; +function TCastleControl.Camera: TCastleCamera; begin Result := SceneManager.Camera; end; diff --git a/src/x3d/castlescenecore.pas b/src/x3d/castlescenecore.pas index a85db55270..77c68395b6 100644 --- a/src/x3d/castlescenecore.pas +++ b/src/x3d/castlescenecore.pas @@ -1669,7 +1669,7 @@ TVisibilitySensors = class({$ifdef CASTLE_OBJFPC}specialize{$endif} TDicti The scene is notified about camera changes automatically, by the @link(TCastleSceneManager). This method may be renamed / removed in future releases.) } - procedure CameraChanged(ACamera: TCamera); override; + procedure CameraChanged(const ACamera: TCastleCamera); override; { List of handlers for VRML/X3D Script node with "compiled:" protocol. This is read-only, change this only by RegisterCompiledScript. } @@ -6714,13 +6714,13 @@ function TCastleSceneCore.CameraViewKnown: boolean; Result := (World <> nil) and World.CameraKnown; end; -procedure TCastleSceneCore.CameraChanged(ACamera: TCamera); +procedure TCastleSceneCore.CameraChanged(const ACamera: TCastleCamera); begin inherited; UpdateCameraEvents; { handle WatchForTransitionComplete, looking at ACamera.Animation } - if ProcessEvents and WatchForTransitionComplete and not ACamera.Animation then + if ProcessEvents and WatchForTransitionComplete {TODO:and not ACamera.Animation} then begin BeginChangesSchedule; try diff --git a/src/x3d/opengl/castlescene.pas b/src/x3d/opengl/castlescene.pas index 1d6d0fcc89..74e088767d 100644 --- a/src/x3d/opengl/castlescene.pas +++ b/src/x3d/opengl/castlescene.pas @@ -685,7 +685,7 @@ TCustomShaders = record procedure ViewChangedSuddenly; override; procedure VisibleChangeNotification(const Changes: TVisibleChanges); override; - procedure CameraChanged(ACamera: TCamera); override; + procedure CameraChanged(const ACamera: TCastleCamera); override; { Screen effects information, used by TCastleAbstractViewport.ScreenEffects. ScreenEffectsCount may actually prepare screen effects. @@ -2148,7 +2148,7 @@ procedure TCastleScene.VisibleChangeNotification(const Changes: TVisibleChanges) end; end; -procedure TCastleScene.CameraChanged(ACamera: TCamera); +procedure TCastleScene.CameraChanged(const ACamera: TCastleCamera); var I: Integer; begin diff --git a/src/x3d/opengl/castlescreeneffects.pas b/src/x3d/opengl/castlescreeneffects.pas index a7e6b27147..5ba02bc97a 100644 --- a/src/x3d/opengl/castlescreeneffects.pas +++ b/src/x3d/opengl/castlescreeneffects.pas @@ -129,7 +129,7 @@ TCastleScreenEffects = class(TCastleUserInterface) FScreenEffectsTimeScale: Single; { World to pass dummy camera position to ScreenEffectsScene. } World: TSceneManagerWorld; - Camera: TWalkCamera; + Camera: TCastleCamera; { Valid only between Render and RenderOverChildren calls. } RenderScreenEffects: Boolean; @@ -304,7 +304,7 @@ procedure TCastleScreenEffects.AddScreenEffect(const Node: TAbstractChildNode); // TODO: creating class with abstract methods here World := TSceneManagerWorld.Create(Self); World.Add(ScreenEffectsScene); - Camera := TWalkCamera.Create(Self); + Camera := TCastleCamera.Create(Self); end; { Note that AddChildren by default has AllowDuplicates=true,