Kamera (2): Unterschied zwischen den Versionen

Version vom 5. Februar 2008, 06:00 Uhr

Eine Beschreibung findet ihr unter Kamera (1).
Die verwendete Toolsammlung findet ihr unter Kamera (3).

{******************************************************************}
(*
  Released as part of the camera example program
  Visit us @ http://www.delphigl.com
  Maintained by Florian Sievert (Phobeus)
  Phobeus@DelphiGL.com
-------------------------------------------------------------------
  License
  -------
  Copyright (C) 2007 Andree Heyroth

  This license applies to everything on www.delphigl.com, except where
  otherwise noted.

  This software is provided 'as-is', without any express or implied warranty.
  In no event will the authors be held liable for any damages arising from
  the use of this software.

  Permission is granted to anyone to use this software for any purpose,
  including commercial applications, and to alter it and redistribute it
  freely, subject to the following restrictions:

  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software in a
     product, an acknowledgment in the product documentation would be
     appreciated but is not required.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. This notice may not be removed or altered from any source distribution.

  Description
  -----------
  Component containing methods and properties which are useful for moving and
  rotating an existing scene in any dimension (yaw, pitcxh and roll/vertical,
  horizontal and depth).

  Requirements
  ------------
  - SDL 1.2 (http://www.libsdl.org/download-1.2.php or your distribution)
  - Borland Delphi version 5.0 and above

  History
  -------
  see below (unfortunately in german)

  Contact
  -------
  I created this source code in my spare time. If you find a bug or just
  wanna say hello, feel free to write to the contributor:

    Andree Heyroth (AndyH)
    email : heyroth@syncro-concept.de
    Visit: http://www.delphigl.com

*******************************************************************************)

// Wie ich selber immer wieder merken muss, ist eine Software anscheinend
// nie fertig. Immer moechte man etwas verbessern oder neue Features
// einbauen.
// Sollte also jemand Änderungs- oder Verbesserungsvorschläge haben oder
// neue Ideen einbringen wollen, oder sollten Verstaendnisfragen bestehen,
// so mailt bitte an
//
// heyroth@syncro-concept.de
//
// Danke.
//
// Updates:
//
// 06.11.2005
// Die Deklaration der DESTROY Methode war falsch. Das fuehrte dazu,
// dass in der Methode CREATE erzeugte Objekte nicht richtig frei-
// gegeben wurden und es zu EAccessViolations kam. Die Methode wird
// jetzt in der PUBLIC Section mit der Direktive OVERRIDE aufgerufen.
//
// 11.11.2005
// Die Positionierung funktioniert jetzt.
// Wegen eines Verstaendnisproblems wurden die Positionen immer auf den
// Kamerapunkt aufaddiert. Das bedeutete, dass die Positionierung aus
// dem Ruder lief wenn sie nicht im Nullpunkt stattfand. Je groesser die
// gewuenschte Position war um so groesser war die Abweichung von der
// Darstellung.
// Ich habe nicht bedacht, dass bei einer "Kamera"-bewegung und -drehung
// ja eigentlich die Szene bewegt und gedreht wird. Deswegen wurden nach
// einer Positionierung die folgenden Projektionen immer basierend auf der
// danach gueltigen Kameraposition gemacht.
// Jetzt wird die Position so gesetzt, dass die gewuenschte Kameraposition
// immer vor dem Betrachter steht.
//
// 23.11.2005
// Neues Flag (FFixedAxis) zur Entscheidung zwischen angepasster und realer
// Drehung. Dadurch wird das Bewegungsmodell angepasst. Siehe Methode Offset,
// bzw. UpdateMatrixOffset.
//
// 10.12.2005
// Property PointOfRotation ist jetzt nicht mehr ReadOnly.
// Der Blickpunkt bzw. Rotationspunkt kann jetzt direkt verändert werden.
// So kann eine neue Blickrichtung angenommen werden ohne vorher die Kamera-
// eigenschaften zu sichern und nach einem PositionCamera wieder zu setzen.
//
// 19.12.2005
// Neue Methode PositionCross.
// Die Methode PositionCross schiebt das Fadenkreuz in den angegebenen Punkt
// ohne die Lage der Szene zu verändern. Diese Funktionalitaet ist anders als
// ein neues Setzen der Property FPointOfRotation weil dabei die Szene in das
// Koordinatenkreuz geschoben wird.
//
// 31.01.2006
// Umstellung auf genaueres Zahlenformat
// Da die Darstellung von Szenen ausserhalb des Bereichs von FLOAT-Zahlen
// nicht funktioniert, muss alles auf DOUBLE umgestellt werden. Dazu gehört
// das Ersetzen von Datentypen und der Aufruf der entsprechenden GL-Funktionen.
//
// 24.09.2007
// Um den Einstieg zu erleichtern habe ich die ganzen Steuerfunktionen in die
// Kamera verlegt. Die "normalen" Funktionen wie Drehen und Verschieben werden
// jetzt durch Weitergabe der Tastendrücke und Mauseigenschaften an die
// Kamera abgearbeitet. Die Auswertung erfolgt dort. Sollten andere Tasten
// als die von mir vorgesehenen gewünscht sein, muss dies in der Kamera
// geändert werden.

unit Camera;

interface

  Uses
    DglOpenGL,
    Util,
    Windows,
    Classes,
    Messages,
    Controls;

  type
  TCameraMatrix=Class
    StackMatrix: array [0..9] of TArrMatrix;
    StackCtr: integer;
    Matrix: TArrMatrix;
    InverseMatrix: TArrMatrix;
    constructor Create;
    //destructor destroy;
    procedure Identity;
    procedure Push;
    procedure Pop;
    procedure Load(M: TArrMatrix);
  end;

  TCamera=Class
    Enabled: boolean;
    function UpVector: TGLvector;
    procedure RestorePosition(pos: integer);
    procedure SavePosition(pos: integer);
    function GiveStoredPosition(pos: integer): TGLvector;
    procedure RotateCamera(ix, iy, iz: GLdouble);
    procedure TranslateCamera(ix, iy, iz: GLdouble);
    procedure CameraHome;
    procedure PositionCamera(PositionVec: TGLvector; ViewVec: TGLvector; upVec: TGLvector);
    procedure Adjust;
    procedure Apply;
    procedure ApplyForTerrain;
  private
    // Dreh- und Bewegungsrichtung festlegen (in Mousedown).
    // Pfeil hoch  : Szene nach oben
    // Pfeil runter: Szene nach unten
    // Pfeil rechts: Szene nach rechts
    // Pfeil links : Szene nach links
    // Page Up     : Szene in den Bildschirm schieben (verkleinern)
    // Page Down   : Szene aus dem Bildschirm schieben (vergrößern)
    //
    // Wird FDir auf true gesetzt ist die Tastenfunktion jeweils umgekehrt.
    // so verschiebt sich entweder die szene oder das objekt.
    FDir: boolean;
    FPosition: TGLvector;
    FViewDirection: TGLvector;

    FAltPressed,
    FShiftPressed,
    FCtrlPressed: boolean;

    FRightMousePressed: boolean;
    FLeftMousePressed: boolean;

    FSpeedMultiplier: double;

    FxStart,                  // berechnung der mausbewegungen.
    FxDelta,                  // delta = aktuelle position minus start
    FyStart,                  // start wird erfasst sobald eine maustaste
    FyDelta:integer;          // gedrückt wird.
    FxRot,                    // umrechnung von delta in rotation wenn
    FyRot:double;             // drehung gewünscht ist (je nach taste)

    FPointOfRotation: TGLvector;
    HomeMatrix: TCameraMatrix;
    CameraMatrix: TCameraMatrix;
    Initiated: boolean;
    PosArray: array [0..9] of TCameraMatrix;
    RotArray: array [0..9] of TGLvector;
    FFixedAxis: boolean;
    procedure Debug (Text: string);
    function UpdateMatrixOffset(newMatrix: TArrMatrix): TArrMatrix;
    function GetViewDirection: TGLvector;
    procedure SetViewDirection (View: TGLvector);
    procedure Initiate;
    function GetPosition: TGLvector;
    procedure SetPosition (Pos: TGLvector);
    procedure Identity;
    procedure Offset(x, y, z: GLdouble);
    procedure RotateRoundAxis(rx, ry, rz: GLdouble);
    procedure SetPointOfRotation (NewPoint: TGLvector);
    function ProcessArrowKeys (Key: integer; Shift: TShiftState): boolean;
    function GiveSpeed: TGLdouble;
    procedure RotateScene(Direction: byte; Geschwindigkeit: GLdouble);
    procedure MoveScene (Direction: byte; Geschwindigkeit: GLdouble);
  public
    constructor Create;
    destructor Destroy;override;
    function InverseMatrix: TArrMatrix;
    procedure ApplyInvers;
    procedure PositionCross(CrossVec: TGLvector);
    function HandleKeyboardInput (Key: Word; Shift: TShiftState): boolean;
    procedure KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    function KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState): boolean;
    procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    function MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer): boolean;
    function MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean): boolean;
    procedure MouseEnter(var msg:TMessage);
    procedure MouseLeave(var msg: TMessage);
  published
    property PointOfRotation: TGLvector read FPointOfRotation write SetPointOfRotation;
    property Position: TGLvector read GetPosition write SetPosition;
    property ViewDirection: TGLvector read GetViewDirection write SetViewDirection;
    property FixedAxis: boolean read FFixedAxis write FFixedAxis;
    property SpeedMultiplier: double read FSpeedMultiplier write FSpeedMultiplier;
  end;
  TPCamera=^TCamera;

