//
// This unit is part of the GLScene Engine https://github.com/glscene
//
{
   Implements a tiled texture plane.

	 History :  
       23/08/10 - Yar - Added OpenGLTokens to uses, replaced OpenGL1x functions to OpenGLAdapter
       30/03/07 - DaStr - Added $I GLScene.inc
       28/03/07 - DaStr - Renamed parameters in some methods
                             (thanks Burkhard Carstens) (Bugtracker ID = 1678658)
       23/03/07 - DaStr - Added explicit pointer dereferencing
                             (thanks Burkhard Carstens) (Bugtracker ID = 1678644)
       19/08/05 - Mathx - Made index of materials start from 0 not from 1 (thanks to uhfath)
       23/03/04 - EG - Added NoZWrite
       09/01/04 - EG - Creation
    
}
unit GLTilePlane;

interface

{$I GLScene.inc}

uses
  Classes, GLScene, GLVectorGeometry, OpenGLTokens, GLContext, GLMaterial, GLObjects,
  GLCrossPlatform, GLPersistentClasses, GLVectorLists, GLRenderContextInfo;

type

   // TGLTiledAreaRow
   //
   { Stores row information for a tiled area. }
   TGLTiledAreaRow = class (TPersistentObject)
	   private
			 
         FColMin, FColMax : Integer;
         FData : TIntegerList;

		protected
			 
         procedure SetColMin(const val : Integer);
         procedure SetColMax(const val : Integer);

         function GetCell(col : Integer) : Integer;
         procedure SetCell(col, val : Integer);

		public
			 
			constructor Create; override;
         destructor Destroy; override;
	      procedure WriteToFiler(writer : TVirtualWriter); override;
	      procedure ReadFromFiler(reader : TVirtualReader); override;

         property Cell[col : Integer] : Integer read GetCell write SetCell; default;
         property ColMin : Integer read FColMin write SetColMin;
         property ColMax : Integer read FColMax write SetColMax;
         property Data : TIntegerList read FData;

         procedure Pack;
         function Empty : Boolean;

         procedure RemapTiles(remapList : TIntegerList);

   end;

   // TGLTiledArea
   //
   { Stores tile information in a tiled area.
      Each tile stores an integer value with zero the default value,
      assumed as "empty". }
   TGLTiledArea = class (TPersistentObject)
	   private
			 
         FRowMin, FRowMax : Integer;
         FRows : TPersistentObjectList;

		protected
			 
         procedure SetRowMin(const val : Integer);
         procedure SetRowMax(const val : Integer);

         function GetTile(col, row : Integer) : Integer;
         procedure SetTile(col, row, val : Integer);
         function GetRow(index : Integer) : TGLTiledAreaRow;

		public
			 
			constructor Create; override;
         destructor Destroy; override;
	      procedure WriteToFiler(writer : TVirtualWriter); override;
	      procedure ReadFromFiler(reader : TVirtualReader); override;

         property Tile[col, row : Integer] : Integer read GetTile write SetTile; default;
         property Row[index : Integer] : TGLTiledAreaRow read GetRow;

         property RowMin : Integer read FRowMin write SetRowMin;
         property RowMax : Integer read FRowMax write SetRowMax;

         procedure Pack;
         procedure Clear;
         function Empty : Boolean;

         procedure RemapTiles(remapList : TIntegerList);

   end;

   // TGLTilePlane
   //
   { A tiled textured plane.
      This plane object stores and displays texture tiles that composes it,
      and is optimized to minimize texture switches when rendering. 
      Its bounding dimensions are determined by its painted tile. }
	TGLTilePlane = class (TGLImmaterialSceneObject)
	   private
			 
         FNoZWrite : Boolean;
         FTiles : TGLTiledArea;
         FMaterialLibrary : TGLMaterialLibrary;
         FSortByMaterials : Boolean;

		protected
			 
         procedure SetNoZWrite(const val : Boolean);
         procedure SetTiles(const val : TGLTiledArea);
         procedure SetMaterialLibrary(const val : TGLMaterialLibrary);
         procedure SetSortByMaterials(const val : Boolean);

         procedure Notification(AComponent: TComponent; Operation: TOperation); override;

		public
			 
			constructor Create(AOwner: TComponent); override;
         destructor Destroy; override;

         procedure DoRender(var ARci : TGLRenderContextInfo;
                            ARenderSelf, ARenderChildren : Boolean); override;
         procedure BuildList(var rci : TGLRenderContextInfo); override;

         // Access to the TiledArea data
         property Tiles : TGLTiledArea read FTiles write SetTiles;
         { Controls the sorting of tiles by material.
            This property should ideally be left always at its default, True,
            except for debugging and performance measurement, which is why
            it's only public and not published. }
         property SortByMaterials : Boolean read FSortByMaterials write SetSortByMaterials;

		published
			 

         { If True the tiles are rendered without writing to the ZBuffer. }
         property NoZWrite : Boolean read FNoZWrite write SetNoZWrite;
         { Material library where tiles materials will be stored/retrieved.
            The lower 16 bits of the tile integer value is understood as being
            the index of the tile's material in the library (material of
            index zero is thus unused). }
         property MaterialLibrary : TGLMaterialLibrary read FMaterialLibrary write SetMaterialLibrary;
   end;

