unit KM_Render_Mobile;

interface

uses
  KM_RenderTypes;

procedure KMRenderMobileInvalidateCurrentContext;
procedure KMRenderMobileInitializeCurrentContext;
function KMRenderMobileTextureBackendReady: Boolean;
function KMRenderMobileMaxTextureSize: Cardinal;
procedure KMRenderMobileBindTexture(aTexId: Cardinal);
function KMRenderMobileCreateTexture(aMinFilter, aMagFilter: TKMFilterType): Cardinal;
procedure KMRenderMobileDeleteTexture(aTexId: Cardinal);
procedure KMRenderMobileUpdateTexture(aTexture: Cardinal; aWidth, aHeight: Word; aMode: TKMTexFormat; const aData: Pointer);
procedure KMRenderMobileInvalidateTextureBindingCache;
procedure KMRenderMobileApplyOrdinary2DProjection(aScreenX, aScreenY: Word);
procedure KMRenderMobileClearCurrentTarget;
procedure KMRenderMobileSetActiveTextureUnit0;
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(
  aIntensity: Single; aWidth, aHeight: Word);

implementation

uses
  SysUtils, CastleGLUtils, CastleGLES, CastleRectangles, CastleProjection, CastleRenderContext, CastleVectors,
  CastleGLShaders, CastleRenderOptions, CastleRenderPrimitives, Math;

var
  gTextureBackendReady: Boolean;
  gTextureBindingKnown: Boolean;
  gCachedTextureId: Cardinal;
  gSampledProgram: TGLSLProgram;
  gSolidMesh: TCastleRenderUnlitMesh = nil;

const
  SampledVertexShader =
    'attribute vec3 aPosition;' + #10 +
    'attribute vec2 aTexCoord;' + #10 +
    'uniform mat4 uProjection;' + #10 +
    'varying vec2 vTexCoord;' + #10 +
    'void main() {' + #10 +
    '  gl_Position = uProjection * vec4(aPosition, 1.0);' + #10 +
    '  vTexCoord = aTexCoord;' + #10 +
    '}';
  SampledFragmentShader =
    'uniform sampler2D uTexture;' + #10 +
    'uniform vec4 uColor;' + #10 +
    'varying vec2 vTexCoord;' + #10 +
    'void main() {' + #10 +
    '  gl_FragColor = texture2D(uTexture, vTexCoord) * uColor;' + #10 +
    '}';


procedure KMRenderMobileApplyOrdinary2DProjection(aScreenX, aScreenY: Word);
var
  Dimensions: TFloatRectangle;
begin
  Dimensions.Left := 0;
  Dimensions.Width := aScreenX;
  Dimensions.Bottom := aScreenY;
  Dimensions.Height := -Single(aScreenY);
  RenderContext.ProjectionMatrix := OrthoProjectionMatrix(Dimensions, -100, 100);
end;


procedure KMRenderMobileClearCurrentTarget;
begin
  RenderContext.Clear([cbColor, cbDepth, cbStencil], TVector4.Zero);
end;


procedure KMRenderMobileDrawBrightnessOverlay(
  aIntensity: Single; aWidth, aHeight: Word);
begin
  DrawRectangle(
    Rectangle(0, 0, aWidth, aHeight),
    Vector4(aIntensity, aIntensity, aIntensity, aIntensity),
    bsDstColor, bdOne, True);
  RenderContext.BlendingEnable(bsSrcAlpha, bdOneMinusSrcAlpha);
end;


procedure KMRenderMobileSetActiveTextureUnit0;
begin
  CastleGLES.glActiveTexture(CastleGLES.GL_TEXTURE0);
end;


procedure KMRenderMobileInitializeSampledProgram;
var
  candidate: TGLSLProgram;
  positionAttribute, texCoordAttribute: TGLSLAttribute;
  projectionUniform, textureUniform, colorUniform: TGLSLUniform;
