LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
    Unit for navigating TGLBaseObjects.
6

7
	 History :  
8
       20/02/07 - DaStr - Moved Notification(), SetObject(), SetUseVirtualUp(),
9
                             SetVirtualUp(), CalcRight() to the "protected" section
10
                             Private "point1" renamed to FPrevPoint
11
                             Updated comments
12
                             TGLNavigator.SetObject made virtual
13
       19/02/07 - DaStr - TGLNavigator.Create - FVirtualUp creation fixed
14
                             Added default values to TGLNavigator and TGLUserInterface
15
       29/01/07 - DaStr - Moved registration to GLSceneRegister.pas
16
       08/03/06 - ur - Fixed warnigs for Delphi 2006
17
       31/10/05 - Mathx - Fixed bug 1340637 relating to freeNotifications on 
18
                             the TGLUserInterface component.
19
       18/12/04 - PhP - Added FlyForward
20
       03/07/04 - LR - Added GLShowCursor, GLSetCursorPos, GLGetCursorPos,
21
                          GLGetScreenWidth, GLGetScreenHeight for Linux compatibility       
22
       11/05/04 - JAJ - Added some features and fixed a bug.
23
       01/06/03 - JAJ - Added notification to movingobject...
24
       01/06/03 - fig - CurrentHangle implementet...
25
       14/07/02 - EG - InvertMouse (Joen A. Joensen)
26
       18/03/02 - EG - Added MouseLookActive property, Fixed framerate dependency
27
       15/03/02 - JAJ - Structure Change - Mouselook moved to newly created TGLUserInterface.
28
       15/03/02 - RMCH - Added Mouselook capability.
29
       09/11/00 - JAJ - First submitted. Base Class TGLNavigator included.
30
	 
31
}
32
unit GLNavigator;
33

34
interface
35

36
{$I GLScene.inc}
37

38
uses
39
  // VCL
40
  SysUtils, Classes,
41

42
  GLVectorGeometry, GLScene, GLCrossPlatform, GLCoordinates, GLScreen
43
  , GLVectorTypes;
44

45
type
46

47
	// TGLNavigator
48
	//
49
	{ TGLNavigator is the component for moving a TGLBaseSceneObject, and all Classes based on it,
50
      this includes all the objects from the Scene Editor.
51

52
	   The four calls to get you started is
53
       
54
  	    TurnHorisontal : it turns left and right.
55
	    TurnVertical : it turns up and down.
56
	    MoveForward :	moves back and forth.
57
      FlyForward : moves back and forth in the movingobject's direction
58
       
59
	   The three properties to get you started is
60
       
61
	    MovingObject : The Object that you are moving.
62
	    UseVirtualUp : When UseVirtualUp is set you navigate Quake style. If it isn't
63
   		it's more like Descent.
64
	    AngleLock : Allows you to block the Vertical angles. Should only be used in
65
			conjunction with UseVirtualUp.
66
	    MoveUpWhenMovingForward : Changes movement from Quake to Arcade Airplane...
67
      (no tilt and flying)
68
	    InvertHorizontalSteeringWhenUpsideDown : When using virtual up, and vertically
69
      rotating beyond 90 degrees, will make steering seem inverted, so we "invert" back
70
      to normal.
71
       
72
   }
73
  TGLNavigator = class(TComponent)
74
  private
75
    FObject: TGLBaseSceneObject;
76
    FVirtualRight: TVector;
77
    FVirtualUp: TGLCoordinates;
78
    FUseVirtualUp: boolean;
79
    FAutoUpdateObject: boolean;
80
    FMaxAngle: single;
81
    FMinAngle: single;
82
    FCurrentVAngle: single;
83
    FCurrentHAngle: single;
84
    FAngleLock: boolean;
85
    FMoveUpWhenMovingForward: boolean;
86
    FInvertHorizontalSteeringWhenUpsideDown: boolean;
87
  protected