var
  FDebugFile: Textfile;
  FDebugFileName: string;
  FDebugOn: boolean;

const
  VK_0 = $30;
  VK_1 = $31;
  VK_2 = $32;
  VK_3 = $33;
  VK_4 = $34;
  VK_5 = $35;
  VK_6 = $36;
  VK_7 = $37;
  VK_8 = $38;
  VK_9 = $39;

  VK_A = $41;
  VK_B = $42;
  VK_C = $43;
  VK_D = $44;
  VK_E = $45;
  VK_F = $46;
  VK_G = $47;
  VK_H = $48;
  VK_I = $49;
  VK_J = $4A;
  VK_K = $4B;
  VK_L = $4C;
  VK_M = $4D;
  VK_N = $4E;
  VK_O = $4F;
  VK_P = $50;
  VK_Q = $51;
  VK_R = $52;
  VK_S = $53;
  VK_T = $54;
  VK_U = $55;
  VK_V = $56;
  VK_W = $57;
  VK_X = $58;
  VK_Y = $59;
  VK_Z = $5A;

  // Standard-Keycodes für Tastatureingaben definieren
  CKeyCameraHome = VK_0;
  CKeyCameraAdjust = VK_A;

  DIR_HORIZONTAL: byte = 1;
  DIR_VERTIKAL: byte = 2;
  DIR_ZENTRAL: byte = 3;

