Files
kam-mobile/code/KM_Render_Mobile.pas
T
admin_d 6d3b8e6ac5
Sync changed files to Google Drive / sync (push) Successful in 2m2s
Complete BigTask
2026-10-08 11:59:40 +05:00

374 lines
13 KiB
ObjectPascal

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.