//-------------------------------------------------------------
//-------------------------------------------------------------
//-------------------------------------------------------------
implementation
//-------------------------------------------------------------
//-------------------------------------------------------------
//-------------------------------------------------------------

uses XOpenGL;

// ------------------
// ------------------ TGLTiledAreaRow ------------------
// ------------------

// Create
//
constructor TGLTiledAreaRow.Create;
begin
   inherited;
   FData:=TIntegerList.Create;
   FColMin:=0;
   FColMax:=-1;
end;

// Destroy
//
destructor TGLTiledAreaRow.Destroy;
begin
   FData.Free;
   inherited;
end;

// WriteToFiler
//
procedure TGLTiledAreaRow.WriteToFiler(writer : TVirtualWriter);
begin
   inherited WriteToFiler(writer);
   with writer do begin
      WriteInteger(0); // Archive Version 0
      WriteInteger(FColMin);
      FData.WriteToFiler(writer);
   end;
end;

// ReadFromFiler
//
procedure TGLTiledAreaRow.ReadFromFiler(reader : TVirtualReader);
var
	archiveVersion : Integer;
begin
   inherited ReadFromFiler(reader);
   archiveVersion:=reader.ReadInteger;
	if archiveVersion=0 then with reader do begin
      FColMin:=ReadInteger;
      FData.ReadFromFiler(reader);
      FColMax:=FColMin+FData.Count-1;
   end;
end;

// Pack
//
procedure TGLTiledAreaRow.Pack;
var
   i, startSkip : Integer;
begin
   startSkip:=MaxInt;
   for i:=0 to FData.Count-1 do begin
      if FData.List^[i]<>0 then begin
         startSkip:=i;
         Break;
      end;
   end;
   if startSkip=MaxInt then begin
      FData.Clear;
      FColMax:=ColMin-1;
   end else begin
      for i:=FData.Count-1 downto 0 do begin
         if FData.List^[i]<>0 then begin
            FData.Count:=i+1;
            FColMax:=FColMin+FData.Count-1;
            Break;
         end;
      end;
      if startSkip>0 then begin
         FData.DeleteItems(0, startSkip);
         FColMin:=FColMin+startSkip;
      end;
   end;
end;

// Empty
//
function TGLTiledAreaRow.Empty : Boolean;
begin
   Result:=(FData.Count=0);
end;

// RemapTiles
//
procedure TGLTiledAreaRow.RemapTiles(remapList : TIntegerList);
var
   i, k : Integer;
begin
   for i:=0 to FData.Count-1 do begin
      k:=FData[i];
      if Cardinal(k)<Cardinal(remapList.Count) then
         FData[i]:=remapList[k]
      else FData[i]:=0;
   end;
end;