implementation

uses SysUtils;

constructor TCameraMatrix.Create;
begin
  inherited create;
  StackCtr := 0;
end;

procedure TCameraMatrix.Push;
begin
  if (StackCtr > -1) and (StackCtr < 10) then begin
    StackMatrix[StackCtr] := Matrix;
    inc (StackCtr);
  end;
end;

procedure TCameraMatrix.Pop;
begin
  if (StackCtr > 0) and (StackCtr < 11) then begin
    dec (StackCtr);
    Load (StackMatrix[StackCtr]);
  end;
end;

procedure TCameraMatrix.Identity;
// GetIdentity: aus OpenGL.pas
// initialisiert die CameraMatrix mit der Identitaetsmatrix
begin
  Matrix := GetIdentity(Matrix);
  InverseMatrix := GetIdentity(InverseMatrix);
end;

procedure TCameraMatrix.Load(M: TArrMatrix);
// die Matrix mit den Werten einer beliebigen anderen matrix fuellen
var
  i: integer;
begin
  for i:=0 to 15 do
    Matrix[i]:=M[i];
  // die invertierte Matrix kann benutzt werden um Objkekte z.B.
  // immer zum Benutzer auszurichten
  InvertMatrix (M, InverseMatrix);
end;

constructor TCamera.Create;
var
  i: integer;
begin
  inherited create;

  // Initiated wird gebraucht um einmal alle Positionsspeicher
  // mit der Anfangsposition zu belegen
  Initiated := false;

  // Kameramatrix anlegen
  CameraMatrix := TCameraMatrix.Create;

  // Matrix der letzten Position von PositionCamera anlegen
  HomeMatrix := TCameraMatrix.Create;

  // Positionsspeicher anlegen
  for i := 0 to 9 do
    PosArray[i] := TCameraMatrix.Create;

  // standardmaessig immer entlang der bildschirmachsen verschieben
  FFixedAxis := true;

  // flags für die tasten alt, ctrl und shift initialisieren
  FAltPressed := false;
  FCtrlPressed := false;
  FShiftPressed := false;

  // normalerweise wird die geschwindigkeit nicht verändert
  FSpeedMultiplier := 1.0;

  // normale bildschirmbewegung
  FDir := false;
end;

destructor TCamera.Destroy;
// alle in create belegten Resourcen wieder freigeben
var
  i: integer;
begin
  FreeAndNil (CameraMatrix);
  FreeAndNil (HomeMatrix);
  for i := 0 to 9 do
    FreeAndNil (PosArray[i]);

  inherited destroy;
end;

procedure TCamera.RotateRoundAxis(rx, ry, rz: GLdouble);
// hier drehen wir jetzt um die einzelnen Achsen.
// die Parameter geben die "Drehgeschwindigkeit" vor.
var
  newMatrix: TArrMatrix;
  tempX, tempY, tempZ: TGLvector;
begin
  glMatrixMode (GL_MODELVIEW);
  glPushMatrix();

  // aktuelle Position und Lage der Kamera herstellen
  glLoadMatrixd(@CameraMatrix.Matrix);

  if FFixedAxis then begin
    // über die bildschirmachsen drehen
    tempX := GetMatrixX (CameraMatrix.InverseMatrix);
    tempY := GetMatrixY (CameraMatrix.InverseMatrix);
    tempZ := GetMatrixZ (CameraMatrix.InverseMatrix);
    // wenn gewuenscht um die X-Achse drehen
    if(rx <> 0) then
      glRotated(rx,tempX.X,tempX.Y,tempX.Z);

    // wenn gewuenscht um die Y-Achse drehen
    if(ry <> 0) then
      glRotated(ry,tempY.X,tempY.Y,tempY.Z);

    // wenn gewuenscht um die Z-Achse drehen
    if(rz <> 0) then
      glRotated(rz,tempZ.X,tempZ.Y,tempZ.Z);
  end
  else begin
    // über die achsen des koordinatenkreuzes drehen
    // wenn gewuenscht um die X-Achse drehen
    if(rx <> 0) then
      glRotated(rx,1,0,0);

    // wenn gewuenscht um die Y-Achse drehen
    if(ry <> 0) then
      glRotated(ry,0,1,0);

    // wenn gewuenscht um die Z-Achse drehen
    if(rz <> 0) then
      glRotated(rz,0,0,1);
  end;

  // die neu erzeugte Matrix auslesen
  glGetDoublev(GL_MODELVIEW_MATRIX, @newMatrix);

  glPopMatrix();

  // und in die Kameramatrix sichern
  CameraMatrix.Load(newMatrix);
