1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192: 193: 194: 195: 196: 197: 198: 199: 200: 201: 202: 203: 204: 205: 206: 207: 208: 209: 210: 211: 212: 213: 214: 215: 216: 217: 218: 219: 220: 221: 222: 223: 224: 225: 226: 227: 228: 229: 230: 231: 232: 233: 234: 235: 236: 237: 238: 239: 240: 241: 242: 243: 244: 245: 246: 247: 248: 249: 250: 251: 252: 253: 254: 255: 256: 257: 258: 259: 260:
| unit Game;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, g4d_Genesis, G4D_BaseType, G4D_XForm3D, G4D_geTypes, G4D_Vfile, G4DDriver, g4d_Vec3D;
type TForm3 = class(TForm) procedure FormCreate (Sender: TObject); procedure FormActivate (Sender: TObject); procedure FormDestroy (Sender: TObject); procedure FormClick (Sender: TObject); private Engine : pgeEngine; World : pgeWorld; Camera : pgeCamera; Driver : pgeDriver; DMode : pgeDriver_Mode; XForm : geXForm3D; isRunning: Boolean; CW8087 : DWord; procedure ExitError (Txt: String); procedure CreateGame; procedure RunGame; procedure FreeGame; procedure GetMousePos;
public procedure GetInput;
end; const Pfad = '.\'; BSP_Datei = 'G4DWorld.bsp'; GVersion = 'G4DPlay1'; OK = GE_TRUE; MaxWidth = 640; MaxHeight = 480; MCW_EM = DWORD($133f); var Form3: TForm3; GHandle : HWnd; GInstance : LongInt; ViewVector: geVec3D; MinVector : geVec3D; MaxVector : geVec3D; TurnVector: geVec3D; LookVector: geVec3D;
implementation
{$R *.dfm}
procedure TForm3.FormCreate(Sender: TObject); var AppDir: String; begin CW8087 := Default8087CW; Set8087CW(MCW_EM); GHandle := Self.Handle; GInstance := hInstance; AppDir := ExtractFilePath (Application.Exename); Engine := geEngine_CreateWithVersion (GHandle, GVersion, PChar(AppDir), GE_VERSION); if Engine = nil then ExitError ('3D-Engine kann nicht gestartet werden!'); SetDriver (GInstance, GHandle, Engine, Driver, DMode); geVec3d_Set (@ViewVector, 0.0, 0.0, 0.0); end;
procedure TForm3.ExitError (Txt: String); begin ShowMessage (Txt); halt; end;
procedure TForm3.FormActivate(Sender: TObject); begin if (Driver = nil) or (DMode = nil) then ExitError ('Kein Grafiktreiber/modus ausgewählt!'); if geEngine_SetDriverAndMode(Engine, Driver, DMode) <> OK then ExitError ('Grafikinitialisierung fehlgeschlagen!'); geEngine_EnableFrameRateCounter(Engine, GE_FALSE); Cursor := crCross; CreateGame; RunGame; Close; end;
procedure TForm3.FormDestroy(Sender: TObject); begin FreeGame; Set8087CW (CW8087); end;
procedure TForm3.CreateGame; var WorldScreen: geRect; WorldName: String; WorldFile: pgeVFile; begin with WorldScreen do begin Left := 0; Right := MaxWidth - 1; Top := 0; Bottom := MaxHeight - 1; end; geXForm3D_SetIdentity (@XForm); Camera:= geCamera_Create (2.0, @WorldScreen); if Camera = nil then ExitError('Kamera kann nicht installiert werden!'); WorldName := Pfad + BSP_Datei; WorldFile := geVFile_OpenNewSystem (nil, GE_VFILE_TYPE_DOS, PChar(WorldName), nil, GE_VFILE_OPEN_READONLY); 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!'); if geEngine_AddWorld(Engine, World) <> OK then ExitError ('Welt/Level lässt sich nicht einbinden!'); 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); end;
procedure TForm3.RunGame; begin isRunning := true; while isRunning do begin Application.ProcessMessages; GetInput; GetMousePos; geXForm3D_SetIdentity (@XForm); geXForm3D_Translate (@XForm, ViewVector.x, ViewVector.y, ViewVector.z); geXForm3D_RotateX (@XForm, TurnVector.x); geXForm3D_RotateY (@XForm, TurnVector.y); geXForm3D_RotateZ (@XForm, TurnVector.z); geCamera_SetWorldSpaceXForm (Camera, @XForm); if geEngine_BeginFrame(Engine, Camera, GE_TRUE) <> OK then ExitError ('BeginFrame gescheitert!'); if geEngine_RenderWorld (Engine, World, Camera, 0.0) <> OK then ExitError ('Rendering gescheitert!'); if geEngine_EndFrame(Engine) <> OK then ExitError ('EndFrame gescheitert!'); end; end;
procedure TForm3.FreeGame; begin if Camera <> nil then geCamera_Destroy (@Camera); if World <> nil then geWorld_Free (World); if Engine <> nil then geEngine_Free (Engine); Camera := nil; World := nil; Engine := nil; end;
procedure TForm3.FormClick(Sender: TObject); begin isRunning := false; end;
procedure TForm3.GetInput; const xDiff=4.0; yDiff=2.0; zDiff=6.0; begin 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; 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; if GetAsyncKeystate(VK_PRIOR) < 0 then LookVector.y := ViewVector.y + yDiff; if GetAsyncKeystate(VK_NEXT) < 0 then LookVector.y := ViewVector.y - yDiff; if GetAsyncKeystate(VK_ESCAPE) < 0 then isRunning := false; end;
procedure TForm3.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); if xMouse < 0 then TurnVector.y := TurnVector.y + xDiff; if xMouse > 0 then TurnVector.y := TurnVector.y - xDiff; 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. |