begin
  if gSampledProgram <> nil then Exit;

  candidate := TGLSLProgram.Create;
  try
    candidate.FragmentShaderRequired := True;
    candidate.AttachVertexShader(SampledVertexShader);
    candidate.AttachFragmentShader(SampledFragmentShader);
    candidate.Link;
    positionAttribute := candidate.Attribute('aPosition');
    texCoordAttribute := candidate.Attribute('aTexCoord');
    projectionUniform := candidate.Uniform('uProjection', umIgnore);
    textureUniform := candidate.Uniform('uTexture', umIgnore);
    colorUniform := candidate.Uniform('uColor', umIgnore);
    if (projectionUniform.Location = -1) or (textureUniform.Location = -1)
       or (colorUniform.Location = -1) then
      raise Exception.Create('Sampled shader is missing a required uniform');
    gSampledProgram := candidate;
    candidate := nil;
  finally
    candidate.Free;
  end;
end;


procedure KMRenderMobileActivateSampledProgram;
begin
  if gSampledProgram = nil then
    raise Exception.Create('Sampled shader program is not ready');
  gSampledProgram.Enable;
end;


procedure KMRenderMobileInvalidateSampledProgram;
begin
  FreeAndNil(gSampledProgram);
end;


procedure KMRenderMobileDisposeSolidMesh;
begin
  FreeAndNil(gSolidMesh);
end;


function KMRenderMobileSampledProgramReady: Boolean;
begin
  Result := gSampledProgram <> nil;
end;


procedure KMRenderMobileDrawSampledTriangles(
  const aPositionData, aTexCoordData: Pointer;
  aStride, aVertexCount: Integer;
  aColorR, aColorG, aColorB, aColorA: Single);
var
  positionAttribute, texCoordAttribute: TGLSLAttribute;
  projectionUniform, colorUniform: TGLSLUniform;
  positionEnabled, texCoordEnabled: Boolean;
begin
  if (aPositionData = nil) or (aTexCoordData = nil) or (aStride <= 0) or (aVertexCount <= 0) then
    raise Exception.Create('Invalid sampled triangle draw input');
  if gSampledProgram = nil then
    KMRenderMobileActivateSampledProgram;

  positionAttribute := gSampledProgram.Attribute('aPosition');
  texCoordAttribute := gSampledProgram.Attribute('aTexCoord');
  projectionUniform := gSampledProgram.Uniform('uProjection', umIgnore);
  colorUniform := gSampledProgram.Uniform('uColor', umIgnore);
  if (projectionUniform.Location = -1) or (colorUniform.Location = -1) then
    raise Exception.Create('Sampled shader is missing a required draw uniform');

  KMRenderMobileActivateSampledProgram;
  projectionUniform.SetValue(RenderContext.ProjectionMatrix);
  colorUniform.SetValue(Vector4(aColorR, aColorG, aColorB, aColorA));
  RenderContext.BindBuffer[btArray] := 0;
  positionEnabled := False;
  texCoordEnabled := False;
  try
    positionAttribute.EnableArrayVector3(nil, CastleGLES.GLsizei(aStride), PtrUInt(aPositionData));
    positionEnabled := True;
    texCoordAttribute.EnableArrayVector2(nil, CastleGLES.GLsizei(aStride), PtrUInt(aTexCoordData));
    texCoordEnabled := True;
    CastleGLES.glDrawArrays(CastleGLES.GL_TRIANGLES, 0, CastleGLES.GLsizei(aVertexCount));
  finally
    if texCoordEnabled then texCoordAttribute.DisableArray;
    if positionEnabled then positionAttribute.DisableArray;
  end;
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
    raise Exception.Create('Texture backend is not ready');
end;


procedure KMRenderMobileInvalidateCurrentContext;
begin
  gTextureBackendReady := False;
  KMRenderMobileInvalidateTextureBindingCache;
end;