end;

procedure TCamera.Identity;
begin
  CameraMatrix.Identity;
  HomeMatrix.Identity;

  Enabled := true;
end;

procedure TCamera.Offset(x, y, z: GLdouble);
// verschieben der Kamera auf einer beliebigen Achse
var
  newMatrix: TArrMatrix;
  //OldView: TGLvector;
begin
  Debug ('- Offset - Start --------------------------------------------------');
  glMatrixMode (GL_MODELVIEW);

  glPushMatrix();
  glLoadIdentity;
  glTranslated(x,y,z);
  glGetDoublev(GL_MODELVIEW_MATRIX, @newMatrix);
  glPopMatrix();

  Debug ('Position: '+GLvectorToText (GetMatrixPos (newMatrix)));
  newMatrix := UpdateMatrixOffset (newMatrix);
  CameraMatrix.Load(newMatrix);
  Debug ('- Offset - Ende- --------------------------------------------------');
end;

procedure TCamera.PositionCamera(PositionVec: TGLvector;
			                           ViewVec: TGLvector;
			                           upVec: TGLvector);
var
  newMatrix: TArrMatrix;
  i: integer;
  P, V, U: TGLvector;
  Laenge: GLdouble;
begin
  Debug ('- PositionCamera - Start ------------------------------------------');
  // die gewuenschte konstruktion immer auf die Z-ebene projizieren.
  // zuerst die position in den nullpunkt holen
  InitVector (P, 0, 0, 0);
  // jetzt den viewpoint um den gleichen betrag reduzieren, damit
  // die gerade parallel verschoben wird.
  V := SubtractVector (ViewVec, PositionVec);
  // U ist halt schneller geschrieben als upVec...
  U := upVec;

  // den betrag ermitteln, um den die kamera nachher auf der Z-Achse
  // verschoben werden muss
  Laenge := Magnitude (SubtractVector (P, V));

  Identity;

  glMatrixMode (GL_MODELVIEW);
  glPushMatrix;
  glLoadIdentity;

  // glulookat wird die matrix parallel zur Z-achse ausrichten
  gluLookAt (P.X, P.Y, P.Z, V.X, V.Y, V.Z, U.X, U.Y, U.Z);
  glGetDoublev(GL_MODELVIEW_MATRIX, @newMatrix);
  glPopMatrix;

  CameraMatrix.Load(newMatrix);
  HomeMatrix.Load(newMatrix);

  // da wir uns jetzt am zielpunkt befinden, müssen wir auf der Z-achse
  // wieder zurueck zur kameraposition
  Offset (0, 0, -Laenge);

  // alle positionsspeicher mit der Kameraposition, Blickrichtung
  // und dem upVector belegen. Nur beim ersten Aufruf von
  // PositionCamera
  if not Initiated then
    Initiate;

  FPointOfRotation := ViewVec;
  Debug ('PointOfRotation: '+GLvectorToText (FPointOfRotation));
  Debug ('- PositionCamera - Ende -------------------------------------------');
end;

procedure TCamera.PositionCross (CrossVec: TGLvector);
// diese prozedur verschiebt, im gegensatz zu einem verändern von
// PointOfRotation, das Koordinatenkreuz und nicht die Szene.
var
  newMatrix: TArrMatrix;
  PosDiff: TGLvector;
begin
  Debug ('- PositionCross - Start -------------------------------------------');

  PosDiff := SubtractVector (FPointOfRotation, CrossVec);

  // Szene in das koordinatenkreuz verschieben
  FPointOfRotation := CrossVec;

  // jetzt die Szene wieder um den gleichen betrag zurückverschieben
  // das sieht dann so aus, als ob das koordinatenkreuz verschoben
  // worden wäre
  // zuerst die aktuelle neue Situation herstellen
  // (mit neuem FPointOfRotation)
  Apply;

  // jetzt um den Differenzbetrag des alten und neuen
  // Rotationspunkts zurück verschieben
  glTranslated (-PosDiff.X, 0, 0);
  glTranslated (0, -PosDiff.Y, 0);
  glTranslated (0, 0, -PosDiff.Z);

  // jetzt vom neuen Rotationspunktes zurück ins Zentrum, damit beim
  // nächsten Apply das glTranslatef (-FPointOfRotation, ...) klappt
  glTranslated (CrossVec.X, 0, 0);
  glTranslated (0, CrossVec.Y, 0);
  glTranslated (0, 0, CrossVec.Z);

  // aktuelle Matrix holen...
  glGetDoublev(GL_MODELVIEW_MATRIX, @newMatrix);

  // und als Kameramatrix abspeichern
  CameraMatrix.Load(newmatrix);
  Debug ('- PositionCross - Ende --------------------------------------------');
