unit fPortalD; interface uses Winapi.OpenGL, System.SysUtils, System.Classes, System.Math, System.Types, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Imaging.Jpeg, GLS.Scene, Stage.VectorTypes, GLS.PersistentClasses, Stage.Keyboard, GLS.Coordinates, GLS.BaseClasses, GLS.XCollection, Stage.Utils, GLS.Texture, GLS.VectorFileObjects, GLS.Objects, GLS.Cadencer, GLS.Portal, GLS.SceneViewer, GLS.Material, GLS.SimpleNavigation; type TFormPortal = class(TForm) Label1: TLabel; GLScene1: TGLScene; GLSceneViewer1: TGLSceneViewer; Label2: TLabel; BUForward: TButton; BUTurnLeft: TButton; BUTurnRight: TButton; BUBackward: TButton; SGMap: TStringGrid; GLMaterialLibrary1: TGLMaterialLibrary; BBProcess: TButton; GLLightSource1: TGLLightSource; DummyCube1: TGLDummyCube; GLCamera1: TGLCamera; Timer1: TTimer; GLCadencer1: TGLCadencer; Portal1: TGLPortal; Label3: TLabel; CBAuto: TCheckBox; CBFog: TCheckBox; procedure FormCreate(Sender: TObject); procedure BBProcessClick(Sender: TObject); procedure BUTurnLeftClick(Sender: TObject); procedure BUTurnRightClick(Sender: TObject); procedure BUForwardClick(Sender: TObject); procedure BUBackwardClick(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure GLCadencer1Progress(Sender: TObject; const deltaTime, newTime: Double); procedure SGMapSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String); procedure CBFogClick(Sender: TObject); procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); private mx, my: Integer; public portalCount, triangleCount: Integer; end; var FormPortal: TFormPortal; implementation {$R *.DFM} procedure TFormPortal.FormCreate(Sender: TObject); var i: Integer; begin var Path: TFileName := GetCurrentAssetPath(); // Load Texture for ground SetCurrentDir(Path + '\texture'); for i := 0 to 15 do SGMap.Cells[i, i] := 'X'; SGMap.Cells[8, 8] := ''; SGMap.Col := 8; SGMap.Row := 12; with GLMaterialLibrary1 do begin AddTextureMaterial('gnd', 'walkway.jpg'); with AddTextureMaterial('wall', 'rawwall.jpg') do begin TextureScale.Y := 3; end; end; BBProcessClick(Self); end; procedure TFormPortal.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); begin GLCamera1.AdjustDistanceToTarget(Power(1.1, WheelDelta / 120)); end; procedure TFormPortal.BBProcessClick(Sender: TObject); var X, Y, n: Integer; h: Single; Sector: TGLSectorMeshObject; Poly: TFGPolygon; begin h := 3; portalCount := 0; triangleCount := 0; Portal1.MeshObjects.Clear; for X := -7 to 8 do for Y := -7 to 8 do begin Sector := TGLSectorMeshObject.CreateOwned(Portal1.MeshObjects); with Sector.Vertices do begin n := Count; Add(X, 0, Y); Add(X + 1, 0, Y); Add(X + 1, 0, Y + 1); Add(X, 0, Y + 1); Add(X, h, Y); Add(X + 1, h, Y); Add(X + 1, h, Y + 1); Add(X, h, Y + 1); end; with Sector.TexCoords do begin Add(0, 0, 0); Add(1, 0, 0); Add(1, 1, 0); Add(0, 1, 0); end; // ground Sector.Normals.Add(0, 1, 0); if SGMap.Cells[X + 7, Y + 7] = '' then begin Poly := TFGPolygon.CreateOwned(Sector.FaceGroups); with Poly do begin MaterialName := 'gnd'; Add(n + 0, 0, 0); Add(n + 3, 0, 3); Add(n + 2, 0, 2); Add(n + 1, 0, 1); end; end; // front wall Sector.Normals.Add(0, 0, 1); if (Y = -7) or (SGMap.Cells[X + 7, Y - 1 + 7] <> '') then begin Poly := TFGPolygon.CreateOwned(Sector.FaceGroups); Poly.MaterialName := 'wall'; Inc(triangleCount, 2); end else begin Poly := TFGPortalPolygon.CreateOwned(Sector.FaceGroups); TFGPortalPolygon(Poly).DestinationSectorIndex := (X + 7) * 16 + (Y - 1 + 7); Inc(portalCount); end; with Poly do begin Add(n + 0, 1, 3); Add(n + 1, 1, 2); Add(n + 5, 1, 1); Add(n + 4, 1, 0); end; // left wall Sector.Normals.Add(1, 0, 0); if (X = -7) or (SGMap.Cells[X - 1 + 7, Y + 7] <> '') then begin Poly := TFGPolygon.CreateOwned(Sector.FaceGroups); Poly.MaterialName := 'wall'; Inc(triangleCount, 2); end else begin Poly := TFGPortalPolygon.CreateOwned(Sector.FaceGroups); TFGPortalPolygon(Poly).DestinationSectorIndex := (X - 1 + 7) * 16 + (Y + 7); Inc(portalCount); end; with Poly do begin Add(n + 4, 2, 1); Add(n + 7, 2, 0); Add(n + 3, 2, 3); Add(n + 0, 2, 2); end; // right wall Sector.Normals.Add(-1, 0, 0); if (X = 8) or (SGMap.Cells[X + 1 + 7, Y + 7] <> '') then begin Poly := TFGPolygon.CreateOwned(Sector.FaceGroups); Poly.MaterialName := 'wall'; Inc(triangleCount, 2); end else begin Poly := TFGPortalPolygon.CreateOwned(Sector.FaceGroups); TFGPortalPolygon(Poly).DestinationSectorIndex := (X + 1 + 7) * 16 + (Y + 7); Inc(portalCount); end; with Poly do begin Add(n + 1, 3, 3); Add(n + 2, 3, 2); Add(n + 6, 3, 1); Add(n + 5, 3, 0); end; // back wall Sector.Normals.Add(0, 0, 1); if (Y = 8) or (SGMap.Cells[X + 7, Y + 1 + 7] <> '') then begin Poly := TFGPolygon.CreateOwned(Sector.FaceGroups); Poly.MaterialName := 'wall'; Inc(triangleCount, 2); end else begin Poly := TFGPortalPolygon.CreateOwned(Sector.FaceGroups); TFGPortalPolygon(Poly).DestinationSectorIndex := (X + 7) * 16 + (Y + 1 + 7); Inc(portalCount); end; with Poly do begin Add(n + 3, 4, 2); Add(n + 7, 4, 1); Add(n + 6, 4, 0); Add(n + 2, 4, 3); end; end; Portal1.StructureChanged; end; procedure TFormPortal.BUTurnLeftClick(Sender: TObject); begin DummyCube1.Turn(-15); GLCamera1.TransformationChanged; end; procedure TFormPortal.BUTurnRightClick(Sender: TObject); begin DummyCube1.Turn(+15); GLCamera1.TransformationChanged; end; procedure TFormPortal.BUForwardClick(Sender: TObject); begin DummyCube1.Move(-0.25); GLCamera1.TransformationChanged; end; procedure TFormPortal.BUBackwardClick(Sender: TObject); begin DummyCube1.Move(0.25); GLCamera1.TransformationChanged; end; procedure TFormPortal.Timer1Timer(Sender: TObject); begin Caption := Format('%.2f FPS - %d Portals - %d Triangles', [GLSceneViewer1.FramesPerSecond, portalCount, triangleCount]); GLSceneViewer1.ResetPerformanceMonitor; end; procedure TFormPortal.GLCadencer1Progress(Sender: TObject; const deltaTime, newTime: Double); begin if IsKeyDown('Z') or IsKeyDown('W') then DummyCube1.Move(-3 * deltaTime) else if IsKeyDown('S') then DummyCube1.Move(3 * deltaTime); if IsKeyDown('A') or IsKeyDown('Q') then DummyCube1.Turn(-60 * deltaTime) else if IsKeyDown('D') then DummyCube1.Turn(60 * deltaTime); GLCamera1.TransformationChanged; end; procedure TFormPortal.GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin mx := X; my := Y; end; procedure TFormPortal.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if ssLeft in Shift then begin GLCamera1.MoveAroundTarget(my - Y, mx - X); end; mx := X; my := Y; end; procedure TFormPortal.SGMapSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String); begin if CBAuto.Checked then BBProcessClick(Self); end; procedure TFormPortal.CBFogClick(Sender: TObject); begin if CBFog.Checked then GLCamera1.DepthOfView := 11 else GLCamera1.DepthOfView := 100; GLSceneViewer1.Buffer.FogEnable := CBFog.Checked; end; end.