procedure KMRenderMobileInitializeCurrentContext;
begin
  gTextureBackendReady := False;
  try
    KMRenderMobileInvalidateTextureBindingCache;
    if (GLFeatures = nil) or (GLFeatures.MaxTextureSize = 0) then
      raise Exception.Create('Texture backend initialization failed');
    if not (Assigned(glGenTextures)
        and Assigned(glBindTexture)
        and Assigned(glDeleteTextures)
        and Assigned(glTexParameteri)
        and Assigned(glTexImage2D)
        and Assigned(glGetIntegerv)
        and Assigned(glPixelStorei)
        and Assigned(CastleGLES.glGetError)) then
      raise Exception.Create('Texture backend initialization failed');
    gTextureBackendReady := True;
  except
    gTextureBackendReady := False;
    raise;
  end;
end;


function DrainTextureGLErrors: string;
var
  ErrorCode: CastleGLES.GLenum;
begin
  Result := '';
  repeat
    ErrorCode := CastleGLES.glGetError();
    if ErrorCode <> CastleGLES.GL_NO_ERROR then
    begin
      if Result <> '' then Result := Result + ', ';
      Result := Result + '0x' + IntToHex(ErrorCode, 8);
    end;
  until ErrorCode = CastleGLES.GL_NO_ERROR;
end;


procedure RequireTextureNoGLError(const aOperation, aStage: string);
var
  Errors: string;
begin
  Errors := DrainTextureGLErrors;
  if Errors <> '' then
  begin
    KMRenderMobileInvalidateTextureBindingCache;
    raise Exception.Create(Format('texture %s — current GLES error at %s: %s',
      [aOperation, aStage, Errors]));
  end;
end;


procedure RequireNoPreexistingTextureGLError(const aOperation: string);
var
  Errors: string;
begin
  Errors := DrainTextureGLErrors;
  if Errors <> '' then
  begin
    KMRenderMobileInvalidateTextureBindingCache;
    raise Exception.Create(Format('texture %s — pre-existing GLES error(s): %s',
      [aOperation, Errors]));
  end;
end;


procedure KMRenderMobileBindTexture(aTexId: Cardinal);
begin
  RequireTextureBackendReady;
  if gTextureBindingKnown and (gCachedTextureId = aTexId) then Exit;

  CastleGLES.glBindTexture(CastleGLES.GL_TEXTURE_2D, CastleGLES.GLuint(aTexId));
  gCachedTextureId := aTexId;
  gTextureBindingKnown := True;
end;


function IsPowerOfTwo(aValue: Cardinal): Boolean;
begin
  Result := (aValue <> 0) and ((aValue and (aValue - 1)) = 0);
end;


procedure KMRenderMobileUpdateTexture(aTexture: Cardinal; aWidth, aHeight: Word; aMode: TKMTexFormat; const aData: Pointer);
var
  alphaData: array of Byte;
  pixelCount, I: Cardinal;
  unpackAlignment: CastleGLES.GLint;
  alignmentKnown, alignmentSetAttempted, bindAttempted: Boolean;
  operationUnverified: Boolean;
  finalizeErrors, finalizeEntryErrors: string;

  procedure AddFinalizeError(const aStage, aMessage: string);
  begin
    if finalizeErrors <> '' then finalizeErrors := finalizeErrors + '; ';
    finalizeErrors := finalizeErrors + aStage + ': ' + aMessage;
  end;

  procedure CollectFinalizePending(const aStage: string);
  var
    Errors: string;
  begin
    if not gTextureBackendReady then Exit;
    try
      Errors := DrainTextureGLErrors;
      if Errors <> '' then AddFinalizeError(aStage, Errors);
    except
      on E: Exception do AddFinalizeError(aStage, E.Message);
    end;
  end;

  procedure FinalizeUpdate(aCheckPending: Boolean);
  begin
    finalizeEntryErrors := '';
    if aCheckPending and operationUnverified and gTextureBackendReady then
      try
        finalizeEntryErrors := DrainTextureGLErrors;
        if finalizeEntryErrors <> '' then
          AddFinalizeError('update/finalize-entry', finalizeEntryErrors);
      except
        on E: Exception do
          AddFinalizeError('update/finalize-entry', E.Message);
      end;

    if bindAttempted then
      if gTextureBackendReady then
        try
          operationUnverified := True;
          KMRenderMobileBindTexture(0);
          RequireTextureNoGLError('update', 'unbind');
          operationUnverified := False;
        except
          on E: Exception do
          begin
            operationUnverified := False;
            AddFinalizeError('update/unbind', E.Message);
            CollectFinalizePending('update/unbind');
          end;
        end
      else
        AddFinalizeError('update/unbind', 'current texture context is unavailable');

    if alignmentKnown and alignmentSetAttempted and (unpackAlignment <> 1) then
      if gTextureBackendReady then
        try
          operationUnverified := True;
          CastleGLES.glPixelStorei(CastleGLES.GL_UNPACK_ALIGNMENT, unpackAlignment);
          RequireTextureNoGLError('update', 'restore-unpack');
          operationUnverified := False;
        except
          on E: Exception do
          begin
            operationUnverified := False;
            AddFinalizeError('update/restore-unpack', E.Message);
            CollectFinalizePending('update/restore-unpack');
          end;
        end
      else
        AddFinalizeError('update/restore-unpack', 'current texture context is unavailable');
  end;