end;

procedure TCamera.CameraHome;
// Kamera in die beim letzten Aufruf von PositionCamera uebergebene
// Position/Lage bringen
begin
  CameraMatrix.Load(HomeMatrix.Matrix);
end;

procedure TCamera.SavePosition (pos: integer);
// wie der Prozedurname schon sagt...
begin
  if (pos < 0) or (pos > 9) then
    exit;

  PosArray[pos].Load(CameraMatrix.Matrix);
  RotArray[pos] := FPointOfRotation;
end;

procedure TCamera.RestorePosition (pos: integer);
// wie der Prozedurname schon sagt...
begin
  if (pos < 0) or (pos > 9) then
    exit;

  CameraMatrix.Load(PosArray[pos].Matrix);
  FPointOfRotation := RotArray[pos];
end;

function TCamera.GiveStoredPosition (pos: integer): TGLvector;
// gibt den Inhalt des durch pos bestimmten
// Positionsspecihers zurueck
begin
  if (pos < 0) or (pos > 9) then
    exit;

  result := GetMatrixPos (PosArray[pos].Matrix);
end;

procedure TCamera.TranslateCamera(ix, iy, iz: GLdouble);
// vom Benutzer aufzurufende Methode um eine Verschiebung
// durchzufuehren
begin
  Offset (ix, iy, iz);
end;

procedure TCamera.RotateCamera(ix, iy, iz: GLdouble);
// vom Benutzer aufzurufende Methode um eine Drehung
// durchzufuehren
begin
  RotateRoundAxis (-iy, -ix, -iz);
end;

procedure TCamera.Apply;
// hier wird die Kamera eingeschaltet. Nach dem Aufruf dieser Prozedur
// sollte die Szene mit allen benoetigten Drehungen, Verschiebungen
// gezeichnet werden.
begin
  if not Enabled then
    exit;

  glMatrixMode (GL_MODELVIEW);
  glLoadMatrixd(@CameraMatrix.Matrix);
  glTranslated (-FPointOfRotation.X,
                -FPointOfRotation.y,
                -FPointOfRotation.Z);
end;

procedure TCamera.ApplyForTerrain;
// hier wird wie in Apply die Kamera eingeschaltet. da man um ein terrain
// (skycube, ...) anzuzeigen aber immer die gleiche entfernung zur welt
// einhalten muss, wird hier nur gedreht und nicht verschoben.
var
  pos: TGLvector;
begin
  if not Enabled then
    exit;

  glMatrixMode (GL_MODELVIEW);
  // für das Terrain nur die Drehung ausführen
  glLoadMatrixd(@CameraMatrix.Matrix);
  // deswegen jetzt die verschiebung zurücknehmen
  Pos := GetMatrixPos (CameraMatrix.InverseMatrix);
  glTranslated (Pos.X, Pos.Y, Pos.Z);
end;

function TCamera.GetPosition: TGLvector;
// diese Property-Funktion fragt die aktuelle Position der Kamera ab
begin
  // position: letzte Spalte der Matrix
  result := AddVector (GetMatrixPos (CameraMatrix.InverseMatrix), FPointOfRotation);
end;

procedure TCamera.SetPosition (Pos: TGLvector);
// diese Property-Funktion setzt eine neue Position der Kamera
var
  m: TArrMatrix;
begin
  // position: letzte Spalte der Matrix
  m := CameraMatrix.Matrix;
  SetMatrixPos (m, SubtractVector (Pos, FPointOfRotation));
  CameraMatrix.Load (m);
end;

function TCamera.GetViewDirection: TGLvector;
// mit dieser Funktion kann die aktuelle Blickrichtung der Kamera
// abgefragt werden
var
  return: TGLvector;
begin
  // view direction: dritte Spalte der Matrix (Z-Achse)
  result := GetMatrixZ (CameraMatrix.InverseMatrix);
end;

procedure TCamera.SetViewDirection (View: TGLvector);
// mit dieser Funktion kann die aktuelle Blickrichtung der Kamera
// gesetzt werden
begin
  // view direction: dritte Spalte der Matrix (Z-Achse)
  SetMatrixZ (CameraMatrix.InverseMatrix, View);
end;

function TCamera.UpVector: TGLvector;
// mit dieser Funktion kann die aktuelle Ausrichtung der Kamera
// abgefragt werden
var
  return: TGLvector;
begin
  // upVector: zweite Spalte der Matrix (Y-Achse)
  result := GetMatrixY (CameraMatrix.InverseMatrix);
end;

procedure TCamera.Adjust;
// mit dieser Prozedur kann die Kamera zu jeder Zeit, unabhaengig
// von Drehung und Position, zur Y-Achse ausgerichtet werden.
// Die aktuelle Position wird dabei beibehalten.
var
  m: TArrMatrix;
  v: TGLvector;
