Complete BigTask

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