88
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
89
    procedure SetObject(NewObject: TGLBaseSceneObject); virtual;
90
    procedure SetUseVirtualUp(UseIt: boolean);
91
    procedure SetVirtualUp(Up: TGLCoordinates);
92
    function CalcRight: TVector;
93
  public
94
    constructor Create(AOwner: TComponent); override;
95
    destructor Destroy; override;
96

97
    procedure TurnHorizontal(Angle: single);
98
    procedure TurnVertical(Angle: single);
99
    procedure MoveForward(Distance: single);
100
    procedure StrafeHorizontal(Distance: single);
101
    procedure StrafeVertical(Distance: single);
102
    procedure Straighten;
103
    procedure FlyForward(Distance: single);
104

105
    procedure LoadState(Stream: TStream);
106
    procedure SaveState(Stream: TStream);
107

108
    property CurrentVAngle: single read FCurrentVAngle;
109
    property CurrentHAngle: single read FCurrentHAngle;
110
  published
111
    property MoveUpWhenMovingForward: boolean read FMoveUpWhenMovingForward write FMoveUpWhenMovingForward default False;
112
    property InvertHorizontalSteeringWhenUpsideDown: boolean read FInvertHorizontalSteeringWhenUpsideDown write FInvertHorizontalSteeringWhenUpsideDown default False;
113
    property VirtualUp: TGLCoordinates read FVirtualUp write SetVirtualUp;
114
    property MovingObject: TGLBaseSceneObject read FObject write SetObject;
115
    property UseVirtualUp: boolean read FUseVirtualUp write SetUseVirtualUp default False;
116
    property AutoUpdateObject: boolean read FAutoUpdateObject write FAutoUpdateObject default False;
117
    property MaxAngle: single read FMaxAngle write FMaxAngle;
118
    property MinAngle: single read FMinAngle write FMinAngle;
119
    property AngleLock: boolean read FAngleLock write FAngleLock default False;
120
  end;
121

122
	// TGLUserInterface
123
	//
124
	{ TGLUserInterface is the component which reads the userinput and transform it into action.
125

126
	   The four calls to get you started is
127
       
128
 	    MouseLookActivate : set us up the bomb.
129
 	    MouseLookDeActivate : defuses it.
130
	    Mouselook(deltaTime: double) : handles mouse look... Should be called in the Cadencer event. (Though it works every where!)
131
	    MouseUpdate : Resets mouse position so that you don't notice that the mouse is limited to the screen should be called after Mouselook.
132
       
133
	   The four properties to get you started are:
134
       
135
	    InvertMouse     : Inverts the mouse Y axis.
136
	    MouseSpeed      : Also known as mouse sensitivity.
137
	    GLNavigator     : The Navigator which receives the user movement.
138
	    GLVertNavigator : The Navigator which if set receives the vertical user movement. Used mostly for cameras....
139
       
140
   }
141

142
  TGLUserInterface = class(TComponent)
143
  private
144
    FPrevPoint: TGLPoint;
145
    midScreenX, midScreenY: integer;
146
    FMouseActive: boolean;
147
    FMouseSpeed: single;
148
    FGLNavigator: TGLNavigator;
149
    FGLVertNavigator: TGLNavigator;
150
    FInvertMouse: boolean;
151
    procedure MouseInitialize;
152
    procedure SetMouseLookActive(const val: boolean);
153
    procedure setNavigator(val: TGLNavigator);
154
    procedure setVertNavigator(val: TGLNavigator);
155
  protected
156
    procedure Notification(AComponent: TComponent; operation: TOperation); override;
157
  public
158
    constructor Create(AOwner: TComponent); override;
159
    destructor Destroy; override;
160
    procedure MouseUpdate;
161
    function MouseLook : Boolean;
162
    procedure MouseLookActiveToggle;
163
    procedure MouseLookActivate;
164
    procedure MouseLookDeactivate;
165
    function IsMouseLookOn: Boolean;
166
    procedure TurnHorizontal(Angle : Double);