// SetColMax
//
procedure TGLTiledAreaRow.SetColMax(const val : Integer);
begin
   if val>=ColMin then
      FData.Count:=val-ColMin+1
   else FData.Clear;
   FColMax:=val;
end;

// SetColMin
//
procedure TGLTiledAreaRow.SetColMin(const val : Integer);
begin
   if ColMax>=val then begin
      if val<ColMin then
         FData.InsertNulls(0, ColMin-val)
      else FData.DeleteItems(0, val-ColMin);
   end else FData.Clear;
   FColMin:=val;
end;

// GetCell
//
function TGLTiledAreaRow.GetCell(col : Integer) : Integer;
begin
   if (col>=ColMin) and (col<=ColMax) then
      Result:=FData[col-ColMin]
   else Result:=0;
end;

// SetCell
//
procedure TGLTiledAreaRow.SetCell(col, val : Integer);
var
   i : Integer;
begin
   i:=col-ColMin;
   if Cardinal(i)>=Cardinal(FData.Count) then begin
      if ColMin<=ColMax then begin
         if col<ColMin then ColMin:=col;
         if col>ColMax then ColMax:=col;
      end else begin
         FColMin:=col;
         FColMax:=col;
         FData.Add(val);
         Exit;
      end;
   end;
   FData[col-ColMin]:=val;
end;

// ------------------
// ------------------ TGLTiledArea ------------------
// ------------------

// Create
//
constructor TGLTiledArea.Create;
begin
   inherited;
   FRows:=TPersistentObjectList.Create;
   FRowMax:=-1;
end;

// Destroy
//
destructor TGLTiledArea.Destroy;
begin
   FRows.CleanFree;
   inherited;
end;

// WriteToFiler
//
procedure TGLTiledArea.WriteToFiler(writer : TVirtualWriter);
begin
   inherited WriteToFiler(writer);
   with writer do begin
      WriteInteger(0); // Archive Version 0
      WriteInteger(FRowMin);
      FRows.WriteToFiler(writer);
   end;
end;

// ReadFromFiler
//
procedure TGLTiledArea.ReadFromFiler(reader : TVirtualReader);
var
	archiveVersion : Integer;
begin
   inherited ReadFromFiler(reader);
   archiveVersion:=reader.ReadInteger;
	if archiveVersion=0 then with reader do begin
      FRowMin:=ReadInteger;
      FRows.ReadFromFiler(reader);
      FRowMax:=FRowMin+FRows.Count-1;
   end;
end;

// Pack
//
procedure TGLTiledArea.Pack;
var
   i, firstNonNil, lastNonNil : Integer;
   r : TGLTiledAreaRow;
begin
   // pack all rows, free empty ones, determine 1st and last non-nil
   lastNonNil:=-1;
   firstNonNil:=FRows.Count;
   for i:=0 to FRows.Count-1 do begin
      r:=TGLTiledAreaRow(FRows.List^[i]);
      if Assigned(r) then begin
         r.Pack;
         if r.FData.Count=0 then begin
            r.Free;
            FRows.List^[i]:=nil;
         end;
      end;
      if Assigned(r) then begin
         lastNonNil:=i;
         if i<firstNonNil then firstNonNil:=i;
      end;
   end;
   if lastNonNil>=0 then begin
      FRows.Count:=lastNonNil+1;
      FRowMax:=FRowMin+FRows.Count-1;
      if firstNonNil>0 then begin
         FRowMin:=FRowMin+firstNonNil;
         FRows.DeleteItems(0, firstNonNil);
      end;
   end else FRows.Clear;
end;

// Clear
//
procedure TGLTiledArea.Clear;
begin
   FRows.Clean;
   FRowMin:=0;
   FRowMax:=-1;
end;

// Empty
//
function TGLTiledArea.Empty : Boolean;
begin
   Result:=(FRows.Count=0);
end;

// RemapTiles
//
procedure TGLTiledArea.RemapTiles(remapList : TIntegerList);
var
   i : Integer;
   r : TGLTiledAreaRow;