begin
  try
    RequireTextureBackendReady;
    if (aTexture = 0) or (aWidth = 0) or (aHeight = 0)
       or not IsPowerOfTwo(aWidth) or not IsPowerOfTwo(aHeight)
       or (aData = nil) then
      raise Exception.Create('Invalid texture upload parameters');
    if not (aMode in [tfRGB5A1, tfRGBA8, tfAlpha8]) then
      raise Exception.Create('Unsupported texture upload format');

    RequireNoPreexistingTextureGLError('update');
    if aMode = tfAlpha8 then
    begin
      pixelCount := Cardinal(aWidth) * Cardinal(aHeight);
      SetLength(alphaData, pixelCount);
      for I := 0 to pixelCount - 1 do
        alphaData[I] := Byte((PCardinal(aData)[I] shr 24) and $FF);
    end;

    alignmentKnown := False;
    alignmentSetAttempted := False;
    bindAttempted := False;
    operationUnverified := False;
    finalizeErrors := '';
    try
      operationUnverified := True;
      CastleGLES.glGetIntegerv(CastleGLES.GL_UNPACK_ALIGNMENT, @unpackAlignment);
      RequireTextureNoGLError('update', 'glGetIntegerv');
      operationUnverified := False;
      alignmentKnown := True;

      if unpackAlignment <> 1 then
      begin
        alignmentSetAttempted := True;
        operationUnverified := True;
        CastleGLES.glPixelStorei(CastleGLES.GL_UNPACK_ALIGNMENT, 1);
        RequireTextureNoGLError('update', 'glPixelStorei(1)');
        operationUnverified := False;
      end;

      bindAttempted := True;
      operationUnverified := True;
      KMRenderMobileBindTexture(aTexture);
      RequireTextureNoGLError('update', 'glBindTexture');
      operationUnverified := False;

      case aMode of
        tfRGB5A1, tfRGBA8:
          begin
            operationUnverified := True;
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_R, CastleGLES.GL_RED);
            RequireTextureNoGLError('update', 'glTexParameteri(GL_TEXTURE_SWIZZLE_R)');
            operationUnverified := False;
            operationUnverified := True;
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_G, CastleGLES.GL_GREEN);
            RequireTextureNoGLError('update', 'glTexParameteri(GL_TEXTURE_SWIZZLE_G)');
            operationUnverified := False;
            operationUnverified := True;
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_B, CastleGLES.GL_BLUE);
            RequireTextureNoGLError('update', 'glTexParameteri(GL_TEXTURE_SWIZZLE_B)');
            operationUnverified := False;
            operationUnverified := True;
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_A, CastleGLES.GL_ALPHA);
            RequireTextureNoGLError('update', 'glTexParameteri(GL_TEXTURE_SWIZZLE_A)');
            operationUnverified := False;
            if aMode = tfRGB5A1 then
            begin
              operationUnverified := True;
              CastleGLES.glTexImage2D(CastleGLES.GL_TEXTURE_2D, 0, CastleGLES.GL_RGB5_A1,
                aWidth, aHeight, 0, CastleGLES.GL_RGBA, CastleGLES.GL_UNSIGNED_BYTE, aData);
              RequireTextureNoGLError('update', 'glTexImage2D');
              operationUnverified := False;
            end
            else
            begin
              operationUnverified := True;
              CastleGLES.glTexImage2D(CastleGLES.GL_TEXTURE_2D, 0, CastleGLES.GL_RGBA8,
                aWidth, aHeight, 0, CastleGLES.GL_RGBA, CastleGLES.GL_UNSIGNED_BYTE, aData);
              RequireTextureNoGLError('update', 'glTexImage2D');
              operationUnverified := False;
            end;
          end;
        tfAlpha8:
          begin
            operationUnverified := True;
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_R, CastleGLES.GL_ONE);
            RequireTextureNoGLError('update', 'glTexParameteri(GL_TEXTURE_SWIZZLE_R)');
            operationUnverified := False;
            operationUnverified := True;
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_G, CastleGLES.GL_ONE);
            RequireTextureNoGLError('update', 'glTexParameteri(GL_TEXTURE_SWIZZLE_G)');
            operationUnverified := False;
            operationUnverified := True;
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_B, CastleGLES.GL_ONE);
            RequireTextureNoGLError('update', 'glTexParameteri(GL_TEXTURE_SWIZZLE_B)');
            operationUnverified := False;
            operationUnverified := True;
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_A, CastleGLES.GL_RED);
            RequireTextureNoGLError('update', 'glTexParameteri(GL_TEXTURE_SWIZZLE_A)');
            operationUnverified := False;
            operationUnverified := True;
            CastleGLES.glTexImage2D(CastleGLES.GL_TEXTURE_2D, 0, CastleGLES.GL_R8,
              aWidth, aHeight, 0, CastleGLES.GL_RED, CastleGLES.GL_UNSIGNED_BYTE, @alphaData[0]);
            RequireTextureNoGLError('update', 'glTexImage2D');
            operationUnverified := False;
          end;
      end;
    except
      on E: Exception do
      begin
        KMRenderMobileInvalidateTextureBindingCache;
        FinalizeUpdate(True);
        if finalizeErrors <> '' then
          E.Message := E.Message + '; secondary finalize failure(s): ' + finalizeErrors;
        raise;
      end;
    end;

    FinalizeUpdate(False);
    if finalizeErrors <> '' then
      raise Exception.Create('texture update failed: ' + finalizeErrors);
  except
    KMRenderMobileInvalidateTextureBindingCache;
    raise;
  end;