167
    procedure TurnVertical(Angle : Double);
168
    property MouseLookActive : Boolean read FMouseActive write SetMouseLookActive;
169
  published
170
    property InvertMouse: boolean read FInvertMouse write FInvertMouse default False;
171
    property MouseSpeed: single read FMouseSpeed write FMouseSpeed;
172
    property GLNavigator: TGLNavigator read FGLNavigator write setNavigator;
173
    property GLVertNavigator: TGLNavigator read FGLVertNavigator write setVertNavigator;
174
  end;
175

176
implementation
177

178
Constructor TGLNavigator.Create(AOwner : TComponent);
179
Begin
180
  inherited;
181
  FVirtualUp := TGLCoordinates.CreateInitialized(Self, ZHmgVector, csPoint);
182
  FCurrentVAngle := 0;
183
  FCurrentHAngle := 0;
184
End;
185

186
Destructor  TGLNavigator.Destroy;
187

188
Begin
189
  FVirtualUp.Free;
190
  inherited;
191
End;
192

193

194
Procedure   TGLNavigator.SetObject(NewObject : TGLBaseSceneObject);
195
Begin
196
  If FObject <> NewObject then
197
  Begin
198
    If Assigned(FObject) then
199
      FObject.RemoveFreeNotification(Self);
200

201
    FObject := NewObject;
202
    If Assigned(FObject) then
203
    Begin
204
      if csdesigning in componentstate then
205
      Begin
206
        If VectorLength(FVirtualUp.AsVector) = 0 then
207
        Begin
208
          FVirtualUp.AsVector := FObject.Up.AsVector;
209
        End;
210
        Exit;
211
      End;
212

213
      If FUseVirtualUp Then FVirtualRight := CalcRight;
214

215
      FObject.FreeNotification(Self);
216
    End;
217
  End;
218
End;
219

220
procedure   TGLNavigator.Notification(AComponent: TComponent; Operation: TOperation);
221

222
Begin
223
  If Operation = opRemove then
224
  If AComponent = FObject then
225
    MovingObject := Nil;
226

227
  inherited;
228
End;
229

230
Function    TGLNavigator.CalcRight : TVector;
231

232
Begin
233
  If Assigned(FObject) then
234
  If FUseVirtualUp Then
235
  Begin
236
    VectorCrossProduct(FObject.Direction.AsVector, FVirtualUp.AsVector, Result);
237
    ScaleVector(Result,1/VectorLength(Result));
238
  End else VectorCrossProduct(FObject.Direction.AsVector, FObject.Up.AsVector, Result); { automaticly length(1), if not this is a bug }
239
End;
240

241
Procedure   TGLNavigator.TurnHorizontal(Angle : Single);
242

243
Var
244
  T : TVector;
245
  U : TAffineVector;
246
  TempVal : Single;
247

248

249
Begin
250
  If InvertHorizontalSteeringWhenUpsideDown and ((CurrentVAngle < -90) or (CurrentVAngle > 90)) then
251
    Angle := -Angle;
252

253
  FCurrentHAngle:=(FCurrentHAngle-Angle);
254

255
  If (FCurrentHAngle < 0) or (FCurrentHAngle > 360) then
256
  Begin
257
    TempVal := (FCurrentHAngle)/360;
258
    FCurrentHAngle :=  (TempVal-Floor(TempVal))*360;
259
  End;
260

261
  Angle := DegToRad(Angle); {make it ready for Cos and Sin }
262
  If FUseVirtualUp Then
263
  Begin
264
    SetVector(U, VirtualUp.AsVector);
265
    T := FObject.Up.AsVector;
266
    RotateVector(T,U,Angle);
267
    FObject.Up.AsVector := T;
268

269
    T := FObject.Direction.AsVector;
270
    RotateVector(T,U,Angle);
271
    FObject.Direction.AsVector := T;
