GLScene/Source/GLS.MeshUtils.pas

//
// The graphics engine GLScene
//
unit GLS.MeshUtils;

(* General utilities for mesh manipulations *)

interface

{$I Stage.Defines.inc}

uses
  System.Classes,
  System.SysUtils,
  System.Math,

  GLS.PersistentClasses,
  GLS.VectorLists,
  Stage.VectorGeometry,
  Stage.VectorTypes;

(* 
  Converts a triangle strips into a triangle list.
  Vertices are added to list, based on the content of strip. Both non-indexed
  and indexed variants are available, the output is *always* non indexed. 
*)
procedure ConvertStripToList(const strip: TGLAffineVectorList;
  list: TGLAffineVectorList); overload;
procedure ConvertStripToList(const strip: TGLIntegerList;
  list: TGLIntegerList); overload;
procedure ConvertStripToList(const strip: TGLAffineVectorList;
  const indices: TGLIntegerList; list: TGLAffineVectorList); overload;
function ConvertStripToList(const AindicesList: PLongWordArray; Count: LongWord;
  RestartIndex: LongWord): TGLLongWordList; overload;
function ConvertFansToList(const AindicesList: PLongWordArray; Count: LongWord;
  RestartIndex: LongWord): TGLLongWordList;
// Expands an indexed structure into a non-indexed structure.
procedure ConvertIndexedListToList(const data: TGLAffineVectorList;
  const indices: TGLIntegerList; list: TGLAffineVectorList);
(* 
  Builds a vector-count optimized indices list.
  The returned list (to be freed by caller) contains an "optimized" indices
  list in which duplicates coordinates in the original vertices list are used
  only once (the first available duplicate in the list is used).
  The vertices list is left untouched, to remap/cleanup, you may use the
  RemapAndCleanupReferences function. 
*)
function BuildVectorCountOptimizedIndices(const vertices: TGLAffineVectorList;
  const normals: TGLAffineVectorList = nil;
  const texCoords: TGLAffineVectorList = nil): TGLIntegerList;
(* 
  Alters a reference array and removes unused reference values.
  This functions scans the reference list and removes all values that aren't
  referred in the indices list, the indices list is *not* remapped. 
*)
procedure RemapReferences(reference: TGLAffineVectorList;
  const indices: TGLIntegerList); overload;
procedure RemapReferences(reference: TGLIntegerList;
  const indices: TGLIntegerList); overload;
(* 
  Alters a reference/indice pair and removes unused reference values.
  This functions scans the reference list and removes all values that aren't
  referred in the indices list, and the indices list is remapped so as to remain
  coherent. 
*)
procedure RemapAndCleanupReferences(reference: TGLAffineVectorList;
  indices: TGLIntegerList);
(* 
  Creates an indices map from a remap list.
  The remap list is what BuildVectorCountOptimizedIndices, a list of indices
  to distinct/unique items, the indices map contains the indices of these items
  after a remap and cleanup of the set referred by remapIndices... Clear?
  In short it takes the output of BuildVectorCountOptimizedIndices and can change
  it to something suitable for RemapTrianglesIndices.
  Any simpler documentation of this function welcome ;) 
*)
function RemapIndicesToIndicesMap(remapIndices: TGLIntegerList): TGLIntegerList;
(* 
  Remaps a list of triangles vertex indices and remove degenerate triangles.
  The indicesMap provides newVertexIndex:=indicesMap[oldVertexIndex] 
*)
procedure RemapTrianglesIndices(indices, indicesMap: TGLIntegerList);
(* 
  Remaps a list of indices.
  The indicesMap provides newVertexIndex:=indicesMap[oldVertexIndex] 
*)
procedure remapIndices(indices, indicesMap: TGLIntegerList);
(* 
  Attempts to unify triangle winding.
  Depending on topology, this may or may not be successful (some topologies
  can't be unified, f.i. those that have duplicate triangles, those that
  have edges shared by more than two triangles, those that have unconnected
  submeshes etc.) 
*)
procedure UnifyTrianglesWinding(indices: TGLIntegerList);
// Inverts the triangles winding (vertex order).
procedure InvertTrianglesWinding(indices: TGLIntegerList);
(* 
  Builds normals for a triangles list.
  Builds one normal per reference vertex (may be NullVector is reference isn't
  used), which is the averaged for normals of all adjacent triangles.
  Returned list must be freed by caller. 
*)
function BuildNormals(reference: TGLAffineVectorList; indices: TGLIntegerList)
  : TGLAffineVectorList;
(* 
  Builds a list of non-oriented (non duplicated) edges list.
  Each edge is represented by the two integers of its vertices,
  sorted in ascending order. If not nil then
  - triangleEdges is filled with the 3 indices of the 3 edges
  of the triangle, the edges ordering respecting the original triangle
  orientation;
  - edgesTriangles is filled with the indices of the first index
  of the triangle in triangleIndices that have this edge.
  A maximum of two triangles can be referred by this list,
  and its final size will be that of the Result (ie. non oriented edges list) 
*)
function BuildNonOrientedEdgesList(triangleIndices: TGLIntegerList;
  triangleEdges: TGLIntegerList = nil; edgesTriangles: TGLIntegerList = nil)
  : TGLIntegerList;
(* 
  Welds all vertices separated by a distance inferior to weldRadius.
  Any two vertices whose distance is inferior to weldRadius will be merged
  (ie. one of them will be removed, and the other replaced by the barycenter).
  The indicesMap is constructed to allow remapping of indices lists with the
  simple rule: newVertexIndex:=indicesMap[oldVertexIndex].
  The logic is protected from chain welding, and only vertices that were
  initially closer than weldRadius will be welded in the same resulting vertex.
  This procedure can be used for mesh simplification, but preferably at design-time
  for it is not optimized for speed. This is more a "fixing" utility for meshes
  exported from high-polycount CAD tools (to remove duplicate vertices,
  quantification errors, etc.) 
*)
procedure WeldVertices(vertices: TGLAffineVectorList; indicesMap: TGLIntegerList;
  weldRadius: Single);
(* 
  Attempts to create as few as possible triangle strips to cover the mesh.
  The indices parameters define a set of triangles as a set of indices to
  vertices in a vertex pool, free of duplicate vertices (or resulting
  stripification will be of lower quality).
  The function returns a list of TGLIntegerList, each of these lists hosting
  a triangle strip, returned objects must be freed by caller.
  If agglomerateLoneTriangles is True, the first of the lists actually contains
  the agglomerated list of the triangles that couldn't be stripified. 
*)
function StripifyMesh(indices: TGLIntegerList; maxVertexIndex: Integer;
  agglomerateLoneTriangles: Boolean = False): TGLPersistentObjectList;
(* 
  Increases indices coherency wrt vertex caches.
  The indices parameters is understood as vertex indices of a triangles set,
  the triangles are reordered to maximize coherency (vertex reuse) over the
  cacheSize latest indices. This allows higher rendering performance from
  hardware renderers that implement vertex cache (nVidia GeForce family f.i.),
  allowing reuse of T&L performance (similar to stripification without
  the normals issues of strips).
  This procedure performs a coherency optimization via a greedy hill-climber
  algorithm (ie. not optimal but fast). 
*)
procedure IncreaseCoherency(indices: TGLIntegerList; cacheSize: Integer);

type
  TSubdivideEdgeEvent = procedure(const idxA, idxB, newIdx: Integer); register;
(* 
  Subdivides mesh triangles.
  Splits along edges, each triangle becomes four. The smoothFactor can be
  used to control subdivision smoothing, zero means no smoothing (tesselation
  only), while 1 means "sphere" subdivision (a low res sphere will be subdivided
  in a higher-res sphere), values outside of the [0..1] range are for, er,
  artistic purposes.
  The procedure is not intended for real-time use. 
*)
procedure SubdivideTriangles(smoothFactor: Single; vertices: TGLAffineVectorList;
  triangleIndices: TGLIntegerList; normals: TGLAffineVectorList = nil;
  onSubdivideEdge: TSubdivideEdgeEvent = nil);
// Create list of indices of triangles with adjacency from triangle list 
function MakeTriangleAdjacencyList(const AindicesList: PLongWordArray;
  Count: LongWord; const AVerticesList: PAffineVectorArray): TGLLongWordList;

var
  vImprovedFixingOpenTriangleEdge: Boolean = False;
  vEdgeInfoReserveSize: LongWord = 64;

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

var
  v0to255reciproquals: array of Single;

function Get0to255reciproquals: PSingleArray;
var
  i: Integer;
begin
  if Length(v0to255reciproquals) <> 256 then
  begin
    SetLength(v0to255reciproquals, 256);
    for i := 1 to 255 do
      v0to255reciproquals[i] := 1 / i;
  end;
  Result := @v0to255reciproquals[0];
end;

procedure ConvertStripToList(const strip: TGLAffineVectorList;
  list: TGLAffineVectorList);
var
  i: Integer;
  stripList: PAffineVectorArray;
begin
  list.AdjustCapacityToAtLeast(list.Count + 3 * (strip.Count - 2));
  stripList := strip.list;
  for i := 0 to strip.Count - 3 do
  begin
    if (i and 1) = 0 then
      list.Add(stripList[i + 0], stripList[i + 1], stripList[i + 2])
    else
      list.Add(stripList[i + 2], stripList[i + 1], stripList[i + 0]);
  end;
end;

procedure ConvertStripToList(const strip: TGLIntegerList; list: TGLIntegerList);
var
  i: Integer;
  stripList: PIntegerArray;