begin
   for i:=0 to FRows.Count-1 do begin
      r:=TGLTiledAreaRow(FRows[i]);
      if Assigned(r) then
         r.RemapTiles(remapList);
   end;
end;

// GetTile
//
function TGLTiledArea.GetTile(col, row : Integer) : Integer;
var
   i : Integer;
   r : TGLTiledAreaRow;
begin
   i:=row-RowMin;
   if Cardinal(i)<Cardinal(FRows.Count) then begin
      r:=TGLTiledAreaRow(FRows[row-RowMin]);
      if Assigned(r) then
         Result:=r.Cell[col]
      else Result:=0;
   end else Result:=0;
end;

// SetTile
//
procedure TGLTiledArea.SetTile(col, row, val : Integer);
var
   r : TGLTiledAreaRow;
begin
   if row<RowMin then RowMin:=row;
   if row>RowMax then RowMax:=row;
   r:=TGLTiledAreaRow(FRows[row-RowMin]);
   if not Assigned(r) then begin
      r:=TGLTiledAreaRow.Create;
      FRows[row-RowMin]:=r;
   end;
   r.Cell[col]:=val;
end;

// GetRow
//
function TGLTiledArea.GetRow(index : Integer) : TGLTiledAreaRow;
begin
   index:=index-RowMin;
   if Cardinal(index)<Cardinal(FRows.Count) then
      Result:=TGLTiledAreaRow(FRows[index])
   else Result:=nil;
end;

// SetRowMax
//
procedure TGLTiledArea.SetRowMax(const val : Integer);
begin
   if val>=RowMin then begin
      if val>RowMax then
         FRows.AddNils(val-RowMax)
      else FRows.DeleteAndFreeItems(val-RowMin+1, FRows.Count);
   end else FRows.Clean;
   FRowMax:=val;
end;

// SetRowMin
//
procedure TGLTiledArea.SetRowMin(const val : Integer);
begin
   if val<=RowMax then begin
      if val<RowMin then
         FRows.InsertNils(0, RowMin-val)
      else FRows.DeleteAndFreeItems(0, val-RowMin);
   end else FRows.Clean;
   FRowMin:=val;
end;

// ------------------
// ------------------ TGLTilePlane ------------------
// ------------------

// Create
//
constructor TGLTilePlane.Create(AOwner:Tcomponent);
begin
   inherited Create(AOwner);
   FTiles:=TGLTiledArea.Create;
   FSortByMaterials:=True;
end;

// Destroy
//
destructor TGLTilePlane.Destroy;
begin
   MaterialLibrary:=nil;
   FTiles.Free;
   inherited;
end;

// SetNoZWrite
//
procedure TGLTilePlane.SetNoZWrite(const val : Boolean);
begin
   if FNoZWrite<>val then begin
      FNoZWrite:=val;
      StructureChanged;
   end;
end;

// SetTiles
//
procedure TGLTilePlane.SetTiles(const val : TGLTiledArea);
begin
   if val<>FTiles then begin
      FTiles.Assign(val);
      StructureChanged;
   end;
end;

// SetMaterialLibrary
//
procedure TGLTilePlane.SetMaterialLibrary(const val : TGLMaterialLibrary);
begin
   if FMaterialLibrary<>val then begin
      if Assigned(FMaterialLibrary) then begin
         DestroyHandle;
         FMaterialLibrary.RemoveFreeNotification(Self);
      end;
      FMaterialLibrary:=val;
      if Assigned(FMaterialLibrary) then
         FMaterialLibrary.FreeNotification(Self);
      StructureChanged;
   end;
end;

// SetSortByMaterials
//
procedure TGLTilePlane.SetSortByMaterials(const val : Boolean);
begin
   FSortByMaterials:=val;
	StructureChanged;
end;

// Notification
//
procedure TGLTilePlane.Notification(AComponent: TComponent; Operation: TOperation);
begin
   if Operation=opRemove then begin
      if AComponent=FMaterialLibrary then
         MaterialLibrary:=nil;
   end;
   inherited;
end;

