Complete BigTask

code/KM_RenderAux_Mobile.pas

@@ -0,0 +1,487 @@
+unit KM_RenderAux_Mobile;
+{$I KaM_Remake.inc}
+interface
+uses
+  KM_Points, KM_CommonTypes;
+
+procedure KMRenderAuxMobileFill(
+  const aPoints: array of TKMPointF;
+  const aColor: TKMColor4f);
+procedure KMRenderAuxMobileStroke(
+  const aPoints: array of TKMPointF;
+  aClosed: Boolean;
+  aWorldWidth: Single;
+  aPattern: Word;
+  aPatternBitWorldLength: Single;
+  const aColor: TKMColor4f);
+
+implementation
+uses
+  SysUtils, Math, KM_Render;
+
+type
+  TSolidVertexArray = array of TKMSolidVertex;
+  TPointArray = array of TKMPointF;
+  TIndexArray = array of Integer;
+
+function IsFinitePoint(const P: TKMPointF): Boolean;
+begin
+  Result := not IsNan(P.X) and not IsInfinite(P.X)
+        and not IsNan(P.Y) and not IsInfinite(P.Y);
+end;
+
+function IsFiniteColor(const C: TKMColor4f): Boolean;
+begin
+  Result := not IsNan(C.R) and not IsInfinite(C.R)
+        and not IsNan(C.G) and not IsInfinite(C.G)
+        and not IsNan(C.B) and not IsInfinite(C.B)
+        and not IsNan(C.A) and not IsInfinite(C.A);
+end;
+
+function SignedCross(const A, B, C: TKMPointF): Double;
+begin
+  Result := (Double(B.X) - A.X) * (Double(C.Y) - A.Y)
+          - (Double(B.Y) - A.Y) * (Double(C.X) - A.X);
+end;
+
+function SameAdjacentPoint(const A, B: TKMPointF): Boolean;
+begin
+  Result := (A.X = B.X) and (A.Y = B.Y);
+end;
+
+function Distance(const A, B: TKMPointF): Double;
+var
+  DX, DY: Double;
+begin
+  DX := Double(A.X) - B.X;
+  DY := Double(A.Y) - B.Y;
+  Result := Sqrt(DX * DX + DY * DY);
+end;
+
+function NearClosingRepeat(const Points: TPointArray): Boolean;
+var
+  FirstEdge, LastEdge, ClosingDistance: Double;
+  I: Integer;
+begin
+  Result := False;
+  if Length(Points) < 3 then
+    Exit;
+
+  if SameAdjacentPoint(Points[0], Points[High(Points)]) then
+  begin
+    Result := True;
+    Exit;
+  end;
+
+  FirstEdge := 0;
+  for I := 1 to High(Points) do
+  begin
+    FirstEdge := Distance(Points[I - 1], Points[I]);
+    if FirstEdge > 0 then
+      Break;
+  end;
+
+  LastEdge := 0;
+  for I := High(Points) - 1 downto 0 do
+  begin
+    LastEdge := Distance(Points[I + 1], Points[I]);
+    if LastEdge > 0 then
+      Break;
+  end;
+
+  if (FirstEdge <= 0) or (LastEdge <= 0) then
+    Exit;
+  ClosingDistance := Distance(Points[0], Points[High(Points)]);
+  Result := ClosingDistance <= 1E-6 * Min(FirstEdge, LastEdge);
+end;
+
+function OnSegment(const A, B, P: TKMPointF): Boolean;
+begin
+  Result := (SignedCross(A, B, P) = 0)
+        and (P.X >= Min(A.X, B.X)) and (P.X <= Max(A.X, B.X))
+        and (P.Y >= Min(A.Y, B.Y)) and (P.Y <= Max(A.Y, B.Y));
+end;
+
+function SegmentsIntersect(const A, B, C, D: TKMPointF): Boolean;
+var
+  O1, O2, O3, O4: Double;
+begin
+  O1 := SignedCross(A, B, C);
+  O2 := SignedCross(A, B, D);
+  O3 := SignedCross(C, D, A);
+  O4 := SignedCross(C, D, B);
+  Result := ((O1 = 0) and OnSegment(A, B, C))
+         or ((O2 = 0) and OnSegment(A, B, D))
+         or ((O3 = 0) and OnSegment(C, D, A))
+         or ((O4 = 0) and OnSegment(C, D, B))
+         or ((((O1 < 0) and (O2 > 0)) or ((O1 > 0) and (O2 < 0)))
+          and (((O3 < 0) and (O4 > 0)) or ((O3 > 0) and (O4 < 0))));
+end;
+
+function SegmentCrossesOrTouchesNonNeighbor(const Points: TPointArray;
+  EdgeA, EdgeB: Integer): Boolean;
+var
+  N, NextA, NextB: Integer;
+  Shared: Boolean;
+  CommonPoint, OtherA, OtherB: TKMPointF;
+begin
+  N := Length(Points);
+  NextA := (EdgeA + 1) mod N;
+  NextB := (EdgeB + 1) mod N;
+  Shared := (EdgeA = EdgeB) or (NextA = EdgeB) or (NextB = EdgeA);
+  if not SegmentsIntersect(Points[EdgeA], Points[NextA], Points[EdgeB], Points[NextB]) then
+  begin
+    Result := False;
+    Exit;
+  end;
+
+  if not Shared then
+  begin
+    Result := True;
+    Exit;
+  end;
+
+  if NextA = EdgeB then
+  begin
+    CommonPoint := Points[NextA];
+    OtherA := Points[EdgeA];
+    OtherB := Points[NextB];
+  end
+  else if NextB = EdgeA then
+  begin
+    CommonPoint := Points[NextB];
+    OtherA := Points[NextA];
+    OtherB := Points[EdgeB];
+  end
+  else
+  begin
+    Result := True;
+    Exit;
+  end;
+
+  Result := (SignedCross(CommonPoint, OtherA, OtherB) = 0)
+        and ((Double(OtherA.X) - CommonPoint.X) * (Double(OtherB.X) - CommonPoint.X)
+           + (Double(OtherA.Y) - CommonPoint.Y) * (Double(OtherB.Y) - CommonPoint.Y) > 0);
+end;
+
+function PointInOrOnTriangle(const P, A, B, C: TKMPointF;
+  Winding: Double): Boolean;
+begin
+  Result := (Winding * SignedCross(A, B, P) >= 0)
+        and (Winding * SignedCross(B, C, P) >= 0)
+        and (Winding * SignedCross(C, A, P) >= 0);
+end;
+
+procedure AppendTriangle(const A, B, C: TKMPointF; var Dest: TSolidVertexArray);
+var
+  L: Integer;
+begin
+  L := Length(Dest);
+  SetLength(Dest, L + 3);
+  Dest[L].X := A.X; Dest[L].Y := A.Y; Dest[L].Z := 0.0;
+  Dest[L + 1].X := B.X; Dest[L + 1].Y := B.Y; Dest[L + 1].Z := 0.0;
+  Dest[L + 2].X := C.X; Dest[L + 2].Y := C.Y; Dest[L + 2].Z := 0.0;
+end;
+
+procedure AppendRibbon(const A, B: TKMPointF; HalfWidth: Single;
+  var Triangles: TSolidVertexArray);
+var
+  DX, DY, L, NX, NY: Double;
+  AL, AR, BL, BR: TKMPointF;
+begin
+  DX := Double(B.X) - A.X;
+  DY := Double(B.Y) - A.Y;
+  L := Sqrt(DX * DX + DY * DY);
+  if L = 0 then
+    Exit;
+  NX := -DY / L * HalfWidth;
+  NY := DX / L * HalfWidth;
+  AL.X := A.X + NX; AL.Y := A.Y + NY;
+  AR.X := A.X - NX; AR.Y := A.Y - NY;
+  BL.X := B.X + NX; BL.Y := B.Y + NY;
+  BR.X := B.X - NX; BR.Y := B.Y - NY;
+  AppendTriangle(AL, BL, BR, Triangles);
+  AppendTriangle(AL, BR, AR, Triangles);
+end;
+
+procedure AppendBevel(const Prev, P, Next: TKMPointF; HalfWidth: Single;
+  var Triangles: TSolidVertexArray);
+var
+  DX1, DY1, DX2, DY2, L1, L2, CrossValue: Double;
+  NX1, NY1, NX2, NY2: Double;
+  V1, V2: TKMPointF;
+begin
+  DX1 := Double(P.X) - Prev.X; DY1 := Double(P.Y) - Prev.Y;
+  DX2 := Double(Next.X) - P.X; DY2 := Double(Next.Y) - P.Y;
+  L1 := Sqrt(DX1 * DX1 + DY1 * DY1);
+  L2 := Sqrt(DX2 * DX2 + DY2 * DY2);
+  if (L1 = 0) or (L2 = 0) then Exit;
+  DX1 := DX1 / L1; DY1 := DY1 / L1;
+  DX2 := DX2 / L2; DY2 := DY2 / L2;
+  CrossValue := DX1 * DY2 - DY1 * DX2;
+  if (Abs(CrossValue) <= 1E-6) or ((DX1 + DX2) * (DX1 + DX2) +
+      (DY1 + DY2) * (DY1 + DY2) <= 1E-12) then Exit;
+  NX1 := -DY1 * HalfWidth; NY1 := DX1 * HalfWidth;
+  NX2 := -DY2 * HalfWidth; NY2 := DX2 * HalfWidth;
+  if CrossValue > 0 then
+  begin
+    V1.X := P.X - NX2; V1.Y := P.Y - NY2;
+    V2.X := P.X - NX1; V2.Y := P.Y - NY1;
+  end
+  else
+  begin
+    V1.X := P.X + NX1; V1.Y := P.Y + NY1;
+    V2.X := P.X + NX2; V2.Y := P.Y + NY2;
+  end;
+  AppendTriangle(P, V1, V2, Triangles);
+end;
+
+procedure AppendOpenRun(const A, B: TKMPointF;
+  StartDistance, EndDistance, TotalLength: Double;
+  HalfWidth: Single; var Triangles: TSolidVertexArray);
+var
+  StartPoint, EndPoint: TKMPointF;
+begin
+  if TotalLength <= 0 then Exit;
+  StartPoint.X := A.X + (B.X - A.X) * (StartDistance / TotalLength);
+  StartPoint.Y := A.Y + (B.Y - A.Y) * (StartDistance / TotalLength);
+  EndPoint.X := A.X + (B.X - A.X) * (EndDistance / TotalLength);
+  EndPoint.Y := A.Y + (B.Y - A.Y) * (EndDistance / TotalLength);
+  AppendRibbon(StartPoint, EndPoint, HalfWidth, Triangles);
+end;
+
+procedure EmitSolidStroke(const Triangles: TSolidVertexArray;
+  const aColor: TKMColor4f);
+var
+  I: Integer;
+begin
+  if Length(Triangles) = 0 then Exit;
+  if Length(Triangles) mod 3 <> 0 then
+    raise Exception.Create('invalid AUX stroke output');
+  for I := 0 to High(Triangles) do
+    if IsNan(Triangles[I].X) or IsInfinite(Triangles[I].X)
+      or IsNan(Triangles[I].Y) or IsInfinite(Triangles[I].Y)
+      or IsNan(Triangles[I].Z) or IsInfinite(Triangles[I].Z) then
+      raise Exception.Create('non-finite AUX stroke output');
+  TKMRender.DrawSolidTriangles(Triangles, aColor);
+end;
+
+procedure KMRenderAuxMobileStroke(const aPoints: array of TKMPointF;
+  aClosed: Boolean; aWorldWidth: Single; aPattern: Word;
+  aPatternBitWorldLength: Single; const aColor: TKMColor4f);
+var
+  Points: TPointArray;
+  Triangles: TSolidVertexArray;
+  I, N: Integer;
+  K: Int64;
+  L, BitLength, S: Double;
+  RunOpen: Boolean;
+begin
+  if not IsFiniteColor(aColor) then
+    raise Exception.Create('non-finite AUX stroke color');
+  if IsNan(aWorldWidth) or IsInfinite(aWorldWidth) or (aWorldWidth <= 0) then
+    raise Exception.Create('invalid AUX stroke width');
+  for I := 0 to High(aPoints) do
+    if not IsFinitePoint(aPoints[I]) then
+      raise Exception.Create('non-finite AUX stroke point');
+  if (aPattern <> $FFFF) and (aPattern <> 0) then
+  begin
+    if aClosed or (Length(aPoints) <> 2) then
+      raise Exception.Create('invalid patterned AUX stroke');
+    if IsNan(aPatternBitWorldLength) or IsInfinite(aPatternBitWorldLength)
+      or (aPatternBitWorldLength <= 0) then
+      raise Exception.Create('invalid AUX stroke pattern length');
+  end;
+
+  SetLength(Points, 0);
+  for I := 0 to High(aPoints) do
+    if (Length(Points) = 0) or not SameAdjacentPoint(Points[High(Points)], aPoints[I]) then
+    begin
+      SetLength(Points, Length(Points) + 1);
+      Points[High(Points)] := aPoints[I];
+    end;
+  if aClosed and NearClosingRepeat(Points) then
+    SetLength(Points, Length(Points) - 1);
+  N := Length(Points);
+  if ((not aClosed) and (N < 2)) or (aClosed and (N < 3)) or (aPattern = 0) then
+    Exit;
+  if aClosed then
+  begin
+    I := 2;
+    while I < N do
+    begin
+      if not SameAdjacentPoint(Points[I], Points[0])
+        and not SameAdjacentPoint(Points[I], Points[1]) then Break;
+      Inc(I);
+    end;
+    if I = N then Exit;
+  end;
+
+  if aPattern = $FFFF then
+  begin
+    for I := 0 to N - 2 do
+    begin
+      AppendRibbon(Points[I], Points[I + 1], aWorldWidth / 2, Triangles);
+      if I > 0 then
+        AppendBevel(Points[I - 1], Points[I], Points[I + 1], aWorldWidth / 2, Triangles);
+    end;
+    if aClosed then
+    begin
+      AppendRibbon(Points[N - 1], Points[0], aWorldWidth / 2, Triangles);
+      AppendBevel(Points[N - 2], Points[N - 1], Points[0], aWorldWidth / 2, Triangles);
+      AppendBevel(Points[N - 1], Points[0], Points[1], aWorldWidth / 2, Triangles);
+    end;
+  end
+  else
+  begin
+    L := Distance(Points[0], Points[1]);
+    if L = 0 then Exit;
+    BitLength := aPatternBitWorldLength;
+    RunOpen := False;
+    S := 0;
+    K := 0;
+    while K * BitLength < L do
+    begin
+      if ((aPattern shr Integer(K mod 16)) and 1) <> 0 then
+      begin
+        if not RunOpen then S := K * BitLength;
+        RunOpen := True;
+      end
+      else if RunOpen then
+      begin
+        AppendOpenRun(Points[0], Points[1], S, K * BitLength, L,
+          aWorldWidth / 2, Triangles);
+        RunOpen := False;
+      end;
+      Inc(K);
+    end;
+    if RunOpen then
+      AppendOpenRun(Points[0], Points[1], S, L, L, aWorldWidth / 2, Triangles);
+  end;
+  EmitSolidStroke(Triangles, aColor);
+end;
+
+procedure KMRenderAuxMobileFill(const aPoints: array of TKMPointF;
+  const aColor: TKMColor4f);
+var
+  Points: TPointArray;
+  Remaining: TIndexArray;
+  SolidVertices: TSolidVertexArray;
+  I, J, N, EarIndex, PrevIndex, CurrIndex, NextIndex, PointIndex: Integer;
+  ExpectedVertexCount: Int64;
+  Area, CrossValue, Winding: Double;
+  FoundEar: Boolean;
+  P: TKMPointF;
+begin
+  for I := 0 to High(aPoints) do
+    if not IsFinitePoint(aPoints[I]) then
+      raise Exception.Create('non-finite AUX fill point');
+  if not IsFiniteColor(aColor) then
+    raise Exception.Create('non-finite AUX fill color');
+
+  SetLength(Points, 0);
+  for I := 0 to High(aPoints) do
+    if (Length(Points) = 0) or not SameAdjacentPoint(Points[High(Points)], aPoints[I]) then
+    begin
+      SetLength(Points, Length(Points) + 1);
+      Points[High(Points)] := aPoints[I];
+    end;
+
+  if NearClosingRepeat(Points) then
+    SetLength(Points, Length(Points) - 1);
+  N := Length(Points);
+  if N < 3 then
+    Exit;
+
+  for I := 0 to N - 1 do
+    for J := I + 1 to N - 1 do
+      if SegmentCrossesOrTouchesNonNeighbor(Points, I, J) then
+        raise Exception.Create('invalid AUX fill perimeter');
+
+  Area := 0;
+  for I := 0 to N - 1 do
+  begin
+    J := (I + 1) mod N;
+    Area := Area + Double(Points[I].X) * Points[J].Y
+                  - Double(Points[J].X) * Points[I].Y;
+  end;
+  if Abs(Area) / 2 <= 1E-6 then
+    Exit;
+  Winding := 1;
+  if Area < 0 then
+    Winding := -1;
+
+  if N = 3 then
+  begin
+    AppendTriangle(Points[0], Points[1], Points[2], SolidVertices);
+  end
+  else
+  begin
+    SetLength(Remaining, N);
+    for I := 0 to N - 1 do
+      Remaining[I] := I;
+
+    while Length(Remaining) > 3 do
+    begin
+      FoundEar := False;
+      for I := 0 to High(Remaining) do
+      begin
+        PrevIndex := (I + Length(Remaining) - 1) mod Length(Remaining);
+        NextIndex := (I + 1) mod Length(Remaining);
+        PrevIndex := Remaining[PrevIndex];
+        CurrIndex := Remaining[I];
+        NextIndex := Remaining[NextIndex];
+        CrossValue := SignedCross(Points[PrevIndex], Points[CurrIndex], Points[NextIndex]);
+        if (Winding * CrossValue <= 0) or (Abs(CrossValue) / 2 <= 1E-6) then
+          Continue;
+
+        FoundEar := True;
+        for J := 0 to High(Remaining) do
+        begin
+          PointIndex := Remaining[J];
+          if (PointIndex = PrevIndex) or (PointIndex = CurrIndex) or (PointIndex = NextIndex) then
+            Continue;
+          if PointInOrOnTriangle(Points[PointIndex], Points[PrevIndex],
+            Points[CurrIndex], Points[NextIndex], Winding) then
+          begin
+            FoundEar := False;
+            Break;
+          end;
+        end;
+        if not FoundEar then
+          Continue;
+
+        AppendTriangle(Points[PrevIndex], Points[CurrIndex], Points[NextIndex], SolidVertices);
+        EarIndex := I;
+        for J := EarIndex to High(Remaining) - 1 do
+          Remaining[J] := Remaining[J + 1];
+        SetLength(Remaining, Length(Remaining) - 1);
+        FoundEar := True;
+        Break;
+      end;
+
+      if not FoundEar then
+        raise Exception.Create('invalid polygon triangulation');
+    end;
+
+    AppendTriangle(Points[Remaining[0]], Points[Remaining[1]],
+      Points[Remaining[2]], SolidVertices);
+  end;
+
+  if Length(SolidVertices) mod 3 <> 0 then
+    raise Exception.Create('invalid AUX fill output');
+  ExpectedVertexCount := Int64(N - 2) * 3;
+  if Length(SolidVertices) <> ExpectedVertexCount then
+    raise Exception.Create('invalid AUX fill output');
+  for I := 0 to High(SolidVertices) do
+    if IsNan(SolidVertices[I].X) or IsInfinite(SolidVertices[I].X)
+      or IsNan(SolidVertices[I].Y) or IsInfinite(SolidVertices[I].Y)
+      or IsNan(SolidVertices[I].Z) or IsInfinite(SolidVertices[I].Z) then
+      raise Exception.Create('non-finite AUX fill output');
+
+  if Length(SolidVertices) = 0 then
+    Exit;
+  TKMRender.DrawSolidTriangles(SolidVertices, aColor);
+end;
+
+end.