begin
  // position aus der aktuellen cameramatrix holen
  v := GetMatrixPos (CameraMatrix.Matrix);
  // m mit identitätsmatrix initialisieren
  m := GetIdentity(m);
  // die position aus der aktuellen cameramatrix in m speichern
  SetMatrixPos (m, v);
  // m als aktuelle cameramatrix speichern
  CameraMatrix.Load(m);
end;

function TCamera.InverseMatrix: TArrMatrix;
begin
  result := CameraMatrix.InverseMatrix;
end;

procedure TCamera.Initiate;
var
  i: integer;
begin
  for i := 0 to 9 do
    SavePosition (i);
  Initiated := true;
end;

function TCamera.UpdateMatrixOffset (newMatrix: TArrMatrix): TArrMatrix;
begin
  // wenn ich mit Multiply (FixedAxis) arbeite, wird die zeichnung immer
  // entlang der bildschirmachsen verschoben. wenn ich Multiply, version 2
  // nehme, wird sie auf den errechneten achsen verschoben.
  if FFixedAxis then begin
    result := Multiply (newMatrix, CameraMatrix.Matrix);
  end
  else begin
    result := Multiply (CameraMatrix.Matrix, newMatrix);
  end;
end;

procedure TCamera.SetPointOfRotation (NewPoint: TGLvector);
// setzt den viewpoint oder rotationpoint  ohne die anderen parameter zu
// veraendern. so kann man z.B. eine Kamerafahrt in immer der gleichen
// position simulieren.
begin
  FPointOfRotation := NewPoint;
end;

procedure TCamera.Debug (Text: string);
begin
  if not FDebugOn then
    exit;
  writeln (FDebugFile, DateToStr (date) + ' | ' +
                       TimeToStr (time) + ' | ' +
                       Text);
end;

procedure TCamera.ApplyInvers;
var
  M: TArrMatrix;
begin
  // Um Objekte immer zum benutzer ausrichten, darf nur die drehung angewendet
  // werden und nicht die verschiebung. Verschiebung wird hier zurückgenommen.
  // Vorher muss die Kamera angewendet und die nötigen Verschiebungen/
  // Drehungen ausgeführt werden.
  M := InverseMatrix;
  M[12] := 0;
  M[13] := 0;
  M[14] := 0;
  M[15] := 1;
  glMultMatrixd(@M);
end;

function TCamera.HandleKeyboardInput (Key: Word; Shift: TShiftState): boolean;
// diese funktion sollte zur steuerung des bildschirmablaufs gewählt werden,
// wenn nicht auf die tasteneingabe gewartet wird (bildschirmaufbau nach
// timer-event).
// in der Timermethode zB.:
// if FCamera.HandleDeviceInput then
//   Render;  // oder wie die routine bei euch heißt ...
begin
  result := false;

  if not FAltPressed then FAltPressed := ssAlt in Shift;
  if not FCtrlPressed then FCtrlPressed := ssCtrl in Shift;
  // das mit Key=16 ist ´ne krücke, aber sendmessage mit VK_SHIFT klappt
  // bei mir nicht!
  if not FShiftPressed then FShiftPressed := (ssShift in Shift) or (Key = 16);

  case Key of
    CKeyCameraHome:           // (ausgangsposition)
    begin
      if not (FAltPressed or FCtrlPressed or FShiftPressed) then begin
        CameraHome;
        result := true;
      end;
    end;

    CKeyCameraAdjust:
    begin                     // (ausrichten)
      Adjust;
      result := true;
    end;

    VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT:
      result := ProcessArrowKeys (Key, Shift);
  else                        // case
    if (Key > $29) and (Key < $40) then begin   // 0 - 9
      if FAltPressed then begin                 // position speichern?
        SavePosition(Key-48);
        result := true;
      end;
      if FShiftPressed then begin
        RestorePosition(Key-48);
        result := true;
      end;
    end;
  end;


end;

function TCamera.ProcessArrowKeys (Key: integer; Shift: TShiftState): boolean;
// arbeitet die für die jeweiligen kameraaktionen definierten tastendrücke
// ab. hierbei werden wie gewünscht die kameraeigenschaften geändert:
// lage, position, ...
var
  POR: TGLVector;
  nDir: double;
