...
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
// Genesis_for_Delphi-Units
G4D_Genesis, G4D_BaseType, G4D_XForm3D, G4D_Vec3D, G4D_geTypes, G4D_Vfile,
G4DDriver, G4DFigur;
type
TForm1 =
class(TForm)
procedure FormCreate (Sender: TObject);
procedure FormActivate (Sender: TObject);
procedure FormDestroy (Sender: TObject);
procedure FormClick (Sender: TObject);
private
{ Private-Deklarationen }
Engine : pgeEngine;
// 3D-Engine
World : pgeWorld;
// World/Level
Camera : pgeCamera;
// Kamera/Betrachter
Driver : pgeDriver;
// Grafiktreiber
DMode : pgeDriver_Mode;
// Grafikmodus
XForm : geXForm3D;
// Matrix für Welt->Betrachter
isRunning : Boolean;
// Schalter für Spiel (ein/aus)
CW8087 : DWord;
// FPU-Kontrollwert
ViewVector: geVec3D;
// aktuelle Betrachterposition
LookVector: geVec3D;
// neue Betrachterposition
TurnVector: geVec3D;
// Drehwinkel
MinVector : geVec3D;
// min. Kollisionsgrenze
MaxVector : geVec3D;
// max. Kollisionsgrenze
Figur : TFigur;
// Figur (Gegner?)
procedure ExitError (Txt:
String);
procedure CreateGame;
procedure RunGame;
procedure FreeGame;
procedure GetInput;
procedure GetMousePos;
function Collision: Boolean;
procedure SetFigure;
public
{ Public-Deklarationen }
end;
const
Pfad = '
.\';
ACT_Datei = '
G4DFigur.act';
BSP_Datei = '
G4DWorld.bsp';
GVersion = '
G4DPlay3';
OK = GE_TRUE;
// Kontrollwert für Engine-Methoden
MaxWidth = 640;
// Max. Screenbreite
MaxHeight = 480;
// Max. Screenhöhe
MCW_EM = DWORD($133f);
// für evtl. Division-durch-Null-Fehler
var
Form1 : TForm1;
// Spiel-"Unterlage"
GHandle : HWnd;
// Handle des Formulars
GInstance : LongInt;
// Handle der Applikation
implementation
{$R *.DFM}
procedure TForm1.ExitError (Txt:
String);
begin
// Fehlermeldung anzeigen, Programm abbrechen
ShowMessage (Txt); halt;
end;
procedure TForm1.CreateGame;
var
WorldScreen: geRect;
// Anzeigefläche
WorldName:
String;
// Name der BSP-Datei (Welt/Level)
WorldFile: pgeVFile;
// BSP-Datei (Welt/Level)
begin
// Anzeigefläche festlegen
with WorldScreen
do
begin
Left := 0; Right := MaxWidth - 1;
Top := 0; Bottom := MaxHeight - 1;
end;
// Koordinaten-Matrix setzen
geXForm3D_SetIdentity (@XForm);
// Kamera initialisieren
Camera:= geCamera_Create (2.0, @WorldScreen);
if Camera =
nil then
ExitError('
Kamera kann nicht installiert werden!');
// BSP-Datei laden
WorldName := Pfad + BSP_Datei;
WorldFile := geVFile_OpenNewSystem (
nil,
GE_VFILE_TYPE_DOS, PChar(WorldName),
nil, GE_VFILE_OPEN_READONLY);
// Wenn Datei ok, Welt/Level erzeugen
if WorldFile <>
nil then
begin
World := geWorld_Create(WorldFile);
geVFile_Close(WorldFile);
end;
if World =
nil then
ExitError ('
Welt/Level lässt sich nicht erzeugen!');
// Welt/Level mit 3D-Engine verknüpfen
if geEngine_AddWorld(Engine, World) <> OK
then
ExitError ('
Welt/Level lässt sich nicht einbinden!');
// Betrachterposition "nullen"
geVec3d_Set (@ViewVector, 0.0, 0.0, 0.0);
LookVector := ViewVector;
geVec3d_Set (@TurnVector, 0.0, 0.0, 0.0);
geVec3d_Set (@MinVector,-20.0,-20.0,-20.0);
geVec3d_Set (@MaxVector, 20.0, 20.0, 20.0);
// Figur erzeugen und positionieren
Figur := TFigur.Create (World, Pfad + ACT_Datei);
SetFigure;
end;
procedure TForm1.RunGame;
begin
// Spielmodus auf "Laufen" einstellen
isRunning := true;
// Solange Spiel "läuft"
while isRunning
do
begin
// ggf. auf Ereignisse reagieren (z.B. Tastatur/Maus)
Application.ProcessMessages;
// Tasten und Maus abfragen
GetInput;
GetMousePos;
// Koordinaten und Winkel ausrichten
geXForm3D_SetIdentity (@XForm);
geXForm3D_RotateX (@XForm, TurnVector.x);
geXForm3D_RotateY (@XForm, TurnVector.y);
geXForm3D_RotateZ (@XForm, TurnVector.z);
geXForm3D_Translate
(@XForm, ViewVector.x, ViewVector.y, ViewVector.z);
geCamera_SetWorldSpaceXForm (Camera, @XForm);
// Rendering starten
if geEngine_BeginFrame(Engine, Camera, GE_TRUE) <> OK
then
ExitError ('
BeginFrame gescheitert!');
// Figur mit Bewegung rendern
Figur.Render (GetTickCount);
// Welt/Level rendern und darstellen
if geEngine_RenderWorld (Engine, World, Camera, 0.0) <> OK
then
ExitError ('
Rendering gescheitert!');
// Rendering beenden
if geEngine_EndFrame(Engine) <> OK
then
ExitError ('
EndFrame gescheitert!');
end;
end;
procedure TForm1.FreeGame;
begin
// Figurdaten freigeben
Figur.Free;
// Kamera, Welt und Engine freigeben
if Camera <>
nil then geCamera_Destroy (@Camera);
if World <>
nil then geWorld_Free (World);
if Engine <>
nil then geEngine_Free (Engine);
// Zeiger "nullen"
Camera :=
nil; World :=
nil; Engine :=
nil;
end;
procedure TForm1.GetInput;
const xDiff=4.0; yDiff=2.0; zDiff=6.0;
begin
// Links-Rechts-Bewegung
if GetAsyncKeystate(VK_LEFT) < 0
then
begin
LookVector.x := ViewVector.x - xDiff * cos(TurnVector.y);
LookVector.z := ViewVector.z + xDiff * sin(TurnVector.y);
end;
if GetAsyncKeystate(VK_RIGHT) < 0
then
begin
LookVector.x := ViewVector.x + xDiff * cos(TurnVector.y);
LookVector.z := ViewVector.z - xDiff * sin(TurnVector.y);
end;
// Vor-Zurück-Bewegung
if GetAsyncKeystate(VK_UP) < 0
then
begin
LookVector.x := ViewVector.x - zDiff * sin(TurnVector.y);
LookVector.z := ViewVector.z - zDiff * cos(TurnVector.y);
end;
if GetAsyncKeystate(VK_DOWN) < 0
then
begin
LookVector.x := ViewVector.x + zDiff * sin(TurnVector.y);
LookVector.z := ViewVector.z + zDiff * cos(TurnVector.y);
end;
// Rauf-Runter-Bewegung
if GetAsyncKeystate(VK_PRIOR) < 0
then
LookVector.y := ViewVector.y + yDiff;
if GetAsyncKeystate(VK_NEXT) < 0
then
LookVector.y := ViewVector.y - yDiff;
// Ende mit Esc
if GetAsyncKeystate(VK_ESCAPE) < 0
then isRunning := false;
// Neue View-Werte nur, wenn keine Kollision
if not Collision
then ViewVector := LookVector;
end;
procedure TForm1.GetMousePos;
const xDiff=0.05; yDiff=0.03;
var xMouse, yMouse: Integer; MousePos: TPoint;
begin
GetCursorPos (MousePos);
xMouse := (MousePos.x - Screen.Width
div 2);
yMouse := (MousePos.y - Screen.Height
div 2);
// Drehen links/rechts
if xMouse < 0
then TurnVector.y := TurnVector.y + xDiff;
if xMouse > 0
then TurnVector.y := TurnVector.y - xDiff;
// Schauen rauf/runter
if yMouse < 0
then
if TurnVector.x < 1
then TurnVector.x := TurnVector.x + yDiff;
if yMouse > 0
then
if TurnVector.x > -1
then TurnVector.x := TurnVector.x - yDiff;
SetCursorpos (Screen.Width
div 2, Screen.Height
div 2);
end;
function TForm1.Collision: Boolean;
var KontaktInfo: GE_Collision;
begin
Result := Boolean(geWorld_Collision (World, @MinVector, @MaxVector,
@LookVector, @ViewVector, GE_CONTENTS_SOLID_CLIP, GE_COLLIDE_ALL,
0,
nil,
nil, @KontaktInfo));
end;
// für jede ACT-Datei neu anpassen!!!
procedure TForm1.SetFigure;
begin
// Figur skalieren und ausrichten
Figur.SetScale (1.5, 1.5, 1.5);
// "Körpermaße" setzen
Figur.SetRange (-50,0,-50, 50,150,50);
// Geschwindigkeit festlegen, Bewegung einschalten
Figur.SetMotion (3.0, '
Walk', true);
// Figur.SetMotion (1.5, 'Idle', false);
// y-Wert anpassen, Abstand zum Betrachter lassen
Figur.SetPosition (ViewVector.x, ViewVector.y, ViewVector.z-300);
// Figur.SetRotation (0, pi/2, 0);
end;
procedure TForm1.FormCreate(Sender: TObject);
var AppDir:
String;
begin
// Wert von ControlWord speichern, Division durch Null "ausschalten"
CW8087 := Default8087CW;
Set8087CW(MCW_EM);
// Handle/Instanz von Formular/Applikation für 3D-Engine festlegen
GHandle := Self.Handle;
GInstance := hInstance;
// Pfad der Applikation ermitteln
AppDir := ExtractFilePath (Application.Exename);
// 3D-Engine initialisieren
Engine := geEngine_CreateWithVersion
(GHandle, GVersion, PChar(AppDir), GE_VERSION);
if Engine =
nil then
ExitError ('
3D-Engine kann nicht gestartet werden!');
// Treiber auswählen (Methode aus Unit G4DDriver)
SetDriver (GInstance, GHandle, Engine, Driver, DMode);
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
// Grafiktreiber/modus überprüfen
if (Driver =
nil)
or (DMode =
nil)
then
ExitError ('
Kein Grafiktreiber/modus ausgewählt!');
// Grafiktreiber/modus initialisieren
if geEngine_SetDriverAndMode(Engine, Driver, DMode) <> OK
then
ExitError ('
Grafikinitialisierung fehlgeschlagen!');
// Anzeigedaten für Engine ausschalten
geEngine_EnableFrameRateCounter(Engine, GE_FALSE);
// Mauszeiger als kleines Fadenkreuz
Cursor := crCross;
// Spiel initialisieren
CreateGame;
// Wiederholungs-Schleife für Spielverlauf
RunGame;
// Formular (bei Spielende) schließen
Close;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
// Spiel "freigeben"
FreeGame;
// Alten FPU-Kontrollwert wiederherstellen
Set8087CW (CW8087);
end;
procedure TForm1.FormClick(Sender: TObject);
begin
isRunning := false;
end;
end.