unit Game4C;
// TPlayer findet etwas zum Mitnehmen (und einen Baum)
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
// Genesis_for_Delphi-Units
G4D_Genesis, G4D_BaseType, G4D_XForm3D, G4D_Vec3D, G4D_geTypes,
G4D_Vfile, GDriver, GEntity, GModel, GFigur, GActor;
type
TPlay =
class(TForm)
procedure FormCreate (Sender: TObject);
procedure FormActivate (Sender: TObject);
procedure FormDestroy (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
Player : TPlayer;
// Spielfigur (du selbst)
Ding : TActor;
// Was zum Mitnehmen
Baum : TActor;
// Etwas Vegetation
SoftTime : DWord;
// Bremse für Tasten/Mausabfrage
CanTake : Boolean;
// Schalter für Nehmen-Geben
isTaken : Boolean;
// Schalter für Nehmen-Geben
procedure ExitError (Txt:
String);
procedure CreateGame;
procedure RunGame;
procedure FreeGame;
procedure SetActors;
procedure GetInput;
procedure GetMousePos;
procedure TakeThing;
public
{ Public-Deklarationen }
end;
const
APfad = '
.\actors\';
BPfad = '
.\levels\';
ACT_Datei1 = '
Tree1.act';
//ACT_Datei1 = 'Tree2.act';
ACT_Datei2 = '
Medikit1.act';
BSP_Datei = '
World2.bsp';
GVersion = '
GPlay4C';
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
Play : TPlay;
// Spiel-"Unterlage"
GHandle : HWnd;
// Handle des Formulars
GInstance : LongInt;
// Handle der Applikation
implementation
{$R *.DFM}
procedure TPlay.ExitError (Txt:
String);
begin
// Fehlermeldung anzeigen, Programm abbrechen
ShowMessage (Txt); halt;
end;
procedure TPlay.CreateGame;
var WorldScreen: geRect; WorldName:
String; WorldFile: pgeVFile;
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 := BPfad + 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!');
// Figur/Gegenstand im Spiel erzeugen
Player := TPlayer.Create (World);
Baum := TActor.Create (World, APfad + ACT_Datei1);
Ding := TActor.Create (World, APfad + ACT_Datei2);
SetActors;
// Alle vorhandenen Türen und Plattformen "einsammeln"
DoorList := TList.Create;
PlatList := TList.Create;
GetAllDoors (World, DoorList);
GetAllPlatforms (World, PlatList);
// Startposition ermitteln
with Player
do
begin
ViewVector := GetStartPosition (World);
LookVector := ViewVector;
end;
// Bremswertvorgabe
BrakeTime := 33;
// Dinge sind zum Nehmen da
CanTake := true;
isTaken := false;
end;
procedure TPlay.RunGame;
var i: Integer;
begin
// Spielmodus auf "Laufen" einstellen
isRunning := true;
// Solange Spiel "läuft"
SoftTime := GetTickCount;
while isRunning
do
begin
// ggf. auf Ereignisse reagieren (z.B. Tastatur/Maus)
while SoftTime+BrakeTime > GetTickCount
do
Application.ProcessMessages;
SoftTime := GetTickCount;
// Beschaffenheit prüfen
Player.CheckContents;
if not Player.CanSwim
then
begin
// Gravitation testen
Player.CheckGravity;
// Falls Plattform, dann "mitfahren"
Player.Shift (0, Player.StepHeight/2, 0);
end;
// Tasten und Maus abfragen
GetInput;
GetMousePos;
// Koordinaten und Winkel für Player ausrichten
Player.SetMatrix (XForm, true);
geCamera_SetWorldSpaceXForm (Camera, @XForm);
// Rendering starten
if geEngine_BeginFrame(Engine, Camera, GE_TRUE) <> OK
then
ExitError ('
BeginFrame gescheitert!');
// Baum/Ding in aktuellem Zustand rendern
Baum.Render (GetTickCount);
Ding.Render (GetTickCount);
// Türen und Plattformen in aktuellem Zustand rendern
for i := 0
to DoorList.Count-1
do
TDoor(DoorList[i]).Render (GetTickCount);
for i := 0
to PlatList.Count-1
do
TPlatform(PlatList[i]).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!');
// Anzeige-Dummy (für WindowMode)
// geEngine_Printf(Engine, 0,0,' ');
end;
end;
procedure TPlay.FreeGame;
var i: Integer;
begin
// Player/Akteure freigeben
if Player <>
nil then Player.Free;
if Baum <>
nil then Baum.Free;
if Ding <>
nil then Ding.Free;
// Türdaten/Plattformdaten freigeben, Listenzeiger "nullen"
for i := 0
to DoorList.Count-1
do
if DoorList[i] <>
nil then TDoor(DoorList[i]).Free;
DoorList.Free; DoorList :=
nil;
for i := 0
to PlatList.Count-1
do
if PlatList[i] <>
nil then TPlatform(PlatList[i]).Free;
PlatList.Free; PlatList :=
nil;
// 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 TPlay.SetActors;
begin
with Baum
do
begin
// Maßstab und Richtung festlegen
SetScale (1.5, 1.5, 1.5);
geVec3d_Set (@TurnVector, 0.0, -Pi/4, 0.0);
// In Ecke setzen
geVec3d_Set (@ViewVector, Player.ViewVector.x,
Player.ViewVector.y + 200, Player.ViewVector.z - 300);
LookVector := ViewVector;
end;
with Ding
do
begin
// Maßstab festlegen und "Lage justieren"
SetScale (1.5, 1.5, 1.5);
geVec3d_Set (@MinVector, 0.0, -BodyHeight, 0.0);
// Auf Block setzen
ViewVector.x := Player.ViewVector.x - 300;
ViewVector.z := Player.ViewVector.z + 300;
LookVector := ViewVector;
end;
end;
procedure TPlay.GetInput;
const xDiff=15.0; yDiff=15.0; zDiff=20.0;
begin
with Player
do
begin
// Laufen (zusammen mit Pfeiltasten)
if GetAsyncKeystate(VK_SHIFT) < 0
then
if CanSwim
then BrakeTime := 33
else BrakeTime := 11;
if GetAsyncKeystate(VK_SHIFT) = 0
then
if CanSwim
then BrakeTime := 99
else BrakeTime := 33;
// 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;
// Springen
if GetAsyncKeystate(VK_CONTROL) < 0
then
begin CanJump := true; Jump;
end;
// Einzelsprung
if GetAsyncKeystate(VK_RBUTTON) < 0
then Jump;
if GetAsyncKeyState(VK_RBUTTON) = 0
then CanJump := true;
// Ducken/Aufrichten
if GetAsyncKeystate(VK_SPACE) < 0
then
begin Duck; CanDuck := false;
end;
if GetAsyncKeyState(VK_SPACE) = 0
then CanDuck := true;
// Auf-Ab-Tauchen
if GetAsyncKeystate(VK_PRIOR) < 0
then
LookVector.y := ViewVector.y + yDiff;
if GetAsyncKeystate(VK_NEXT) < 0
then
LookVector.y := ViewVector.y - yDiff;
// Gegenstand aufnehmen
if GetAsyncKeystate(VK_MENU) < 0
then
begin TakeThing; CanTake:= false;
end;
if GetAsyncKeyState(VK_MENU) = 0
then CanTake := true;
// Ende mit Esc
if GetAsyncKeystate(VK_ESCAPE) < 0
then isRunning := false;
// Ende mit linker Maustaste
if GetAsyncKeystate(VK_LBUTTON) < 0
then isRunning := false;
// Neue View-Werte nur, wenn keine Kollision
if not Collision
then ViewVector := LookVector;
end;
end;
procedure TPlay.GetMousePos;
const xDiff=0.1; yDiff=0.05;
var xMouse, yMouse: Integer; MousePos: TPoint;
begin
with Player
do
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;
end;
procedure TPlay.TakeThing;
begin
if not CanTake
then exit;
// Ding nehmen oder geben, wenn in Reichweite
with Ding
do
begin
if ((ViewVector.x < Player.ViewVector.x+150)
and (ViewVector.x > Player.ViewVector.x-150))
and ((ViewVector.z < Player.ViewVector.z+150)
and (ViewVector.z > Player.ViewVector.z-150))
then
begin
isTaken :=
not isTaken;
if isTaken
then Disappear
else Appear;
end;
end;
end;
procedure TPlay.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 GDriver)
SetDriver (GInstance, GHandle, Engine, Driver, DMode);
end;
procedure TPlay.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 TPlay.FormDestroy(Sender: TObject);
begin
// Spiel "freigeben"
FreeGame;
// Alten FPU-Kontrollwert wiederherstellen
Set8087CW (CW8087);
end;
end.