begin
  result := false;

  nDir := 1.0*FSpeedMultiplier;
  if FDir then
    nDir := -1.0;

  case Key of
  VK_UP:            // Szene aus dem Drehpunkt entlang der vertikalen
  begin             // verschieben
    if ssShift in Shift then begin
      RotateScene (DIR_HORIZONTAL, GiveSpeed*-1.0);
    end else begin
      POR := PointOfRotation;
      POR.Y := POR.Y + nDir;
      PointOfRotation := POR;
    end;
    result := true;
  end;
  VK_DOWN:          // Szene aus dem Drehpunkt entlang der vertikalen
  begin             // verschieben
    if ssShift in Shift then begin
      RotateScene (DIR_HORIZONTAL, GiveSpeed);
    end else begin
      POR := PointOfRotation;
      POR.Y := POR.Y - nDir;
      PointOfRotation := POR;
    end;
    result := true;
  end;
  VK_LEFT:          // Szene aus dem Drehpunkt entlang der horizontalen
  begin             // verschieben
    if ssShift in Shift then begin
      RotateScene (DIR_VERTIKAL, GiveSpeed*-1.0);
    end else begin
      POR := PointOfRotation;
      POR.X := POR.X - nDir;
      PointOfRotation := POR;
    end;
    result := true;
  end;
  VK_RIGHT:         // Szene aus dem Drehpunkt entlang der horizontalen
  begin             // verschieben
    if ssShift in Shift then begin
      RotateScene (DIR_VERTIKAL, GiveSpeed);
    end else begin
      POR := PointOfRotation;
      POR.X := POR.X + nDir;
      PointOfRotation := POR;
    end;
    result := true;
  end;
  VK_PRIOR:         // Szene aus dem Drehpunkt entlang der Bildschirmachse
  begin             // verschieben
    if ssShift in Shift then begin
      RotateScene (DIR_ZENTRAL, GiveSpeed*-1.0);
    end else begin
      POR := PointOfRotation;
      POR.Z := POR.Z - nDir;
      PointOfRotation := POR;
    end;
    result := true;
  end;
  VK_NEXT:          // Szene aus dem Drehpunkt entlang der Bildschirmachse
  begin             // verschieben
    if ssShift in Shift then begin
      RotateScene (DIR_ZENTRAL, GiveSpeed);
    end else begin
      POR := PointOfRotation;
      POR.Z := POR.Z + nDir;
      PointOfRotation := POR;
    end;
    result := true;
  end;
  end;
end;

procedure TCamera.KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
// überprüfen ob eine sondertaste wieder losgelassen wurde
begin
  if not (ssAlt in Shift) then
    FAltPressed := false;
  if not (ssCtrl in Shift) then
    FCtrlPressed := false;
  if not (ssAlt in Shift) then
    FShiftPressed := false;
end;

function TCamera.KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState): boolean;
var
  POR: TGLVector;
begin
  // hier werden die aktionen für die angezeigten tastenbelegungen
  // umgesetzt
  result := false;

  // wie bei den maustasten: merken, ob eine sondertaste gedrückt
  // wurde um feststellen zu können ob diese gehalten wird. in
  // KeyUp wird der zustand entsprechend zurückgesetzt.
  if not FAltPressed then FAltPressed := ssAlt in Shift;
  if not FCtrlPressed then FCtrlPressed := ssCtrl in Shift;
  if not FShiftPressed then FShiftPressed := (ssShift in Shift);

  case key of
  ord ('A'):        // Szene zum Benutzer ausrichten. Position wird
  begin             // nicht verändert
    Adjust;
    result := true;
  end;
  VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT:
    result := ProcessArrowKeys (Key, Shift);
  ord('0'):         // den Drehpunkt in den Nullpunkt schieben. Die
  begin             // Kameraposition bleibt unverändert.
    InitVector (POR, 0, 0, 0);
    PointOfRotation := POR;
    result := true;
  end;
  ord('I'):         // Dreh- und Bewegungsrichtung umschalten
  begin
    FDir := not FDir;
    result := true;
  end;
  ord('U'):         // Umschalten zwischen Drehung/Bewegung entlang der
  begin             // angezeigten Achsen bzw. Bildschirmachsen
    FixedAxis := not FixedAxis;
    result := true;
  end;
  end;
end;

procedure TCamera.MouseDown(Sender: TObject; Button: TMouseButton;
                            Shift: TShiftState; X, Y: Integer);
// hier merken wir uns, welche Maustaste gedrückt wurde. Solange die
// Tastenvariable true ist, kann abgeprüft werden ob die Taste gedrückt
// ist. In MouseUp wird die entsprechende Variable wieder auf false
// gesetzt.
begin
  if Button = mbRight then begin
    //rechte maustaste gedrückt
    FRightMousePressed:=true;
  end else if Button = mbLeft then begin
    //rechte maustaste gedrückt
    FLeftMousePressed:=true;
  end;
  //Startposition für die Mausbewegung merken
  FxStart := X;
  FyStart := Y;
end;

procedure TCamera.MouseUp(Sender: TObject; Button: TMouseButton;
                          Shift: TShiftState; X, Y: Integer);
// eine maustaste wurde losgelassen. mal sehen, ob eine aktion
// unterbunden werden muss.
begin
  if Button = mbRight then begin
    FRightMousePressed:=false;
  end else if Button = mbLeft then begin
    FLeftMousePressed:=false;
  end;
end;

function TCamera.MouseMove(Sender: TObject; Shift: TShiftState; X,
                           Y: Integer): boolean;
