unit fPortal; 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, GLS.VectorTypes, GLS.Texture, GLS.VectorFileObjects, GLS.PersistentClasses, GLS.Objects, GLS.Cadencer, GLS.Portal, GLS.SceneViewer, GLS.Material, GLS.Coordinates, GLS.BaseClasses, GLS.Keyboard, GLS.Utils; 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 SetGLSceneMediaDir(); 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.