begin
  list.AdjustCapacityToAtLeast(list.Count + 3 * (strip.Count - 2));
  stripList := strip.list;
  for i := 0 to strip.Count - 3 do
  begin
    if (i and 1) = 0 then
      list.Add(stripList[i + 0], stripList[i + 1], stripList[i + 2])
    else
      list.Add(stripList[i + 2], stripList[i + 1], stripList[i + 0]);
  end;
end;

procedure ConvertStripToList(const strip: TGLAffineVectorList;
  const indices: TGLIntegerList; list: TGLAffineVectorList);
var
  i: Integer;
  stripList: PAffineVectorArray;
begin
  list.AdjustCapacityToAtLeast(list.Count + 3 * (indices.Count - 2));
  stripList := strip.list;
  for i := 0 to indices.Count - 3 do
  begin
    if (i and 1) = 0 then
      list.Add(stripList[indices[i + 0]], stripList[indices[i + 1]],
        stripList[indices[i + 2]])
    else
      list.Add(stripList[indices[i + 2]], stripList[indices[i + 1]],
        stripList[indices[i + 0]])
  end;
end;

procedure ConvertIndexedListToList(const data: TGLAffineVectorList;
  const indices: TGLIntegerList; list: TGLAffineVectorList);
var
  i: Integer;
  indicesList: PIntegerArray;
  dataList, listList: PAffineVectorArray;
  oldResetMem: Boolean;
begin
  Assert(data <> list); // this is not allowed

  oldResetMem := list.SetCountResetsMemory;
  list.SetCountResetsMemory := False;

  list.Count := indices.Count;

  list.SetCountResetsMemory := oldResetMem;

  indicesList := indices.list;
  dataList := data.list;
  listList := list.list;

  for i := 0 to indices.Count - 1 do
    listList[i] := dataList[indicesList[i]];
end;

function BuildVectorCountOptimizedIndices(const vertices: TGLAffineVectorList;
  const normals: TGLAffineVectorList = nil;
  const texCoords: TGLAffineVectorList = nil): TGLIntegerList;
var
  i, j, k: Integer;
  found: Boolean;
  hashSize: Integer;
  hashTable: array of TGLIntegerList;
  list: TGLIntegerList;
  verticesList, normalsList, texCoordsList: PAffineVectorArray;
const
  cVerticesPerHashKey = 48;
  cInvVerticesPerHashKey = 1 / cVerticesPerHashKey;

  function HashKey(const v: TAffineVector; hashSize: Integer): Integer;
  begin
    Result := ((Integer(PIntegerArray(@v)[0]) xor Integer(PIntegerArray(@v)[1])
      xor Integer(PIntegerArray(@v)[2])) shr 16) and hashSize;
  end;

begin
  Result := TGLIntegerList.Create;
  Result.Capacity := vertices.Count;

  if Assigned(normals) then
  begin
    Assert(normals.Count >= vertices.Count);
    normalsList := normals.list
  end
  else
    normalsList := nil;
  if Assigned(texCoords) then
  begin
    Assert(texCoords.Count >= vertices.Count);
    texCoordsList := texCoords.list
  end
  else
    texCoordsList := nil;

  verticesList := vertices.list;

  // This method is very fast, at the price of memory requirement its
  // probable complexity is only O(n) (it's a kind of bucket-sort hellspawn)

  // Initialize data structures for a hash table
  // (each vertex will only be compared to vertices of similar hash value)
  hashSize := (1 shl MaxInteger(Integer(0),
    Integer(Trunc(Log2(vertices.Count * cInvVerticesPerHashKey))))) - 1;
  if hashSize < 7 then
    hashSize := 7;
  if hashSize > 65535 then
    hashSize := 65535;
  SetLength(hashTable, hashSize + 1);
  // allocate and fill our hashtable (will store "reference" vertex indices)
  for i := 0 to hashSize do
  begin
    hashTable[i] := TGLIntegerList.Create;
    hashTable[i].GrowthDelta := cVerticesPerHashKey div 2;
  end;
  // here we go for all vertices
  if Assigned(texCoordsList) or Assigned(normalsList) then
  begin
    for i := 0 to vertices.Count - 1 do
    begin
      list := hashTable[HashKey(verticesList[i], hashSize)];
      found := False;
      // Check each vertex against its hashkey siblings
      if list.Count > 0 then
      begin
        if Assigned(texCoordsList) then
        begin
          if Assigned(normalsList) then
          begin
            for j := 0 to list.Count - 1 do
            begin
              k := list.list[j];
              if VectorEquals(verticesList[k], verticesList[i]) and
                VectorEquals(normalsList[k], normalsList[i]) and
                VectorEquals(texCoordsList[k], texCoordsList[i]) then
              begin
                // vertex known, just store its index
                Result.Add(k);
                found := True;
                Break;
              end;
            end;
          end
          else
          begin
            for j := 0 to list.Count - 1 do
            begin
              k := list.list[j];
              if VectorEquals(verticesList[k], verticesList[i]) and
                VectorEquals(texCoordsList[k], texCoordsList[i]) then
              begin
                // vertex known, just store its index
                Result.Add(k);
                found := True;
                Break;
              end;
            end;
          end;
        end
        else
        begin
          for j := 0 to list.Count - 1 do
          begin
            k := list.list[j];
            if VectorEquals(verticesList[k], verticesList[i]) and
              VectorEquals(normalsList[k], normalsList[i]) then
            begin
              // vertex known, just store its index
              Result.Add(k);
              found := True;
              Break;
            end;
          end;
        end;
      end;
      if not found then
      begin
        // vertex unknown, store index and add to the hashTable's list
        list.Add(i);
        Result.Add(i);
      end;
    end;
  end
  else
  begin
    for i := 0 to vertices.Count - 1 do
    begin
      list := hashTable[HashKey(verticesList[i], hashSize)];
      found := False;
      // Check each vertex against its hashkey siblings
      for j := 0 to list.Count - 1 do
      begin
        k := list.list[j];
        if VectorEquals(verticesList[k], verticesList[i]) then
        begin
          // vertex known, just store its index
          Result.Add(k);
          found := True;
          Break;
        end;
      end;
      if not found then
      begin
        // vertex unknown, store index and add to the hashTable's list
        list.Add(i);
        Result.Add(i);
      end;
    end;
  end;
  // free hash data
  for i := 0 to hashSize do
    hashTable[i].Free;
  SetLength(hashTable, 0);
end;

// RemapReferences (vectors)
//
procedure RemapReferences(reference: TGLAffineVectorList;
  const indices: TGLIntegerList);
var
  i: Integer;
  tag: array of Byte;
  refListI, refListN: PAffineVector;
  indicesList: PIntegerArray;
begin
  Assert(reference.Count = indices.Count);
  SetLength(tag, reference.Count);
  indicesList := indices.list;
  // 1st step, tag all used references
  for i := 0 to indices.Count - 1 do
    tag[indicesList[i]] := 1;
  // 2nd step, build remap indices and cleanup references
  refListI := @reference.list[0];
  refListN := refListI;
  for i := 0 to High(tag) do
  begin
    if tag[i] <> 0 then
    begin
      if refListN <> refListI then
        refListN^ := refListI^;
      Inc(refListN);
    end;
    Inc(refListI);
  end;
  reference.Count := (Cardinal(refListN) - Cardinal(@reference.list[0]))
    div SizeOf(TAffineVector);
end;

procedure RemapReferences(reference: TGLIntegerList; const indices: TGLIntegerList);
var
  i, n: Integer;
  tag: array of Byte;
  refList: PIntegerArray;
  indicesList: PIntegerArray;
begin
  Assert(reference.Count = indices.Count);
  SetLength(tag, reference.Count);
  indicesList := indices.list;
  // 1st step, tag all used references
  for i := 0 to indices.Count - 1 do
    tag[indicesList[i]] := 1;
  // 2nd step, build remap indices and cleanup references
  n := 0;
  refList := reference.list;
  for i := 0 to High(tag) do
  begin
    if tag[i] <> 0 then
    begin
      if n <> i then
        refList[n] := refList[i];
      Inc(n);
    end;
  end;
  reference.Count := n;
end;

procedure RemapAndCleanupReferences(reference: TGLAffineVectorList;
  indices: TGLIntegerList);
var
  i, n: Integer;
  tag: array of Integer;
  refList: PAffineVectorArray;
  indicesList: PIntegerArray;
begin
  Assert(reference.Count = indices.Count);
  SetLength(tag, reference.Count);
  indicesList := indices.list;
  // 1st step, tag all used references
  for i := 0 to indices.Count - 1 do
    tag[indicesList[i]] := 1;
  // 2nd step, build remap indices and cleanup references
  n := 0;
  refList := reference.list;
  for i := 0 to High(tag) do
  begin
    if tag[i] <> 0 then
    begin
      tag[i] := n;
      if n <> i then
        refList[n] := refList[i];
      Inc(n);
    end;
  end;
  reference.Count := n;
  // 3rd step, remap indices
  for i := 0 to indices.Count - 1 do
    indicesList[i] := tag[indicesList[i]];
end;

function RemapIndicesToIndicesMap(remapIndices: TGLIntegerList): TGLIntegerList;
var
  i, n: Integer;
  tag: array of Integer;
  remapList, indicesMap: PIntegerArray;