begin
  result := false;
  //Verschieben und Drehen funktioniert nur, wenn eine Maustaste
  // gedrückt ist
  if not (FRightMousePressed or FLeftMousePressed) then
    exit;

  //berechnen, wie weit die Maus verschoben wurde
  FxDelta := FxStart-X;
  FyDelta := FyStart-Y;

  //anpassen, damit es nicht zu schnell geht
  FxRot := FxRot - FyDelta;
  Fyrot := FyRot - FxDelta;

  //Startpunkt für den nächsten Aufruf festlegen
  FxStart := X;
  FyStart := Y;

  // Rechte Maustaste:
  // Kamera drehen (vertikal bei Maus hoch/runter,
  //                horizontal bei Maus links/rechts
  //                um die Bildschirmachse bei Mausrad oder wenn shift)
  if FRightMousePressed then begin
    if FShiftPressed then begin
      // wenn kein mausrad vorhanden ist, soll das ja auch gehen
      if FyRot+FxRot <> 0 then begin
        RotateScene (DIR_ZENTRAL, (FyRot+FxRot)*GiveSpeed);
      end;
    end
    else begin
      if FxRot <> 0 then begin
        RotateScene (DIR_HORIZONTAL, FxRot*GiveSpeed);
      end;
      if FyRot <> 0 then begin
        RotateScene (DIR_VERTIKAL, FyRot*GiveSpeed);
      end;
    end;
  end;

  // Linke Maustaste:
  // Kamera bewegen (vertikal bei Maus hoch/runter,
  //                horizontal bei Maus links/rechts
  //                entlang der Bildschirmachse bei Mausrad oder wenn shift)
  if FLeftMousePressed then begin
    if FShiftPressed then begin
      // wenn kein mausrad vorhanden ist, soll das ja auch gehen
      if FyRot+FxRot <> 0 then begin
        MoveScene (DIR_ZENTRAL, (FyRot+FxRot)*GiveSpeed);
      end
    end
    else begin
      if FxRot <> 0 then begin
        MoveScene (DIR_HORIZONTAL, FxRot*GiveSpeed);
      end;
      if FyRot <> 0 then begin
        MoveScene (DIR_VERTIKAL, -FyRot*GiveSpeed);
      end;
    end;
  end;

  FxRot := 0;
  FyRot := 0;

  result := true;
end;

procedure TCamera.RotateScene (Direction: byte;
                               Geschwindigkeit: GLdouble);
begin
  if Direction = DIR_HORIZONTAL then // um die X-Achse drehenx
  begin
    RotateCamera(0, Geschwindigkeit, 0);
  end
  else if Direction = DIR_VERTIKAL then // um die y-Achse drehen
  begin
    RotateCamera (Geschwindigkeit, 0, 0);
  end
  else if Direction = DIR_ZENTRAL then // um die z-Achse drehen
  begin
    RotateCamera(0, 0, Geschwindigkeit);
  end;
end;

function TCamera.GiveSpeed: TGLdouble;
begin
  // Initiale Geschwindigkeit
  result := 1;

  // wenn die Geschwindigkeit für eine Mausbewegung oder -drehung ist, soll
  // es nicht so schnell gehen
  if FRightMousePressed or FLeftMousePressed then begin
    result := result / 20;
  end;

  // wenn die alt-taste gedrückt wurde, soll es ja schneller gehen
  if FAltPressed then begin
    result := (result * 60.0);
  end;

  // jetzt mit dem individuellen speemultiplier multiplizieren
  result := result * FSpeedMultiplier;

  // wenn die drehrichtung umgeschaltet wurde, hier auch
  // umschalten
  if FDir then begin
    result := -result;
  end;
end;

procedure TCamera.MoveScene (Direction: byte; Geschwindigkeit: GLdouble);
begin
  if Direction = DIR_VERTIKAL then begin
    TranslateCamera (Geschwindigkeit, 0, 0);
  end;
  if Direction = DIR_HORIZONTAL then begin
    TranslateCamera (0, Geschwindigkeit, 0);
  end;
  if Direction = DIR_ZENTRAL then begin
    TranslateCamera (0, 0, Geschwindigkeit);
  end;
end;

function TCamera.MouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean): boolean;
begin
  if FRightMousePressed then begin
    RotateScene (DIR_ZENTRAL, (WheelDelta/10)*GiveSpeed);
  end
  else begin
    MoveScene (DIR_ZENTRAL, (WheelDelta/360)*GiveSpeed);
  end;
  result := true;
end;

procedure TCamera.MouseEnter(var msg:TMessage);
begin
  FRightMousePressed:=false;
  FLeftMousePressed:=false;
end;

procedure TCamera.MouseLeave(var msg: TMessage);
begin
  FRightMousePressed:=false;
  FLeftMousePressed:=false;
  FAltPressed := false;
  FCtrlPressed := false;
  FShiftPressed := false;
end;

Initialization
  FDebugOn := false; // auf true setzen, wenn debug infos gewünscht sind
  FDebugFileName := ExePath + 'SKANAL3D_CAMERA.DBG';
  if FDebugOn then begin
    AssignFile (FDebugFile, FDebugFileName);
    Rewrite (FDebugFile);
  end;

finalization
  if FDebugOn then begin
    CloseFile (FDebugFile);
    FDebugFileName := '';
  end;

end.