// DoRender
//
procedure TGLTilePlane.DoRender(var ARci : TGLRenderContextInfo;
                                ARenderSelf, ARenderChildren : Boolean);
var
   i : Integer;
begin
   if (not ListHandleAllocated) and Assigned(FMaterialLibrary) then begin
      for i:=0 to MaterialLibrary.Materials.Count-1 do
         MaterialLibrary.Materials[i].PrepareBuildList;
   end;
   inherited;
end;

// BuildList
//
procedure TGLTilePlane.BuildList(var rci : TGLRenderContextInfo);
type
   TQuadListInfo = packed record
      x, y : TIntegerList;
   end;

   procedure IssueQuad(col, row : Integer);
   begin
      xgl.TexCoord2f(col, row);      GL.Vertex2f(col, row);
      xgl.TexCoord2f(col+1, row);    GL.Vertex2f(col+1, row);
      xgl.TexCoord2f(col+1, row+1);  GL.Vertex2f(col+1, row+1);
      xgl.TexCoord2f(col, row+1);    GL.Vertex2f(col, row+1);
   end;

var
   i, j, row, col, t : Integer;
   r : TGLTiledAreaRow;
   libMat : TGLLibMaterial;
   quadInfos : array of TQuadListInfo;
begin
   if MaterialLibrary=nil then Exit;
   // initialize infos
   GL.Normal3fv(@ZVector);
   if FNoZWrite then
      rci.GLStates.DepthWriteMask := False;
   if SortByMaterials then begin
      SetLength(quadInfos, MaterialLibrary.Materials.Count);
      for i:=0 to High(quadInfos) do begin //correction in (i:=0) from (i:=1)
         quadInfos[i].x:=TIntegerList.Create;
         quadInfos[i].y:=TIntegerList.Create;
      end;
      // collect quads into quadInfos, sorted by material
      for row:=Tiles.RowMin to Tiles.RowMax do begin
         r:=Tiles.Row[row];
         if Assigned(r) then begin
            for col:=r.ColMin to r.ColMax do begin
               t:=r.Cell[col] and $FFFF;
               if (t>-1) and (t<MaterialLibrary.Materials.Count) then begin //correction in (t>-1) from (t>0)
                  quadInfos[t].x.Add(col);
                  quadInfos[t].y.Add(row);
               end;
            end;
         end;
      end;
      // render and cleanup
      for i:=0 to High(quadInfos) do begin //correction in (i:=0) from (i:=1)
         if quadInfos[i].x.Count>0 then begin
            libMat:=MaterialLibrary.Materials[i];
            libMat.Apply(rci);
            repeat
               GL.Begin_(GL_QUADS);
               with quadInfos[i] do for j:=0 to x.Count-1 do
                  IssueQuad(x[j], y[j]);
               GL.End_;
            until not libMat.UnApply(rci);
         end;
         quadInfos[i].x.Free;
         quadInfos[i].y.Free;
      end;
   end else begin
      // process all quads in order
      for row:=Tiles.RowMin to Tiles.RowMax do begin
         r:=Tiles.Row[row];
         if Assigned(r) then begin
            for col:=r.ColMin to r.ColMax do begin
               t:=r.Cell[col] and $FFFF;
               if (t>-1) and (t<MaterialLibrary.Materials.Count) then begin //correction in (t>-1) from (t>0)
                  libMat:=MaterialLibrary.Materials[t];
                  libMat.Apply(rci);
                  repeat
                     GL.Begin_(GL_QUADS);
                     IssueQuad(col, row);
                     GL.End_;
                  until not libMat.UnApply(rci);
               end;
            end;
         end;
      end;
   end;
   if FNoZWrite then
      rci.GLStates.DepthWriteMask := True;
end;

//-------------------------------------------------------------
//-------------------------------------------------------------
//-------------------------------------------------------------
initialization
//-------------------------------------------------------------
//-------------------------------------------------------------
//-------------------------------------------------------------

   RegisterClasses([TGLTilePlane, TGLTiledAreaRow, TGLTiledArea]);

end.
