unit fTiles; interface uses Winapi.OpenGL, Winapi.Windows, System.SysUtils, System.Classes, System.Math, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Imaging.Jpeg, Vcl.StdCtrls, GLS.VectorTypes, GLS.Objects, GLS.Graph, GLS.Scene, GLS.SceneViewer, GLS.VectorGeometry, GLS.TilePlane, GLS.Texture, GLS.Cadencer, GLS.Context, GLS.Material, GLS.Coordinates, GLS.BaseClasses, GLS.RenderContextInfo, GLS.TextureFormat, GLS.Keyboard, GLS.Utils, GLS.SimpleNavigation; type TFormTiles = class(TForm) GLScene: TGLScene; GLSceneViewer1: TGLSceneViewer; GLCamera: TGLCamera; DCTarget: TGLDummyCube; GLXYZGrid: TGLXYZGrid; Panel1: TPanel; GLMaterialLibrary: TGLMaterialLibrary; GLLightSource: TGLLightSource; Timer1: TTimer; GLCadencer1: TGLCadencer; Label1: TLabel; CBMaterial: TComboBox; GLTilePlane: TGLTilePlane; GLDirectOpenGL: TGLDirectOpenGL; DCSelection: TGLDummyCube; GLLines1: TGLLines; BUPack: TButton; Label2: TLabel; CBShowGrid: TCheckBox; CBSortByMaterials: TCheckBox; GLSimpleNavigation1: TGLSimpleNavigation; procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure FormCreate(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure GLCadencer1Progress(Sender: TObject; const deltaTime, newTime: Double); procedure GLDirectOpenGLRender(Sender: TObject; var rci: TGLRenderContextInfo); procedure BUPackClick(Sender: TObject); procedure CBShowGridClick(Sender: TObject); procedure CBSortByMaterialsClick(Sender: TObject); private public mx, my: Integer; tileX, tileY: Integer; mip, translateOffset: TGLVector; translating: Boolean; end; var FormTiles: TFormTiles; implementation {$R *.dfm} procedure TFormTiles.FormCreate(Sender: TObject); var i, j: Integer; begin SetGLSceneMediaDir(); GLMaterialLibrary.TexturePaths := GetCurrentDir(); GLMaterialLibrary.LibMaterialByName('beigemarble').Material.Texture.Image.LoadFromFile('beigemarble.jpg'); GLMaterialLibrary.LibMaterialByName('marbletiles').Material.Texture.Image.LoadFromFile('marbletiles.jpg'); GLMaterialLibrary.LibMaterialByName('walkway').Material.Texture.Image.LoadFromFile('walkway.jpg'); // fill the tiled area with random tiles RandSeed := 0; for i := -20 to 20 do for j := -20 to 20 do GLTilePlane.Tiles[i, j] := Random(GLMaterialLibrary.Materials.Count - 1) + 1; // set all tile materials to anisotropic, // add them to the material selection combo for i := 0 to GLMaterialLibrary.Materials.Count - 1 do begin GLMaterialLibrary.Materials[i].Material.Texture.FilteringQuality := tfAnisotropic; CBMaterial.Items.Add(GLMaterialLibrary.Materials[i].Name); end; CBMaterial.ItemIndex := 0; end; procedure TFormTiles.GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin mx := X; my := Y; if Shift = [ssLeft] then begin GLTilePlane.Tiles[tileX, tileY] := CBMaterial.ItemIndex; GLTilePlane.StructureChanged; end else if Shift = [ssRight] then begin GLTilePlane.Tiles[tileX, tileY] := 0; GLTilePlane.StructureChanged; end; end; procedure TFormTiles.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); begin GLCamera.AdjustDistanceToTarget(Power(1.1, WheelDelta / 120)); end; procedure TFormTiles.GLCadencer1Progress(Sender: TObject; const deltaTime, newTime: Double); var ip: TGLVector; mp: TPoint; shiftDown: Boolean; begin shiftDown := (IsKeyDown(VK_LSHIFT) or IsKeyDown(VK_RSHIFT)); DCSelection.Visible := not shiftDown; if DCSelection.Visible then GLSceneViewer1.Cursor := crDefault else GLSceneViewer1.Cursor := crHandPoint; GetCursorPos(mp); mp := GLSceneViewer1.ScreenToClient(mp); if PtInRect(GLSceneViewer1.ClientRect, mp) then begin GLSceneViewer1.Buffer.ScreenVectorIntersectWithPlaneXY (VectorMake(mp.X, GLSceneViewer1.Height - mp.Y, 0), 0, ip); tileX := Round(ip.X - 0.5); tileY := Round(ip.Y - 0.5); DCSelection.Position.SetPoint(tileX, tileY, 0); if shiftDown then begin if IsKeyDown(VK_LBUTTON) then begin if not translating then begin translateOffset := ip; translating := True; end; DCTarget.Position.Translate(VectorAdd(VectorSubtract(mip, ip), translateOffset)) end else translating := False; if IsKeyDown(VK_RBUTTON) then begin GLCamera.MoveAroundTarget((my - mp.Y) * 0.5, (mx - mp.X) * 0.5); end; end else begin translating := False; if IsKeyDown(VK_LBUTTON) then begin GLTilePlane.Tiles[tileX, tileY] := CBMaterial.ItemIndex; GLTilePlane.StructureChanged; end; if IsKeyDown(VK_RBUTTON) then begin GLTilePlane.Tiles[tileX, tileY] := 0; GLTilePlane.StructureChanged; end; end; mx := mp.X; my := mp.Y; end; GLSceneViewer1.Invalidate; end; procedure TFormTiles.GLDirectOpenGLRender(Sender: TObject; var rci: TGLRenderContextInfo); begin // we clear the depth buffer, so that the grid is always in front of the // tile plane and won't Z-Fight with it glClear(GL_DEPTH_BUFFER_BIT); end; procedure TFormTiles.BUPackClick(Sender: TObject); begin // packing a tile area removes unused area from the in-memory structures GLTilePlane.Tiles.Pack; end; procedure TFormTiles.CBShowGridClick(Sender: TObject); begin GLXYZGrid.Visible := CBShowGrid.Checked; end; procedure TFormTiles.CBSortByMaterialsClick(Sender: TObject); begin GLTilePlane.SortByMaterials := CBSortByMaterials.Checked; end; procedure TFormTiles.Timer1Timer(Sender: TObject); begin Caption := GLSceneViewer1.FramesPerSecondText; GLSceneViewer1.ResetPerformanceMonitor; end; end.