272
  End else FObject.Direction.AsVector := VectorCombine(FObject.Direction.AsVector,CalcRight,Cos(Angle),Sin(Angle));
273
End;
274

275
Procedure   TGLNavigator.TurnVertical(Angle : Single);
276

277
Var
278
  ExpectedAngle : Single;
279
  CosAngle, SinAngle : Single;
280
  TempVal : Single;
281
  Direction : TVector;
282

283
Begin
284
  ExpectedAngle := FCurrentVAngle+Angle;
285
  If FAngleLock then
286
  Begin
287
    If ExpectedAngle > FMaxAngle then
288
    Begin
289
      If FCurrentVAngle = FMaxAngle then Exit;
290
      Angle := FMaxAngle-FCurrentVAngle;
291
      ExpectedAngle := FMaxAngle;
292
    End else
293
    Begin
294
      If ExpectedAngle < FMinAngle then
295
      Begin
296
        If FCurrentVAngle = FMinAngle then Exit;
297
        Angle := FMinAngle-FCurrentVAngle;
298
        ExpectedAngle := FMinAngle;
299
      End;
300
    End;
301
  End;
302
  FCurrentVAngle := ExpectedAngle;
303

304
  If (FCurrentVAngle < -180) or (FCurrentVAngle > 180) then
305
  Begin
306
    TempVal := (FCurrentVAngle+180)/360;
307
    FCurrentVAngle := (TempVal-Floor(TempVal))*360-180;
308
  End;
309

310
  Angle := DegToRad(Angle); {make it ready for Cos and Sin }
311
  SinCos(Angle,SinAngle,CosAngle);
312
  Direction := VectorCombine(MovingObject.Direction.AsVector,MovingObject.Up.AsVector,CosAngle,SinAngle);
313
  MovingObject.Up.AsVector := VectorCombine(MovingObject.Direction.AsVector,MovingObject.Up.AsVector,SinAngle,CosAngle);
314
  MovingObject.Direction.AsVector := Direction;
315
End;
316

317
Procedure   TGLNavigator.MoveForward(Distance : Single);
318
Begin
319
  If (FUseVirtualUp and (not MoveUpWhenMovingForward)) Then
320
  Begin
321
    FObject.Position.AsVector := VectorCombine(FObject.Position.AsVector,VectorCrossProduct(FVirtualUp.AsVector,CalcRight),1,Distance);
322
  End else FObject.Position.AsVector := VectorCombine(FObject.Position.AsVector,FObject.Direction.AsVector,1,Distance);
323
End;
324

325
Procedure   TGLNavigator.StrafeHorizontal(Distance : Single);
326
Begin
327
  FObject.Position.AsVector := VectorCombine(FObject.Position.AsVector,CalcRight,1,Distance);
328
End;
329

330
Procedure   TGLNavigator.StrafeVertical(Distance : Single);
331
Begin
332
  If UseVirtualUp Then
333
  Begin
334
    FObject.Position.AsVector := VectorCombine(FObject.Position.AsVector,FVirtualUp.AsVector,1,Distance);
335
  End else FObject.Position.AsVector := VectorCombine(FObject.Position.AsVector,FObject.Up.AsVector,1,Distance);
336
End;
337

338
procedure TGLNavigator.FlyForward(Distance: single);
339
begin
340
  FObject.Position.AsVector := VectorCombine(FObject.Position.AsVector, FObject.Direction.AsVector, 1, Distance);
341
end;
342

343
Procedure TGLNavigator.Straighten;
344

345
Var
346
  R : TVector;
347
  D : TVector;
348
  A : Single;
349

350
Begin
351
  FCurrentVAngle     := 0;
352
  FCurrentHAngle     := 0;
353

354
  R := CalcRight;
355
  A := VectorAngleCosine(AffineVectorMake(MovingObject.Up.AsVector), AffineVectorMake(VirtualUp.AsVector));
356
  MovingObject.Up.AsVector := VirtualUp.AsVector;
357

358
  VectorCrossProduct(R, FVirtualUp.AsVector, D);
