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 KMRenderMobileActivateSampledProgram;
procedure KMRenderMobileInvalidateSampledProgram;
procedure KMRenderMobileInitializeSampledProgram;
function KMRenderMobileSampledProgramReady: Boolean;
procedure KMRenderMobileDrawBrightnessOverlay(
  aIntensity: Single; aWidth, aHeight: Word);

implementation

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

var
  gTextureBackendReady: Boolean;
  gTextureBindingKnown: Boolean;
  gCachedTextureId: Cardinal;
  gSampledProgram: TGLSLProgram;

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;


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 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)) then
      raise Exception.Create('Texture backend initialization failed');
    gTextureBackendReady := True;
  except
    gTextureBackendReady := False;
    raise;
  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;
  restoreUnpackAlignment: Boolean;
begin
  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 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;

  CastleGLES.glGetIntegerv(CastleGLES.GL_UNPACK_ALIGNMENT, @unpackAlignment);
  restoreUnpackAlignment := unpackAlignment <> 1;
  if restoreUnpackAlignment then
    CastleGLES.glPixelStorei(CastleGLES.GL_UNPACK_ALIGNMENT, 1);
  try
    KMRenderMobileBindTexture(aTexture);
    try
      case aMode of
        tfRGB5A1:
          begin
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_R, CastleGLES.GL_RED);
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_G, CastleGLES.GL_GREEN);
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_B, CastleGLES.GL_BLUE);
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_A, CastleGLES.GL_ALPHA);
            CastleGLES.glTexImage2D(CastleGLES.GL_TEXTURE_2D, 0, CastleGLES.GL_RGB5_A1, aWidth, aHeight, 0, CastleGLES.GL_RGBA, CastleGLES.GL_UNSIGNED_BYTE, aData);
          end;
        tfRGBA8:
          begin
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_R, CastleGLES.GL_RED);
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_G, CastleGLES.GL_GREEN);
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_B, CastleGLES.GL_BLUE);
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_A, CastleGLES.GL_ALPHA);
            CastleGLES.glTexImage2D(CastleGLES.GL_TEXTURE_2D, 0, CastleGLES.GL_RGBA8, aWidth, aHeight, 0, CastleGLES.GL_RGBA, CastleGLES.GL_UNSIGNED_BYTE, aData);
          end;
        tfAlpha8:
          begin
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_R, CastleGLES.GL_ONE);
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_G, CastleGLES.GL_ONE);
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_B, CastleGLES.GL_ONE);
            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_A, CastleGLES.GL_RED);
            CastleGLES.glTexImage2D(CastleGLES.GL_TEXTURE_2D, 0, CastleGLES.GL_R8, aWidth, aHeight, 0, CastleGLES.GL_RED, CastleGLES.GL_UNSIGNED_BYTE, @alphaData[0]);
          end;
      end;
    finally
      KMRenderMobileBindTexture(0);
    end;
  finally
    if restoreUnpackAlignment then
      CastleGLES.glPixelStorei(CastleGLES.GL_UNPACK_ALIGNMENT, unpackAlignment);
  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;
begin
  RequireTextureBackendReady;
  texture := 0;
  CastleGLES.glGenTextures(1, @texture);
  if texture = 0 then
    raise Exception.Create('Texture generation failed');
  try
    KMRenderMobileBindTexture(Cardinal(texture));
    CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_MIN_FILTER, TextureFilter(aMinFilter));
    CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_MAG_FILTER, TextureFilter(aMagFilter));
    CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_WRAP_S, CastleGLES.GL_CLAMP_TO_EDGE);
    CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_WRAP_T, CastleGLES.GL_CLAMP_TO_EDGE);
    CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_MAX_LEVEL, 0);
    Result := Cardinal(texture);
  except
    KMRenderMobileDeleteTexture(Cardinal(texture));
    raise;
  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.