begin
  SetLength(tag, remapIndices.Count);
  // 1st step, tag all used indices
  remapList := remapIndices.list;
  for i := 0 to remapIndices.Count - 1 do
    tag[remapList[i]] := 1;
  // 2nd step, build indices offset table
  n := 0;
  for i := 0 to remapIndices.Count - 1 do
  begin
    if tag[i] > 0 then
    begin
      tag[i] := n;
      Inc(n);
    end;
  end;
  // 3rd step, fillup indices map
  Result := TGLIntegerList.Create;
  Result.Count := remapIndices.Count;
  indicesMap := Result.list;
  for i := 0 to Result.Count - 1 do
    indicesMap[i] := tag[remapList[i]];
end;

procedure RemapTrianglesIndices(indices, indicesMap: TGLIntegerList);
var
  i, k, a, b, c, n: Integer;
begin
  Assert((indices.Count mod 3) = 0); // must be a multiple of 3
  n := indices.Count;
  i := 0;
  k := 0;
  while i < n do
  begin
    a := indicesMap[indices[i]];
    b := indicesMap[indices[i + 1]];
    c := indicesMap[indices[i + 2]];
    if (a <> b) and (b <> c) and (a <> c) then
    begin
      indices[k] := a;
      indices[k + 1] := b;
      indices[k + 2] := c;
      Inc(k, 3);
    end;
    Inc(i, 3);
  end;
  indices.Count := k;
end;

procedure remapIndices(indices, indicesMap: TGLIntegerList);
var
  i: Integer;
  map, ind: PIntegerArray;
begin
  ind := indices.list;
  map := indicesMap.list;
  for i := 0 to indices.Count - 1 do
    ind[i] := map[ind[i]];
end;

procedure UnifyTrianglesWinding(indices: TGLIntegerList);
var
  nbTris: Integer;
  mark: array of ByteBool; // marks triangles that have been processed
  triangleStack: TGLIntegerList; // marks triangles winded, that must be processed

  procedure TestRewind(a, b: Integer);
  var
    i, n: Integer;
    x, y, z: Integer;
  begin
    i := indices.Count - 3;
    n := nbTris - 1;
    while i > 0 do
    begin
      if not mark[n] then
      begin
        x := indices[i];
        y := indices[i + 1];
        z := indices[i + 2];
        if ((x = a) and (y = b)) or ((y = a) and (z = b)) or
          ((z = a) and (x = b)) then
        begin
          indices.Exchange(i, i + 2);
          mark[n] := True;
          triangleStack.Push(n);
        end
        else if ((x = b) and (y = a)) or ((y = b) and (z = a)) or
          ((z = b) and (x = a)) then
        begin
          mark[n] := True;
          triangleStack.Push(n);
        end;
      end;
      Dec(i, 3);
      Dec(n);
    end;
  end;

  procedure ProcessTriangleStack;
  var
    n, i: Integer;
  begin
    while triangleStack.Count > 0 do
    begin
      // get triangle, it is *assumed* properly winded
      n := triangleStack.Pop;
      i := n * 3;
      mark[n] := True;
      // rewind neighbours
      TestRewind(indices[i + 0], indices[i + 1]);
      TestRewind(indices[i + 1], indices[i + 2]);
      TestRewind(indices[i + 2], indices[i + 0]);
    end;
  end;

var
  n: Integer;
begin
  nbTris := indices.Count div 3;
  SetLength(mark, nbTris);
  // Build connectivity data
  triangleStack := TGLIntegerList.Create;
  try
    triangleStack.Capacity := nbTris div 4;
    // Pick a triangle, adjust normals of neighboring triangles, recurse
    for n := 0 to nbTris - 1 do
    begin
      if mark[n] then
        Continue;
      triangleStack.Push(n);
      ProcessTriangleStack;
    end;
  finally
    triangleStack.Free;
  end;
end;

procedure InvertTrianglesWinding(indices: TGLIntegerList);
var
  i: Integer;
begin
  Assert((indices.Count mod 3) = 0);
  i := indices.Count - 3;
  while i >= 0 do
  begin
    indices.Exchange(i, i + 2);
    Dec(i, 3);
  end;
end;

function BuildNormals(reference: TGLAffineVectorList; indices: TGLIntegerList)
  : TGLAffineVectorList;
var
  i, n, k: Integer;
  normalsCount: array of Byte;
  v: TAffineVector;
  refList, resultList: PAffineVectorArray;
  indicesList: PIntegerArray;
  reciproquals: PSingleArray;
begin
  Result := TGLAffineVectorList.Create;
  Result.Count := reference.Count;
  SetLength(normalsCount, reference.Count);
  refList := reference.list;
  indicesList := indices.list;
  resultList := Result.list;
  // 1st step, calculate triangle normals and sum
  i := 0;
  while i < indices.Count do
  begin
    v := CalcPlaneNormal(refList[indicesList[i]], refList[indicesList[i + 1]],
      refList[indicesList[i + 2]]);
    for n := i to i + 2 do
    begin
      k := indicesList[n];
      AddVector(resultList[k], v);
      Inc(normalsCount[k]);
    end;
    Inc(i, 3);
  end;
  // 2nd step, average normals
  reciproquals := Get0to255reciproquals;
  for i := 0 to reference.Count - 1 do
    ScaleVector(resultList[i], reciproquals[normalsCount[i]]);
end;

//----------------------------------------------------------
function BuildNonOrientedEdgesList(triangleIndices: TGLIntegerList;
  triangleEdges: TGLIntegerList = nil; edgesTriangles: TGLIntegerList = nil)
  : TGLIntegerList;
const
  cEdgesHashMax = 127; // must be a power of two minus 1
var
  edgesHash: array [0 .. cEdgesHashMax] of TGLIntegerList;
  curTri: Integer;
  edges: TGLIntegerList;

  function ProcessEdge(a, b: Integer): Integer;
  var
    i, n: Integer;
    HashKey: Integer;
    edgesList, iList: PIntegerArray;
    hashList: TGLIntegerList;
  begin
    if a >= b then
    begin
      i := a;
      a := b;
      b := i;
    end;
    HashKey := (a xor b) and cEdgesHashMax;
    hashList := edgesHash[HashKey];
    edgesList := edges.list;
    iList := hashList.list;
    for i := 0 to hashList.Count - 1 do
    begin
      n := iList[i];
      if (edgesList[n] = a) and (edgesList[n + 1] = b) then
      begin
        Result := n;
        Exit;
      end;
    end;
    Result := edges.Count;
    hashList.Add(Result);
    edges.Add(a, b);
  end;

  function ProcessEdge2(a, b: Integer): Integer;
  var
    n: Integer;
    HashKey: Integer;
    edgesList: PIntegerArray;
    iList, iListEnd: PInteger;
    hashList: TGLIntegerList;
  begin
    if a >= b then
    begin
      n := a;
      a := b;
      b := n;
    end;
    HashKey := (a xor (b shl 1)) and cEdgesHashMax;
    edgesList := edges.list;
    hashList := edgesHash[HashKey];
    iList := @hashList.list[0];
    iListEnd := @hashList.list[hashList.Count];
    while Cardinal(iList) < Cardinal(iListEnd) do
    begin
      n := iList^;
      if (edgesList[n] = a) and (edgesList[n + 1] = b) then
      begin
        edgesTriangles[n + 1] := curTri;
        Result := n;
        Exit;
      end;
      Inc(iList);
    end;
    Result := edges.Count;
    hashList.Add(Result);
    edges.Add(a, b);
    edgesTriangles.Add(curTri, -1);
  end;

var
  j, k: Integer;
  triIndicesList: PIntegerArray;
begin
  Result := TGLIntegerList.Create;
  Result.Capacity := 1024;
  Result.GrowthDelta := 1024;
  if Assigned(triangleEdges) then
    triangleEdges.Count := triangleIndices.Count;
  if Assigned(edgesTriangles) then
    edgesTriangles.Count := 0;
  // Creates Hash
  k := (triangleIndices.Count div (cEdgesHashMax + 1)) + 128;
  for j := 0 to High(edgesHash) do
  begin
    edgesHash[j] := TGLIntegerList.Create;
    edgesHash[j].Capacity := k;
  end;
  // collect all edges
  curTri := 0;
  triIndicesList := triangleIndices.list;
  edges := Result;
  if Assigned(triangleEdges) then
  begin
    if Assigned(edgesTriangles) then
    begin
      while curTri < triangleIndices.Count do
      begin
        triangleEdges[curTri] := ProcessEdge2(triIndicesList[curTri],
          triIndicesList[curTri + 1]);
        triangleEdges[curTri + 1] := ProcessEdge2(triIndicesList[curTri + 1],
          triIndicesList[curTri + 2]);
        triangleEdges[curTri + 2] := ProcessEdge2(triIndicesList[curTri + 2],
          triIndicesList[curTri]);
        Inc(curTri, 3);
      end;
    end
    else
    begin
      while curTri < triangleIndices.Count do
      begin
        triangleEdges[curTri] := ProcessEdge(triIndicesList[curTri],
          triIndicesList[curTri + 1]);
        triangleEdges[curTri + 1] := ProcessEdge(triIndicesList[curTri + 1],
          triIndicesList[curTri + 2]);
        triangleEdges[curTri + 2] := ProcessEdge(triIndicesList[curTri + 2],
          triIndicesList[curTri]);
        Inc(curTri, 3);
      end;
    end;
  end
  else
  begin
    if Assigned(edgesTriangles) then
    begin
      while curTri < triangleIndices.Count do
      begin
        ProcessEdge2(triIndicesList[curTri], triIndicesList[curTri + 1]);
        ProcessEdge2(triIndicesList[curTri + 1], triIndicesList[curTri + 2]);
        ProcessEdge2(triIndicesList[curTri + 2], triIndicesList[curTri]);
        Inc(curTri, 3);
      end;
    end
    else
    begin
      while curTri < triangleIndices.Count do
      begin
        ProcessEdge(triIndicesList[curTri], triIndicesList[curTri + 1]);
        ProcessEdge(triIndicesList[curTri + 1], triIndicesList[curTri + 2]);
        ProcessEdge(triIndicesList[curTri + 2], triIndicesList[curTri]);
        Inc(curTri, 3);
      end;
    end;
  end;
  // remove Hash
  for j := 0 to High(edgesHash) do
    edgesHash[j].Free;