359

360
  If A >= 0 then
361
    ScaleVector(D,-1/VectorLength(D))
362
  else
363
    ScaleVector(D,1/VectorLength(D));
364

365
  MovingObject.Direction.AsVector := D;
366
End;
367

368
Procedure   TGLNavigator.SetUseVirtualUp(UseIt : Boolean);
369

370
Begin
371
  FUseVirtualUp := UseIt;
372
  if csdesigning in componentstate then Exit;
373
  If FUseVirtualUp then FVirtualRight := CalcRight;
374
End;
375

376

377
Procedure   TGLNavigator.SetVirtualUp(Up : TGLCoordinates);
378
Begin
379
  FVirtualUp.Assign(Up);
380
  if csdesigning in componentstate then Exit;
381
  If FUseVirtualUp then FVirtualRight := CalcRight;
382
End;
383

384
Procedure   TGLNavigator.LoadState(Stream : TStream);
385

386
Var
387
  Vector : TAffineVector;
388
  B : ByteBool;
389
  S : Single;
390

391
Begin
392
  Stream.Read(Vector,SizeOf(TAffineVector));
393
  FObject.Position.AsAffineVector := Vector;
394
  Stream.Read(Vector,SizeOf(TAffineVector));
395
  FObject.Direction.AsAffineVector := Vector;
396
  Stream.Read(Vector,SizeOf(TAffineVector));
397
  FObject.Up.AsAffineVector := Vector;
398
  Stream.Read(B,SizeOf(ByteBool));
399
  UseVirtualUp := B;
400
  Stream.Read(B,SizeOf(ByteBool));
401
  FAngleLock := B;
402
  Stream.Read(S,SizeOf(Single));
403
  FMaxAngle := S;
404
  Stream.Read(S,SizeOf(Single));
405
  FMinAngle := S;
406
  Stream.Read(S,SizeOf(Single));
407
  FCurrentVAngle := S;
408
  Stream.Read(S,SizeOf(Single));
409
  FCurrentHAngle := S;
410
End;
411

412
Procedure   TGLNavigator.SaveState(Stream : TStream);
413

414
Var
415
  Vector : TAffineVector;
416
  B : ByteBool;
417
  S : Single;
418

419
Begin
420
  Vector := FObject.Position.AsAffineVector;
421
  Stream.Write(Vector,SizeOf(TAffineVector));
422
  Vector := FObject.Direction.AsAffineVector;
423
  Stream.Write(Vector,SizeOf(TAffineVector));
424
  Vector := FObject.Up.AsAffineVector;
425
  Stream.Write(Vector,SizeOf(TAffineVector));
426
  B := UseVirtualUp;
427
  Stream.Write(B,SizeOf(ByteBool));
428
  B := FAngleLock;
429
  Stream.Write(B,SizeOf(ByteBool));
430
  S := FMaxAngle;
431
  Stream.Write(S,SizeOf(Single));
432
  S := FMinAngle;
433
  Stream.Write(S,SizeOf(Single));
434
  S := FCurrentVAngle;
435
  Stream.Write(S,SizeOf(Single));
436
  S := FCurrentHAngle;
437
  Stream.Write(S,SizeOf(Single));
438
End;
439

440
function TGLUserInterface.IsMouseLookOn: Boolean;
441
begin
442
   Result:=FMouseActive;
443
end;
444

445
Procedure   TGLUserInterface.TurnHorizontal(Angle : Double);
446

447
Begin
448
  GLNavigator.TurnHorizontal(Angle);
449
End;
450

451
Procedure   TGLUserInterface.TurnVertical(Angle : Double);
452

453
Begin
454
  If Assigned(GLVertNavigator) then GLVertNavigator.TurnVertical(Angle)
455
  else GLNavigator.TurnVertical(Angle);
456
End;
457

458
procedure TGLUserInterface.MouseLookActiveToggle;
459
begin
460
   if FMouseActive then