code/KM_Render_Mobile.pas

@@ -21,8 +21,13 @@ procedure KMRenderMobileDrawSampledTriangles(
   const aPositionData, aTexCoordData: Pointer;
   aStride, aVertexCount: Integer;
   aColorR, aColorG, aColorB, aColorA: Single);
+procedure KMRenderMobileDrawSolidTriangles(
+  const aPositionData: Pointer;
+  aStride, aVertexCount: Integer;
+  aColorR, aColorG, aColorB, aColorA: Single);
 procedure KMRenderMobileActivateSampledProgram;
 procedure KMRenderMobileInvalidateSampledProgram;
+procedure KMRenderMobileDisposeSolidMesh;
 procedure KMRenderMobileInitializeSampledProgram;
 function KMRenderMobileSampledProgramReady: Boolean;
 procedure KMRenderMobileDrawBrightnessOverlay(
@@ -32,13 +37,14 @@ implementation
 
 uses
   SysUtils, CastleGLUtils, CastleGLES, CastleRectangles, CastleProjection, CastleRenderContext, CastleVectors,
-  CastleGLShaders, CastleRenderOptions;
+  CastleGLShaders, CastleRenderOptions, CastleRenderPrimitives, Math;
 
 var
   gTextureBackendReady: Boolean;
   gTextureBindingKnown: Boolean;
   gCachedTextureId: Cardinal;
   gSampledProgram: TGLSLProgram;
+  gSolidMesh: TCastleRenderUnlitMesh = nil;
 
 const
   SampledVertexShader =
@@ -138,6 +144,12 @@ begin
 end;
 
 
+procedure KMRenderMobileDisposeSolidMesh;
+begin
+  FreeAndNil(gSolidMesh);
+end;
+
+
 function KMRenderMobileSampledProgramReady: Boolean;
 begin
   Result := gSampledProgram <> nil;
@@ -184,6 +196,86 @@ begin
 end;
 
 
+procedure KMRenderMobileDrawSolidTriangles(
+  const aPositionData: Pointer;
+  aStride, aVertexCount: Integer;
+  aColorR, aColorG, aColorB, aColorA: Single);
+var
+  i: Integer;
+  vertexData: NativeUInt;
+  x, y, z: Single;
+  vertices: array of TVector4;
+  drawException: TObject;
+begin
+  if (aVertexCount <= 0) or (aPositionData = nil)
+     or (aStride < 3 * SizeOf(Single)) or ((aVertexCount mod 3) <> 0) then
+    raise Exception.Create('Invalid solid triangle draw input');
+  for i := 0 to aVertexCount - 1 do
+  begin
+    vertexData := NativeUInt(aPositionData) + NativeUInt(i) * NativeUInt(aStride);
+    Move(Pointer(vertexData)^, x, SizeOf(x));
+    Move(Pointer(vertexData + SizeOf(Single))^, y, SizeOf(y));
+    Move(Pointer(vertexData + 2 * SizeOf(Single))^, z, SizeOf(z));
+    if IsNan(x) or IsInfinite(x) or IsNan(y) or IsInfinite(y)
+       or IsNan(z) or IsInfinite(z) then
+      raise Exception.Create('Solid triangle coordinates must be finite');
+  end;
+  if IsNan(aColorR) or IsInfinite(aColorR)
+     or IsNan(aColorG) or IsInfinite(aColorG)
+     or IsNan(aColorB) or IsInfinite(aColorB)
+     or IsNan(aColorA) or IsInfinite(aColorA) then
+    raise Exception.Create('Solid triangle color must be finite');
+  if not gTextureBackendReady then
+    raise Exception.Create('current graphics backend unavailable');
+
+  SetLength(vertices, aVertexCount);
+  for i := 0 to aVertexCount - 1 do
+  begin
+    vertexData := NativeUInt(aPositionData) + NativeUInt(i) * NativeUInt(aStride);
+    Move(Pointer(vertexData)^, x, SizeOf(x));
+    Move(Pointer(vertexData + SizeOf(Single))^, y, SizeOf(y));
+    Move(Pointer(vertexData + 2 * SizeOf(Single))^, z, SizeOf(z));
+    vertices[i] := Vector4(x, y, z, 1.0);
+  end;
+
+  if gSolidMesh = nil then
+    gSolidMesh := TCastleRenderUnlitMesh.Create(True);
+  drawException := nil;
+  try
+    try
+      gSolidMesh.SetVertexes(vertices, True);
+      gSolidMesh.Color := Vector4(aColorR, aColorG, aColorB, aColorA);
+      gSolidMesh.ModelViewProjection := RenderContext.ProjectionMatrix;
+      gSolidMesh.Render(pmTriangles);
+    except
+      drawException := ExceptObject;
+      raise;
+    end;
+  finally
+    try
+      try
+        RenderContext.CurrentVao := nil;
+      finally
+        try
+          RenderContext.BindBuffer[btArray] := 0;
+        finally
+          RenderContext.BindBuffer[btElementArray] := 0;
+        end;
+      end;
+    except
+      if drawException = nil then raise;
+      // Keep the active draw exception even if cleanup or diagnostic allocation fails.
+      try
+        if (drawException is Exception) and (ExceptObject is Exception) then
+          Exception(drawException).Message := Exception(drawException).Message
+            + '; solid binding reset failed: ' + Exception(ExceptObject).Message;
+      except
+      end;
+    end;
+  end;
+end;
+
+
 procedure RequireTextureBackendReady;
 begin
   if not gTextureBackendReady then

config/extra-paths.json

@@ -27,6 +27,7 @@
     "src/res/KM_ResTypes.pas",
     "src/utils/KromOGLUtils.pas",
     "src/render/KM_RenderPool.pas",
+    "src/render/KM_RenderAux.pas",
     "src/gui/KM_InterfaceGame.pas",
     "src/render/KM_RenderTerrain.pas",
     "src/res/KM_ResInterpolation.pas",

port-source/kam_remake/src/KM_GameApp.pas

@@ -24,6 +24,7 @@ type
     fGraphicsGenerationAccepted: Boolean;
     fGraphicsAttemptGeneration: QWord;
     fApplicationGraphicsReadyGeneration: QWord;
+    fMenuRecoveryRequestedGeneration: QWord;
 
     fGlobalTickCount: Cardinal;
     fIsExiting: Boolean;
@@ -73,6 +74,7 @@ type
     function GetActiveInterface: TKMUserInterfaceCommon;
     procedure GraphicsContextAvailabilityChanged(aAvailable: Boolean);
     function IsCurrentGraphicsAttempt(aCandidateGeneration: QWord): Boolean;
+    procedure TryRequestMenuGraphicsRecovery(aCandidateGeneration: QWord);
     procedure ReevaluateApplicationGraphicsReadiness(aCandidateGeneration: QWord);
     function ApplicationGraphicsReadyForCurrentGeneration: Boolean;
     procedure RenderPresentationFrame;
@@ -199,6 +201,7 @@ begin
   fGraphicsGenerationAccepted := False;
   fGraphicsAttemptGeneration := 0;
   fApplicationGraphicsReadyGeneration := 0;
+  fMenuRecoveryRequestedGeneration := 0;
 
   fCampaigns := TKMCampaignsCollection.Create;
 
@@ -228,6 +231,7 @@ begin
   gRes.LoadMainResources(gGameSettings.Locale, gGameSettings.GFX.LoadFullFonts);
 
   candidateGeneration := fGraphicsAttemptGeneration;
+  TryRequestMenuGraphicsRecovery(candidateGeneration);
   if candidateGeneration <> 0 then
   begin
     if IsCurrentGraphicsAttempt(candidateGeneration)
@@ -300,12 +304,15 @@ begin
     fGraphicsAttemptGeneration := fGraphicsGeneration;
     fGraphicsGenerationAccepted := True;
     fApplicationGraphicsReadyGeneration := 0;
+    fMenuRecoveryRequestedGeneration := 0;
     candidateGeneration := fGraphicsAttemptGeneration;
 
     TKMRender.GraphicsContextChanged(True);
     if not TKMRender.TextureBackendReady then
       raise Exception.Create('Graphics texture backend is not ready after context restore');
 
+    TryRequestMenuGraphicsRecovery(candidateGeneration);
+
     if gRes <> nil then
       gRes.InvalidateFontGraphicsContext;
 
@@ -331,10 +338,15 @@ begin
     fGraphicsGenerationAccepted := False;
     fGraphicsAttemptGeneration := 0;
     fApplicationGraphicsReadyGeneration := 0;
+    fMenuRecoveryRequestedGeneration := 0;
 
     if gRes <> nil then
       try
+        try
+          gRes.InvalidateMenuGraphicsContext;
+        finally
           gRes.InvalidateFontGraphicsContext;
+        end;
       finally
         TKMRender.GraphicsContextChanged(False);
       end
@@ -358,6 +370,8 @@ begin
     Exit;
   if not gRes.FontResourcesReadyForGeneration(aCandidateGeneration) then
     Exit;
+  if not gRes.MenuGraphicsReadyForGeneration(aCandidateGeneration) then
+    Exit;
   if gGame <> nil then
   begin
     if gRes = nil then
@@ -385,6 +399,10 @@ begin
   end;
 
   Result := gRes.FontResourcesReadyForGeneration(fGraphicsGeneration);
+  if not Result then
+    Exit;
+
+  Result := gRes.MenuGraphicsReadyForGeneration(fGraphicsGeneration);
 end;
 
 
@@ -397,6 +415,26 @@ begin
 end;
 
 
+procedure TKMGameApp.TryRequestMenuGraphicsRecovery(aCandidateGeneration: QWord);
+var
+  accepted: Boolean;
+begin
+  if aCandidateGeneration = 0 then Exit;
+  if not IsCurrentGraphicsAttempt(aCandidateGeneration) then Exit;
+  if not TKMRender.TextureBackendReady then Exit;
+  if gRes = nil then Exit;
+  if gRes.DataState = rlsNone then Exit;
+  if fMenuRecoveryRequestedGeneration = aCandidateGeneration then Exit;
+
+  accepted := gRes.RequestMenuGraphicsRecovery(aCandidateGeneration, @IsCurrentGraphicsAttempt);
+  if not accepted then Exit;
+
+  if IsCurrentGraphicsAttempt(aCandidateGeneration)
+    and TKMRender.TextureBackendReady then
+    fMenuRecoveryRequestedGeneration := aCandidateGeneration;
+end;
+
+
 { Destroy what was created }
 destructor TKMGameApp.Destroy;
 begin
@@ -1568,6 +1606,7 @@ begin
   if fNetworking <> nil then fNetworking.UpdateStateIdle;
   candidateGeneration := fGraphicsAttemptGeneration;
   try
+    TryRequestMenuGraphicsRecovery(candidateGeneration);
     if gRes <> nil then
       gRes.UpdateStateIdle;
   finally

port-source/kam_remake/src/render/KM_Render.pas

@@ -16,6 +16,10 @@ type
     U, V: Single;
   end;
 
+  TKMSolidVertex = record
+    X, Y, Z: Single;
+  end;
+
   //General OpenGL handling
   TKMRender = class
   private
@@ -30,6 +34,7 @@ type
     class function TextureBackendReady: Boolean; static;
     class function SampledProgramReady: Boolean; static;
     class procedure DrawSampledTriangles(const aVertices: array of TKMSampledVertex; const aColor: TKMColor4f); static;
+    class procedure DrawSolidTriangles(const aVertices: array of TKMSolidVertex; const aColor: TKMColor4f); static;
     class function GetMaxTexSize: Cardinal; static;
     class function GenerateTextureCommon(aMinFilter, aMagFilter: TKMFilterType): Cardinal;
     class function GenTexture(DestX, DestY: Word; const Data: Pointer; Mode: TKMTexFormat; aMinFilter, aMagFilter: TKMFilterType): Cardinal;
@@ -69,9 +74,16 @@ end;
 
 destructor TKMRender.Destroy;
 begin
+  try
+    KMRenderMobileDisposeSolidMesh;
+  finally
+    try
       KMRenderMobileInvalidateSampledProgram;
+    finally
       inherited;
     end;
+  end;
+end;
 
 
 //We have to use this method EVERY time we want to bind texture. Otherwise collisions could happen
@@ -143,10 +155,17 @@ begin
   end
   else
   begin
+    try
+      KMRenderMobileDisposeSolidMesh;
+    finally
+      try
         KMRenderMobileInvalidateCurrentContext;
+      finally
         KMRenderMobileInvalidateSampledProgram;
       end;
     end;
+  end;
+end;
 
 
 class function TKMRender.TextureBackendReady: Boolean;
@@ -175,6 +194,32 @@ begin
 end;
 
 
+class procedure TKMRender.DrawSolidTriangles(const aVertices: array of TKMSolidVertex; const aColor: TKMColor4f);
+var
+  i: Integer;
+begin
+  if Length(aVertices) = 0 then Exit;
+  if (Length(aVertices) mod 3) <> 0 then
+    raise Exception.Create('Solid triangle vertex count must be divisible by three');
+
+  for i := 0 to High(aVertices) do
+    if IsNan(aVertices[i].X) or IsInfinite(aVertices[i].X)
+       or IsNan(aVertices[i].Y) or IsInfinite(aVertices[i].Y)
+       or IsNan(aVertices[i].Z) or IsInfinite(aVertices[i].Z) then
+      raise Exception.Create('Solid triangle coordinates must be finite');
+  if IsNan(aColor.R) or IsInfinite(aColor.R)
+     or IsNan(aColor.G) or IsInfinite(aColor.G)
+     or IsNan(aColor.B) or IsInfinite(aColor.B)
+     or IsNan(aColor.A) or IsInfinite(aColor.A) then
+    raise Exception.Create('Solid triangle color must be finite');
+
+  RenderContext.DepthFunc := dfLessEqual;
+  RenderContext.BlendingEnable(bsSrcAlpha, bdOneMinusSrcAlpha);
+  KMRenderMobileDrawSolidTriangles(@aVertices[0].X, SizeOf(TKMSolidVertex), Length(aVertices),
+    aColor.R, aColor.G, aColor.B, aColor.A);
+end;
+
+
 class function TKMRender.GetMaxTexSize: Cardinal;
 begin
   Result := KMRenderMobileMaxTextureSize;

port-source/kam_remake/src/render/KM_RenderAux.pas

@@ -0,0 +1,507 @@
+unit KM_RenderAux;
+{$I KaM_Remake.inc}
+interface
+uses
+ KromOGLUtils,
+ KM_CommonClasses, KM_CommonTypes, KM_Points;
+
+type
+  TKMLineMode = (lmStrip, lmPairs);
+
+  //Debug symbols render
+  TKMRenderAux = class
+  private
+    fCurrentColor: TKMColor4f;
+    procedure RenderDot(pX, pY: Single; Size: Single = 0.05);
+    procedure RenderLine(const A, B: TKMPointF; aPattern: Word; aWorldWidth: Single);
+    procedure DispatchAuxSegments(const P: array of TKMPointF;
+      aLineMode: TKMLineMode; aWorldWidth: Single);
+    procedure RenderQuad(pX, pY: Integer); overload;
+    procedure RenderQuad(pX, pY: Single); overload;
+  public
+    constructor Create;
+    procedure Circle(x, y, rad: Single; Fill, Line: TColor4);
+    procedure CircleOnTerrain(x, y, rad: Single; Fill, Line: TColor4); overload;
+    procedure CircleOnTerrain(X, Y, Rad: Single; aColor: TColor4); overload;
+    procedure Dot(x, y: Single; aCol: TColor4; aSize: Single = 0.05);
+    procedure DotOnTerrain(x, y: Single; aCol: TColor4; aSize: Single = 0.05);
+    procedure LineOnTerrain(x1, y1, x2, y2: Single; aCol: TColor4; aPattern: Word = $FFFF; aDots: Boolean = True); overload;
+    procedure LineOnTerrain(const A, B: TKMPoint; aCol: TColor4; aPattern: Word = $FFFF; aDots: Boolean = True); overload;
+    procedure LineOnTerrain(const A, B: TKMPointF; aCol: TColor4; aPattern: Word = $FFFF; aDots: Boolean = True); overload;
+    procedure LineOnTerrain(const aPoints: TKMPointArray; aColor: Cardinal; aThickness: Integer = -1; aLineMode: TKMLineMode = lmStrip; aPattern: Word = $FFFF); overload;
+    procedure LineOnTerrain(const aPoints: TKMPointFArray; aColor: Cardinal; aThickness: Integer = -1; aLineMode: TKMLineMode = lmStrip; aPattern: Word = $FFFF); overload;
+    procedure LineOnTerrain(aPoints: TKMPointList; aColor: Cardinal; aInset: Single = 0; aThickness: Integer = -1;
+                            aLineMode: TKMLineMode = lmStrip; aPattern: Word = $FFFF); overload;
+    procedure Line(const A, B: TKMPoint; aCol: TColor4; aPattern: Word = $FFFF); overload;
+    procedure Line(const A, B: TKMPointF; aCol: TColor4; aPattern: Word = $FFFF); overload;
+    procedure Line(x1, y1, x2, y2: Single; aCol: TColor4; aPattern: Word = $FFFF; aThickness: Integer = -1); overload;
+    procedure Line(const aPoints: TKMPointFArray; const aColor: TKMColor4f; aThickness: Integer = -1; aLineMode: TKMLineMode = lmStrip; aPattern: Word = $FFFF); overload;
+    procedure Square(const aRect: TKMRect; const aColor: TKMColor4f);
+    procedure Triangle(x1, y1, x2, y2, X3, Y3: Single; aCol: TColor4);
+    procedure TriangleOnTerrain(x1, y1, x2, y2, X3, Y3: Single; aCol: TColor4);
+    
+    procedure Projectile(x1, y1, x2, y2: Single);
+    procedure SetColor(aCol: Cardinal);
+    procedure QuadI(pX, pY: Integer); overload;
+    procedure QuadI(pX, pY: Integer; aCol: TColor4); overload;
+    procedure Quad(pX, pY: Integer); overload;
+    procedure Quad(pX, pY: Integer; aCol: TColor4); overload;
+    procedure Quad(pX, pY: Single); overload;
+    procedure Quad(pX, pY: Single; aCol: TColor4); overload;
+    procedure SquareOnTerrain(x1, y1, x2, y2: Single; aLineColor: TColor4; aThickness: Integer = -1);
+    procedure Text(pX, pY: Single; const aText: string; aCol: TColor4); overload;
+    procedure Text(pX, pY: Single; const aText: string; aCol: TColor4; const aInset: TKMPointF; aConsiderTextLength: Boolean = True); overload;
+    procedure TextAtCorner(pX, pY: Integer; const aCorner: Byte; const aText: string; aCol: TColor4);
+    procedure UnitMoves(const aRect: TKMRect);
+    procedure UnitPointers(pX, pY: Single; Count: Integer);
+    procedure UnitRoute(NodeList: TKMPointList; Pos: Integer; aUID: Integer);
+    procedure Wires(const aRect: TKMRect);
+    procedure RenderWireTile(const P: TKMPoint; Col: TColor4; aInset: Single = 0.0);
+  end;
+
+
+var
+  gRenderAux: TKMRenderAux;
+
+
+implementation
+uses
+  SysUtils, Math,
+  KM_Defaults,
+  // Do not add KM_Game dependancy, use KM_RenderGameAux instead
+  KM_RenderAux_Mobile, KM_Terrain, KM_TerrainTypes;
+
+
+function AuxLineWorldWidth(aThickness: Integer): Single;
+begin
+  if aThickness > 0 then
+    Result := aThickness / CELL_SIZE_PX
+  else
+    Result := 2 / CELL_SIZE_PX;
+end;
+
+
+constructor TKMRenderAux.Create;
+begin
+  inherited Create;
+  fCurrentColor := TKMColor4f.White;
+end;
+
+
+//Simple dot to know where it actualy is
+procedure TKMRenderAux.RenderDot(pX, pY: Single; Size: Single = 0.05);
+var
+  Points: array[0..3] of TKMPointF;
+begin
+  Points[0] := KMPointF(pX - Size, pY + Size);
+  Points[1] := KMPointF(pX + Size, pY + Size);
+  Points[2] := KMPointF(pX + Size, pY - Size);
+  Points[3] := KMPointF(pX - Size, pY - Size);
+  KMRenderAuxMobileFill(Points, fCurrentColor);
+end;
+
+
+procedure TKMRenderAux.RenderLine(const A, B: TKMPointF; aPattern: Word; aWorldWidth: Single);
+begin
+  KMRenderAuxMobileStroke([A, B], False, aWorldWidth, aPattern,
+    2 / CELL_SIZE_PX, fCurrentColor);
+end;
+
+
+procedure TKMRenderAux.DispatchAuxSegments(const P: array of TKMPointF;
+  aLineMode: TKMLineMode; aWorldWidth: Single);
+var
+  I: Integer;
+begin
+  if Length(P) < 2 then Exit;
+  if aLineMode = lmStrip then
+    KMRenderAuxMobileStroke(P, False, aWorldWidth, $FFFF,
+      2 / CELL_SIZE_PX, fCurrentColor)
+  else
+    for I := 0 to Length(P) div 2 - 1 do
+      KMRenderAuxMobileStroke([P[2 * I], P[2 * I + 1]], False,
+        aWorldWidth, $FFFF, 2 / CELL_SIZE_PX, fCurrentColor);
+end;
+
+
+procedure TKMRenderAux.RenderQuad(pX, pY: Integer);
+var
+  Points: array[0..3] of TKMPointF;
+begin
+  if not gTerrain.TileInMapCoords(pX, pY) then Exit;
+  with gTerrain do
+  begin
+    Points[0] := KMPointF(pX - 1, pY - 1 - LandExt^[pY, pX].RenderHeight / CELL_HEIGHT_DIV);
+    Points[1] := KMPointF(pX, pY - 1 - LandExt^[pY, pX + 1].RenderHeight / CELL_HEIGHT_DIV);
+    Points[2] := KMPointF(pX, pY - LandExt^[pY + 1, pX + 1].RenderHeight / CELL_HEIGHT_DIV);
+    Points[3] := KMPointF(pX - 1, pY - LandExt^[pY + 1, pX].RenderHeight / CELL_HEIGHT_DIV);
+  end;
+  KMRenderAuxMobileFill(Points, fCurrentColor);
+end;
+
+
+procedure TKMRenderAux.RenderQuad(pX, pY: Single);
+var
+  rect: TKMRectF;
+  Points: array[0..3] of TKMPointF;
+begin
+  rect := KMRectF(pX - 1, pY - 1, pX, pY);
+
+  rect := gTerrain.EnsureVerticesRectWithinMap(rect);
+  Points[0] := KMPointF(rect.Left, gTerrain.RenderFlatToHeight(rect.Left, rect.Top));
+  Points[1] := KMPointF(rect.Right, gTerrain.RenderFlatToHeight(rect.Right, rect.Top));
+  Points[2] := KMPointF(rect.Right, gTerrain.RenderFlatToHeight(rect.Right, rect.Bottom));
+  Points[3] := KMPointF(rect.Left, gTerrain.RenderFlatToHeight(rect.Left, rect.Bottom));
+  KMRenderAuxMobileFill(Points, fCurrentColor);
+end;
+
+
+procedure TKMRenderAux.Circle(x, y, rad: Single; Fill, Line: TColor4);
+const
+  SEC_COUNT = 20;
+var
+  I: Integer;
+  Outer, Inner: array[0..SEC_COUNT * 2] of TKMPointF;
+begin
+  for I := -SEC_COUNT to SEC_COUNT do
+  begin
+    Outer[I + SEC_COUNT] := KMPointF(X + Cos(I / SEC_COUNT * Pi) * Rad,
+                                    Y + Sin(I / SEC_COUNT * Pi) * Rad);
+    Inner[I + SEC_COUNT] := KMPointF(X + Cos(I / SEC_COUNT * Pi) * Rad / 3,
+                                    Y + Sin(I / SEC_COUNT * Pi) * Rad / 3);
+  end;
+  SetColor(Fill);
+  KMRenderAuxMobileFill(Outer, fCurrentColor);
+  KMRenderAuxMobileFill(Inner, fCurrentColor);
+  SetColor(Line);
+  KMRenderAuxMobileStroke(Outer, True, 2 / CELL_SIZE_PX, $FFFF, 2 / CELL_SIZE_PX, fCurrentColor);
+end;
+
+
+procedure TKMRenderAux.CircleOnTerrain(X, Y, Rad: Single; aColor: TColor4);
+begin
+  CircleOnTerrain(X, Y, Rad, aColor, aColor);
+end;
+
+
+procedure TKMRenderAux.CircleOnTerrain(X, Y, Rad: Single; Fill, Line: TColor4);
+const
+  SEC_COUNT = 24;
+var
+  I: Integer;
+  C, S: Single;
+  Points: array[0..SEC_COUNT * 2 - 1] of TKMPointF;
+begin
+  for I := -SEC_COUNT to SEC_COUNT - 1 do
+  begin
+    C := Cos(I / SEC_COUNT * Pi) * Rad;
+    S := Sin(I / SEC_COUNT * Pi) * Rad;
+    Points[I + SEC_COUNT] := KMPointF(X + C, gTerrain.RenderFlatToHeight(X + C, Y + S));
+  end;
+  SetColor(Fill);
+  KMRenderAuxMobileFill(Points, fCurrentColor);
+  SetColor(Line);
+  KMRenderAuxMobileStroke(Points, True, 2 / CELL_SIZE_PX, $FFFF, 2 / CELL_SIZE_PX, fCurrentColor);
+end;
+
+
+procedure TKMRenderAux.SquareOnTerrain(X1, Y1, X2, Y2: Single; aLineColor: TColor4; aThickness: Integer = -1);
+var
+  I: Integer;
+  Width: Single;
+  Points: TKMPointFArray;
+  procedure AddPoint(PX, PY: Single);
+  var
+    N: Integer;
+  begin
+    N := Length(Points);
+    SetLength(Points, N + 1);
+    Points[N] := KMPointF(PX, gTerrain.RenderFlatToHeight(PX, PY));
+  end;
+begin
+  SetColor(aLineColor);
+  AddPoint(X1, Y1);
+  for I := Ceil(X1) to Trunc(X2) do AddPoint(I, Y1);
+  AddPoint(X2, Y1);
+  AddPoint(X2, Y2);
+  for I := Trunc(X2) downto Ceil(X1) do AddPoint(I, Y2);
+  AddPoint(X1, Y2);
+  if aThickness > 0 then
+    Width := aThickness / CELL_SIZE_PX
+  else
+    Width := 2 / CELL_SIZE_PX;
+  KMRenderAuxMobileStroke(Points, True, Width, $FFFF, 2 / CELL_SIZE_PX, fCurrentColor);
+end;
+
+
+procedure TKMRenderAux.Dot(X,Y: Single; aCol: TColor4; aSize: Single = 0.05);
+begin
+  SetColor(aCol);
+  RenderDot(X, Y, aSize);
+end;
+
+
+procedure TKMRenderAux.DotOnTerrain(x, y: Single; aCol: TColor4; aSize: Single = 0.05);
+begin
+  SetColor(aCol);
+  RenderDot(X, gTerrain.RenderFlatToHeight(X, Y), aSize);
+end;
+
+
+procedure TKMRenderAux.LineOnTerrain(x1, y1, x2, y2: Single; aCol: TColor4; aPattern: Word = $FFFF; aDots: Boolean = True);
+var
+  Points: array[0..1] of TKMPointF;
+  Y1h, Y2h: Single;
+begin
+  SetColor(aCol);
+  Y1h := gTerrain.RenderFlatToHeight(x1, y1);
+  Y2h := gTerrain.RenderFlatToHeight(x2, y2);
+  Points[0] := KMPointF(x1, Y1h);
+  Points[1] := KMPointF(x2, Y2h);
+  RenderLine(Points[0], Points[1], aPattern, AuxLineWorldWidth(-1));
+  if aDots then
+  begin
+    RenderDot(x1, Y1h, 0.05);
+    RenderDot(x2, Y2h, 0.05);
+  end;
+end;
+
+
+procedure TKMRenderAux.LineOnTerrain(const A,B: TKMPoint; aCol: TColor4; aPattern: Word = $FFFF; aDots: Boolean = True);
+begin
+  LineOnTerrain(A.X, A.Y, B.X, B.Y, aCol, aPattern, aDots);
+end;
+
+
+procedure TKMRenderAux.LineOnTerrain(const A,B: TKMPointF; aCol: TColor4; aPattern: Word = $FFFF; aDots: Boolean = True);
+begin
+  LineOnTerrain(A.X, A.Y, B.X, B.Y, aCol, aPattern, aDots);
+end;
+
+
+procedure TKMRenderAux.Line(const A, B: TKMPoint; aCol: TColor4; aPattern: Word = $FFFF);
+begin
+  Line(A.X, A.Y, B.X, B.Y, aCol, aPattern);
+end;
+
+
+procedure TKMRenderAux.Line(const A, B: TKMPointF; aCol: TColor4; aPattern: Word = $FFFF);
+begin
+  Line(A.X, A.Y, B.X, B.Y, aCol, aPattern);
+end;
+
+
+procedure TKMRenderAux.Line(X1,Y1,X2,Y2: Single; aCol: TColor4; aPattern: Word = $FFFF; aThickness: Integer = -1);
+var
+  Points: array[0..1] of TKMPointF;
+begin
+  SetColor(aCol);
+  Points[0] := KMPointF(X1, Y1);
+  Points[1] := KMPointF(X2, Y2);
+  RenderLine(Points[0], Points[1], aPattern, AuxLineWorldWidth(aThickness));
+  RenderDot(X1, Y1, 0.05);
+  RenderDot(X2, Y2, 0.05);
+end;
+
+
+procedure TKMRenderAux.Line(const aPoints: TKMPointFArray; const aColor: TKMColor4f; aThickness: Integer = -1; aLineMode: TKMLineMode = lmStrip;
+                          aPattern: Word = $FFFF);
+var
+  I: Integer;
+  Points: TKMPointFArray;
+begin
+  fCurrentColor := aColor;
+  if not (aLineMode in [lmStrip, lmPairs]) then
+    raise Exception.Create('Wrong LineMode');
+  SetLength(Points, Length(aPoints));
+  for I := 0 to High(aPoints) do
+    Points[I] := aPoints[I];
+  DispatchAuxSegments(Points, aLineMode, AuxLineWorldWidth(aThickness));
+end;
+
+
+procedure TKMRenderAux.LineOnTerrain(const aPoints: TKMPointFArray; aColor: Cardinal; aThickness: Integer = -1;
+                                   aLineMode: TKMLineMode = lmStrip; aPattern: Word = $FFFF);
+var
+  I: Integer;
+  Points: TKMPointFArray;
+begin
+  SetColor(aColor);
+  if not (aLineMode in [lmStrip, lmPairs]) then
+    raise Exception.Create('Wrong LineMode');
+  SetLength(Points, Length(aPoints));
+  for I := 0 to High(aPoints) do
+    Points[I] := KMPointF(Single(aPoints[I].X),
+      gTerrain.RenderFlatToHeight(aPoints[I].X, aPoints[I].Y));
+  DispatchAuxSegments(Points, aLineMode, AuxLineWorldWidth(aThickness));
+end;
+
+
+procedure TKMRenderAux.LineOnTerrain(const aPoints: TKMPointArray; aColor: Cardinal; aThickness: Integer;
+                                   aLineMode: TKMLineMode; aPattern: Word);
+var
+  I: Integer;
+  Points: TKMPointFArray;
+begin
+  SetColor(aColor);
+  if not (aLineMode in [lmStrip, lmPairs]) then
+    raise Exception.Create('Wrong LineMode');
+  SetLength(Points, Length(aPoints));
+  for I := 0 to High(aPoints) do
+    Points[I] := KMPointF(Single(aPoints[I].X),
+      gTerrain.RenderFlatToHeight(aPoints[I].X, aPoints[I].Y));
+  DispatchAuxSegments(Points, aLineMode, AuxLineWorldWidth(aThickness));
+end;
+
+
+procedure TKMRenderAux.LineOnTerrain(aPoints: TKMPointList; aColor: Cardinal; aInset: Single = 0; aThickness: Integer = -1;
+                                   aLineMode: TKMLineMode = lmStrip; aPattern: Word = $FFFF);
+var
+  I: Integer;
+  SourceX, SourceY: Single;
+  Points: TKMPointFArray;
+begin
+  SetColor(aColor);
+  if not (aLineMode in [lmStrip, lmPairs]) then
+    raise Exception.Create('Wrong LineMode');
+  SetLength(Points, aPoints.Count);
+  for I := 0 to aPoints.Count - 1 do
+  begin
+    SourceX := aPoints[I].X + aInset;
+    SourceY := aPoints[I].Y + aInset;
+    Points[I] := KMPointF(SourceX, gTerrain.RenderFlatToHeight(SourceX, SourceY));
+  end;
+  DispatchAuxSegments(Points, aLineMode, AuxLineWorldWidth(aThickness));
+end;
+
+
+procedure TKMRenderAux.Square(const aRect: TKMRect; const aColor: TKMColor4f);
+var
+  Points: array[0..3] of TKMPointF;
+begin
+  Points[0] := KMPointF(aRect.Left, aRect.Top);
+  Points[1] := KMPointF(aRect.Right, aRect.Top);
+  Points[2] := KMPointF(aRect.Right, aRect.Bottom);
+  Points[3] := KMPointF(aRect.Left, aRect.Bottom);
+  KMRenderAuxMobileFill(Points, fCurrentColor);
+end;
+
+
+procedure TKMRenderAux.Triangle(x1, y1, x2, y2, X3, Y3: Single; aCol: TColor4);
+var
+  Points: array[0..2] of TKMPointF;
+begin
+  SetColor(aCol);
+  Points[0] := KMPointF(x1, y1);
+  Points[1] := KMPointF(x2, y2);
+  Points[2] := KMPointF(x3, Y3);
+  KMRenderAuxMobileFill(Points, fCurrentColor);
+end;
+
+
+procedure TKMRenderAux.TriangleOnTerrain(x1, y1, x2, y2, X3, Y3: Single; aCol: TColor4);
+var
+  Points: array[0..2] of TKMPointF;
+begin
+  SetColor(aCol);
+  Points[0] := KMPointF(x1, gTerrain.RenderFlatToHeight(x1, y1));
+  Points[1] := KMPointF(x2, gTerrain.RenderFlatToHeight(x2, y2));
+  Points[2] := KMPointF(x3, gTerrain.RenderFlatToHeight(x3, y3));
+  KMRenderAuxMobileFill(Points, fCurrentColor);
+end;
+
+
+procedure TKMRenderAux.Projectile(x1, y1, x2, y2: Single);
+begin
+end;
+
+procedure TKMRenderAux.SetColor(aCol: Cardinal);
+begin
+  fCurrentColor := TKMColor4f.New(aCol);
+end;
+
+
+procedure TKMRenderAux.Quad(pX, pY: Integer);
+begin
+  RenderQuad(pX, pY);
+end;
+
+
+procedure TKMRenderAux.QuadI(pX, pY: Integer);
+begin
+  Quad(pX, pY);
+end;
+
+
+procedure TKMRenderAux.Quad(pX, pY: Integer; aCol: TColor4);
+begin
+  SetColor(aCol);
+  RenderQuad(pX, pY);
+end;
+
+
+procedure TKMRenderAux.QuadI(pX, pY: Integer; aCol: TColor4);
+begin
+  Quad(pX, pY, aCol);
+end;
+
+
+procedure TKMRenderAux.Quad(pX, pY: Single);
+begin
+  RenderQuad(pX, pY);
+end;
+
+
+procedure TKMRenderAux.Quad(pX, pY: Single; aCol: TColor4);
+begin
+  SetColor(aCol);
+  RenderQuad(pX, pY);
+end;
+
+
+procedure TKMRenderAux.Text(pX, pY: Single; const aText: string; aCol: TColor4);
+begin
+end;
+
+procedure TKMRenderAux.Text(pX, pY: Single; const aText: string; aCol: TColor4; const aInset: TKMPointF; aConsiderTextLength: Boolean = True);
+begin
+end;
+
+procedure TKMRenderAux.TextAtCorner(pX, pY: Integer; const aCorner: Byte; const aText: string; aCol: TColor4);
+begin
+end;
+
+procedure TKMRenderAux.UnitMoves(const aRect: TKMRect);
+begin
+end;
+
+procedure TKMRenderAux.UnitPointers(pX,pY: Single; Count: Integer);
+begin
+end;
+
+procedure TKMRenderAux.UnitRoute(NodeList: TKMPointList; Pos: Integer; aUID: Integer);
+begin
+end;
+
+procedure TKMRenderAux.Wires(const aRect: TKMRect);
+begin
+end;
+
+procedure TKMRenderAux.RenderWireTile(const P: TKMPoint; Col: TColor4; aInset: Single = 0.0);
+var
+  Points: array[0..3] of TKMPointF;
+begin
+  if not gTerrain.TileInMapCoords(P.X, P.Y) then Exit;
+  SetColor(Col);
+  with gTerrain do
+  begin
+    Points[0] := KMPointF(P.X - 1 + aInset, P.Y - 1 + aInset - LandExt^[P.Y, P.X].RenderHeight / CELL_HEIGHT_DIV);
+    Points[1] := KMPointF(P.X - aInset, P.Y - 1 + aInset - LandExt^[P.Y, P.X + 1].RenderHeight / CELL_HEIGHT_DIV);
+    Points[2] := KMPointF(P.X - aInset, P.Y - aInset - LandExt^[P.Y + 1, P.X + 1].RenderHeight / CELL_HEIGHT_DIV);
+    Points[3] := KMPointF(P.X - 1 + aInset, P.Y - aInset - LandExt^[P.Y + 1, P.X].RenderHeight / CELL_HEIGHT_DIV);
+  end;
+  KMRenderAuxMobileStroke(Points, True, 2 / CELL_SIZE_PX, $FFFF, 2 / CELL_SIZE_PX, fCurrentColor);
+end;
+
+
+end.

port-source/kam_remake/src/res/KM_ResSprites.pas

@@ -12,6 +12,9 @@ uses
 
 
 type
+  TKMMenuGPUPhase = (mgpInvalidated, mgpRecovering, mgpCurrentReady, mgpFailed);
+  TKMMenuCandidateCheck = function(aCandidateGeneration: QWord): Boolean of object;
+
   // How do we want to soften the sprite
   TKMSpriteSoftening = (ssNone, ssOnlyShadow, ssWhole);
 
@@ -45,6 +48,8 @@ type
   private
     fTemp: Boolean;
     fPad: Byte; // Padding between sprites to avoid neighbour edge visibility
+    fMenuReplayCreatedTextures: TList<Cardinal>;
+    fMenuReplayContextAccepted: TBooleanFuncSimple;
 
     procedure SetGFXData(aTexID: Cardinal; aSpriteInfo: TKMBinItem; aAtlasType: TKMSpriteAtlasType);
     procedure PrepareAtlases(aSpriteInfo: TBinArray; aMode: TKMSpriteAtlasType; aTexType: TKMTexFormat;
@@ -123,6 +128,30 @@ type
   private
     fAlphaShadows: Boolean; //Remember which state we loaded
     fSprites: array [TRXType] of TKMSpritePack;
+    fMenuInitial: array[TRXType] of record
+      InitialBuilt: Boolean;
+      SourceURI: string;
+      SourceIsAlphaVariant: Boolean;
+      InitialBaseAtlasCount: Integer;
+      InitialMaskAtlasCount: Integer;
+      InitialRawSpriteCount: Integer;
+      InitialTotalSpriteCount: Integer;
+      InitialGeneratedStartI: Integer;
+    end;
+    fMenuInitialCaptured: array[TRXType] of Boolean;
+    fMenuPhase: TKMMenuGPUPhase;
+    fMenuCandidateGeneration, fMenuReadyGeneration: QWord;
+    fMenuCandidateIsCurrent: TKMMenuCandidateCheck;
+    fMenuNextPackOrdinal: Integer;
+    fMenuFailedRT: TRXType;
+    fMenuFailureClass, fMenuFailureText: string;
+    fMenuPackProof: array[TRXType] of record
+      Generation: QWord;
+      Verified: Boolean;
+      BaseCount, MaskCount: Integer;
+    end;
+    fMenuInitialGpuVerified: array[TRXType] of Boolean;
+    fMenuInitialLoadFinished, fMenuInitialGPUCaptureValid, fMenuInitialCaptureRevoked: Boolean;
     fStepProgress: TKMEvent;
     fStepCaption: TUnicodeStringEvent;
     fGenTexIdStartI: Integer;
@@ -168,6 +197,13 @@ type
     function GetSpritesRXAFilePath(aRT: TRXType): string;
 
     function GetGameResourcesReady: Boolean;
+    function PrepareInitialMenuPackCPU(aRT: TRXType): Boolean;
+    function TryReplayInitialMenuPack(aRT: TRXType; aContextAccepted: TBooleanFuncSimple): Boolean;
+    function VerifyReplayedMenuPackGFX(aRT: TRXType; aCreatedIDs: TList<Cardinal>): Boolean;
+    function CaptureInitialMenuPackGPU(aRT: TRXType): Boolean;
+    function MenuContextAccepted: Boolean;
+    procedure ReconcileMenuGraphicsProof;
+    procedure AdvanceMenuGraphicsRecovery;
     procedure AcceptGameResourceRequest(aAlphaShadows, aForceReload: Boolean);
     procedure FailGameResourceRequest(aRT: TRXType; const aClass, aMessage: string);
     procedure AdvanceGameResourceRequest;
@@ -183,6 +219,9 @@ type
     procedure PreloadGameResources(aAlphaShadows: Boolean);
     procedure StartGameSpriteRecovery;
     procedure ClearTemp;
+    procedure InvalidateMenuGraphicsContext;
+    function AcceptMenuGraphicsCandidate(aGeneration: QWord; aIsCurrent: TKMMenuCandidateCheck): Boolean;
+    function MenuGraphicsReadyForGeneration(aGeneration: QWord): Boolean;
 
     class function AllTilesOnOneAtlas: Boolean;
 
@@ -236,6 +275,8 @@ uses
   KM_GameSettings;
 
 type
+  EKMMenuReplayContextAbort = class(Exception);
+
   TKMGameResourceWorker = class(TThread)
   private
     fOwner: TKMResSprites;
@@ -260,6 +301,20 @@ var
   AllTilesInOneTexture: Boolean = False;
 
 
+function ValidMenuUV(const aCoords: TKMTexCoords): Boolean;
+begin
+  Result := not IsNan(aCoords.u1) and not IsInfinite(aCoords.u1)
+        and not IsNan(aCoords.v1) and not IsInfinite(aCoords.v1)
+        and not IsNan(aCoords.u2) and not IsInfinite(aCoords.u2)
+        and not IsNan(aCoords.v2) and not IsInfinite(aCoords.v2)
+        and (aCoords.u1 >= 0) and (aCoords.u1 <= 1)
+        and (aCoords.v1 >= 0) and (aCoords.v1 <= 1)
+        and (aCoords.u2 >= 0) and (aCoords.u2 <= 1)
+        and (aCoords.v2 >= 0) and (aCoords.v2 <= 1)
+        and (aCoords.u1 < aCoords.u2) and (aCoords.v1 < aCoords.v2);
+end;
+
+
 function GetMaxAtlasSize: Integer;
 begin
   Result := MAX_GAME_ATLAS_SIZE;
@@ -274,6 +329,8 @@ begin
 
   fRT := aRT;
   fTemp := aTemp;
+  fMenuReplayCreatedTextures := nil;
+  fMenuReplayContextAccepted := nil;
 
   //Terrain tiles need padding to avoid edge bleeding
   if fRT = rxTiles then
@@ -1300,8 +1357,28 @@ begin
 
     if aFillGFXData then
     begin
+      if Assigned(fMenuReplayCreatedTextures) and (RX_INFO[fRT].Usage = ruMenu) then
+        if not Assigned(fMenuReplayContextAccepted) or not fMenuReplayContextAccepted()
+        or not TKMRender.TextureBackendReady then
+          raise EKMMenuReplayContextAbort.Create('Menu replay graphics context is unavailable');
+
       texID := TKMRender.GenTexture(aSpriteInfo[I].Width, aSpriteInfo[I].Height, @atlasData[0], aTexType, ftNearest, ftNearest);
 
+      if Assigned(fMenuReplayCreatedTextures) and (RX_INFO[fRT].Usage = ruMenu) then
+      begin
+        try
+          fMenuReplayCreatedTextures.Add(texID);
+        except
+          try
+            if Assigned(fMenuReplayContextAccepted) and fMenuReplayContextAccepted()
+            and TKMRender.TextureBackendReady then
+              TKMRender.DeleteTexture(texID);
+          except
+          end;
+          raise;
+        end;
+      end;
+
       //Now that we know texture IDs we can fill GFXData structure
       SetGFXData(texID, aSpriteInfo[I], aMode);
     end else
@@ -1457,9 +1534,34 @@ begin
   fGamePublishedThroughIndex := -1;
   FillChar(fGameRecoveryPending, SizeOf(fGameRecoveryPending), 0);
   fTemp := aTemp;
+  fMenuPhase := mgpInvalidated;
+  fMenuCandidateGeneration := 0;
+  fMenuReadyGeneration := 0;
+  fMenuCandidateIsCurrent := nil;
+  fMenuNextPackOrdinal := Ord(Low(TRXType));
+  fMenuFailedRT := Low(TRXType);
+  fMenuFailureClass := '';
+  fMenuFailureText := '';
+  fMenuInitialLoadFinished := False;
+  fMenuInitialGPUCaptureValid := False;
+  fMenuInitialCaptureRevoked := False;
 
   for RT := Low(TRXType) to High(TRXType) do
   begin
+    fMenuPackProof[RT].Generation := 0;
+    fMenuPackProof[RT].Verified := False;
+    fMenuPackProof[RT].BaseCount := 0;
+    fMenuPackProof[RT].MaskCount := 0;
+    fMenuInitialGpuVerified[RT] := False;
+    fMenuInitialCaptured[RT] := False;
+    fMenuInitial[RT].InitialBuilt := False;
+    fMenuInitial[RT].SourceURI := '';
+    fMenuInitial[RT].SourceIsAlphaVariant := False;
+    fMenuInitial[RT].InitialBaseAtlasCount := 0;
+    fMenuInitial[RT].InitialMaskAtlasCount := 0;
+    fMenuInitial[RT].InitialRawSpriteCount := 0;
+    fMenuInitial[RT].InitialTotalSpriteCount := 0;
+    fMenuInitial[RT].InitialGeneratedStartI := 0;
     fSprites[RT] := TKMSpritePack.Create(RT, fTemp);
     if RX_INFO[RT].Usage = ruGame then
       fGameRXTypes.Add(IntToStr(Integer(RT)));
@@ -1476,6 +1578,16 @@ var
   cleanupRT: TRXType;
   hasCleanup: Boolean;
 begin
+  fMenuCandidateIsCurrent := nil;
+  fMenuCandidateGeneration := 0;
+  fMenuReadyGeneration := 0;
+  for RT := Low(TRXType) to High(TRXType) do
+  begin
+    fMenuPackProof[RT].Generation := 0;
+    fMenuPackProof[RT].Verified := False;
+    fMenuPackProof[RT].BaseCount := 0;
+    fMenuPackProof[RT].MaskCount := 0;
+  end;
   Inc(fGameRequestSerial);
   hasCleanup := (fGameRXIndex >= 0) and (fGameRXIndex < fGameRXTypes.Count);
   if hasCleanup then
@@ -1515,6 +1627,240 @@ begin
 end;
 
 
+procedure TKMResSprites.InvalidateMenuGraphicsContext;
+var
+  RT: TRXType;
+  I: Integer;
+begin
+  fMenuReadyGeneration := 0;
+  fMenuPhase := mgpInvalidated;
+  fMenuCandidateGeneration := 0;
+  fMenuCandidateIsCurrent := nil;
+  fMenuNextPackOrdinal := Ord(Low(TRXType));
+  fMenuFailedRT := Low(TRXType);
+  fMenuFailureClass := '';
+  fMenuFailureText := '';
+  fMenuInitialGPUCaptureValid := False;
+  fMenuInitialCaptureRevoked := True;
+  for RT := Low(TRXType) to High(TRXType) do
+  begin
+    fMenuPackProof[RT].Generation := 0;
+    fMenuPackProof[RT].Verified := False;
+    fMenuPackProof[RT].BaseCount := 0;
+    fMenuPackProof[RT].MaskCount := 0;
+    fMenuInitialGpuVerified[RT] := False;
+  end;
+
+  for RT := Low(TRXType) to High(TRXType) do
+    if RX_INFO[RT].Usage = ruMenu then
+      for I := 0 to High(gGFXData[RT]) do
+      begin
+        gGFXData[RT, I].Tex.TexID := 0;
+        gGFXData[RT, I].Tex.u1 := 0;
+        gGFXData[RT, I].Tex.v1 := 0;
+        gGFXData[RT, I].Tex.u2 := 0;
+        gGFXData[RT, I].Tex.v2 := 0;
+        gGFXData[RT, I].Alt.TexID := 0;
+        gGFXData[RT, I].Alt.u1 := 0;
+        gGFXData[RT, I].Alt.v1 := 0;
+        gGFXData[RT, I].Alt.u2 := 0;
+        gGFXData[RT, I].Alt.v2 := 0;
+        gGFXData[RT, I].PxWidth := 0;
+        gGFXData[RT, I].PxHeight := 0;
+      end;
+end;
+
+
+function TKMResSprites.AcceptMenuGraphicsCandidate(aGeneration: QWord; aIsCurrent: TKMMenuCandidateCheck): Boolean;
+var
+  RT: TRXType;
+  HasInitialMembers, InitialProofValid: Boolean;
+begin
+  Result := False;
+  if (aGeneration = 0) or not Assigned(aIsCurrent) then Exit;
+  try
+    if not aIsCurrent(aGeneration) then Exit;
+  except
+    Exit;
+  end;
+  if not TKMRender.TextureBackendReady or not fMenuInitialLoadFinished then Exit;
+
+  if fMenuCandidateGeneration = aGeneration then
+  begin
+    fMenuCandidateIsCurrent := aIsCurrent;
+    Result := True;
+    Exit;
+  end;
+
+  if fMenuCandidateGeneration <> 0 then
+    InvalidateMenuGraphicsContext;
+
+  fMenuCandidateGeneration := aGeneration;
+  fMenuCandidateIsCurrent := aIsCurrent;
+  fMenuReadyGeneration := 0;
+  fMenuPhase := mgpRecovering;
+  fMenuNextPackOrdinal := Ord(Low(TRXType));
+  fMenuFailureClass := '';
+  fMenuFailureText := '';
+  fMenuFailedRT := Low(TRXType);
+  for RT := Low(TRXType) to High(TRXType) do
+  begin
+    fMenuPackProof[RT].Generation := 0;
+    fMenuPackProof[RT].Verified := False;
+    fMenuPackProof[RT].BaseCount := 0;
+    fMenuPackProof[RT].MaskCount := 0;
+  end;
+
+  HasInitialMembers := False;
+  for RT := Low(TRXType) to High(TRXType) do
+    if (RX_INFO[RT].Usage = ruMenu) and fMenuInitial[RT].InitialBuilt then
+      HasInitialMembers := True;
+
+  if not HasInitialMembers then
+    ReconcileMenuGraphicsProof
+  else
+  if fMenuInitialGPUCaptureValid and not fMenuInitialCaptureRevoked and MenuContextAccepted then
+  begin
+    InitialProofValid := True;
+    for RT := Low(TRXType) to High(TRXType) do
+      if (RX_INFO[RT].Usage = ruMenu) and fMenuInitial[RT].InitialBuilt
+      and (not fMenuInitialGpuVerified[RT]
+        or (fMenuInitial[RT].InitialBaseAtlasCount <= 0)
+        or (fMenuInitial[RT].InitialMaskAtlasCount < 0)) then
+        InitialProofValid := False;
+
+    if InitialProofValid and (fMenuCandidateGeneration = aGeneration)
+    and MenuContextAccepted and TKMRender.TextureBackendReady
+    and not fMenuInitialCaptureRevoked then
+    begin
+      for RT := Low(TRXType) to High(TRXType) do
+        if (RX_INFO[RT].Usage = ruMenu) and fMenuInitial[RT].InitialBuilt then
+        begin
+          fMenuPackProof[RT].Generation := aGeneration;
+          fMenuPackProof[RT].Verified := True;
+          fMenuPackProof[RT].BaseCount := fMenuInitial[RT].InitialBaseAtlasCount;
+          fMenuPackProof[RT].MaskCount := fMenuInitial[RT].InitialMaskAtlasCount;
+        end;
+      ReconcileMenuGraphicsProof;
+    end;
+  end;
+  Result := True;
+end;
+
+
+procedure TKMResSprites.AdvanceMenuGraphicsRecovery;
+var
+  I: Integer;
+  RT: TRXType;
+  AttemptGeneration: QWord;
+  ReplaySucceeded: Boolean;
+  FailureClass, FailureText: string;
+begin
+  if (fMenuPhase in [mgpCurrentReady, mgpInvalidated])
+  or (fMenuCandidateGeneration = 0) or not fMenuInitialLoadFinished
+  or not MenuContextAccepted then Exit;
+  if not (fMenuPhase in [mgpRecovering, mgpFailed]) then Exit;
+
+  AttemptGeneration := fMenuCandidateGeneration;
+  for I := fMenuNextPackOrdinal to Ord(High(TRXType)) do
+  begin
+    if (I < Ord(Low(TRXType))) or (I > Ord(High(TRXType))) then Continue;
+    RT := TRXType(I);
+    if (RX_INFO[RT].Usage <> ruMenu) or not fMenuInitial[RT].InitialBuilt then Continue;
+    if fMenuPackProof[RT].Verified
+    and (fMenuPackProof[RT].Generation = AttemptGeneration)
+    and (fMenuPackProof[RT].BaseCount = fMenuInitial[RT].InitialBaseAtlasCount)
+    and (fMenuPackProof[RT].BaseCount > 0)
+    and (fMenuPackProof[RT].MaskCount = fMenuInitial[RT].InitialMaskAtlasCount)
+    and (fMenuPackProof[RT].MaskCount >= 0) then Continue;
+
+    fMenuNextPackOrdinal := Ord(RT);
+    if fMenuPhase = mgpFailed then
+      fMenuPhase := mgpRecovering;
+    if (fMenuCandidateGeneration <> AttemptGeneration) or not MenuContextAccepted then Exit;
+
+    ReplaySucceeded := False;
+    FailureClass := 'ReplayUnavailableOrInvalid';
+    FailureText := '';
+    try
+      ReplaySucceeded := TryReplayInitialMenuPack(RT, @MenuContextAccepted);
+    except
+      on E: Exception do
+      begin
+        FailureClass := E.ClassName;
+        FailureText := E.Message;
+      end;
+    end;
+
+    if (fMenuCandidateGeneration <> AttemptGeneration)
+    or (fMenuPhase = mgpInvalidated) then Exit;
+
+    if ReplaySucceeded then
+    begin
+      if not MenuContextAccepted or (fMenuCandidateGeneration <> AttemptGeneration) then
+      begin
+        fMenuReadyGeneration := 0;
+        Exit;
+      end;
+      fMenuPackProof[RT].Generation := AttemptGeneration;
+      fMenuPackProof[RT].Verified := True;
+      fMenuPackProof[RT].BaseCount := fMenuInitial[RT].InitialBaseAtlasCount;
+      fMenuPackProof[RT].MaskCount := fMenuInitial[RT].InitialMaskAtlasCount;
+      fMenuFailureClass := '';
+      fMenuFailureText := '';
+      fMenuFailedRT := Low(TRXType);
+      fMenuNextPackOrdinal := Ord(RT) + 1;
+      ReconcileMenuGraphicsProof;
+    end else
+    begin
+      fMenuPackProof[RT].Generation := 0;
+      fMenuPackProof[RT].Verified := False;
+      fMenuPackProof[RT].BaseCount := 0;
+      fMenuPackProof[RT].MaskCount := 0;
+      fMenuReadyGeneration := 0;
+      fMenuPhase := mgpFailed;
+      fMenuNextPackOrdinal := Ord(RT);
+      fMenuFailedRT := RT;
+      fMenuFailureClass := FailureClass;
+      fMenuFailureText := FailureText;
+    end;
+    Exit;
+  end;
+  ReconcileMenuGraphicsProof;
+end;
+
+
+function TKMResSprites.MenuGraphicsReadyForGeneration(aGeneration: QWord): Boolean;
+var
+  RT: TRXType;
+begin
+  Result := False;
+  if (aGeneration = 0) or not fMenuInitialLoadFinished
+  or (fMenuPhase <> mgpCurrentReady)
+  or (fMenuCandidateGeneration <> aGeneration)
+  or (fMenuReadyGeneration <> aGeneration)
+  or not Assigned(fMenuCandidateIsCurrent)
+  or not TKMRender.TextureBackendReady then Exit;
+  if not MenuContextAccepted then Exit;
+
+  for RT := Low(TRXType) to High(TRXType) do
+    if (RX_INFO[RT].Usage = ruMenu) and fMenuInitial[RT].InitialBuilt
+    and (not fMenuPackProof[RT].Verified
+      or (fMenuPackProof[RT].Generation <> aGeneration)
+      or (fMenuPackProof[RT].BaseCount <> fMenuInitial[RT].InitialBaseAtlasCount)
+      or (fMenuPackProof[RT].BaseCount <= 0)
+      or (fMenuPackProof[RT].MaskCount <> fMenuInitial[RT].InitialMaskAtlasCount)
+      or (fMenuPackProof[RT].MaskCount < 0)) then Exit;
+
+  if (fMenuCandidateGeneration <> aGeneration)
+  or (fMenuReadyGeneration <> aGeneration)
+  or (fMenuPhase <> mgpCurrentReady)
+  or not MenuContextAccepted
+  or not TKMRender.TextureBackendReady then Exit;
+  Result := True;
+end;
+
+
 //aLegacyGeneration - support for maps with rev <= r10745, where transitions were written as generated terrain Id
 //instead of generation parameters (TekKind + FullMaskType)
 //Also there was no mkSoft mask and tkSnowOnTerrain terrain kind
@@ -1768,6 +2114,15 @@ procedure TKMResSprites.LoadMenuResources;
 var
   RT: TRXType;
 begin
+  {$IFDEF NO_OGL}
+  raise Exception.Create('Menu sprite loading requires graphics atlas support (NO_OGL is unsupported)');
+  {$ENDIF}
+
+  fMenuInitialLoadFinished := False;
+  fMenuInitialGPUCaptureValid := False;
+  for RT := Low(TRXType) to High(TRXType) do
+    fMenuInitialGpuVerified[RT] := False;
+
   for RT := Low(TRXType) to High(TRXType) do
     if RX_INFO[RT].Usage = ruMenu then
     begin
@@ -1782,9 +2137,499 @@ begin
       fSprites[RT].MakeGFX(RT in [rxGUI, rxTiles]);
       {$ENDIF}
 
+      if not fTemp and not fMenuInitialCaptured[RT] and not fMenuInitial[RT].InitialBuilt
+         and (Length(fSprites[RT].Atlases[saBase]) > 0)
+         and (fMenuInitial[RT].InitialRawSpriteCount > 0)
+         and (fMenuInitial[RT].SourceURI <> '')
+         and (fSprites[RT].RXData.Count >= fMenuInitial[RT].InitialRawSpriteCount)
+         and ((RT <> rxTiles) or (fGenTexIdStartI > 0)) then
+      begin
+        fMenuInitial[RT].InitialBaseAtlasCount := Length(fSprites[RT].Atlases[saBase]);
+        fMenuInitial[RT].InitialMaskAtlasCount := Length(fSprites[RT].Atlases[saMask]);
+        fMenuInitial[RT].InitialTotalSpriteCount := fSprites[RT].RXData.Count;
+        if RT = rxTiles then
+          fMenuInitial[RT].InitialGeneratedStartI := fGenTexIdStartI;
+        fMenuInitial[RT].InitialBuilt := True;
+      end;
+      if not fTemp then
+        fMenuInitialCaptured[RT] := True;
+
+      if fMenuInitial[RT].InitialBuilt and not fMenuInitialCaptureRevoked
+      and TKMRender.TextureBackendReady then
+        fMenuInitialGpuVerified[RT] := CaptureInitialMenuPackGPU(RT);
+
       if Assigned(fStepProgress) then
         fStepProgress;
     end;
+
+  fMenuInitialLoadFinished := True;
+  fMenuInitialGPUCaptureValid := not fMenuInitialCaptureRevoked and TKMRender.TextureBackendReady;
+  if fMenuInitialGPUCaptureValid then
+    for RT := Low(TRXType) to High(TRXType) do
+      if (RX_INFO[RT].Usage = ruMenu) and fMenuInitial[RT].InitialBuilt
+      and not fMenuInitialGpuVerified[RT] then
+      begin
+        fMenuInitialGPUCaptureValid := False;
+        Break;
+      end;
+end;
+
+
+function TKMResSprites.CaptureInitialMenuPackGPU(aRT: TRXType): Boolean;
+var
+  I: Integer;
+  BaseIDs, MaskIDs: TList<Cardinal>;
+  HasBase, HasMask: Boolean;
+  Coords: TKMTexCoords;
+begin
+  Result := False;
+  if not fMenuInitial[aRT].InitialBuilt or (fSprites[aRT] = nil)
+  or (fMenuInitial[aRT].InitialBaseAtlasCount <= 0)
+  or (fMenuInitial[aRT].InitialMaskAtlasCount < 0)
+  or (fSprites[aRT].RXData.Count <> fMenuInitial[aRT].InitialTotalSpriteCount)
+  or (fSprites[aRT].RXData.Count < fMenuInitial[aRT].InitialRawSpriteCount)
+  or (fMenuInitial[aRT].InitialRawSpriteCount <= 0)
+  or (Length(gGFXData[aRT]) < fSprites[aRT].RXData.Count + 1)
+  or (Length(fSprites[aRT].RXData.Size) < fSprites[aRT].RXData.Count + 1)
+  or (Length(fSprites[aRT].RXData.RGBA) < fSprites[aRT].RXData.Count + 1)
+  or (Length(fSprites[aRT].RXData.Mask) < fSprites[aRT].RXData.Count + 1)
+  or (Length(fSprites[aRT].RXData.HasMask) < fSprites[aRT].RXData.Count + 1)
+  or ((aRT = rxTiles) and (fGenTexIdStartI <> fMenuInitial[aRT].InitialGeneratedStartI))
+  or ((aRT in [rxGui, rxGuiMain]) and (fMenuInitial[aRT].InitialGeneratedStartI <> 0))
+  or not TKMRender.TextureBackendReady then Exit;
+
+  BaseIDs := TList<Cardinal>.Create;
+  MaskIDs := TList<Cardinal>.Create;
+  try
+    for I := 1 to fSprites[aRT].RXData.Count do
+    begin
+      HasBase := (fSprites[aRT].RXData.Size[I].X * fSprites[aRT].RXData.Size[I].Y <> 0)
+             and (Length(fSprites[aRT].RXData.RGBA[I]) > 0);
+      HasMask := (fSprites[aRT].RXData.Size[I].X * fSprites[aRT].RXData.Size[I].Y <> 0)
+             and fSprites[aRT].RXData.HasMask[I]
+             and (Length(fSprites[aRT].RXData.Mask[I]) > 0);
+      Coords := gGFXData[aRT, I].Tex;
+      if HasBase then
+      begin
+        if (Coords.TexID = 0) or not ValidMenuUV(Coords)
+        or (gGFXData[aRT, I].PxWidth <> fSprites[aRT].RXData.Size[I].X)
+        or (gGFXData[aRT, I].PxHeight <> fSprites[aRT].RXData.Size[I].Y) then Exit;
+        if BaseIDs.IndexOf(Coords.TexID) < 0 then BaseIDs.Add(Coords.TexID);
+      end else
+      if (Coords.TexID <> 0) or (Coords.u1 <> 0) or (Coords.v1 <> 0)
+      or (Coords.u2 <> 0) or (Coords.v2 <> 0)
+      or (gGFXData[aRT, I].PxWidth <> 0) or (gGFXData[aRT, I].PxHeight <> 0) then Exit;
+
+      Coords := gGFXData[aRT, I].Alt;
+      if HasMask then
+      begin
+        if (Coords.TexID = 0) or not ValidMenuUV(Coords) then Exit;
+        if MaskIDs.IndexOf(Coords.TexID) < 0 then MaskIDs.Add(Coords.TexID);
+      end else
+      if (Coords.TexID <> 0) or (Coords.u1 <> 0) or (Coords.v1 <> 0)
+      or (Coords.u2 <> 0) or (Coords.v2 <> 0) then Exit;
+    end;
+
+    if (BaseIDs.Count <> fMenuInitial[aRT].InitialBaseAtlasCount)
+    or (MaskIDs.Count <> fMenuInitial[aRT].InitialMaskAtlasCount) then Exit;
+    for I := 0 to BaseIDs.Count - 1 do
+      if MaskIDs.IndexOf(BaseIDs[I]) >= 0 then Exit;
+    Result := TKMRender.TextureBackendReady;
+  finally
+    MaskIDs.Free;
+    BaseIDs.Free;
+  end;
+end;
+
+
+function TKMResSprites.MenuContextAccepted: Boolean;
+begin
+  Result := False;
+  if (fMenuCandidateGeneration = 0) or not fMenuInitialLoadFinished
+  or not Assigned(fMenuCandidateIsCurrent) then Exit;
+  try
+    Result := fMenuCandidateIsCurrent(fMenuCandidateGeneration)
+          and TKMRender.TextureBackendReady;
+  except
+    Result := False;
+  end;
+end;
+
+
+procedure TKMResSprites.ReconcileMenuGraphicsProof;
+var
+  RT: TRXType;
+  Generation: QWord;
+begin
+  fMenuReadyGeneration := 0;
+  if not fMenuInitialLoadFinished or (fMenuCandidateGeneration = 0)
+  or not (fMenuPhase in [mgpRecovering, mgpCurrentReady])
+  or not MenuContextAccepted then Exit;
+  Generation := fMenuCandidateGeneration;
+  for RT := Low(TRXType) to High(TRXType) do
+    if (RX_INFO[RT].Usage = ruMenu) and fMenuInitial[RT].InitialBuilt
+    and (not fMenuPackProof[RT].Verified
+      or (fMenuPackProof[RT].Generation <> Generation)
+      or (fMenuPackProof[RT].BaseCount <> fMenuInitial[RT].InitialBaseAtlasCount)
+      or (fMenuPackProof[RT].BaseCount <= 0)
+      or (fMenuPackProof[RT].MaskCount <> fMenuInitial[RT].InitialMaskAtlasCount)
+      or (fMenuPackProof[RT].MaskCount < 0)) then Exit;
+  if not MenuContextAccepted or not TKMRender.TextureBackendReady
+  or (fMenuCandidateGeneration <> Generation) then Exit;
+  fMenuReadyGeneration := Generation;
+  fMenuPhase := mgpCurrentReady;
+end;
+
+
+function TKMResSprites.PrepareInitialMenuPackCPU(aRT: TRXType): Boolean;
+var
+  I: Integer;
+  PixelCount: Int64;
+  HasActiveSprite: Boolean;
+
+  function ValidateTerrainLookup(aLegacy: Boolean): Boolean;
+  var
+    TK: TKMTerrainKind;
+    MK: TKMTileMaskKind;
+    MT: TKMTileMaskType;
+    MST: TKMTileMaskSubType;
+    Transition: Word;
+    LookupIndex, StartI: Integer;
+  begin
+    Result := False;
+    if aLegacy then
+    begin
+      StartI := fGenTexIdStartILegacy;
+      if Length(fGenTerrainToTerKindLegacy) = 0 then Exit;
+    end else begin
+      StartI := fGenTexIdStartI;
+      if Length(fGenTerrainToTerKind) = 0 then Exit;
+    end;
+
+    for TK := Succ(tkCustom) to High(TKMTerrainKind) do
+      for MK := Succ(mkNone) to High(TKMTileMaskKind) do
+        for MT := Succ(tmtNone) to High(TKMTileMaskType) do
+          for MST := Low(TKMTileMaskSubType) to High(TKMTileMaskSubType) do
+          begin
+            if aLegacy then
+              Transition := fGenTerrainTransitionsLegacy[TK, MK, MT, MST]
+            else
+              Transition := fGenTerrainTransitions[TK, MK, MT, MST];
+            if Transition = 0 then Continue;
+            LookupIndex := Integer(Transition) + 1 - StartI;
+            if (LookupIndex < 0) or
+               (aLegacy and (LookupIndex >= Length(fGenTerrainToTerKindLegacy))) or
+               (not aLegacy and (LookupIndex >= Length(fGenTerrainToTerKind))) then Exit;
+            if not aLegacy and (Integer(Transition) < fMenuInitial[aRT].InitialGeneratedStartI - 1) then Exit;
+            if not aLegacy and (Integer(Transition) >= fMenuInitial[aRT].InitialTotalSpriteCount) then Exit;
+          end;
+    Result := True;
+  end;
+
+begin
+  Result := False;
+  if not (aRT in [rxGui, rxGuiMain, rxTiles])
+  or (RX_INFO[aRT].Usage <> ruMenu)
+  or not fMenuInitial[aRT].InitialBuilt
+  or fTemp
+  or (fSprites[aRT] = nil)
+  or (fMenuInitial[aRT].SourceURI = '')
+  or (fMenuInitial[aRT].InitialRawSpriteCount <= 0)
+  or (fMenuInitial[aRT].InitialBaseAtlasCount <= 0)
+  or (fMenuInitial[aRT].InitialMaskAtlasCount < 0)
+  or (fMenuInitial[aRT].InitialTotalSpriteCount < fMenuInitial[aRT].InitialRawSpriteCount) then Exit;
+
+  if aRT = rxTiles then
+  begin
+    if fMenuInitial[aRT].InitialGeneratedStartI <= 0 then Exit;
+  end else
+  if (aRT in [rxGui, rxGuiMain]) then
+  begin
+    if (fMenuInitial[aRT].InitialGeneratedStartI <> 0)
+    or (fMenuInitial[aRT].InitialTotalSpriteCount <> fMenuInitial[aRT].InitialRawSpriteCount) then Exit;
+  end;
+
+  fSprites[aRT].ClearTemp;
+  fSprites[aRT].AllocateRXData(0);
+  fSprites[aRT].LoadFromRXXFile(fMenuInitial[aRT].SourceURI, 1);
+  with fSprites[aRT].fRXData do
+  begin
+    if (Count <> fMenuInitial[aRT].InitialRawSpriteCount)
+    or (Length(Flag) < Count + 1)
+    or (Length(Size) < Count + 1)
+    or (Length(Pivot) < Count + 1)
+    or (Length(RGBA) < Count + 1)
+    or (Length(Mask) < Count + 1)
+    or (Length(HasMask) < Count + 1) then Exit;
+
+    HasActiveSprite := False;
+    for I := 1 to Count do
+      if Flag[I] = 1 then
+      begin
+        if (Size[I].X <= 0) or (Size[I].Y <= 0) then Exit;
+        PixelCount := Int64(Size[I].X) * Int64(Size[I].Y);
+        if (PixelCount <= 0) or (PixelCount > High(Integer))
+        or (Length(RGBA[I]) <> PixelCount) then Exit;
+        if HasMask[I] and (Length(Mask[I]) <> PixelCount) then Exit;
+        HasActiveSprite := True;
+      end;
+    if not HasActiveSprite then Exit;
+  end;
+
+  if aRT <> rxTiles then
+  begin
+    Result := fSprites[aRT].RXData.Count = fMenuInitial[aRT].InitialTotalSpriteCount;
+    Exit;
+  end;
+
+  GenerateTerrainTransitions(fSprites[rxTiles], False);
+  GenerateTerrainTransitions(nil, True);
+  Result := (fGenTexIdStartI = fMenuInitial[rxTiles].InitialGeneratedStartI)
+        and (fSprites[rxTiles].RXData.Count = fMenuInitial[rxTiles].InitialTotalSpriteCount)
+        and ValidateTerrainLookup(False)
+        and (fGenTexIdStartILegacy = 4999)
+        and ValidateTerrainLookup(True);
+end;
+
+
+function TKMResSprites.VerifyReplayedMenuPackGFX(aRT: TRXType; aCreatedIDs: TList<Cardinal>): Boolean;
+var
+  I, J, BaseCount, ExpectedCount: Integer;
+  HasBase, HasMask: Boolean;
+  Coords: TKMTexCoords;
+begin
+  Result := False;
+  if (aCreatedIDs = nil) or (fSprites[aRT] = nil)
+  or (fSprites[aRT].RXData.Count <> fMenuInitial[aRT].InitialTotalSpriteCount)
+  or (Length(gGFXData[aRT]) < fSprites[aRT].RXData.Count + 1)
+  or (Length(fSprites[aRT].RXData.Size) < fSprites[aRT].RXData.Count + 1)
+  or (Length(fSprites[aRT].RXData.RGBA) < fSprites[aRT].RXData.Count + 1)
+  or (Length(fSprites[aRT].RXData.Mask) < fSprites[aRT].RXData.Count + 1)
+  or (Length(fSprites[aRT].RXData.HasMask) < fSprites[aRT].RXData.Count + 1) then Exit;
+
+  BaseCount := fMenuInitial[aRT].InitialBaseAtlasCount;
+  ExpectedCount := BaseCount + fMenuInitial[aRT].InitialMaskAtlasCount;
+  if (Length(fSprites[aRT].Atlases[saBase]) <> BaseCount)
+  or (Length(fSprites[aRT].Atlases[saMask]) <> fMenuInitial[aRT].InitialMaskAtlasCount)
+  or (aCreatedIDs.Count <> ExpectedCount) then Exit;
+
+  for I := 0 to aCreatedIDs.Count - 1 do
+  begin
+    if aCreatedIDs[I] = 0 then Exit;
+    for J := 0 to I - 1 do
+      if aCreatedIDs[I] = aCreatedIDs[J] then Exit;
+  end;
+
+  for I := 1 to fSprites[aRT].RXData.Count do
+  begin
+    HasBase := (fSprites[aRT].RXData.Size[I].X * fSprites[aRT].RXData.Size[I].Y <> 0)
+           and (Length(fSprites[aRT].RXData.RGBA[I]) > 0);
+    HasMask := (fSprites[aRT].RXData.Size[I].X * fSprites[aRT].RXData.Size[I].Y <> 0)
+           and fSprites[aRT].RXData.HasMask[I]
+           and (Length(fSprites[aRT].RXData.Mask[I]) > 0);
+    Coords := gGFXData[aRT, I].Tex;
+    if HasBase then
+    begin
+      if (Coords.TexID = 0) or (aCreatedIDs.IndexOf(Coords.TexID) < 0)
+      or not ValidMenuUV(Coords)
+      or (gGFXData[aRT, I].PxWidth <> fSprites[aRT].RXData.Size[I].X)
+      or (gGFXData[aRT, I].PxHeight <> fSprites[aRT].RXData.Size[I].Y) then Exit;
+      J := 0;
+      while (J < BaseCount) and (aCreatedIDs[J] <> Coords.TexID) do Inc(J);
+      if J = BaseCount then Exit;
+    end else
+    if (Coords.TexID <> 0) or (Coords.u1 <> 0) or (Coords.v1 <> 0)
+    or (Coords.u2 <> 0) or (Coords.v2 <> 0)
+    or (gGFXData[aRT, I].PxWidth <> 0) or (gGFXData[aRT, I].PxHeight <> 0) then Exit;
+
+    Coords := gGFXData[aRT, I].Alt;
+    if HasMask then
+    begin
+      if (Coords.TexID = 0) or not ValidMenuUV(Coords) then Exit;
+      J := BaseCount;
+      while (J < aCreatedIDs.Count) and (aCreatedIDs[J] <> Coords.TexID) do Inc(J);
+      if J = aCreatedIDs.Count then Exit;
+    end else
+    if (Coords.TexID <> 0) or (Coords.u1 <> 0) or (Coords.v1 <> 0)
+    or (Coords.u2 <> 0) or (Coords.v2 <> 0) then Exit;
+  end;
+
+  Result := True;
+end;
+
+
+function TKMResSprites.TryReplayInitialMenuPack(aRT: TRXType; aContextAccepted: TBooleanFuncSimple): Boolean;
+var
+  I: Integer;
+  CreatedIDs: TList<Cardinal>;
+  SavedAllTilesInOneTexture, AttemptSucceeded, ControlledAbort, TerrainSnapshot: Boolean;
+  SavedGenTexIdStartI, SavedGenTexIdStartILegacy: Integer;
+  SavedTransitions, SavedTransitionsLegacy: array of Byte;
+  SavedTerrainInfo, SavedTerrainInfoLegacy: array of TKMGenTerrainInfo;
+
+  function ContextAcceptedNow: Boolean;
+  begin
+    Result := False;
+    try
+      Result := Assigned(aContextAccepted) and aContextAccepted();
+    except
+      Result := False;
+    end;
+  end;
+
+  function ReplayDeleteAllowed: Boolean;
+  begin
+    Result := False;
+    try
+      Result := ContextAcceptedNow and TKMRender.TextureBackendReady;
+    except
+      Result := False;
+    end;
+  end;
+
+  procedure ClearGFXData;
+  var
+    K: Integer;
+  begin
+    for K := 0 to High(gGFXData[aRT]) do
+    begin
+      gGFXData[aRT, K].Tex.TexID := 0;
+      gGFXData[aRT, K].Tex.u1 := 0;
+      gGFXData[aRT, K].Tex.v1 := 0;
+      gGFXData[aRT, K].Tex.u2 := 0;
+      gGFXData[aRT, K].Tex.v2 := 0;
+      gGFXData[aRT, K].Alt.TexID := 0;
+      gGFXData[aRT, K].Alt.u1 := 0;
+      gGFXData[aRT, K].Alt.v1 := 0;
+      gGFXData[aRT, K].Alt.u2 := 0;
+      gGFXData[aRT, K].Alt.v2 := 0;
+      gGFXData[aRT, K].PxWidth := 0;
+      gGFXData[aRT, K].PxHeight := 0;
+    end;
+  end;
+
+begin
+  Result := False;
+  if not (aRT in [rxGui, rxGuiMain, rxTiles])
+  or (RX_INFO[aRT].Usage <> ruMenu)
+  or not fMenuInitial[aRT].InitialBuilt
+  or fTemp
+  or not Assigned(aContextAccepted)
+  or (fSprites[aRT] = nil)
+  or (fMenuInitial[aRT].SourceURI = '')
+  or (fMenuInitial[aRT].InitialRawSpriteCount <= 0)
+  or (fMenuInitial[aRT].InitialBaseAtlasCount <= 0)
+  or (fMenuInitial[aRT].InitialMaskAtlasCount < 0)
+  or (fMenuInitial[aRT].InitialTotalSpriteCount < fMenuInitial[aRT].InitialRawSpriteCount) then Exit;
+  if (aRT = rxTiles) and (fMenuInitial[aRT].InitialGeneratedStartI <= 0) then Exit;
+  if (aRT <> rxTiles) and (fMenuInitial[aRT].InitialTotalSpriteCount <> fMenuInitial[aRT].InitialRawSpriteCount) then Exit;
+  if not ContextAcceptedNow or not TKMRender.TextureBackendReady then Exit;
+
+  SavedAllTilesInOneTexture := AllTilesInOneTexture;
+  TerrainSnapshot := aRT = rxTiles;
+  if TerrainSnapshot then
+  begin
+    SavedGenTexIdStartI := fGenTexIdStartI;
+    SavedGenTexIdStartILegacy := fGenTexIdStartILegacy;
+    SetLength(SavedTransitions, SizeOf(fGenTerrainTransitions));
+    SetLength(SavedTransitionsLegacy, SizeOf(fGenTerrainTransitionsLegacy));
+    Move(fGenTerrainTransitions, SavedTransitions[0], Length(SavedTransitions));
+    Move(fGenTerrainTransitionsLegacy, SavedTransitionsLegacy[0], Length(SavedTransitionsLegacy));
+    SavedTerrainInfo := Copy(fGenTerrainToTerKind, 0, Length(fGenTerrainToTerKind));
+    SavedTerrainInfoLegacy := Copy(fGenTerrainToTerKindLegacy, 0, Length(fGenTerrainToTerKindLegacy));
+  end;
+
+  CreatedIDs := nil;
+  AttemptSucceeded := False;
+  ControlledAbort := False;
+  try
+    CreatedIDs := TList<Cardinal>.Create;
+    try
+      for I := 0 to High(gGFXData[aRT]) do
+      begin
+        gGFXData[aRT, I].Tex.TexID := 0;
+        gGFXData[aRT, I].Tex.u1 := 0;
+        gGFXData[aRT, I].Tex.v1 := 0;
+        gGFXData[aRT, I].Tex.u2 := 0;
+        gGFXData[aRT, I].Tex.v2 := 0;
+        gGFXData[aRT, I].Alt.TexID := 0;
+        gGFXData[aRT, I].Alt.u1 := 0;
+        gGFXData[aRT, I].Alt.v1 := 0;
+        gGFXData[aRT, I].Alt.u2 := 0;
+        gGFXData[aRT, I].Alt.v2 := 0;
+        gGFXData[aRT, I].PxWidth := 0;
+        gGFXData[aRT, I].PxHeight := 0;
+      end;
+
+      if not PrepareInitialMenuPackCPU(aRT) then Exit;
+      if Length(gGFXData[aRT]) <= fSprites[aRT].RXData.Count then Exit;
+      if not ContextAcceptedNow or not TKMRender.TextureBackendReady then Exit;
+
+      fSprites[aRT].fMenuReplayCreatedTextures := CreatedIDs;
+      fSprites[aRT].fMenuReplayContextAccepted := aContextAccepted;
+      {$IFNDEF NO_OGL}
+      fSprites[aRT].MakeGFX(aRT in [rxGui, rxTiles], 1, True);
+      {$ELSE}
+      raise EKMMenuReplayContextAbort.Create('Menu replay requires graphics atlas support');
+      {$ENDIF}
+
+      if not VerifyReplayedMenuPackGFX(aRT, CreatedIDs)
+      or not ContextAcceptedNow or not TKMRender.TextureBackendReady then Exit;
+
+      fSprites[aRT].ClearTemp;
+      fSprites[aRT].ClearGameResGenTemp;
+      if not ContextAcceptedNow or not TKMRender.TextureBackendReady then Exit;
+      AttemptSucceeded := True;
+      Result := True;
+    except
+      on E: EKMMenuReplayContextAbort do
+        ControlledAbort := True;
+    end;
+  finally
+    if fSprites[aRT] <> nil then
+    begin
+      fSprites[aRT].fMenuReplayCreatedTextures := nil;
+      fSprites[aRT].fMenuReplayContextAccepted := nil;
+    end;
+
+    if not AttemptSucceeded then
+    begin
+      if CreatedIDs <> nil then
+        for I := 0 to CreatedIDs.Count - 1 do
+        begin
+          if CreatedIDs.IndexOf(CreatedIDs[I]) <> I then Continue;
+          if not ReplayDeleteAllowed then Break;
+          try
+            TKMRender.DeleteTexture(CreatedIDs[I]);
+          except
+          end;
+        end;
+      ClearGFXData;
+      try
+        if fSprites[aRT] <> nil then
+          fSprites[aRT].ClearTemp;
+      except
+      end;
+      try
+        if fSprites[aRT] <> nil then
+          fSprites[aRT].ClearGameResGenTemp;
+      except
+      end;
+      if TerrainSnapshot then
+      begin
+        Move(SavedTransitions[0], fGenTerrainTransitions, Length(SavedTransitions));
+        Move(SavedTransitionsLegacy[0], fGenTerrainTransitionsLegacy, Length(SavedTransitionsLegacy));
+        fGenTerrainToTerKind := SavedTerrainInfo;
+        fGenTerrainToTerKindLegacy := SavedTerrainInfoLegacy;
+        fGenTexIdStartI := SavedGenTexIdStartI;
+        fGenTexIdStartILegacy := SavedGenTexIdStartILegacy;
+        AllTilesInOneTexture := SavedAllTilesInOneTexture;
+      end;
+      Result := False;
+    end;
+    CreatedIDs.Free;
+  end;
+  if ControlledAbort then Result := False;
 end;
 
 
@@ -2093,7 +2938,7 @@ begin
   if gLog <> nil then
     gLog.AddTime('Load Sprites started');
   Result := False;
-  if aRT = rxTiles then
+  if RX_INFO[aRT].Usage = ruMenu then
   begin
     alphaReference := KaMResolvePackagedResource('data/Sprites/' + RX_INFO[aRT].FileName + '_a.rxx');
     normalReference := KaMResolvePackagedResource('data/Sprites/' + RX_INFO[aRT].FileName + '.rxx');
@@ -2101,12 +2946,24 @@ begin
     begin
       fSprites[aRT].LoadFromRXXFile(alphaReference);
       Result := True;
+      if not fTemp and not fMenuInitialCaptured[aRT] and not fMenuInitial[aRT].InitialBuilt then
+      begin
+        fMenuInitial[aRT].SourceURI := alphaReference;
+        fMenuInitial[aRT].SourceIsAlphaVariant := True;
+        fMenuInitial[aRT].InitialRawSpriteCount := fSprites[aRT].RXData.Count;
+      end;
     end
     else
     if KaMResourceExists(normalReference) then
     begin
       fSprites[aRT].LoadFromRXXFile(normalReference);
       Result := True;
+      if not fTemp and not fMenuInitialCaptured[aRT] and not fMenuInitial[aRT].InitialBuilt then
+      begin
+        fMenuInitial[aRT].SourceURI := normalReference;
+        fMenuInitial[aRT].SourceIsAlphaVariant := False;
+        fMenuInitial[aRT].InitialRawSpriteCount := fSprites[aRT].RXData.Count;
+      end;
     end
     else
       Exit;
@@ -2128,9 +2985,12 @@ begin
       Exit;
   end;
 
+  if RX_INFO[aRT].Usage <> ruMenu then
+  begin
     fSprites[aRT].OverloadRXDataFromFolder(ExeDir + 'Sprites' + PathDelim, nil); // Legacy support
     // 'Sprites' folder name confused some of the players, cause there is already data/Sprites folder
     fSprites[aRT].OverloadRXDataFromFolder(ExeDir + 'Modding graphics' + PathDelim, nil);
+  end;
 
   if gLog <> nil then
     gLog.AddTime('Load Sprites Done');
@@ -2181,6 +3041,7 @@ procedure TKMResSprites.UpdateStateIdle;
 begin
   if (fGameRequestSerial <> 0) and not (fGameRequestState in [grsReady, grsFailed]) then
     AdvanceGameResourceRequest;
+  AdvanceMenuGraphicsRecovery;
 end;
 
 

port-source/kam_remake/src/res/KM_Resource.pas

@@ -62,6 +62,10 @@ type
     procedure PreloadGameResources(aAlphaShadows: Boolean);
     procedure LoadGameResources(aAlphaShadows: Boolean; aForceReload: Boolean = False);
     procedure StartGameSpriteRecovery;
+    function RequestMenuGraphicsRecovery(aGeneration: QWord;
+      aIsCurrent: TKMMenuCandidateCheck): Boolean;
+    procedure InvalidateMenuGraphicsContext;
+    function MenuGraphicsReadyForGeneration(aGeneration: QWord): Boolean;
     procedure LoadLocaleFonts(const aLocale: AnsiString; aLoadFullFonts: Boolean);
     function FontResourcesReadyForGeneration(aGeneration: QWord): Boolean;
     procedure InvalidateFontGraphicsContext;
@@ -98,7 +102,7 @@ uses
   {$IFNDEF NO_OGL}
   KM_System,
   {$ENDIF}
-  KromUtils, KM_Log, KM_Points,
+  KromUtils, KM_Log, KM_Points, KM_Render,
   KM_ResTexts, KM_ResKeyFuncs, KM_ResTilesetTypes;
 
 
@@ -411,6 +415,40 @@ begin
 end;
 
 
+function TKMResource.RequestMenuGraphicsRecovery(aGeneration: QWord;
+  aIsCurrent: TKMMenuCandidateCheck): Boolean;
+begin
+  Result := False;
+  if fSprites = nil then Exit;
+  if fDataState = rlsNone then Exit;
+  if aGeneration = 0 then Exit;
+  if not Assigned(aIsCurrent) then Exit;
+  if not aIsCurrent(aGeneration) then Exit;
+  if not TKMRender.TextureBackendReady then Exit;
+
+  Result := fSprites.AcceptMenuGraphicsCandidate(aGeneration, aIsCurrent);
+end;
+
+
+procedure TKMResource.InvalidateMenuGraphicsContext;
+begin
+  if fSprites = nil then Exit;
+  fSprites.InvalidateMenuGraphicsContext;
+end;
+
+
+function TKMResource.MenuGraphicsReadyForGeneration(aGeneration: QWord): Boolean;
+begin
+  Result := False;
+  if aGeneration = 0 then Exit;
+  if fDataState = rlsNone then Exit;
+  if fSprites = nil then Exit;
+  if not TKMRender.TextureBackendReady then Exit;
+
+  Result := fSprites.MenuGraphicsReadyForGeneration(aGeneration);
+end;
+
+
 function TKMResource.IsMsgHouseUnnocupied(aMsgId: Word): Boolean;
 begin
   Result := (aMsgId >= TX_MSG_HOUSE_UNOCCUPIED__22) and (aMsgId <= TX_MSG_HOUSE_UNOCCUPIED__22 + 22);

port-source/kam_remake/src/utils/KromOGLUtils.pas

@@ -1,274 +1,32 @@
 unit KromOGLUtils;
 {$I KaM_Remake.inc}
 interface
-uses
-  dglOpenGL,
-  {$IFDEF FPC} GL, LCLIntf, {$ENDIF}
-  {$IFDEF MSWindows} Windows {$ENDIF}
-  {$IFDEF Unix} LCLType, glx, x, xlib, xutil {$ENDIF}
-  ;
-
-{$IFDEF Unix}
-type HGLRC = Integer;
-type PFD_DRAW_TO_WINDOW = Integer;
-type PFD_SUPPORT_OPENGL = Integer;
-type PFD_DOUBLEBUFFER = Integer;
-type PFD_TYPE_RGBA = Integer;
-type PFD_MAIN_PLANE = Integer;
-{$ENDIF}
 
 type
   TColor4 = Cardinal;
   TTexture = record Tex: Cardinal; U, V: Single; end;
+  TKromPoint2 = record
+    X, Y: Single;
+  end;
+  TKromQuadCoords = array[0..3] of TKromPoint2;
 
-  procedure SetRenderFrame(RenderFrame: HWND; out h_DC: HDC; out h_RC: HGLRC);
+  function KromQuadCoords(Ax, Ay, Bx, By, Cx, Cy, Dx, Dy: Single): TKromQuadCoords;
-  procedure SetRenderFrameAA(DummyFrame, RenderFrame: HWND; AntiAliasing: Byte; out h_DC: HDC; out h_RC: HGLRC);
+  function KromRectCoords(Ax, Ay, Bx, By: Single): TKromQuadCoords;
-
-  procedure BuildFont(h_DC: HDC; FontSize: Integer; FontWeight: Word = FW_NORMAL);
-  procedure glPrint(const text: AnsiString);
-  procedure glkScale(x: Single);
-  procedure glkQuad(Ax, Ay, Bx, By, Cx, Cy, Dx, Dy: Single);
-  procedure glkRect(Ax, Ay, Bx, By: Single);
-
 
 implementation
 
-
+function KromQuadCoords(Ax, Ay, Bx, By, Cx, Cy, Dx, Dy: Single): TKromQuadCoords;
-function SetDCPixelFormat(h_DC: HDC; PixelFormat: Integer): Boolean;
-var
-  nPixelFormat: Integer;
-  PixelDepth: Integer;
-  {$IFDEF MSWINDOWS}
-  pfd: TPixelFormatDescriptor;
-  {$ENDIF}
 begin
-  PixelDepth := 32; //32bpp is common
+  Result[0].X := Ax; Result[0].Y := Ay;
-  {$IFDEF MSWINDOWS}
+  Result[1].X := Bx; Result[1].Y := By;
-  with pfd do begin
+  Result[2].X := Cx; Result[2].Y := Cy;
-    nSize           := SizeOf(TPIXELFORMATDESCRIPTOR); // Size Of This Pixel Format Descriptor
+  Result[3].X := Dx; Result[3].Y := Dy;
-    nVersion        := 1;                    // The version of this data structure
-    dwFlags         := PFD_DRAW_TO_WINDOW    // Buffer supports drawing to window
-                       or PFD_SUPPORT_OPENGL // Buffer supports OpenGL drawing
-                       or PFD_DOUBLEBUFFER;  // Supports double buffering
-    iPixelType      := PFD_TYPE_RGBA;        // RGBA color format
-    cColorBits      := PixelDepth;           // OpenGL color depth
-    cRedBits        := 0;                    // Number of red bitplanes
-    cRedShift       := 0;                    // Shift count for red bitplanes
-    cGreenBits      := 0;                    // Number of green bitplanes
-    cGreenShift     := 0;                    // Shift count for green bitplanes
-    cBlueBits       := 0;                    // Number of blue bitplanes
-    cBlueShift      := 0;                    // Shift count for blue bitplanes
-    cAlphaBits      := 0;                    // Not supported
-    cAlphaShift     := 0;                    // Not supported
-    cAccumBits      := 0;                    // No accumulation buffer
-    cAccumRedBits   := 0;                    // Number of red bits in a-buffer
-    cAccumGreenBits := 0;                    // Number of green bits in a-buffer
-    cAccumBlueBits  := 0;                    // Number of blue bits in a-buffer
-    cAccumAlphaBits := 0;                    // Number of alpha bits in a-buffer
-    cDepthBits      := 16;                   // Specifies the depth of the depth buffer
-    cStencilBits    := 8;                    // Turn off stencil buffer
-    cAuxBuffers     := 0;                    // Not supported
-    iLayerType      := PFD_MAIN_PLANE;       // Ignored
-    bReserved       := 0;                    // Number of overlay and underlay planes
-    dwLayerMask     := 0;                    // Ignored
-    dwVisibleMask   := 0;                    // Transparent color of underlay plane
-    dwDamageMask    := 0;                    // Ignored
-  end;
-
-  if PixelFormat = 0 then
-    nPixelFormat := ChoosePixelFormat(h_DC, @pfd)
-  else
-    nPixelFormat := PixelFormat;
-
-  if nPixelFormat = 0 then begin
-    MessageBox(0, 'Unable to find a suitable pixel format', 'Error', MB_OK or MB_ICONERROR);
-    Result := False;
-    Exit;
-  end;
-
-  //Even with known pixel format we still need to supply some PFD structure
-  if not SetPixelFormat(h_DC, nPixelFormat, @pfd) then begin
-    MessageBox(0, 'Unable to set the pixel format', 'Error', MB_OK or MB_ICONERROR);
-    Result := False;
-    Exit;
-  end;
-
-  Result := True;
-  {$ENDIF}
-  //glXChooseVisual() should be on Uni insted of ChoosePixelFormatx
 end;
 
 
-function GetMultisamplePixelFormat(h_DC: HDC; AntiAliasing: Byte): Integer;
+function KromRectCoords(Ax, Ay, Bx, By: Single): TKromQuadCoords;
-var
-  pixelFormat: Integer;
-  ValidFormat: Boolean;
-  NumFormats: GLUint;
-  iAttributes: array of GLint;
 begin
-  Result := 0;
+  Result := KromQuadCoords(Ax, Ay, Bx, Ay, Bx, By, Ax, By);
-  {$IFDEF MSWINDOWS}
-  if not WGL_ARB_multisample or not Assigned(wglChoosePixelFormatARB) then
-    Exit;
- {$ENDIF}
-  SetLength(iAttributes,21);
-  iAttributes[0] := WGL_DRAW_TO_WINDOW_ARB;
-  iAttributes[1] := 1;
-  iAttributes[2] := WGL_SUPPORT_OPENGL_ARB;
-  iAttributes[3] := 1;
-  iAttributes[4] := WGL_ACCELERATION_ARB;
-  iAttributes[5] := WGL_FULL_ACCELERATION_ARB;
-  iAttributes[6] := WGL_COLOR_BITS_ARB;
-  iAttributes[7] := 24;
-  iAttributes[8] := WGL_ALPHA_BITS_ARB;
-  iAttributes[9] := 8;
-  iAttributes[10] := WGL_DEPTH_BITS_ARB;
-  iAttributes[11] := 16;
-  iAttributes[12] := WGL_STENCIL_BITS_ARB;
-  iAttributes[13] := 0;
-  iAttributes[14] := WGL_DOUBLE_BUFFER_ARB;
-  iAttributes[15] := 1;
-  iAttributes[16] := WGL_SAMPLE_BUFFERS_ARB;
-  iAttributes[17] := 1;
-  iAttributes[18] := WGL_SAMPLES_ARB;
-  iAttributes[19] := AntiAliasing;
-  iAttributes[20] := 0;
-
-  //Try to find mode with slightly worse AA before giving up
-  repeat
-    iAttributes[19] := AntiAliasing;
-    {$IFDEF MSWINDOWS}
-    ValidFormat := wglChoosePixelFormatARB(h_dc, @iAttributes[0], nil, 1, @pixelFormat, @NumFormats);
-    {$ENDIF}
-    if ValidFormat and (NumFormats >= 1) then
-    begin
-      Result := pixelFormat;
-      Exit;
-    end;
-    AntiAliasing := AntiAliasing div 2;
-  until(AntiAliasing < 2);
-end;
-
-
-procedure SetContexts(RenderFrame: HWND; PixelFormat: Integer; out h_DC: HDC; out h_RC: HGLRC);
-begin
-  {$IFDEF MSWINDOWS}
-  h_DC := GetDC(RenderFrame);
-
-  if h_DC = 0 then
-  begin
-    MessageBox(HWND(nil), 'Unable to get a device context', 'Error', MB_OK or MB_ICONERROR);
-    Exit;
-  end;
-
-  if not SetDCPixelFormat(h_DC, PixelFormat) then
-    Exit;
-
-  h_RC := wglCreateContext(h_DC);
-  if h_RC = 0 then
-  begin
-    MessageBox(HWND(nil), 'Unable to create an OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
-    Exit;
-  end;
-
-  if not wglMakeCurrent(h_DC, h_RC) then
-
-  begin
-    MessageBox(HWND(nil), 'Unable to activate OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
-    Exit;
-  end;
-  {$ENDIF}
-end;
-
-
-procedure SetRenderFrame(RenderFrame: HWND; out h_DC: HDC; out h_RC: HGLRC);
-begin
-  InitOpenGL;
-  SetContexts(RenderFrame, 0, h_DC, h_RC);
-  ReadExtensions;
-  ReadImplementationProperties;
-end;
-
-
-{The key problem is this: the function we use to get WGL extensions is, itself, an OpenGL extension.
-Thus like any OpenGL function, it requires an OpenGL context to call it. So in order to get the
-functions we need to create a context, we have to... create a context.
-
-Fortunately, this context does not need to be our final context. All we need to do is create a dummy
-context to get function pointers, then use those functions directly. Unfortunately, Windows does not
-allow recreation of a rendering context within a single HWND. We must destroy previous HWND context
-and create final HWND context after we are finished with the dummy context.}
-procedure SetRenderFrameAA(DummyFrame, RenderFrame: HWND; AntiAliasing: Byte; out h_DC: HDC; out h_RC: HGLRC);
-var
-  PixelFormat: Integer;
-begin
-  InitOpenGL;
-  SetContexts(DummyFrame, 0, h_DC, h_RC);
-  ReadExtensions;
-  ReadImplementationProperties;
-
-  PixelFormat := GetMultisamplePixelFormat(h_DC, AntiAliasing);
-  {$IFDEF MSWINDOWS}
-  wglMakeCurrent(h_DC, 0);
-  wglDeleteContext(h_RC);
-  {$ENDIF}
-  SetContexts(RenderFrame, PixelFormat, h_DC, h_RC);
-  ReadExtensions;
-  ReadImplementationProperties;
-end;
-
-
-procedure BuildFont(h_DC: HDC; FontSize: Integer; FontWeight: Word = FW_NORMAL);
-var
-  Font: HFONT;
-begin
-//New parameter FontSize=16
-  font:=CreateFont(-abs(FontSize),0,0,0,FontWeight,0,0,0,ANSI_CHARSET,
-    OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,
-    ANTIALIASED_QUALITY,FF_DONTCARE or DEFAULT_PITCH,
-    'Terminal');
-  SelectObject(h_dc,font);
-  {$IFDEF MSWindows}
-  wglUseFontBitmaps(h_dc,0,128,20000);
-  {$ENDIF}
-  {$IFDEF Unix}
-  // Emulate these functions (with freetype we should be able to code a multi platform solution)
-  {$ENDIF}
-end;
-
-
-procedure glPrint(const text: AnsiString);
-begin
-  if text = '' then Exit;
-  glPushAttrib(GL_LIST_BIT);
-  glListBase(20000);
-  glCallLists(length(text),GL_UNSIGNED_BYTE,Pchar(@text[1]));
-  glPopAttrib;
-end;
-
-
-procedure glkScale(x: Single);
-begin
-  glScalef(x, x, x);
-end;
-
-
-procedure glkQuad(Ax, Ay, Bx, By, Cx, Cy, Dx, Dy: Single);
-begin
-  glvertex2f(Ax, Ay);
-  glvertex2f(Bx, By);
-  glvertex2f(Cx, Cy);
-  glvertex2f(Dx, Dy);
-end;
-
-
-//Same as glkQuad, but requires on TopLeft and BottomRight coords
-procedure glkRect(Ax, Ay, Bx, By: Single);
-begin
-  glvertex2f(Ax, Ay);
-  glvertex2f(Bx, Ay);
-  glvertex2f(Bx, By);
-  glvertex2f(Ax, By);
 end;