end;

procedure IncreaseCoherency(indices: TGLIntegerList; cacheSize: Integer);
var
  i, n, maxVertex, bestCandidate, bestScore, candidateIdx,
    lastCandidate: Integer;
  trisOfVertex: array of TGLIntegerList;
  candidates: TGLIntegerList;
  indicesList: PIntegerArray;
begin
  // Alloc lookup structure
  maxVertex := indices.MaxInteger;
  SetLength(trisOfVertex, maxVertex + 1);
  for i := 0 to High(trisOfVertex) do
    trisOfVertex[i] := TGLIntegerList.Create;
  candidates := TGLIntegerList.Create;
  indicesList := PIntegerArray(indices.list);
  // Fillup lookup structure
  i := 0;
  while i < indices.Count do
  begin
    trisOfVertex[indicesList[i + 0]].Add(i);
    trisOfVertex[indicesList[i + 1]].Add(i);
    trisOfVertex[indicesList[i + 2]].Add(i);
    Inc(i, 3);
  end;
  // Optimize
  i := 0;
  while i < indices.Count do
  begin
    n := i - cacheSize;
    if n < 0 then
      n := 0;
    candidates.Count := 0;
    while n < i do
    begin
      candidates.Add(trisOfVertex[indicesList[n]]);
      Inc(n);
    end;
    bestCandidate := -1;
    if candidates.Count > 0 then
    begin
      candidateIdx := 0;
      bestScore := 0;
      candidates.Sort;
      lastCandidate := candidates.list[0];
      for n := 1 to candidates.Count - 1 do
      begin
        if candidates.list[n] <> lastCandidate then
        begin
          if n - candidateIdx > bestScore then
          begin
            bestScore := n - candidateIdx;
            bestCandidate := lastCandidate;
          end;
          lastCandidate := candidates.list[n];
          candidateIdx := n;
        end;
      end;
      if candidates.Count - candidateIdx > bestScore then
        bestCandidate := lastCandidate;
    end;
    if bestCandidate >= 0 then
    begin
      trisOfVertex[indicesList[i + 0]].Remove(i);
      trisOfVertex[indicesList[i + 1]].Remove(i);
      trisOfVertex[indicesList[i + 2]].Remove(i);
      trisOfVertex[indicesList[bestCandidate + 0]].Remove(bestCandidate);
      trisOfVertex[indicesList[bestCandidate + 1]].Remove(bestCandidate);
      trisOfVertex[indicesList[bestCandidate + 2]].Remove(bestCandidate);
      trisOfVertex[indicesList[i + 0]].Add(bestCandidate);
      trisOfVertex[indicesList[i + 1]].Add(bestCandidate);
      trisOfVertex[indicesList[i + 2]].Add(bestCandidate);
      indices.Exchange(bestCandidate + 0, i + 0);
      indices.Exchange(bestCandidate + 1, i + 1);
      indices.Exchange(bestCandidate + 2, i + 2);
    end
    else
    begin
      trisOfVertex[indicesList[i + 0]].Remove(i);
      trisOfVertex[indicesList[i + 1]].Remove(i);
      trisOfVertex[indicesList[i + 2]].Remove(i);
    end;
    Inc(i, 3);
  end;
  // Release lookup structure
  candidates.Free;
  for i := 0 to High(trisOfVertex) do
    trisOfVertex[i].Free;
end;

procedure WeldVertices(vertices: TGLAffineVectorList; indicesMap: TGLIntegerList;
  weldRadius: Single);
var
  i, j, n, k: Integer;
  pivot: PAffineVector;
  sum: TAffineVector;
  wr2: Single;
  mark: packed array of ByteBool;
begin
  indicesMap.Count := vertices.Count;
  SetLength(mark, vertices.Count);
  wr2 := Sqr(weldRadius);
  // mark duplicates, compute barycenters and indicesMap
  i := 0;
  k := 0;
  while i < vertices.Count do
  begin
    if not mark[i] then
    begin
      pivot := @vertices.list[i];
      indicesMap[i] := k;
      n := 0;
      j := vertices.Count - 1;
      while j > i do
      begin
        if not mark[j] then
        begin
          if VectorDistance2(pivot^, vertices.list[j]) <= wr2 then
          begin
            if n = 0 then
            begin
              sum := VectorAdd(pivot^, vertices.list[j]);
              n := 2;
            end
            else
            begin
              AddVector(sum, vertices.list[j]);
              Inc(n);
            end;
            indicesMap[j] := k;
            mark[j] := True;
          end;
        end;
        Dec(j);
      end;
      if n > 0 then
        vertices.list[i] := VectorScale(sum, 1 / n);
      Inc(k);
    end;
    Inc(i);
  end;
  // pack vertices list
  k := 0;
  for i := 0 to vertices.Count - 1 do
  begin
    if not mark[i] then
    begin
      vertices.list[k] := vertices.list[i];
      Inc(k);
    end;
  end;
  vertices.Count := k;
end;

function StripifyMesh(indices: TGLIntegerList; maxVertexIndex: Integer;
  agglomerateLoneTriangles: Boolean = False): TGLPersistentObjectList;
var
  accountedTriangles: array of ByteBool;
  vertexTris: array of TGLIntegerList;
  indicesList: PIntegerArray;
  indicesCount: Integer;
  currentStrip: TGLIntegerList;
  nextTriangle, nextVertex: Integer;

  function FindTriangleWithEdge(vertA, vertB: Integer): Boolean;
  var
    i, n: Integer;
    p: PIntegerArray;
    list: TGLIntegerList;
  begin
    Result := False;
    list := vertexTris[vertA];
    for n := 0 to list.Count - 1 do
    begin
      i := list.list[n];
      if not(accountedTriangles[i]) then
      begin
        p := @indicesList[i];
        if (p[0] = vertA) and (p[1] = vertB) then
        begin
          Result := True;
          nextVertex := p[2];
          nextTriangle := i;
          Break;
        end
        else if (p[1] = vertA) and (p[2] = vertB) then
        begin
          Result := True;
          nextVertex := p[0];
          nextTriangle := i;
          Break;
        end
        else if (p[2] = vertA) and (p[0] = vertB) then
        begin
          Result := True;
          nextVertex := p[1];
          nextTriangle := i;
          Break;
        end;
      end;
    end;

  end;

  procedure BuildStrip(vertA, vertB: Integer);
  var
    vertC: Integer;
  begin
    currentStrip.Add(vertA, vertB);
    repeat
      vertC := nextVertex;
      currentStrip.Add(vertC);
      accountedTriangles[nextTriangle] := True;
      if not FindTriangleWithEdge(vertB, vertC) then
        Break;
      currentStrip.Add(nextVertex);
      accountedTriangles[nextTriangle] := True;
      vertB := nextVertex;
      vertA := vertC;
    until not FindTriangleWithEdge(vertB, vertA);
  end;

var
  i, n, triangle: Integer;
  loneTriangles: TGLIntegerList;
begin
  Assert((indices.Count mod 3) = 0, 'indices count is not a multiple of 3!');
  Result := TGLPersistentObjectList.Create;
  // direct access and cache vars
  indicesList := indices.list;
  indicesCount := indices.Count;
  // Build adjacency lookup table (vertex based, not triangle based)
  SetLength(vertexTris, maxVertexIndex + 1);
  for i := 0 to High(vertexTris) do
    vertexTris[i] := TGLIntegerList.Create;
  n := 0;
  triangle := 0;
  for i := 0 to indicesCount - 1 do
  begin
    vertexTris[indicesList[i]].Add(triangle);
    if n = 2 then
    begin
      n := 0;
      Inc(triangle, 3);
    end
    else
      Inc(n);
  end;
  // Now, we use a greedy algo to build triangle strips
  SetLength(accountedTriangles, indicesCount); // yeah, waste of memory
  if agglomerateLoneTriangles then
  begin
    loneTriangles := TGLIntegerList.Create;
    Result.Add(loneTriangles);
  end
  else
    loneTriangles := nil;
  i := 0;
  while i < indicesCount do
  begin
    if not accountedTriangles[i] then
    begin
      accountedTriangles[i] := True;
      if FindTriangleWithEdge(indicesList[i + 1], indicesList[i]) then
      begin
        currentStrip := TGLIntegerList.Create;
        currentStrip.Add(indicesList[i + 2]);
        BuildStrip(indicesList[i], indicesList[i + 1]);
      end
      else if FindTriangleWithEdge(indicesList[i + 2], indicesList[i + 1]) then
      begin
        currentStrip := TGLIntegerList.Create;
        currentStrip.Add(indicesList[i]);
        BuildStrip(indicesList[i + 1], indicesList[i + 2]);
      end
      else if FindTriangleWithEdge(indicesList[i], indicesList[i + 2]) then
      begin
        currentStrip := TGLIntegerList.Create;
        currentStrip.Add(indicesList[i + 1]);
        BuildStrip(indicesList[i + 2], indicesList[i]);
      end
      else
      begin
        if agglomerateLoneTriangles then
          currentStrip := loneTriangles
        else
          currentStrip := TGLIntegerList.Create;
        currentStrip.Add(indicesList[i], indicesList[i + 1],
          indicesList[i + 2]);
      end;
      if currentStrip <> loneTriangles then
        Result.Add(currentStrip);
    end;
    Inc(i, 3);
  end;
  // cleanup
  for i := 0 to High(vertexTris) do
    vertexTris[i].Free;