461
      MouseLookDeactivate
462
   else MouseLookActivate;
463
end;
464

465
procedure TGLUserInterface.MouseLookActivate;
466
begin
467
   if not FMouseActive then begin
468
      FMouseActive := True;
469
      MouseInitialize;
470
      GLShowCursor(False);
471
   end;
472
end;
473

474
procedure TGLUserInterface.MouseLookDeactivate;
475
begin
476
   if FMouseActive then begin
477
      FMouseActive := False;
478
      GLShowCursor(True);
479
   end;
480
end;
481

482
procedure TGLUserInterface.MouseInitialize;
483
begin
484
   midScreenX:=GLGetScreenWidth div 2;
485
   midScreenY:=GLGetScreenHeight div 2;
486

487
   FPrevPoint.x:=midScreenX; FPrevPoint.Y:=midScreenY;
488
   GLSetCursorPos(midScreenX, midScreenY);
489
end;
490

491
// SetMouseLookActive
492
//
493
procedure TGLUserInterface.SetMouseLookActive(const val : Boolean);
494
begin
495
   if val<>FMouseActive then
496
      if val then
497
         MouseLookActivate
498
      else MouseLookDeactivate;
499
end;
500

501
procedure TGLUserInterface.MouseUpdate;
502
begin
503
   if FMouseActive then
504
     GLGetCursorPos(FPrevPoint);
505
end;
506

507
// Mouselook
508
//
509
function  TGLUserInterface.Mouselook : Boolean;
510
var
511
   deltaX, deltaY : Single;
512
begin
513
   Result := False;
514
   if not FMouseActive then exit;
515

516
   deltax:=(FPrevPoint.x-midscreenX)*mousespeed;
517
   deltay:=-(FPrevPoint.y-midscreenY)*mousespeed;
518
   If InvertMouse then deltay:=-deltay;
519

520
   if deltax <> 0 then begin
521
     TurnHorizontal(deltax*0.01);
522
     result := True;
523
   end;
524
   if deltay <> 0 then begin
525
     TurnVertical(deltay*0.01);
526
     result := True;
527
   end;
528

529
   if (FPrevPoint.x <> midScreenX) or (FPrevPoint.y <> midScreenY) then
530
      GLSetCursorPos(midScreenX, midScreenY);
531
end;
532

533
Constructor TGLUserInterface.Create(AOwner : TComponent);
534
Begin
535
  inherited;
536
  FMouseSpeed :=0;
537
  FMouseActive:=False;
538
  midScreenX:=GLGetScreenWidth div 2;
539
  midScreenY:=GLGetScreenHeight div 2;
540
  FPrevPoint.x:=midScreenX; FPrevPoint.Y:=midScreenY;
541
End;
542

543
Destructor  TGLUserInterface.Destroy;
544

545
Begin
546
  if FMouseActive then MouseLookDeactivate; // added by JAJ
547
  inherited;
548
End;
549

550
procedure TGLUserInterface.Notification(AComponent: TComponent; operation:
551
    TOperation);
552
begin
553
     if operation = opRemove then begin
554
          if AComponent = FGLNavigator then
555
               setNavigator(nil);
556
          if AComponent = FGLVertNavigator then
557
               setVertNavigator(nil);
558
     end;
559
     inherited;
560
end;
561

562
procedure TGLUserInterface.setNavigator(val: TGLNavigator);
563
begin
564
     if assigned(FGLNavigator) then FGLNavigator.RemoveFreeNotification(self);
565
     FGLNavigator:= val;
566
     if assigned(val) then val.FreeNotification(self);
567
end;
568

569
procedure TGLUserInterface.setVertNavigator(val: TGLNavigator);
570
begin
571
     if assigned(FGLVertNavigator) then FGLVertNavigator.RemoveFreeNotification(self);
572
     FGLVertNavigator:= val;
573
     if assigned(val) then val.FreeNotification(self);
574
end;
575

576
end.
577