end;


function TextureFilter(aFilter: TKMFilterType): CastleGLES.GLint;
begin
  case aFilter of
    ftNearest: Result := CastleGLES.GL_NEAREST;
    ftLinear:  Result := CastleGLES.GL_LINEAR;
  end;
end;


function KMRenderMobileCreateTexture(aMinFilter, aMagFilter: TKMFilterType): Cardinal;
var
  texture: CastleGLES.GLuint;
  cleanupErrors, cleanupEntryErrors, cleanupFailure: string;
  cleanupReady, cleanupFailed: Boolean;
begin
  RequireTextureBackendReady;
  RequireNoPreexistingTextureGLError('create');
  texture := 0;
  try
    CastleGLES.glGenTextures(1, @texture);
    RequireTextureNoGLError('create', 'glGenTextures');
    if texture = 0 then
      raise Exception.Create('Texture generation failed');
    KMRenderMobileBindTexture(Cardinal(texture));
    RequireTextureNoGLError('create', 'glBindTexture');
    CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_MIN_FILTER, TextureFilter(aMinFilter));
    RequireTextureNoGLError('create', 'glTexParameteri(GL_TEXTURE_MIN_FILTER)');
    CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_MAG_FILTER, TextureFilter(aMagFilter));
    RequireTextureNoGLError('create', 'glTexParameteri(GL_TEXTURE_MAG_FILTER)');
    CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_WRAP_S, CastleGLES.GL_CLAMP_TO_EDGE);
    RequireTextureNoGLError('create', 'glTexParameteri(GL_TEXTURE_WRAP_S)');
    CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_WRAP_T, CastleGLES.GL_CLAMP_TO_EDGE);
    RequireTextureNoGLError('create', 'glTexParameteri(GL_TEXTURE_WRAP_T)');
    CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_MAX_LEVEL, 0);
    RequireTextureNoGLError('create', 'glTexParameteri(GL_TEXTURE_MAX_LEVEL)');
    Result := Cardinal(texture);
  except
    on E: Exception do
    begin
      KMRenderMobileInvalidateTextureBindingCache;
      try
        cleanupErrors := '';
        cleanupEntryErrors := '';
        cleanupFailure := '';
        cleanupFailed := False;
        if texture <> 0 then
        begin
          cleanupReady := False;
          try
            RequireTextureBackendReady;
            cleanupReady := True;
          except
            on CleanupE: Exception do
            begin
              cleanupFailed := True;
              cleanupFailure := 'cleanup unavailable: ' + CleanupE.Message;
            end;
          end;
          if cleanupReady then
          begin
            try
              cleanupEntryErrors := DrainTextureGLErrors;
            except
              on CleanupE: Exception do
              begin
                cleanupFailed := True;
                cleanupFailure := 'cleanup-entry drain failed: ' + CleanupE.Message;
              end;
            end;
            try
              KMRenderMobileDeleteTexture(Cardinal(texture));
            except
              on CleanupE: Exception do
              begin
                cleanupFailed := True;
                if cleanupFailure <> '' then cleanupFailure := cleanupFailure + '; ';
                cleanupFailure := cleanupFailure + 'glDeleteTextures failed: ' + CleanupE.Message;
              end;
            end;
            try
              cleanupErrors := DrainTextureGLErrors;
              if cleanupErrors <> '' then
              begin
                cleanupFailed := True;
                if cleanupFailure <> '' then cleanupFailure := cleanupFailure + '; ';
                cleanupFailure := cleanupFailure + 'glDeleteTextures GLES error(s): ' + cleanupErrors;
              end;
            except
              on CleanupE: Exception do
              begin
                cleanupFailed := True;
                if cleanupFailure <> '' then cleanupFailure := cleanupFailure + '; ';
                cleanupFailure := cleanupFailure + 'cleanup drain failed: ' + CleanupE.Message;
              end;
            end;
            if cleanupEntryErrors <> '' then
            begin
              if cleanupFailed then
              begin
                if cleanupFailure <> '' then cleanupFailure := cleanupFailure + '; ';
                cleanupFailure := cleanupFailure + 'cleanup-entry GLES error(s): ' + cleanupEntryErrors;
              end;
            end;
          end;
        end;
        KMRenderMobileInvalidateTextureBindingCache;
        if cleanupFailed then
          try
            E.Message := E.Message + '; texture create cleanup failed: ' + cleanupFailure;
          except
          end;
      except
        KMRenderMobileInvalidateTextureBindingCache;
      end;
      raise;
    end;
  end;
end;


procedure KMRenderMobileDeleteTexture(aTexId: Cardinal);
var
  texture: CastleGLES.GLuint;
begin
  RequireTextureBackendReady;
  if aTexId = 0 then Exit;
  texture := CastleGLES.GLuint(aTexId);
  CastleGLES.glDeleteTextures(1, @texture);
  if gTextureBindingKnown and (gCachedTextureId = aTexId) then
    gCachedTextureId := 0;
end;


procedure KMRenderMobileInvalidateTextureBindingCache;
begin
  gTextureBindingKnown := False;
end;


function KMRenderMobileTextureBackendReady: Boolean;
begin
  Result := gTextureBackendReady;
end;


function KMRenderMobileMaxTextureSize: Cardinal;
begin
  RequireTextureBackendReady;
  if GLFeatures = nil then
    raise Exception.Create('Texture backend feature state is unavailable');
  Result := GLFeatures.MaxTextureSize;
  if Result = 0 then
    raise Exception.Create('Texture backend maximum texture size is unavailable');
end;

end.