end;

procedure SubdivideTriangles(smoothFactor: Single; vertices: TGLAffineVectorList;
  triangleIndices: TGLIntegerList; normals: TGLAffineVectorList = nil;
  onSubdivideEdge: TSubdivideEdgeEvent = nil);
var
  i, a, b, c, nv: Integer;
  edges: TGLIntegerList;
  triangleEdges: TGLIntegerList;
  p, n: TAffineVector;
  f: Single;
begin
  // build edges list
  triangleEdges := TGLIntegerList.Create;
  try
    edges := BuildNonOrientedEdgesList(triangleIndices, triangleEdges);
    try
      nv := vertices.Count;
      // split all edges, add corresponding vertex & normal
      i := 0;
      while i < edges.Count do
      begin
        a := edges[i];
        b := edges[i + 1];
        p := VectorLerp(vertices[a], vertices[b], 0.5);
        if Assigned(normals) then
        begin
          n := VectorNormalize(VectorLerp(normals[a], normals[b], 0.5));
          normals.Add(n);
          if smoothFactor <> 0 then
          begin
            f := 0.25 * smoothFactor * VectorDistance(vertices[a], vertices[b])
              * (1 - VectorDotProduct(normals[a], normals[b]));
            if VectorDotProduct(normals[a], VectorSubtract(vertices[b],
              vertices[a])) + VectorDotProduct(normals[b],
              VectorSubtract(vertices[a], vertices[b])) > 0 then
              f := -f;
            CombineVector(p, n, f);
          end;
        end;
        if Assigned(onSubdivideEdge) then
          onSubdivideEdge(a, b, vertices.Add(p))
        else
          vertices.Add(p);
        Inc(i, 2);
      end;
      // spawn new triangles geometry
      i := triangleIndices.Count - 3;
      while i >= 0 do
      begin
        a := nv + triangleEdges[i + 0] div 2;
        b := nv + triangleEdges[i + 1] div 2;
        c := nv + triangleEdges[i + 2] div 2;
        triangleIndices.Add(triangleIndices[i + 0], a, c);
        triangleIndices.Add(a, triangleIndices[i + 1], b);
        triangleIndices.Add(b, triangleIndices[i + 2], c);
        triangleIndices[i + 0] := a;
        triangleIndices[i + 1] := b;
        triangleIndices[i + 2] := c;
        Dec(i, 3);
      end;
    finally
      edges.Free;
    end;
  finally
    triangleEdges.Free;
  end;
end;

type

  TTriangleEdgeInfo = record
    adjacentTriangle: array [0 .. 2] of LongWord;
    // Bits 0:1 is edge number of adjacent triangle 0
    // Bits 2:3 is edge number of adjacent triangle 1
    // Bits 4:5 is edge number of adjacent triangle 2
    adjacentTriangleEdges: Byte;
    openEdgeMask: Byte;
  end;

  TTriangleEdgeInfoArray = array of TTriangleEdgeInfo;

  TTriangleBoundary = record
    vertexIndex: LongWord;
    triangle: LongWord;
    edge: LongWord;
    prev: LongWord;
    next: array [0 .. 2] of LongWord;
    active: LongWord;
    maxSqArea: Single;
  end;

  TTriangleBoundaryArray = array of TTriangleBoundary;

  TVector3dw = array [0 .. 2] of LongWord;
  PVector3dw = ^TVector3dw;

var
  indicesList: PLongWordArray; // Reference to indices list of usual triangles
  verticesList: PAffineVectorArray; // Reference to vertices list
  PrimitiveNum: LongWord; // Number of triangles
  edgeInfo: TTriangleEdgeInfoArray;
  boundaryList: TTriangleBoundaryArray;

function sameVertex(i0, i1: LongWord): Boolean;
begin
  Result := (verticesList[i0].x = verticesList[i1].x) and
    (verticesList[i0].y = verticesList[i1].y) and
    (verticesList[i0].z = verticesList[i1].z);
end;

procedure joinTriangles(tri1: Integer; edge1: Cardinal; tri2: Integer;
  edge2: Cardinal);
begin
  Assert((edge1 < 3) and (edge2 < 3), 'joinTriangles: Multiple edge detected.');

  edgeInfo[tri1].adjacentTriangle[edge1] := tri2;
  edgeInfo[tri1].adjacentTriangleEdges := edgeInfo[tri1]
    .adjacentTriangleEdges and not(3 shl (2 * edge1));
  edgeInfo[tri1].adjacentTriangleEdges := edgeInfo[tri1]
    .adjacentTriangleEdges or (edge2 shl (2 * edge1));

  edgeInfo[tri2].adjacentTriangle[edge2] := tri1;
  edgeInfo[tri2].adjacentTriangleEdges := edgeInfo[tri2]
    .adjacentTriangleEdges and not(3 shl (2 * edge2));
  edgeInfo[tri2].adjacentTriangleEdges := edgeInfo[tri2]
    .adjacentTriangleEdges or (edge1 shl (2 * edge2));
end;

procedure matchWithTriangleSharingEdge(triangle, edge, v0, v1,
  otherv: LongWord);
var
  i, j: Integer;
  doubleTri: Integer;
  otherEdge: Integer;
  vertexIndex: PVector3dw;
begin
  doubleTri := -1;
  otherEdge := 0;
  // Match shared edges based on vertex numbers (relatively fast).
  for i := triangle + 1 to PrimitiveNum - 1 do
  begin
    j := i * 3;
    vertexIndex := @indicesList[j];

    if vertexIndex[0] = v0 then
      if vertexIndex[2] = v1 then
        if edgeInfo[i].adjacentTriangle[2] = $FFFFFFFF then
          if vertexIndex[1] = otherv then
          begin
            if (doubleTri < 0) then
            begin
              doubleTri := i;
              otherEdge := 2;
            end;
          end
          else
          begin
            joinTriangles(i, 2, triangle, edge);
            Exit;
          end;

    if vertexIndex[1] = v0 then
      if vertexIndex[0] = v1 then
        if edgeInfo[i].adjacentTriangle[0] = $FFFFFFFF then
          if vertexIndex[2] = otherv then
          begin
            if doubleTri < 0 then
            begin
              doubleTri := i;
              otherEdge := 0;
            end;
          end
          else
          begin
            joinTriangles(i, 0, triangle, edge);
            Exit;
          end;

    if vertexIndex[2] = v0 then
      if vertexIndex[1] = v1 then
        if edgeInfo[i].adjacentTriangle[1] = $FFFFFFFF then
          if vertexIndex[0] = otherv then
          begin
            if doubleTri < 0 then
            begin
              doubleTri := i;
              otherEdge := 1;
            end;
          end
          else
          begin
            joinTriangles(i, 1, triangle, edge);
            Exit;
          end;
  end;

  // Match shared edges based on vertex XYZ values (slow check).
  for i := triangle + 1 to PrimitiveNum - 1 do
  begin
    j := i * 3;
    vertexIndex := @indicesList[j];

    if sameVertex(vertexIndex[0], v0) then
      if sameVertex(vertexIndex[2], v1) then
        if edgeInfo[i].adjacentTriangle[2] = $FFFFFFFF then
          if vertexIndex[0] = otherv then
          begin
            if doubleTri < 0 then
            begin
              doubleTri := i;
              otherEdge := 2;
            end;
          end
          else
          begin
            joinTriangles(i, 2, triangle, edge);
            Exit;
          end;

    if sameVertex(vertexIndex[1], v0) then
      if sameVertex(vertexIndex[0], v1) then
        if edgeInfo[i].adjacentTriangle[0] = $FFFFFFFF then
          if vertexIndex[0] = otherv then
          begin
            if doubleTri < 0 then
            begin
              doubleTri := i;
              otherEdge := 0;
            end;
          end
          else
          begin
            joinTriangles(i, 0, triangle, edge);
            Exit;
          end;

    if sameVertex(vertexIndex[2], v0) then
      if sameVertex(vertexIndex[1], v1) then
        if edgeInfo[i].adjacentTriangle[1] = $FFFFFFFF then
          if vertexIndex[0] = otherv then
          begin
            if doubleTri < 0 then
            begin
              doubleTri := i;
              otherEdge := 1;
            end;
          end
          else
          begin
            joinTriangles(i, 1, triangle, edge);
            Exit;
          end;
  end;

  // Only connect a triangle to a triangle with the exact
  // same three vertices as a last resort.
  if doubleTri >= 0 then
    joinTriangles(doubleTri, otherEdge, triangle, edge);
end;

function ComputeTriangleEdgeInfo: Boolean;
var
  i, j: Integer;
  vertexIndex: PVector3dw;
begin
  Result := True;
  try
    // Initialize edge information as if all triangles are fully disconnected.
    for i := 0 to PrimitiveNum - 1 do
    begin
      edgeInfo[i].adjacentTriangle[0] := $FFFFFFFF; // Vertex 0,1 edge
      edgeInfo[i].adjacentTriangle[1] := $FFFFFFFF; // Vertex 1,2 edge
      edgeInfo[i].adjacentTriangle[2] := $FFFFFFFF; // Vertex 2,0 edge
      edgeInfo[i].adjacentTriangleEdges := (3 shl 0) or (3 shl 2) or (3 shl 4);
      edgeInfo[i].openEdgeMask := 0;
    end;

    for i := 0 to PrimitiveNum - 1 do
    begin
      j := i * 3;
      vertexIndex := @indicesList[j];
      if edgeInfo[i].adjacentTriangle[0] = $FFFFFFFF then
        matchWithTriangleSharingEdge(i, 0, vertexIndex[0], vertexIndex[1],
          vertexIndex[2]);
      if edgeInfo[i].adjacentTriangle[1] = $FFFFFFFF then
        matchWithTriangleSharingEdge(i, 1, vertexIndex[1], vertexIndex[2],
          vertexIndex[0]);
      if edgeInfo[i].adjacentTriangle[2] = $FFFFFFFF then
        matchWithTriangleSharingEdge(i, 2, vertexIndex[2], vertexIndex[0],
          vertexIndex[1]);
    end;
  except
    Result := False;
  end;
end;

procedure findOpenBoundary(triangle, edge: LongWord;
  var boundaryVertices: LongWord);
var
  v0, v, nextEdge, otherTriangle, Count: LongWord;
  i: Byte;
  finded: Boolean;
begin
  Count := 0;
  if (edgeInfo[triangle].openEdgeMask and (1 shl edge)) <> 0 then
    Exit;
  Assert(edgeInfo[triangle].adjacentTriangle[edge] = $FFFFFFFF);

  edgeInfo[triangle].openEdgeMask := edgeInfo[triangle].openEdgeMask or
    (1 shl edge);

  v0 := indicesList[3 * triangle + edge];
  boundaryList[Count].vertexIndex := v0;
  boundaryList[Count].triangle := triangle;
  boundaryList[Count].edge := edge;
  Inc(Count);

  nextEdge := (edge + 1) mod 3;
  v := indicesList[3 * triangle + nextEdge];
  while not sameVertex(v, v0) do
  begin
    otherTriangle := edgeInfo[triangle].adjacentTriangle[nextEdge];
    while otherTriangle <> $FFFFFFFF do
    begin
      finded := False;
      for i := 0 to 2 do
        if edgeInfo[otherTriangle].adjacentTriangle[i] = triangle then
        begin
          Assert(sameVertex(indicesList[3 * otherTriangle + (i + 1) mod 3], v));
          triangle := otherTriangle;
          nextEdge := (i + 1) mod 3;
          finded := True;
          Break;
        end;
      Assert(finded);
      otherTriangle := edgeInfo[triangle].adjacentTriangle[nextEdge];
    end;

    // Mark this edge as processed to avoid reprocessing
    // the boundary multiple times.
    edgeInfo[triangle].openEdgeMask := edgeInfo[triangle].openEdgeMask or
      (1 shl nextEdge);

    boundaryList[Count].vertexIndex := v;
    boundaryList[Count].triangle := triangle;
    boundaryList[Count].edge := nextEdge;
    Inc(Count);

    nextEdge := (nextEdge + 1) mod 3;
    v := indicesList[3 * triangle + nextEdge];
  end;
  boundaryVertices := Count;
end;

function polygonArea(boundaryIndex: LongWord): Single;
var
  // Md2TriangleVertex *v;
  d01, d02, prod: TVector3f;
  v0, v1, v2: Integer;
begin
  // Get the vertices of the triangle along the boundary.
  v0 := boundaryList[boundaryIndex].vertexIndex;
  v1 := boundaryList[boundaryList[boundaryIndex].next[0]].vertexIndex;
  v2 := boundaryList[boundaryList[boundaryIndex].next[1]].vertexIndex;

  // Compute the area of the triangle
  d01 := VectorSubtract(verticesList[v0], verticesList[v1]);
  d02 := VectorSubtract(verticesList[v0], verticesList[v2]);
  prod := VectorCrossProduct(d01, d02);
  Result := VectorLength(prod);
end;

procedure fixOpenTriangle(boundaryIndex: LongWord);
var
  newTriIndex, b0, bp, b1, b2: LongWord;
begin
  b0 := boundaryIndex;
  bp := boundaryList[b0].prev;
  b1 := boundaryList[b0].next[0];
  b2 := boundaryList[b0].next[1];

  Assert(boundaryList[b1].next[0] = b2);
  Assert(boundaryList[bp].next[0] = b0);
  Assert(boundaryList[bp].next[1] = b1);

  // Initialize the new triangle.
  indicesList[PrimitiveNum * 3 + 0] := boundaryList[b2].vertexIndex;
  indicesList[PrimitiveNum * 3 + 1] := boundaryList[b1].vertexIndex;
  indicesList[PrimitiveNum * 3 + 2] := boundaryList[b0].vertexIndex;
  Inc(PrimitiveNum);

  // Mark edge 2 unconnected
  newTriIndex := indicesList[PrimitiveNum * 3 - 3];
  edgeInfo[newTriIndex].adjacentTriangle[2] := $FFFFFFFF;
  edgeInfo[newTriIndex].adjacentTriangleEdges := 3 shl 4;

  // Make sure edges we are joining are currently unconnected.
  Assert(edgeInfo[boundaryList[b1].triangle].adjacentTriangle
    [boundaryList[b1].edge] = $FFFFFFFF);
  Assert(edgeInfo[boundaryList[b0].triangle].adjacentTriangle
    [boundaryList[b0].edge] = $FFFFFFFF);

  // Join the triangles with the new triangle.
  joinTriangles(newTriIndex, 0, boundaryList[b1].triangle,
    boundaryList[b1].edge);
  joinTriangles(newTriIndex, 1, boundaryList[b0].triangle,
    boundaryList[b0].edge);

  // Update the boundary list based on the addition of the new triangle.
  boundaryList[b0].triangle := newTriIndex;
  boundaryList[b0].edge := 2;
  boundaryList[b0].next[0] := b2;
  boundaryList[b0].next[1] := boundaryList[b2].next[0];
  boundaryList[b0].maxSqArea := GLS.MeshUtils.polygonArea(b0);

  boundaryList[bp].next[1] := b2;
  boundaryList[b1].active := 0;
  boundaryList[b2].prev := b0;
end;

procedure fixOpenBoundary(Count: LongWord);
var
  b0, b1, b2: LongWord;
  i: Integer;
  maxMaxSqArea: Single;
  numActive: LongWord;
  minIndex: LongWord;
  min: Single;
begin
  if Count = 1 then
    (* Ugh, a degenerate triangle with two (or perhaps three)
      identical vertices tricking us into thinking that there
      is an open edge.  Hopefully these should be eliminated
      by an earlier "eliminate" pass, but such triangles are
      harmless. *)
    Exit;

  Assert(Count >= 3);

  if Count = 3 then
  begin
    (* Often a common case.  Save bookkeeping and close the triangle
      boundary immediately. *)
    b0 := 0;
    b1 := 1;
    b2 := 2;
  end
  else
  begin
    minIndex := 0;

    boundaryList[0].prev := Count - 1;
    boundaryList[0].next[0] := 1;
    boundaryList[0].next[1] := 2;
    boundaryList[0].active := 1;

    for i := 1 to Count - 3 do
    begin
      boundaryList[i].prev := i - 1;
      boundaryList[i].next[0] := i + 1;
      boundaryList[i].next[1] := i + 2;
      boundaryList[i].active := 1;
    end;
    i := Count - 3;

    boundaryList[i].prev := i - 1;
    boundaryList[i].next[0] := i + 1;
    boundaryList[i].next[1] := 0;
    boundaryList[i].active := 1;

    boundaryList[i + 1].prev := i;
    boundaryList[i + 1].next[0] := 0;
    boundaryList[i + 1].next[1] := 1;
    boundaryList[i + 1].active := 1;

    boundaryList[0].maxSqArea := GLS.MeshUtils.polygonArea(0);
    maxMaxSqArea := boundaryList[0].maxSqArea;

    for i := 1 to Count - 1 do
    begin
      boundaryList[i].maxSqArea := GLS.MeshUtils.polygonArea(i);
      if boundaryList[i].maxSqArea > maxMaxSqArea then
        maxMaxSqArea := boundaryList[i].maxSqArea;
    end;

    (* If triangles are formed from adjacent edges along the
      boundary, at least front-facing such triangle should
      be front-facing (ie, have a non-negative area). *)

    Assert(maxMaxSqArea >= 0.0);
    maxMaxSqArea := 2.0 * maxMaxSqArea;
    numActive := Count;

    while numActive > 3 do
    begin
      min := maxMaxSqArea;
      for i := 0 to Count - 1 do
        if boundaryList[i].active > 0 then
          if boundaryList[i].maxSqArea < min then
            if boundaryList[i].maxSqArea >= 0.0 then
            begin
              min := boundaryList[i].maxSqArea;
              minIndex := i;
            end;

      Assert(min < maxMaxSqArea);
      fixOpenTriangle(minIndex);

      (* Newly created triangle formed from adjacent edges
        along the boundary could be larger than the
        previous largest triangle. *)
      if (boundaryList[minIndex].maxSqArea > maxMaxSqArea) then
        maxMaxSqArea := 2.0 * boundaryList[minIndex].maxSqArea;

      Dec(numActive);
    end;

    for i := 0 to Count - 1 do
      if boundaryList[i].active > 0 then
      begin
        minIndex := i;
        Break;
      end;

    Assert(LongWord(i) < Count);

    b0 := minIndex;
    b1 := boundaryList[b0].next[0];
    b2 := boundaryList[b0].next[1];

    Assert(boundaryList[b0].prev = b2);
    Assert(boundaryList[b1].prev = b0);
    Assert(boundaryList[b1].next[0] = b2);
    Assert(boundaryList[b1].next[1] = b0);
    Assert(boundaryList[b2].prev = b1);
    Assert(boundaryList[b2].next[0] = b0);
    Assert(boundaryList[b2].next[1] = b1);
  end;

  // Place final "keystone" triangle to fill completely the open boundary

  if LongWord(Length(edgeInfo)) < (PrimitiveNum + 1) then
    SetLength(edgeInfo, Length(edgeInfo) + Integer(vEdgeInfoReserveSize));

  // Initialize the new triangle.
  indicesList[PrimitiveNum * 3 + 0] := boundaryList[b2].vertexIndex;
  indicesList[PrimitiveNum * 3 + 1] := boundaryList[b1].vertexIndex;
  indicesList[PrimitiveNum * 3 + 2] := boundaryList[b0].vertexIndex;
  // Join keystone triangle.
  joinTriangles(PrimitiveNum, 0, boundaryList[b1].triangle,
    boundaryList[b1].edge);
  joinTriangles(PrimitiveNum, 1, boundaryList[b0].triangle,
    boundaryList[b0].edge);
  joinTriangles(PrimitiveNum, 2, boundaryList[b2].triangle,
    boundaryList[b2].edge);
  Inc(PrimitiveNum);
end;

procedure findAndFixOpenTriangleGroups(triangle: LongWord);
var
  Count: LongWord;
begin
  if Length(boundaryList) < Integer(1 + 2 * PrimitiveNum) then
    SetLength(boundaryList, 1 + 2 * PrimitiveNum);

  if edgeInfo[triangle].adjacentTriangle[0] = $FFFFFFFF then
  begin
    findOpenBoundary(triangle, 0, Count);
    fixOpenBoundary(Count);
  end;
  if edgeInfo[triangle].adjacentTriangle[1] = $FFFFFFFF then
  begin
    findOpenBoundary(triangle, 1, Count);
    fixOpenBoundary(Count);
  end;
  if edgeInfo[triangle].adjacentTriangle[2] = $FFFFFFFF then
  begin
    findOpenBoundary(triangle, 2, Count);
    fixOpenBoundary(Count);
  end;
end;

procedure CloseOpenTriangleGroups;
var
  i: LongWord;
begin
  i := 0;
  while i < PrimitiveNum do
  begin
    if (edgeInfo[i].adjacentTriangle[0] = $FFFFFFFF) or
      (edgeInfo[i].adjacentTriangle[1] = $FFFFFFFF) or
      (edgeInfo[i].adjacentTriangle[2] = $FFFFFFFF) then
      findAndFixOpenTriangleGroups(i);
    Inc(i);
  end;
end;

procedure CheckForBogusAdjacency;

  function AdjacentEdge(x, n: Integer): Integer;
  begin
    Result := (x shr (2 * n)) and 3;
  end;

var
  i, j: Integer;
  adjacentTriangle, adjacentTriangleSharedEdge: LongWord;
begin
  for i := 0 to PrimitiveNum - 1 do
    for j := 0 to 2 do
    begin
      adjacentTriangleSharedEdge :=
        AdjacentEdge(edgeInfo[i].adjacentTriangleEdges, j);
      adjacentTriangle := edgeInfo[i].adjacentTriangle[j];
      if adjacentTriangle <> $FFFFFFFF then
      begin
        Assert(adjacentTriangleSharedEdge < 3);
        Assert(edgeInfo[adjacentTriangle].adjacentTriangle
          [adjacentTriangleSharedEdge] = LongWord(i));
        Assert(AdjacentEdge(edgeInfo[adjacentTriangle].adjacentTriangleEdges,
          adjacentTriangleSharedEdge) = j);
      end
      else
        Assert(adjacentTriangleSharedEdge = 3);
    end;
end;

procedure reconnectSharedEdges(isTri, wasTri: LongWord);
var
  tri, Count: LongWord;
  i, j: Byte;
begin
  for i := 0 to 3 do
  begin
    tri := edgeInfo[wasTri].adjacentTriangle[i];
    if tri <> $FFFFFFFF then
    begin
      Count := 0;
      for j := 0 to 3 do
      begin
        if edgeInfo[tri].adjacentTriangle[j] = wasTri then
        begin
          edgeInfo[tri].adjacentTriangle[j] := isTri;
          Inc(Count);
        end;
        if edgeInfo[tri].adjacentTriangle[j] = isTri then
          Inc(Count);
      end;
      Assert(Count > 0);
    end;
  end;
end;

procedure possiblyReconnectTriangle(tri, isTri, wasTri: LongWord);
var
  j: Byte;
begin
  for j := 0 to 3 do
    if edgeInfo[tri].adjacentTriangle[j] = wasTri then
      edgeInfo[tri].adjacentTriangle[j] := isTri;
end;

function eliminateAdjacentDegeneratePair(badTri, otherBadTri, goodTri: LongWord)
  : LongWord;
var
  otherGoodTri: LongWord;
  i: Integer;
  j: Byte;
begin
  Assert(badTri < PrimitiveNum);
  Assert(otherBadTri < PrimitiveNum);
  Assert(goodTri < PrimitiveNum);

  otherGoodTri := 0;
  { The other good triangle is the triangle adjacent to the other
    bad triangle but which is not the bad triangle. }
  for i := 0 to 3 do
    if edgeInfo[otherBadTri].adjacentTriangle[i] <> badTri then
    begin
      otherGoodTri := edgeInfo[otherBadTri].adjacentTriangle[i];
      Break;
    end;

  Assert(i < 3);

  (* Fix the good triangle so that both edges adjacent to the
    bad triangle are now adjacent to the other good triangle. *)
  for i := 0 to 3 do
    if edgeInfo[goodTri].adjacentTriangle[i] = badTri then
      edgeInfo[goodTri].adjacentTriangle[i] := otherGoodTri;

  (* Fix the other good triangle so that both edges adjacent to the
    other bad triangle are now adjacent to the good triangle. *)

  for i := 0 to 3 do
    if edgeInfo[otherGoodTri].adjacentTriangle[i] = otherBadTri then
      edgeInfo[otherGoodTri].adjacentTriangle[i] := goodTri;

  (* Decrement the object's triangle count by 2. Then copy
    non-degenerate triangles from the end of the triangle
    list to the slots once used by the eliminated triangles.
    Be sure to copy the edgeInfo data structure too.  Also
    if goodTri is one of the last two triangles, be careful
    to make sure it gets copied. *)

  Dec(PrimitiveNum, 2);

  if goodTri < PrimitiveNum then
  begin
    PVector3dw(@indicesList[3 * badTri])^ :=
      PVector3dw(@indicesList[3 * PrimitiveNum + 3])^;
    edgeInfo[badTri] := edgeInfo[PrimitiveNum + 1];
    PVector3dw(@indicesList[3 * otherBadTri])^ :=
      PVector3dw(@indicesList[3 * PrimitiveNum])^;
    edgeInfo[otherBadTri] := edgeInfo[PrimitiveNum];
    reconnectSharedEdges(badTri, PrimitiveNum + 1);
    reconnectSharedEdges(otherBadTri, PrimitiveNum);
    (* We are moving two triangles and they each might be
      connected to each other.  Possibly reconnect the
      edges appropriately if so. *)
    possiblyReconnectTriangle(badTri, otherBadTri, PrimitiveNum);
    possiblyReconnectTriangle(otherBadTri, badTri, PrimitiveNum + 1);
  end
  else
  begin
    if goodTri = PrimitiveNum + 1 then
      if badTri < PrimitiveNum then
      begin
        PVector3dw(@indicesList[3 * badTri])^ :=
          PVector3dw(@indicesList[3 * PrimitiveNum + 3])^;
        edgeInfo[badTri] := edgeInfo[PrimitiveNum + 1];
        PVector3dw(@indicesList[3 * otherBadTri])^ :=
          PVector3dw(@indicesList[3 * PrimitiveNum])^;
        edgeInfo[otherBadTri] := edgeInfo[PrimitiveNum];
        reconnectSharedEdges(badTri, PrimitiveNum + 1);
        possiblyReconnectTriangle(badTri, otherBadTri, PrimitiveNum);

        if otherBadTri < PrimitiveNum then
        begin
          reconnectSharedEdges(otherBadTri, PrimitiveNum);
          possiblyReconnectTriangle(otherBadTri, badTri, PrimitiveNum + 1);
        end;

        goodTri := badTri;
      end
      else
      begin
        Assert(otherBadTri < PrimitiveNum);
        PVector3dw(@indicesList[3 * otherBadTri])^ :=
          PVector3dw(@indicesList[3 * PrimitiveNum + 3])^;
        edgeInfo[otherBadTri] := edgeInfo[PrimitiveNum + 1];
        PVector3dw(@indicesList[3 * badTri])^ :=
          PVector3dw(@indicesList[3 * PrimitiveNum])^;
        edgeInfo[badTri] := edgeInfo[PrimitiveNum];
        reconnectSharedEdges(otherBadTri, PrimitiveNum + 1);
        possiblyReconnectTriangle(otherBadTri, badTri, PrimitiveNum);

        if badTri < PrimitiveNum then
        begin
          reconnectSharedEdges(badTri, PrimitiveNum);
          possiblyReconnectTriangle(badTri, otherBadTri, PrimitiveNum + 1);
        end;

        goodTri := otherBadTri;
      end
    else
    begin
      Assert(goodTri = PrimitiveNum);
      if badTri < PrimitiveNum then
      begin
        PVector3dw(@indicesList[3 * badTri])^ :=
          PVector3dw(@indicesList[3 * PrimitiveNum])^;
        edgeInfo[badTri] := edgeInfo[PrimitiveNum];
        PVector3dw(@indicesList[3 * otherBadTri])^ :=
          PVector3dw(@indicesList[3 * PrimitiveNum + 3])^;
        edgeInfo[otherBadTri] := edgeInfo[PrimitiveNum + 1];
        reconnectSharedEdges(badTri, PrimitiveNum);
        possiblyReconnectTriangle(badTri, otherBadTri, PrimitiveNum + 1);

        if otherBadTri < PrimitiveNum then
        begin
          reconnectSharedEdges(otherBadTri, PrimitiveNum + 1);
          possiblyReconnectTriangle(otherBadTri, badTri, PrimitiveNum);
        end;

        goodTri := badTri;
      end
      else
      begin
        Assert(otherBadTri < PrimitiveNum);
        PVector3dw(@indicesList[3 * otherBadTri])^ :=
          PVector3dw(@indicesList[3 * PrimitiveNum])^;
        edgeInfo[otherBadTri] := edgeInfo[PrimitiveNum];
        PVector3dw(@indicesList[3 * badTri])^ :=
          PVector3dw(@indicesList[3 * PrimitiveNum + 3])^;
        edgeInfo[badTri] := edgeInfo[PrimitiveNum + 1];
        reconnectSharedEdges(otherBadTri, PrimitiveNum);
        possiblyReconnectTriangle(otherBadTri, badTri, PrimitiveNum + 1);

        if badTri < PrimitiveNum then
        begin
          reconnectSharedEdges(badTri, PrimitiveNum + 1);
          possiblyReconnectTriangle(badTri, otherBadTri, PrimitiveNum);
        end;

        goodTri := otherBadTri;
      end;
    end;
  end;

  Assert(goodTri < PrimitiveNum);

  // Patch up the edge info for the two relocated triangles.
  for i := PrimitiveNum - 1 downto 0 do
    for j := 0 to 3 do
      Assert(edgeInfo[i].adjacentTriangle[j] < PrimitiveNum);

  // Two degenerate triangles eliminated.
  Result := 2;
end;

function findAndFixAdjacentDegeneratePair(tri: LongWord): Integer;
var
  t0, t1, t2: LongWord;
begin

  t0 := edgeInfo[tri].adjacentTriangle[0];
  t1 := edgeInfo[tri].adjacentTriangle[1];
  t2 := edgeInfo[tri].adjacentTriangle[2];

  // Trivially degnerate triangles should have already been eliminated.
  Assert(t0 <> tri);
  Assert(t1 <> tri);
  Assert(t2 <> tri);

  if (t0 = t1) and (t1 = t2) then
  begin
    if t0 <> $FFFFFFFF then
    begin
      Assert(edgeInfo[t0].adjacentTriangle[0] = tri);
      Assert(edgeInfo[t0].adjacentTriangle[1] = tri);
      Assert(edgeInfo[t0].adjacentTriangle[2] = tri);
    end;
    Result := 0;
    Exit;
  end;

  if t0 = t1 then
    if t0 <> $FFFFFFFF then
    begin
      Result := eliminateAdjacentDegeneratePair(tri, t0, t2);
      Exit;
    end;

  if t1 = t2 then
    if t1 <> $FFFFFFFF then
    begin
      Result := eliminateAdjacentDegeneratePair(tri, t1, t0);
      Exit;
    end;

  if t2 = t0 then
    if t1 <> $FFFFFFFF then
    begin
      Result := eliminateAdjacentDegeneratePair(tri, t2, t1);
      Exit;
    end;

  Result := 0;
end;

procedure EliminateAdjacentDegenerateTriangles;
var
  Count: Integer;
  loopCount: Integer;
  i: Integer;
begin
  (* Eliminating two degenerate triangle pairs may
    not be the end of the story if the two "good" triangles
    that get connected are also degenerate.  Loop to
    handle this unlikely event. *)
  Count := 0;
  repeat
    loopCount := Count;
    for i := 0 to PrimitiveNum - 1 do
      Count := Count + findAndFixAdjacentDegeneratePair(i);
  until Count > loopCount;
end;

function MakeTriangleAdjacencyList(const AindicesList: PLongWordArray;
  Count: LongWord; const AVerticesList: PAffineVectorArray): TGLLongWordList;

  function AdjacentEdge(x, n: Integer): Integer;
  begin
    Result := (x shr (2 * n)) and 3;
  end;

var
  i: Integer;
  j: Byte;
  n, ii, jj: LongWord;
  tri, adjtri: TVector3dw;
  NewIndices: TGLLongWordList;
begin
  Result := nil;
  Assert(Assigned(AindicesList));
  Assert(Assigned(AVerticesList));
  PrimitiveNum := Count div 3;
  Assert(PrimitiveNum > 0);
  indicesList := AindicesList;
  verticesList := AVerticesList;

  SetLength(edgeInfo, vEdgeInfoReserveSize + PrimitiveNum);

  if not ComputeTriangleEdgeInfo then
    Exit;
  CheckForBogusAdjacency;
  if vImprovedFixingOpenTriangleEdge then
  begin
    CloseOpenTriangleGroups;
    EliminateAdjacentDegenerateTriangles;
  end;

  NewIndices := TGLLongWordList.Create;
  NewIndices.SetCountResetsMemory := False;
  NewIndices.Capacity := 6 * PrimitiveNum;

  for i := 0 to PrimitiveNum - 1 do
  begin
    n := 3 * i;
    tri[0] := indicesList[n + 0];
    tri[1] := indicesList[n + 1];
    tri[2] := indicesList[n + 2];
    for j := 0 to 2 do
    begin
      NewIndices.Add(tri[j]);
      n := edgeInfo[i].adjacentTriangle[j];
      if n = $FFFFFFFF then
      begin
        jj := (j + 2) mod 3;
        NewIndices.Add(tri[jj]);
      end
      else
      begin
        n := 3 * n;
        adjtri[0] := indicesList[n + 0];
        adjtri[1] := indicesList[n + 1];
        adjtri[2] := indicesList[n + 2];
        ii := (AdjacentEdge(edgeInfo[i].adjacentTriangleEdges, j) + 2) mod 3;
        NewIndices.Add(adjtri[ii]);
      end;
    end;
  end;
  Result := NewIndices;
end;

function ConvertStripToList(const AindicesList: PLongWordArray; Count: LongWord;
  RestartIndex: LongWord): TGLLongWordList;
var
  i: Integer;
  Index, prevIndex1, prevIndex2, stripCount: LongWord;
  NewIndices: TGLLongWordList;
begin
  Result := nil;
  if not Assigned(AindicesList) or (Count < 3) then
    Exit;
  NewIndices := TGLLongWordList.Create;
  stripCount := 0;
  prevIndex1 := 0;
  prevIndex2 := 0;
  for i := 0 to Count - 1 do
  begin
    Index := AindicesList[i];
    if stripCount > 2 then
    begin
      // Check for restart index
      if Index = RestartIndex then
      begin
        stripCount := 0;
        Continue;
      end
      // Check for degenerate triangles
      else if Index = prevIndex1 then
      begin
        Continue;
      end
      else if prevIndex1 = prevIndex2 then
      begin
        stripCount := 0;
        Continue;
      end;
      if Boolean(stripCount and 1) then
      begin
        NewIndices.Add(prevIndex2);
        NewIndices.Add(prevIndex1);
      end
      else
      begin
        NewIndices.Add(prevIndex1);
        NewIndices.Add(prevIndex2);
      end;
    end
    else if stripCount = 2 then
    begin
      NewIndices.Add(prevIndex1);
      NewIndices.Items[NewIndices.Count - 2] := Index;
      prevIndex2 := prevIndex1;
      prevIndex1 := Index;
      Inc(stripCount);
      Continue;
    end;
    NewIndices.Add(Index);
    prevIndex2 := prevIndex1;
    prevIndex1 := Index;
    Inc(stripCount);
  end;

  Result := NewIndices;
end;

function ConvertFansToList(const AindicesList: PLongWordArray; Count: LongWord;
  RestartIndex: LongWord): TGLLongWordList;
var
  i: Integer;
  Index, centerIndex, prevIndex, fansCount: LongWord;
  NewIndices: TGLLongWordList;
  degenerate: Boolean;
begin
  Result := nil;
  if not Assigned(AindicesList) or (Count < 3) then
    Exit;
  NewIndices := TGLLongWordList.Create;
  fansCount := 0;
  prevIndex := 0;
  degenerate := False;
  centerIndex := AindicesList[0];
  for i := 0 to Count - 1 do
  begin
    Index := AindicesList[i];
    if fansCount > 2 then
    begin
      // Check for restart index
      if Index = RestartIndex then
      begin
        fansCount := 0;
        Continue;
      end
      // Check for degenerate triangles
      else if Index = prevIndex then
      begin
        degenerate := True;
        Continue;
      end
      else if degenerate then
      begin
        degenerate := False;
        fansCount := 0;
        Continue;
      end;
      NewIndices.Add(centerIndex);
      NewIndices.Add(prevIndex);
    end
    else if fansCount = 0 then
      centerIndex := Index;
    NewIndices.Add(Index);
    prevIndex := Index;
    Inc(fansCount);
  end;

  Result := NewIndices;
end;

end.