Fix fpcrtl_strappendA, which cut last char from UserPathPrefix
leading to PHYSFS_setWriteDir fail with 'File not found' error,
which led to lack of writing dir and logFile handle being nil,
which led to crash on attempt to write to (absent) log file
(*
* Hedgewars, a free turn based strategy game
* Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; version 2 of the License
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
*)
{$INCLUDE "options.inc"}
{$IF GLunit = GL}{$DEFINE GLunit:=GL,GLext}{$ENDIF}
unit uRender;
interface
uses SDLh, uTypes, GLunit;
procedure initModule;
procedure freeModule;
procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt);
procedure DrawSprite (Sprite: TSprite; X, Y, FrameX, FrameY: LongInt);
procedure DrawSpriteFromRect (Sprite: TSprite; r: TSDL_Rect; X, Y, Height, Position: LongInt); inline;
procedure DrawSpriteClipped (Sprite: TSprite; X, Y, TopY, RightX, BottomY, LeftX: LongInt);
procedure DrawSpriteRotated (Sprite: TSprite; X, Y, Dir: LongInt; Angle: real);
procedure DrawSpriteRotatedF (Sprite: TSprite; X, Y, Frame, Dir: LongInt; Angle: real);
procedure DrawTexture (X, Y: LongInt; Texture: PTexture); inline;
procedure DrawTexture (X, Y: LongInt; Texture: PTexture; Scale: GLfloat);
procedure DrawTexture2 (X, Y: LongInt; Texture: PTexture; Scale, Overlap: GLfloat);
procedure DrawTextureFromRect (X, Y: LongInt; r: PSDL_Rect; SourceTexture: PTexture); inline;
procedure DrawTextureFromRect (X, Y, W, H: LongInt; r: PSDL_Rect; SourceTexture: PTexture); inline;
procedure DrawTextureFromRectDir(X, Y, W, H: LongInt; r: PSDL_Rect; SourceTexture: PTexture; Dir: LongInt);
procedure DrawTextureCentered (X, Top: LongInt; Source: PTexture);
procedure DrawTextureF (Texture: PTexture; Scale: GLfloat; X, Y, Frame, Dir, w, h: LongInt);
procedure DrawTextureRotated (Texture: PTexture; hw, hh, X, Y, Dir: LongInt; Angle: real);
procedure DrawTextureRotatedF (Texture: PTexture; Scale, OffsetX, OffsetY: GLfloat; X, Y, Frame, Dir, w, h: LongInt; Angle: real);
procedure DrawCircle (X, Y, Radius, Width: LongInt);
procedure DrawCircle (X, Y, Radius, Width: LongInt; r, g, b, a: Byte);
procedure DrawCircleFilled (X, Y, Radius: LongInt; r, g, b, a: Byte);
procedure DrawLine (X0, Y0, X1, Y1, Width: Single; color: LongWord); inline;
procedure DrawLine (X0, Y0, X1, Y1, Width: Single; r, g, b, a: Byte);
procedure DrawLineOnScreen (X0, Y0, X1, Y1, Width: Single; r, g, b, a: Byte);
procedure DrawRect (rect: TSDL_Rect; r, g, b, a: Byte; Fill: boolean);
procedure DrawHedgehog (X, Y: LongInt; Dir: LongInt; Pos, Step: LongWord; Angle: real);
procedure DrawScreenWidget (widget: POnScreenWidget);
procedure DrawWater (Alpha: byte; OffsetY, OffsetX: LongInt);
procedure DrawWaves (Dir, dX, dY, oX: LongInt; tnt: Byte);
procedure RenderClear ();
{$IFDEF USE_S3D_RENDERING}
procedure RenderClear (mode: TRenderMode);
{$ENDIF}
procedure RenderSetClearColor (r, g, b, a: real);
procedure Tint (r, g, b, a: Byte); inline;
procedure Tint (c: Longword); inline;
procedure untint(); inline;
procedure setTintAdd (f: boolean); inline;
// call this to finish the rendering of current frame
procedure FinishRender();
function isAreaOffscreen(X, Y, Width, Height: LongInt): boolean; inline;
// 0 => not offscreen, <0 => left/top of screen >0 => right/below of screen
function isDxAreaOffscreen(X, Width: LongInt): LongInt; inline;
function isDyAreaOffscreen(Y, Height: LongInt): LongInt; inline;
procedure SetScale(f: GLfloat);
procedure UpdateViewLimits();
procedure RendererSetup();
procedure RendererCleanup();
procedure ChangeDepth(rm: TRenderMode; d: GLfloat);
procedure ResetDepth(rm: TRenderMode);
// TODO everything below this should not need a public interface
procedure EnableTexture(enable:Boolean);
procedure SetTexCoordPointer(p: Pointer;n: Integer); inline;
procedure SetVertexPointer(p: Pointer;n: Integer); inline;
procedure SetColorPointer(p: Pointer;n: Integer); inline;
procedure UpdateModelviewProjection(); inline;
procedure openglPushMatrix (); inline;
procedure openglPopMatrix (); inline;
procedure openglTranslatef (X, Y, Z: GLfloat); inline;
implementation
uses {$IFNDEF PAS2C} StrUtils, {$ENDIF}SysUtils, uVariables, uUtils, uConsts
{$IFDEF GL2}, uMatrix, uConsole{$ENDIF};
{$IFDEF USE_TOUCH_INTERFACE}
const
FADE_ANIM_TIME = 500;
MOVE_ANIM_TIME = 500;
{$ENDIF}
{$IFDEF GL2}
var
shaderMain: GLuint;
shaderWater: GLuint;
{$ENDIF}
var VertexBuffer : array [0 ..59] of TVertex2f;
TextureBuffer: array [0 .. 7] of TVertex2f;
LastTint: LongWord = 0;
LastColorPointer , LastTexCoordPointer , LastVertexPointer : Pointer;
{$IFDEF GL2}
LastColorPointerN, LastTexCoordPointerN, LastVertexPointerN: Integer;
{$ENDIF}
{$IFDEF USE_S3D_RENDERING}
// texture/vertex buffers for left/right/default eye modes
texLRDtb, texLvb, texRvb: array [0..3] of TVertex2f;
{$ENDIF}
procedure openglLoadIdentity (); forward;
procedure openglTranslProjMatrix(X, Y, Z: GLFloat); forward;
procedure openglScalef (ScaleX, ScaleY, ScaleZ: GLfloat); forward;
procedure openglRotatef (RotX, RotY, RotZ: GLfloat; dir: LongInt); forward;
procedure openglTint (r, g, b, a: Byte); forward;
{$IFDEF USE_S3D_RENDERING OR USE_VIDEO_RECORDING}
procedure CreateFramebuffer(var frame, depth, tex: GLuint); forward;
procedure DeleteFramebuffer(var frame, depth, tex: GLuint); forward;
{$ENDIF}
function isAreaOffscreen(X, Y, Width, Height: LongInt): boolean; inline;
begin
isAreaOffscreen:= (isDxAreaOffscreen(X, Width) <> 0) or (isDyAreaOffscreen(Y, Height) <> 0);
end;
function isDxAreaOffscreen(X, Width: LongInt): LongInt; inline;
begin
if X > ViewRightX then exit(1);
if X + Width < ViewLeftX then exit(-1);
isDxAreaOffscreen:= 0;
end;
function isDyAreaOffscreen(Y, Height: LongInt): LongInt; inline;
begin
if Y > ViewBottomY then exit(1);
if Y + Height < ViewTopY then exit(-1);
isDyAreaOffscreen:= 0;
end;
procedure RenderClear();
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
end;
{$IFDEF USE_S3D_RENDERING}
procedure RenderClear(mode: TRenderMode);
var frame: GLuint;
begin
if (cStereoMode = smHorizontal) or (cStereoMode = smVertical) then
begin
case mode of
rmLeftEye: frame:= frameL;
rmRightEye: frame:= frameR;
else
frame:= defaultFrame;
end;
glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, frame);
RenderClear();
end
else
begin
// draw left eye in red channel only
if mode = rmLeftEye then
begin
glColorMask(GL_TRUE, GL_TRUE, GL_TRUE, GL_TRUE);
RenderClear();
if cStereoMode = smGreenRed then
glColorMask(GL_FALSE, GL_TRUE, GL_FALSE, GL_TRUE)
else if cStereoMode = smBlueRed then
glColorMask(GL_FALSE, GL_FALSE, GL_TRUE, GL_TRUE)
else if cStereoMode = smCyanRed then
glColorMask(GL_FALSE, GL_TRUE, GL_TRUE, GL_TRUE)
else
glColorMask(GL_TRUE, GL_FALSE, GL_FALSE, GL_TRUE);
end
else
begin
// draw right eye in selected channel(s) only
if cStereoMode = smRedGreen then
glColorMask(GL_FALSE, GL_TRUE, GL_FALSE, GL_TRUE)
else if cStereoMode = smRedBlue then
glColorMask(GL_FALSE, GL_FALSE, GL_TRUE, GL_TRUE)
else if cStereoMode = smRedCyan then
glColorMask(GL_FALSE, GL_TRUE, GL_TRUE, GL_TRUE)
else
glColorMask(GL_TRUE, GL_FALSE, GL_FALSE, GL_TRUE);
end;
end;
end;
{$ENDIF}
procedure RenderSetClearColor(r, g, b, a: real);
begin
glClearColor(r, g, b, a);
end;
procedure FinishRender();
begin
{$IFDEF USE_S3D_RENDERING}
if (cStereoMode = smHorizontal) or (cStereoMode = smVertical) then
begin
RenderClear(rmDefault);
SetScale(cDefaultZoomLevel);
// same for all
SetTexCoordPointer(@texLRDtb, Length(texLRDtb));
// draw left frame
glBindTexture(GL_TEXTURE_2D, texl);
SetVertexPointer(@texLvb, Length(texLvb));
//UpdateModelviewProjection;
glDrawArrays(GL_TRIANGLE_FAN, 0, Length(texLvb));
// draw right frame
glBindTexture(GL_TEXTURE_2D, texl);
SetVertexPointer(@texRvb, Length(texRvb));
//UpdateModelviewProjection;
glDrawArrays(GL_TRIANGLE_FAN, 0, Length(texRvb));
SetScale(zoom);
end;
{$ENDIF}
end;
{$IFDEF GL2}
function CompileShader(shaderFile: string; shaderType: GLenum): GLuint;
var
shader: GLuint;
f: Textfile;
source, line: AnsiString;
sourceA: Pchar;
lengthA: GLint;
compileResult: GLint;
logLength: GLint;
log: PChar;
begin
Assign(f, PathPrefix + cPathz[ptShaders] + '/' + shaderFile);
filemode:= 0; // readonly
Reset(f);
if IOResult <> 0 then
begin
AddFileLog('Unable to load ' + shaderFile);
halt(HaltStartupError);
end;
source:='';
while not eof(f) do
begin
ReadLn(f, line);
source:= source + line + #10;
end;
Close(f);
WriteLnToConsole('Compiling shader: ' + PathPrefix + cPathz[ptShaders] + '/' + shaderFile);
sourceA:=PChar(source);
lengthA:=Length(source);
shader:=glCreateShader(shaderType);
glShaderSource(shader, 1, @sourceA, @lengthA);
glCompileShader(shader);
glGetShaderiv(shader, GL_COMPILE_STATUS, @compileResult);
glGetShaderiv(shader, GL_INFO_LOG_LENGTH, @logLength);
if logLength > 1 then
begin
log := GetMem(logLength);
glGetShaderInfoLog(shader, logLength, nil, log);
WriteLnToConsole('========== Compiler log ==========');
WriteLnToConsole(shortstring(log));
WriteLnToConsole('===================================');
FreeMem(log, logLength);
end;
if compileResult <> GL_TRUE then
begin
WriteLnToConsole('Shader compilation failed, halting');
halt(HaltStartupError);
end;
CompileShader:= shader;
end;
function CompileProgram(shaderName: string): GLuint;
var
program_: GLuint;
vs, fs: GLuint;
linkResult: GLint;
logLength: GLint;
log: PChar;
begin
program_:= glCreateProgram();
vs:= CompileShader(shaderName + '.vs', GL_VERTEX_SHADER);
fs:= CompileShader(shaderName + '.fs', GL_FRAGMENT_SHADER);
glAttachShader(program_, vs);
glAttachShader(program_, fs);
glBindAttribLocation(program_, aVertex, PChar('vertex'));
glBindAttribLocation(program_, aTexCoord, PChar('texcoord'));
glBindAttribLocation(program_, aColor, PChar('color'));
glLinkProgram(program_);
glDeleteShader(vs);
glDeleteShader(fs);
glGetProgramiv(program_, GL_LINK_STATUS, @linkResult);
glGetProgramiv(program_, GL_INFO_LOG_LENGTH, @logLength);
if logLength > 1 then
begin
log := GetMem(logLength);
glGetProgramInfoLog(program_, logLength, nil, log);
WriteLnToConsole('========== Compiler log ==========');
WriteLnToConsole(shortstring(log));
WriteLnToConsole('===================================');
FreeMem(log, logLength);
end;
if linkResult <> GL_TRUE then
begin
WriteLnToConsole('Linking program failed, halting');
halt(HaltStartupError);
end;
CompileProgram:= program_;
end;
{$ENDIF}
function glLoadExtension(extension : shortstring) : boolean;
var logmsg: shortstring;
begin
extension:= extension; // avoid hint
glLoadExtension:= false;
logmsg:= 'OpenGL - "' + extension + '" skipped';
{$IFNDEF IPHONEOS}
//TODO: pas2c does not handle
{$IFNDEF PAS2C}
// FreePascal doesnt come with OpenGL ES 1.1 Extension headers
{$IF GLunit <> gles11}
glLoadExtension:= glext_LoadExtension(extension);
if glLoadExtension then
logmsg:= 'OpenGL - "' + extension + '" loaded'
else
logmsg:= 'OpenGL - "' + extension + '" failed to load';
{$ENDIF}
{$ENDIF}
{$ENDIF}
AddFileLog(logmsg);
end;
{$IFDEF USE_S3D_RENDERING OR USE_VIDEO_RECORDING}
procedure CreateFramebuffer(var frame, depth, tex: GLuint);
begin
glGenFramebuffersEXT(1, @frame);
glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, frame);
glGenRenderbuffersEXT(1, @depth);
glBindRenderbufferEXT(GL_RENDERBUFFER_EXT, depth);
glRenderbufferStorageEXT(GL_RENDERBUFFER_EXT, GL_DEPTH_COMPONENT, cScreenWidth, cScreenHeight);
glFramebufferRenderbufferEXT(GL_FRAMEBUFFER_EXT, GL_DEPTH_ATTACHMENT_EXT, GL_RENDERBUFFER_EXT, depth);
glGenTextures(1, @tex);
glBindTexture(GL_TEXTURE_2D, tex);
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB8, cScreenWidth, cScreenHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, nil);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
glFramebufferTexture2DEXT(GL_FRAMEBUFFER_EXT, GL_COLOR_ATTACHMENT0_EXT, GL_TEXTURE_2D, tex, 0);
end;
procedure DeleteFramebuffer(var frame, depth, tex: GLuint);
begin
glDeleteTextures(1, @tex);
glDeleteRenderbuffersEXT(1, @depth);
glDeleteFramebuffersEXT(1, @frame);
end;
{$ENDIF}
procedure RendererCleanup();
begin
{$IFNDEF PAS2C}
{$IFDEF USE_VIDEO_RECORDING}
if defaultFrame <> 0 then
DeleteFramebuffer(defaultFrame, depthv, texv);
{$ENDIF}
{$IFDEF USE_S3D_RENDERING}
if (cStereoMode = smHorizontal) or (cStereoMode = smVertical) then
begin
DeleteFramebuffer(framel, depthl, texl);
DeleteFramebuffer(framer, depthr, texr);
end
{$ENDIF}
{$ENDIF}
end;
procedure RendererSetup();
var AuxBufNum: LongInt = 0;
tmpstr: ansistring;
tmpint: LongInt;
tmpn: LongInt;
begin
// suppress hint/warning
AuxBufNum:= AuxBufNum;
// get the max (h and v) size for textures that the gpu can support
glGetIntegerv(GL_MAX_TEXTURE_SIZE, @MaxTextureSize);
if MaxTextureSize <= 0 then
begin
MaxTextureSize:= 1024;
AddFileLog('OpenGL Warning - driver didn''t provide any valid max texture size; assuming 1024');
end
else if (MaxTextureSize < 1024) and (MaxTextureSize >= 512) then
begin
cReducedQuality := cReducedQuality or rqNoBackground;
AddFileLog('Texture size too small for backgrounds, disabling.');
end;
// everyone loves debugging
// find out which gpu we are using (for extension compatibility maybe?)
AddFileLog('OpenGL-- Renderer: ' + shortstring(pchar(glGetString(GL_RENDERER))));
AddFileLog(' |----- Vendor: ' + shortstring(pchar(glGetString(GL_VENDOR))));
AddFileLog(' |----- Version: ' + shortstring(pchar(glGetString(GL_VERSION))));
AddFileLog(' |----- Texture Size: ' + inttostr(MaxTextureSize));
{$IFDEF USE_VIDEO_RECORDING}
glGetIntegerv(GL_AUX_BUFFERS, @AuxBufNum);
AddFileLog(' |----- Number of auxiliary buffers: ' + inttostr(AuxBufNum));
{$ENDIF}
{$IFNDEF PAS2C}
AddFileLog(' \----- Extensions: ');
// fetch extentions and store them in string
tmpstr := StrPas(PChar(glGetString(GL_EXTENSIONS)));
tmpn := WordCount(tmpstr, [' ']);
tmpint := 1;
repeat
begin
// print up to 3 extentions per row
// ExtractWord will return empty string if index out of range
AddFileLog(TrimRight(
ExtractWord(tmpint, tmpstr, [' ']) + ' ' +
ExtractWord(tmpint+1, tmpstr, [' ']) + ' ' +
ExtractWord(tmpint+2, tmpstr, [' '])
));
tmpint := tmpint + 3;
end;
until (tmpint > tmpn);
{$ENDIF}
AddFileLog('');
defaultFrame:= 0;
{$IFDEF USE_VIDEO_RECORDING}
if GameType = gmtRecord then
begin
if glLoadExtension('GL_EXT_framebuffer_object') then
begin
CreateFramebuffer(defaultFrame, depthv, texv);
glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, defaultFrame);
AddFileLog('Using framebuffer for video recording.');
end
else if AuxBufNum > 0 then
begin
glDrawBuffer(GL_AUX0);
glReadBuffer(GL_AUX0);
AddFileLog('Using auxiliary buffer for video recording.');
end
else
begin
glDrawBuffer(GL_BACK);
glReadBuffer(GL_BACK);
AddFileLog('Warning: off-screen rendering is not supported; using back buffer but it may not work.');
end;
end;
{$ENDIF}
{$IFDEF GL2}
{$IFDEF PAS2C}
err := glewInit();
if err <> GLEW_OK then
begin
WriteLnToConsole('Failed to initialize GLEW.');
halt(HaltStartupError);
end;
{$ENDIF}
{$IFNDEF PAS2C}
if not Load_GL_VERSION_2_0 then
halt;
{$ENDIF}
shaderWater:= CompileProgram('water');
glUseProgram(shaderWater);
glUniform1i(glGetUniformLocation(shaderWater, pchar('tex0')), 0);
uWaterMVPLocation:= glGetUniformLocation(shaderWater, pchar('mvp'));
shaderMain:= CompileProgram('default');
glUseProgram(shaderMain);
glUniform1i(glGetUniformLocation(shaderMain, pchar('tex0')), 0);
uMainMVPLocation:= glGetUniformLocation(shaderMain, pchar('mvp'));
uMainTintLocation:= glGetUniformLocation(shaderMain, pchar('tint'));
uCurrentMVPLocation:= uMainMVPLocation;
Tint(255, 255, 255, 255);
UpdateModelviewProjection;
{$ENDIF}
{$IFDEF USE_S3D_RENDERING}
if (cStereoMode = smHorizontal) or (cStereoMode = smVertical) then
begin
// prepare left and right frame buffers and associated textures
if glLoadExtension('GL_EXT_framebuffer_object') then
begin
CreateFramebuffer(framel, depthl, texl);
CreateFramebuffer(framer, depthr, texr);
// reset
glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, defaultFrame)
end
else
cStereoMode:= smNone;
end;
// set up vertex/texture buffers for frame textures
texLRDtb[0].X:= 0.0;
texLRDtb[0].Y:= 0.0;
texLRDtb[1].X:= 1.0;
texLRDtb[1].Y:= 0.0;
texLRDtb[2].X:= 1.0;
texLRDtb[2].Y:= 1.0;
texLRDtb[3].X:= 0.0;
texLRDtb[3].Y:= 1.0;
if cStereoMode = smHorizontal then
begin
texLvb[0].X:= cScreenWidth / -2;
texLvb[0].Y:= cScreenHeight;
texLvb[1].X:= 0;
texLvb[1].Y:= cScreenHeight;
texLvb[2].X:= 0;
texLvb[2].Y:= 0;
texLvb[3].X:= cScreenWidth / -2;
texLvb[3].Y:= 0;
texRvb[0].X:= 0;
texRvb[0].Y:= cScreenHeight;
texRvb[1].X:= cScreenWidth / 2;
texRvb[1].Y:= cScreenHeight;
texRvb[2].X:= cScreenWidth / 2;
texRvb[2].Y:= 0;
texRvb[3].X:= 0;
texRvb[3].Y:= 0;
end
else
begin
texLvb[0].X:= cScreenWidth / -2;
texLvb[0].Y:= cScreenHeight / 2;
texLvb[1].X:= cScreenWidth / 2;
texLvb[1].Y:= cScreenHeight / 2;
texLvb[2].X:= cScreenWidth / 2;
texLvb[2].Y:= 0;
texLvb[3].X:= cScreenWidth / -2;
texLvb[3].Y:= 0;
texRvb[0].X:= cScreenWidth / -2;
texRvb[0].Y:= cScreenHeight;
texRvb[1].X:= cScreenWidth / 2;
texRvb[1].Y:= cScreenHeight;
texRvb[2].X:= cScreenWidth / 2;
texRvb[2].Y:= cScreenHeight / 2;
texRvb[3].X:= cScreenWidth / -2;
texRvb[3].Y:= cScreenHeight / 2;
end;
{$ENDIF}
// set view port to whole window
glViewport(0, 0, cScreenWidth, cScreenHeight);
{$IFDEF GL2}
uMatrix.initModule;
hglMatrixMode(MATRIX_MODELVIEW);
// prepare default translation/scaling
hglLoadIdentity();
hglScalef(2.0 / cScreenWidth, -2.0 / cScreenHeight, 1.0);
hglTranslatef(0, -cScreenHeight / 2, 0);
EnableTexture(True);
glEnableVertexAttribArray(aVertex);
glEnableVertexAttribArray(aTexCoord);
glGenBuffers(1, @vBuffer);
glGenBuffers(1, @tBuffer);
glGenBuffers(1, @cBuffer);
{$ELSE}
glMatrixMode(GL_MODELVIEW);
// prepare default translation/scaling
glLoadIdentity();
glScalef(2.0 / cScreenWidth, -2.0 / cScreenHeight, 1.0);
glTranslatef(0, -cScreenHeight / 2, 0);
// disable/lower perspective correction (will not need it anyway)
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_FASTEST);
// disable dithering
glDisable(GL_DITHER);
// enable common states by default as they save a lot
glEnable(GL_TEXTURE_2D);
glEnableClientState(GL_VERTEX_ARRAY);
glEnableClientState(GL_TEXTURE_COORD_ARRAY);
{$ENDIF}
// enable alpha blending
glEnable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
// disable/lower perspective correction (will not need it anyway)
end;
procedure openglLoadIdentity(); inline;
begin
{$IFDEF GL2}
hglLoadIdentity();
{$ELSE}
glLoadIdentity();
{$ENDIF}
end;
procedure openglTranslProjMatrix(X, Y, Z: GLfloat); inline;
begin
{$IFDEF GL2}
hglMatrixMode(MATRIX_PROJECTION);
hglTranslatef(X, Y, Z);
hglMatrixMode(MATRIX_MODELVIEW);
{$ELSE}
glMatrixMode(GL_PROJECTION);
glTranslatef(X, Y, Z);
glMatrixMode(GL_MODELVIEW);
{$ENDIF}
end;
procedure openglPushMatrix(); inline;
begin
{$IFDEF GL2}
hglPushMatrix();
{$ELSE}
glPushMatrix();
{$ENDIF}
end;
procedure openglPopMatrix(); inline;
begin
{$IFDEF GL2}
hglPopMatrix();
{$ELSE}
glPopMatrix();
{$ENDIF}
end;
procedure openglTranslatef(X, Y, Z: GLfloat); inline;
begin
{$IFDEF GL2}
hglTranslatef(X, Y, Z);
{$ELSE}
glTranslatef(X, Y, Z);
{$ENDIF}
end;
procedure openglScalef(ScaleX, ScaleY, ScaleZ: GLfloat); inline;
begin
{$IFDEF GL2}
hglScalef(ScaleX, ScaleY, ScaleZ);
{$ELSE}
glScalef(ScaleX, ScaleY, ScaleZ);
{$ENDIF}
end;
procedure openglRotatef(RotX, RotY, RotZ: GLfloat; dir: LongInt); inline;
{ workaround for pascal bug http://bugs.freepascal.org/view.php?id=27222 }
var tmpdir: LongInt;
begin
tmpdir:=dir;
{$IFDEF GL2}
hglRotatef(RotX, RotY, RotZ, tmpdir);
{$ELSE}
glRotatef(RotX, RotY, RotZ, tmpdir);
{$ENDIF}
end;
procedure openglUseColorOnly(b :boolean); inline;
begin
if b then
begin
{$IFDEF GL2}
glDisableVertexAttribArray(aTexCoord);
glEnableVertexAttribArray(aColor);
{$ELSE}
glDisableClientState(GL_TEXTURE_COORD_ARRAY);
glEnableClientState(GL_COLOR_ARRAY);
{$ENDIF}
LastTexCoordPointer:= nil;
end
else
begin
{$IFDEF GL2}
glDisableVertexAttribArray(aColor);
glEnableVertexAttribArray(aTexCoord);
{$ELSE}
glDisableClientState(GL_COLOR_ARRAY);
glEnableClientState(GL_TEXTURE_COORD_ARRAY);
{$ENDIF}
LastColorPointer:= nil;
end;
EnableTexture(not b);
end;
procedure UpdateModelviewProjection(); inline;
{$IFDEF GL2}
var
mvp: TMatrix4x4f;
{$ENDIF}
begin
{$IFDEF GL2}
//MatrixMultiply(mvp, mProjection, mModelview);
{$HINTS OFF}
hglMVP(mvp);
{$HINTS ON}
glUniformMatrix4fv(uCurrentMVPLocation, 1, GL_FALSE, @mvp[0, 0]);
{$ENDIF}
end;
procedure SetTexCoordPointer(p: Pointer; n: Integer); inline;
begin
{$IFDEF GL2}
if (p = LastTexCoordPointer) and (n = LastTexCoordPointerN) then
exit;
glBindBuffer(GL_ARRAY_BUFFER, tBuffer);
glBufferData(GL_ARRAY_BUFFER, sizeof(GLfloat) * n * 2, p, GL_STATIC_DRAW);
glEnableVertexAttribArray(aTexCoord);
glVertexAttribPointer(aTexCoord, 2, GL_FLOAT, GL_FALSE, 0, pointer(0));
LastTexCoordPointerN:= n;
{$ELSE}
if p = LastTexCoordPointer then
exit;
n:= n;
glTexCoordPointer(2, GL_FLOAT, 0, p);
{$ENDIF}
LastTexCoordPointer:= p;
end;
procedure SetVertexPointer(p: Pointer; n: Integer); inline;
begin
{$IFDEF GL2}
if (p = LastVertexPointer) and (n = LastVertexPointerN) then
exit;
glBindBuffer(GL_ARRAY_BUFFER, vBuffer);
glBufferData(GL_ARRAY_BUFFER, sizeof(GLfloat) * n * 2, p, GL_STATIC_DRAW);
glEnableVertexAttribArray(aVertex);
glVertexAttribPointer(aVertex, 2, GL_FLOAT, GL_FALSE, 0, pointer(0));
LastVertexPointerN:= n;
{$ELSE}
if p = LastVertexPointer then
exit;
n:= n;
glVertexPointer(2, GL_FLOAT, 0, p);
{$ENDIF}
LastVertexPointer:= p;
end;
procedure SetColorPointer(p: Pointer; n: Integer); inline;
begin
{$IFDEF GL2}
if (p = LastColorPointer) and (n = LastColorPointerN) then
exit;
glBindBuffer(GL_ARRAY_BUFFER, cBuffer);
glBufferData(GL_ARRAY_BUFFER, n * 4, p, GL_STATIC_DRAW);
glEnableVertexAttribArray(aColor);
glVertexAttribPointer(aColor, 4, GL_UNSIGNED_BYTE, GL_TRUE, 0, pointer(0));
LastColorPointerN:= n;
{$ELSE}
if p = LastColorPointer then
exit;
n:= n;
glColorPointer(4, GL_UNSIGNED_BYTE, 0, p);
{$ENDIF}
LastColorPointer:= p;
end;
procedure EnableTexture(enable:Boolean);
begin
{$IFDEF GL2}
if enable then
glUniform1i(glGetUniformLocation(shaderMain, pchar('enableTexture')), 1)
else
glUniform1i(glGetUniformLocation(shaderMain, pchar('enableTexture')), 0);
{$ELSE}
if enable then
glEnable(GL_TEXTURE_2D)
else
glDisable(GL_TEXTURE_2D);
{$ENDIF}
end;
procedure UpdateViewLimits();
var tmp: LongInt;
begin
// cScaleFactor is 2.0 on "no zoom"
tmp:= round(0.5 + cScreenWidth / cScaleFactor);
ViewRightX := tmp;
ViewLeftX := -tmp;
tmp:= round(0.5 + cScreenHeight / cScaleFactor);
ViewBottomY:= tmp + cScreenHeight div 2;
ViewTopY := -tmp + cScreenHeight div 2;
// visual debugging fun :D
if cViewLimitsDebug then
begin
// some margin on each side
tmp:= trunc(min(cScreenWidth, cScreenHeight) div 2 / cScaleFactor);
ViewLeftX := ViewLeftX + trunc(tmp);
ViewRightX := ViewRightX - trunc(tmp);
ViewBottomY:= ViewBottomY - trunc(tmp);
ViewTopY := ViewTopY + trunc(tmp);
end;
ViewWidth := ViewRightX - ViewLeftX + 1;
ViewHeight:= ViewBottomY - ViewTopY + 1;
end;
procedure SetScale(f: GLfloat);
begin
// leave immediately if scale factor did not change
if f = cScaleFactor then
exit;
// for going back to default scaling just pop matrix
if f = cDefaultZoomLevel then
begin
openglPopMatrix;
end
else
begin
openglPushMatrix; // save default scaling in matrix
openglLoadIdentity();
openglScalef(f / cScreenWidth, -f / cScreenHeight, 1.0);
openglTranslatef(0, -cScreenHeight div 2, 0);
end;
cScaleFactor:= f;
updateViewLimits();
UpdateModelviewProjection;
end;
procedure DrawSpriteFromRect(Sprite: TSprite; r: TSDL_Rect; X, Y, Height, Position: LongInt); inline;
begin
r.y:= r.y + Height * Position;
r.h:= Height;
DrawTextureFromRect(X, Y, @r, SpritesData[Sprite].Texture)
end;
procedure DrawTextureFromRect(X, Y: LongInt; r: PSDL_Rect; SourceTexture: PTexture); inline;
begin
DrawTextureFromRectDir(X, Y, r^.w, r^.h, r, SourceTexture, 1)
end;
procedure DrawTextureFromRect(X, Y, W, H: LongInt; r: PSDL_Rect; SourceTexture: PTexture); inline;
begin
DrawTextureFromRectDir(X, Y, W, H, r, SourceTexture, 1)
end;
procedure DrawTextureFromRectDir(X, Y, W, H: LongInt; r: PSDL_Rect; SourceTexture: PTexture; Dir: LongInt);
var _l, _r, _t, _b: real;
xw, yh: LongInt;
begin
if (SourceTexture^.h = 0) or (SourceTexture^.w = 0) then
exit;
{if isDxAreaOffscreen(X, W) <> 0 then
exit;
if isDyAreaOffscreen(Y, H) <> 0 then
exit;}
// do not draw anything outside the visible screen space (first check fixes some sprite drawing, e.g. hedgehogs)
if (abs(X) > W) and ((abs(X + W / 2) - W / 2) * 2 > ViewWidth) then
exit;
if (abs(Y) > H) and ((abs(Y + H / 2 - (0.5 * cScreenHeight)) - H / 2) * 2 > ViewHeight) then
exit;
_l:= r^.x / SourceTexture^.w * SourceTexture^.rx;
_r:= (r^.x + r^.w) / SourceTexture^.w * SourceTexture^.rx;
// if direction is mirrored, switch left and right
if Dir < 0 then
begin
_t:= _l;
_l:= _r;
_r:= _t;
end;
_t:= r^.y / SourceTexture^.h * SourceTexture^.ry;
_b:= (r^.y + r^.h) / SourceTexture^.h * SourceTexture^.ry;
glBindTexture(GL_TEXTURE_2D, SourceTexture^.id);
xw:= X + W;
yh:= Y + H;
VertexBuffer[0].X:= X;
VertexBuffer[0].Y:= Y;
VertexBuffer[1].X:= xw;
VertexBuffer[1].Y:= Y;
VertexBuffer[2].X:= xw;
VertexBuffer[2].Y:= yh;
VertexBuffer[3].X:= X;
VertexBuffer[3].Y:= yh;
TextureBuffer[0].X:= _l;
TextureBuffer[0].Y:= _t;
TextureBuffer[1].X:= _r;
TextureBuffer[1].Y:= _t;
TextureBuffer[2].X:= _r;
TextureBuffer[2].Y:= _b;
TextureBuffer[3].X:= _l;
TextureBuffer[3].Y:= _b;
SetVertexPointer(@VertexBuffer[0], 4);
SetTexCoordPointer(@TextureBuffer[0], 4);
glDrawArrays(GL_TRIANGLE_FAN, 0, 4);
end;
procedure DrawTexture(X, Y: LongInt; Texture: PTexture); inline;
begin
DrawTexture(X, Y, Texture, 1.0);
end;
procedure DrawTexture(X, Y: LongInt; Texture: PTexture; Scale: GLfloat);
begin
openglPushMatrix;
openglTranslatef(X, Y, 0);
if Scale <> 1.0 then
openglScalef(Scale, Scale, 1);
glBindTexture(GL_TEXTURE_2D, Texture^.id);
SetVertexPointer(@Texture^.vb, Length(Texture^.vb));
SetTexCoordPointer(@Texture^.tb, Length(Texture^.vb));
UpdateModelviewProjection;
glDrawArrays(GL_TRIANGLE_FAN, 0, Length(Texture^.vb));
openglPopMatrix;
end;
{ this contains tweaks in order to avoid land tile borders in blurry land mode }
procedure DrawTexture2(X, Y: LongInt; Texture: PTexture; Scale, Overlap: GLfloat);
var
TextureBuffer: array [0..3] of TVertex2f;
begin
openglPushMatrix;
openglTranslatef(X, Y, 0);
openglScalef(Scale, Scale, 1);
glBindTexture(GL_TEXTURE_2D, Texture^.id);
TextureBuffer[0].X:= Texture^.tb[0].X + Overlap;
TextureBuffer[0].Y:= Texture^.tb[0].Y + Overlap;
TextureBuffer[1].X:= Texture^.tb[1].X - Overlap;
TextureBuffer[1].Y:= Texture^.tb[1].Y + Overlap;
TextureBuffer[2].X:= Texture^.tb[2].X - Overlap;
TextureBuffer[2].Y:= Texture^.tb[2].Y - Overlap;
TextureBuffer[3].X:= Texture^.tb[3].X + Overlap;
TextureBuffer[3].Y:= Texture^.tb[3].Y - Overlap;
SetVertexPointer(@Texture^.vb, 4);
SetTexCoordPointer(@TextureBuffer, 4);
UpdateModelviewProjection;
glDrawArrays(GL_TRIANGLE_FAN, 0, 4);
openglPopMatrix;
end;
procedure DrawTextureF(Texture: PTexture; Scale: GLfloat; X, Y, Frame, Dir, w, h: LongInt);
begin
DrawTextureRotatedF(Texture, Scale, 0, 0, X, Y, Frame, Dir, w, h, 0)
end;
procedure DrawTextureRotatedF(Texture: PTexture; Scale, OffsetX, OffsetY: GLfloat; X, Y, Frame, Dir, w, h: LongInt; Angle: real);
var ft, fb, fl, fr: GLfloat;
hw, hh, nx, ny: LongInt;
begin
// visibility check only under trivial conditions
if (Scale <= 1) then
begin
if Angle <> 0 then
begin
if (OffsetX = 0) and (OffsetY = 0) then
begin
// sized doubled because the sprite might occupy up to 1.4 * of it's
// original size in each dimension, because it is rotated
if isDxAreaOffscreen(X - w, 2 * w) <> 0 then
exit;
if isDYAreaOffscreen(Y - h, 2 * h) <> 0 then
exit;
end;
end
else
begin
if isDxAreaOffscreen(X + dir * trunc(OffsetX) - w div 2, w) <> 0 then
exit;
if isDYAreaOffscreen(Y + trunc(OffsetY) - h div 2, h) <> 0 then
exit;
end;
end;
{
// do not draw anything outside the visible screen space (first check fixes some sprite drawing, e.g. hedgehogs)
if (abs(X) > W) and ((abs(X + dir * OffsetX) - W / 2) * 2 > ViewWidth) then
exit;
if (abs(Y) > H) and ((abs(Y + OffsetY - (cScreenHeight / 2)) - W / 2) * 2 > ViewHeight) then
exit;
}
openglPushMatrix;
openglTranslatef(X, Y, 0);
if Dir = 0 then Dir:= 1;
if Angle <> 0 then
openglRotatef(Angle, 0, 0, Dir);
if (OffsetX <> 0) or (OffsetY <> 0) then
openglTranslatef(Dir*OffsetX, OffsetY, 0);
if Scale <> 1.0 then
openglScalef(Scale, Scale, 1);
// Any reason for this call? And why only in t direction, not s?
//glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
if Dir > 0 then
hw:= w div 2
else
hw:= -w div 2;
hh:= h div 2;
nx:= Texture^.w div w; // number of horizontal frames
if nx = 0 then nx:= 1; // one frame is minimum
ny:= Texture^.h div h; // number of vertical frames
if ny = 0 then ny:= 1;
ft:= (Frame mod ny) * Texture^.ry / ny;
fb:= ((Frame mod ny) + 1) * Texture^.ry / ny;
fl:= (Frame div ny) * Texture^.rx / nx;
fr:= ((Frame div ny) + 1) * Texture^.rx / nx;
glBindTexture(GL_TEXTURE_2D, Texture^.id);
VertexBuffer[0].X:= -hw;
VertexBuffer[0].Y:= -hh;
VertexBuffer[1].X:= hw;
VertexBuffer[1].Y:= -hh;
VertexBuffer[2].X:= hw;
VertexBuffer[2].Y:= hh;
VertexBuffer[3].X:= -hw;
VertexBuffer[3].Y:= hh;
TextureBuffer[0].X:= fl;
TextureBuffer[0].Y:= ft;
TextureBuffer[1].X:= fr;
TextureBuffer[1].Y:= ft;
TextureBuffer[2].X:= fr;
TextureBuffer[2].Y:= fb;
TextureBuffer[3].X:= fl;
TextureBuffer[3].Y:= fb;
SetVertexPointer(@VertexBuffer[0], 4);
SetTexCoordPointer(@TextureBuffer[0], 4);
UpdateModelviewProjection;
glDrawArrays(GL_TRIANGLE_FAN, 0, 4);
openglPopMatrix;
end;
procedure DrawSpriteRotated(Sprite: TSprite; X, Y, Dir: LongInt; Angle: real);
begin
DrawTextureRotated(SpritesData[Sprite].Texture,
SpritesData[Sprite].Width,
SpritesData[Sprite].Height,
X, Y, Dir, Angle)
end;
procedure DrawSpriteRotatedF(Sprite: TSprite; X, Y, Frame, Dir: LongInt; Angle: real);
begin
if Angle <> 0 then
begin
// sized doubled because the sprite might occupy up to 1.4 * of it's
// original size in each dimension, because it is rotated
if isDxAreaOffscreen(X - SpritesData[Sprite].Width, 2 * SpritesData[Sprite].Width) <> 0 then
exit;
if isDYAreaOffscreen(Y - SpritesData[Sprite].Height, 2 * SpritesData[Sprite].Height) <> 0 then
exit;
end
else
begin
if isDxAreaOffscreen(X - SpritesData[Sprite].Width div 2, SpritesData[Sprite].Width) <> 0 then
exit;
if isDYAreaOffscreen(Y - SpritesData[Sprite].Height div 2 , SpritesData[Sprite].Height) <> 0 then
exit;
end;
openglPushMatrix;
openglTranslatef(X, Y, 0);
// mirror
if Dir < 0 then
openglScalef(-1.0, 1.0, 1.0);
// apply angle after (conditional) mirroring
if Angle <> 0 then
openglRotatef(Angle, 0, 0, 1);
DrawSprite(Sprite, -SpritesData[Sprite].Width div 2, -SpritesData[Sprite].Height div 2, Frame);
openglPopMatrix;
end;
procedure DrawTextureRotated(Texture: PTexture; hw, hh, X, Y, Dir: LongInt; Angle: real);
begin
if isDxAreaOffscreen(X, 2 * hw) <> 0 then
exit;
if isDyAreaOffscreen(Y, 2 * hh) <> 0 then
exit;
// do not draw anything outside the visible screen space (first check fixes some sprite drawing, e.g. hedgehogs)
{if (abs(X) > 2 * hw) and ((abs(X) - hw) > cScreenWidth / cScaleFactor) then
exit;
if (abs(Y) > 2 * hh) and ((abs(Y - 0.5 * cScreenHeight) - hh) > cScreenHeight / cScaleFactor) then
exit;}
openglPushMatrix;
openglTranslatef(X, Y, 0);
if Dir < 0 then
begin
hw:= - hw;
openglRotatef(Angle, 0, 0, -1);
end
else
openglRotatef(Angle, 0, 0, 1);
glBindTexture(GL_TEXTURE_2D, Texture^.id);
VertexBuffer[0].X:= -hw;
VertexBuffer[0].Y:= -hh;
VertexBuffer[1].X:= hw;
VertexBuffer[1].Y:= -hh;
VertexBuffer[2].X:= hw;
VertexBuffer[2].Y:= hh;
VertexBuffer[3].X:= -hw;
VertexBuffer[3].Y:= hh;
SetVertexPointer(@VertexBuffer[0], 4);
SetTexCoordPointer(@Texture^.tb, 4);
UpdateModelviewProjection;
glDrawArrays(GL_TRIANGLE_FAN, 0, 4);
openglPopMatrix;
end;
procedure DrawSprite(Sprite: TSprite; X, Y, Frame: LongInt);
var row, col, numFramesFirstCol: LongInt;
begin
if SpritesData[Sprite].imageHeight = 0 then
exit;
numFramesFirstCol:= SpritesData[Sprite].imageHeight div SpritesData[Sprite].Height;
row:= Frame mod numFramesFirstCol;
col:= Frame div numFramesFirstCol;
DrawSprite(Sprite, X, Y, col, row);
end;
procedure DrawSprite(Sprite: TSprite; X, Y, FrameX, FrameY: LongInt);
var r: TSDL_Rect;
begin
r.x:= FrameX * SpritesData[Sprite].Width;
r.w:= SpritesData[Sprite].Width;
r.y:= FrameY * SpritesData[Sprite].Height;
r.h:= SpritesData[Sprite].Height;
DrawTextureFromRect(X, Y, @r, SpritesData[Sprite].Texture)
end;
procedure DrawSpriteClipped(Sprite: TSprite; X, Y, TopY, RightX, BottomY, LeftX: LongInt);
var r: TSDL_Rect;
begin
r.x:= 0;
r.y:= 0;
r.w:= SpritesData[Sprite].Width;
r.h:= SpritesData[Sprite].Height;
if (X < LeftX) then
r.x:= LeftX - X;
if (Y < TopY) then
r.y:= TopY - Y;
if (Y + SpritesData[Sprite].Height > BottomY) then
r.h:= BottomY - Y + 1;
if (X + SpritesData[Sprite].Width > RightX) then
r.w:= RightX - X + 1;
if (r.h < r.y) or (r.w < r.x) then
exit;
dec(r.h, r.y);
dec(r.w, r.x);
DrawTextureFromRect(X + r.x, Y + r.y, @r, SpritesData[Sprite].Texture)
end;
procedure DrawTextureCentered(X, Top: LongInt; Source: PTexture);
var scale: GLfloat;
left : LongInt;
begin
// scale down if larger than screen
if (Source^.w + 20) > cScreenWidth then
begin
scale:= cScreenWidth / (Source^.w + 20);
DrawTexture(X - round(Source^.w * scale) div 2, Top, Source, scale);
end
else
begin
left:= X - Source^.w div 2;
if (not isAreaOffscreen(left, Top, Source^.w, Source^.h)) then
DrawTexture(left, Top, Source);
end;
end;
procedure DrawLine(X0, Y0, X1, Y1, Width: Single; color: LongWord); inline;
begin
DrawLine(X0, Y0, X1, Y1, Width, (color shr 24) and $FF, (color shr 16) and $FF, (color shr 8) and $FF, color and $FF)
end;
procedure DrawLine(X0, Y0, X1, Y1, Width: Single; r, g, b, a: Byte);
begin
openglPushMatrix();
openglTranslatef(WorldDx, WorldDy, 0);
UpdateModelviewProjection;
DrawLineOnScreen(X0, Y0, X1, Y1, Width, r, g, b, a);
openglPopMatrix();
end;
procedure DrawLineOnScreen(X0, Y0, X1, Y1, Width: Single; r, g, b, a: Byte);
begin
glEnable(GL_LINE_SMOOTH);
EnableTexture(False);
glLineWidth(Width);
Tint(r, g, b, a);
VertexBuffer[0].X:= X0;
VertexBuffer[0].Y:= Y0;
VertexBuffer[1].X:= X1;
VertexBuffer[1].Y:= Y1;
SetVertexPointer(@VertexBuffer[0], 2);
glDrawArrays(GL_LINES, 0, 2);
untint();
EnableTexture(True);
glDisable(GL_LINE_SMOOTH);
end;
procedure DrawRect(rect: TSDL_Rect; r, g, b, a: Byte; Fill: boolean);
begin
// do not draw anything outside the visible screen space (first check fixes some sprite drawing, e.g. hedgehogs)
if (abs(rect.x) > rect.w) and ((abs(rect.x + rect.w / 2) - rect.w / 2) * 2 > ViewWidth) then
exit;
if (abs(rect.y) > rect.h) and ((abs(rect.y + rect.h / 2 - (cScreenHeight / 2)) - rect.h / 2) * 2 > ViewHeight) then
exit;
EnableTexture(False);
Tint(r, g, b, a);
with rect do
begin
VertexBuffer[0].X:= x;
VertexBuffer[0].Y:= y;
VertexBuffer[1].X:= x + w;
VertexBuffer[1].Y:= y;
VertexBuffer[2].X:= x + w;
VertexBuffer[2].Y:= y + h;
VertexBuffer[3].X:= x;
VertexBuffer[3].Y:= y + h;
end;
SetVertexPointer(@VertexBuffer[0], 4);
if Fill then
glDrawArrays(GL_TRIANGLE_FAN, 0, 4)
else
begin
glLineWidth(1);
glDrawArrays(GL_LINE_LOOP, 0, 4);
end;
untint;
EnableTexture(True);
end;
procedure DrawCircle(X, Y, Radius, Width: LongInt; r, g, b, a: Byte);
begin
Tint(r, g, b, a);
DrawCircle(X, Y, Radius, Width);
untint;
end;
procedure DrawCircle(X, Y, Radius, Width: LongInt);
var
i: LongInt;
begin
i:= Radius + Width;
if isDxAreaOffscreen(X - i, 2 * i) <> 0 then
exit;
if isDyAreaOffscreen(Y - i, 2 * i) <> 0 then
exit;
for i := 0 to 59 do begin
VertexBuffer[i].X := X + Radius*cos(i*pi/30);
VertexBuffer[i].Y := Y + Radius*sin(i*pi/30);
end;
EnableTexture(False);
glEnable(GL_LINE_SMOOTH);
//openglPushMatrix;
glLineWidth(Width);
SetVertexPointer(@VertexBuffer[0], 60);
glDrawArrays(GL_LINE_LOOP, 0, 60);
//openglPopMatrix;
EnableTexture(True);
glDisable(GL_LINE_SMOOTH);
end;
procedure DrawCircleFilled(X, Y, Radius: LongInt; r, g, b, a: Byte);
var
i: LongInt;
begin
VertexBuffer[0].X := X;
VertexBuffer[0].Y := Y;
for i := 1 to 19 do begin
VertexBuffer[i].X := X + Radius*cos(i*pi/9);
VertexBuffer[i].Y := Y + Radius*sin(i*pi/9);
end;
EnableTexture(False);
Tint(r, g, b, a);
SetVertexPointer(@VertexBuffer[0], 20);
glDrawArrays(GL_TRIANGLE_FAN, 0, 20);
Untint();
EnableTexture(True);
end;
procedure DrawHedgehog(X, Y: LongInt; Dir: LongInt; Pos, Step: LongWord; Angle: real);
const VertexBuffer: array [0..3] of TVertex2f = (
(X: -16; Y: -16),
(X: 16; Y: -16),
(X: 16; Y: 16),
(X: -16; Y: 16));
var l, r, t, b: real;
begin
// do not draw anything outside the visible screen space (first check fixes some sprite drawing, e.g. hedgehogs)
if (abs(X) > 32) and ((abs(X) - 16) * 2 > ViewWidth) then
exit;
if (abs(Y) > 32) and ((abs(Y - cScreenHeight / 2) - 16) * 2 > ViewHeight) then
exit;
t:= Pos * 32 / HHTexture^.h;
b:= (Pos + 1) * 32 / HHTexture^.h;
if Dir = -1 then
begin
l:= (Step + 1) * 32 / HHTexture^.w;
r:= Step * 32 / HHTexture^.w
end
else
begin
l:= Step * 32 / HHTexture^.w;
r:= (Step + 1) * 32 / HHTexture^.w
end;
openglPushMatrix();
openglTranslatef(X, Y, 0);
openglRotatef(Angle, 0, 0, 1);
glBindTexture(GL_TEXTURE_2D, HHTexture^.id);
TextureBuffer[0].X:= l;
TextureBuffer[0].Y:= t;
TextureBuffer[1].X:= r;
TextureBuffer[1].Y:= t;
TextureBuffer[2].X:= r;
TextureBuffer[2].Y:= b;
TextureBuffer[3].X:= l;
TextureBuffer[3].Y:= b;
SetVertexPointer(@VertexBuffer[0], 4);
SetTexCoordPointer(@TextureBuffer[0], 4);
UpdateModelviewProjection;
glDrawArrays(GL_TRIANGLE_FAN, 0, 4);
openglPopMatrix;
end;
procedure DrawScreenWidget(widget: POnScreenWidget);
{$IFDEF USE_TOUCH_INTERFACE}
var alpha: byte = $FF;
begin
with widget^ do
begin
if (fadeAnimStart <> 0) then
begin
if RealTicks > (fadeAnimStart + FADE_ANIM_TIME) then
fadeAnimStart:= 0
else
if show then
alpha:= Byte(trunc((RealTicks - fadeAnimStart)/FADE_ANIM_TIME * $FF))
else
alpha:= Byte($FF - trunc((RealTicks - fadeAnimStart)/FADE_ANIM_TIME * $FF));
end;
with moveAnim do
if animate then
if RealTicks > (startTime + MOVE_ANIM_TIME) then
begin
startTime:= 0;
animate:= false;
frame.x:= target.x;
frame.y:= target.y;
active.x:= active.x + (target.x - source.x);
active.y:= active.y + (target.y - source.y);
end
else
begin
frame.x:= source.x + Round((target.x - source.x) * ((RealTicks - startTime) / MOVE_ANIM_TIME));
frame.y:= source.y + Round((target.y - source.y) * ((RealTicks - startTime) / MOVE_ANIM_TIME));
end;
if show or (fadeAnimStart <> 0) then
begin
Tint($FF, $FF, $FF, alpha);
DrawTexture(frame.x, frame.y, spritesData[sprite].Texture, buttonScale);
untint;
end;
end;
{$ELSE}
begin
widget:= widget; // avoid hint
{$ENDIF}
end;
procedure BeginWater;
begin
{$IFDEF GL2}
glUseProgram(shaderWater);
uCurrentMVPLocation:=uWaterMVPLocation;
UpdateModelviewProjection;
{$ENDIF}
openglUseColorOnly(true);
end;
procedure EndWater;
begin
{$IFDEF GL2}
glUseProgram(shaderMain);
uCurrentMVPLocation:=uMainMVPLocation;
UpdateModelviewProjection;
{$ENDIF}
openglUseColorOnly(false);
end;
procedure PrepareVbForWater(
WithWalls: Boolean;
InTopY, OutTopY, InLeftX, OutLeftX, InRightX, OutRightX, BottomY: LongInt;
out first, count: LongInt);
var firsti, afteri, lol: LongInt;
begin
// We will draw both bottom water and the water walls with a single call,
// by rendering a GL_TRIANGLE_STRIP of eight points.
//
// GL_TRIANGLE_STRIP works like this: "always create triangle between
// newest point and the two points that were specified before it."
//
// To get the result we want we will order the points like this:
// ^ -Y
// |
// 0-------1 7-------6 <--------------------- OutTopY -|
// | /| | _/| |
// | / | | / | |
// | / | | _/ | |
// | / | | / | |
// | / _.3---------5{ | <--------------------- InTopY --|
// | / _/ `---.___ `--._ | |
// |/_/ `---.___\| |
// 2-------------------------4 <--------------------- BottomY -|
// |
// ^ ^ ^ ^ V +Y
// | | | |
// | | | |
// | | | |
// | | | |
// | | | |
// | | | |
// | | | |
// OutLeftX InLeftX InRightX OutRightX
// | | | |
// <---------------------------------------->
// -X +X
//
firsti:= -1;
afteri:= 0;
if InTopY < 0 then
InTopY:= 0;
if not WithWalls then
begin
// if no walls are needed, then bottom water surface spans full length
InLeftX := OutLeftX;
InRightX:= OutRightX;
end
else
begin
// animate water walls raise animation at start of game
if GameTicks < 2000 then
lol:= 2000 - GameTicks
else
lol:= 0;
if InLeftX > ViewLeftX then
begin
VertexBuffer[0].X:= OutLeftX - lol;
VertexBuffer[0].Y:= OutTopY;
VertexBuffer[1].X:= InLeftX - lol;
VertexBuffer[1].Y:= OutTopY;
// shares vertices 2 and 3 with bottom water
firsti:= 0;
afteri:= 4;
end;
if InRightX < ViewRightX then
begin
VertexBuffer[6].X:= OutRightX + lol;
VertexBuffer[6].Y:= OutTopY;
VertexBuffer[7].X:= InRightX + lol;
VertexBuffer[7].Y:= OutTopY;
// shares vertices 4 and 5 with bottom water
if firsti < 0 then
firsti:= 4;
afteri:= 8;
end;
end;
if InTopY < ViewBottomY then
begin
// shares vertices 2-5 with water walls
// starts at vertex 2
if (firsti < 0) or (firsti > 2) then
firsti:= 2;
// ends at vertex 5
if afteri < 6 then
afteri:= 6;
end;
if firsti < 0 then
begin
// nothing to draw at all!
first:= -1;
count:= 0;
exit;
end;
if firsti < 4 then
begin
VertexBuffer[2].X:= OutLeftX;
VertexBuffer[2].Y:= BottomY;
VertexBuffer[3].X:= InLeftX;
VertexBuffer[3].Y:= InTopY;
end;
if afteri > 4 then
begin
VertexBuffer[4].X:= OutRightX;
VertexBuffer[4].Y:= BottomY;
VertexBuffer[5].X:= InRightX;
VertexBuffer[5].Y:= InTopY;
end;
// first index to draw in vertex buffer
first:= firsti;
// number of points to draw
count:= afteri - firsti;
end;
procedure DrawWater(Alpha: byte; OffsetY, OffsetX: LongInt);
var first, count: LongInt;
begin
if (WorldEdge <> weSea) then
PrepareVbForWater(false,
OffsetY + WorldDy + cWaterLine, 0,
0, ViewLeftX,
0, ViewRightX,
ViewBottomY,
first, count)
else
PrepareVbForWater(true,
OffsetY + WorldDy + cWaterLine, ViewTopY,
LongInt(LeftX) + WorldDx - OffsetX, ViewLeftX,
LongInt(RightX) + WorldDx + OffsetX, ViewRightX,
ViewBottomY,
first, count);
// quit if there's nothing to draw (nothing in view)
if count < 1 then
exit;
// drawing time
UpdateModelviewProjection;
BeginWater;
if SuddenDeathDmg then
begin // only set alpha if it differs from what we want
if SDWaterColorArray[0].a <> Alpha then
begin
SDWaterColorArray[0].a := Alpha;
SDWaterColorArray[1].a := Alpha;
SDWaterColorArray[2].a := Alpha;
SDWaterColorArray[3].a := Alpha;
SDWaterColorArray[4].a := Alpha;
SDWaterColorArray[5].a := Alpha;
SDWaterColorArray[6].a := Alpha;
SDWaterColorArray[7].a := Alpha;
end;
SetColorPointer(@SDWaterColorArray[0], 8);
end
else
begin
if WaterColorArray[0].a <> Alpha then
begin
WaterColorArray[0].a := Alpha;
WaterColorArray[1].a := Alpha;
WaterColorArray[2].a := Alpha;
WaterColorArray[3].a := Alpha;
WaterColorArray[4].a := Alpha;
WaterColorArray[5].a := Alpha;
WaterColorArray[6].a := Alpha;
WaterColorArray[7].a := Alpha;
end;
SetColorPointer(@WaterColorArray[0], 8);
end;
SetVertexPointer(@VertexBuffer[0], 8);
glDrawArrays(GL_TRIANGLE_STRIP, first, count);
EndWater;
{$IFNDEF GL2}
// must not be Tint() as color array seems to stay active and color reset is required
glColor4ub($FF, $FF, $FF, $FF);
{$ENDIF}
end;
procedure DrawWaves(Dir, dX, dY, oX: LongInt; tnt: Byte);
var first, count, topy, lx, rx, spriteHeight, spriteWidth: LongInt;
lw, nWaves, shift: GLfloat;
sprite: TSprite;
begin
// note: spriteHeight is the Height of the wave sprite while
// cWaveHeight describes how many pixels of it will be above waterline
if SuddenDeathDmg then
sprite:= sprSDWater
else
sprite:= sprWater;
spriteHeight:= SpritesData[sprite].Height;
// shift parameters by wave height
// ( ox and dy are used to create different horizontal and vertical offsets
// between wave layers )
dY:= -cWaveHeight + dy;
ox:= -cWaveHeight + ox;
lx:= LongInt(LeftX) + WorldDx - ox;
rx:= LongInt(RightX) + WorldDx + ox;
topy:= cWaterLine + WorldDy + dY;
if (WorldEdge <> weSea) then
PrepareVbForWater(false,
topy, 0,
0, ViewLeftX,
0, ViewRightX,
topy + spriteHeight,
first, count)
else
PrepareVbForWater(true,
topy, ViewTopY,
lx, lx - spriteHeight,
rx, rx + spriteHeight,
topy + spriteHeight,
first, count);
// quit if there's nothing to draw (nothing in view)
if count < 1 then
exit;
if SuddenDeathDmg then
Tint(LongInt(tnt) * SDWaterColorArray[1].r div 255 + 255 - tnt,
LongInt(tnt) * SDWaterColorArray[1].g div 255 + 255 - tnt,
LongInt(tnt) * SDWaterColorArray[1].b div 255 + 255 - tnt,
255
)
else
Tint(LongInt(tnt) * WaterColorArray[1].r div 255 + 255 - tnt,
LongInt(tnt) * WaterColorArray[1].g div 255 + 255 - tnt,
LongInt(tnt) * WaterColorArray[1].b div 255 + 255 - tnt,
255
);
if WorldEdge = weSea then
begin
lw:= playWidth;
dX:= ox;
end
else
begin
lw:= ViewWidth;
dx:= dx - WorldDx;
end;
spriteWidth:= SpritesData[sprite].Width;
nWaves:= lw / spriteWidth;
shift:= - nWaves / 2;
TextureBuffer[3].X:= shift + ((LongInt(RealTicks shr 6) * Dir + dX) mod spriteWidth) / (spriteWidth - 1);
TextureBuffer[3].Y:= 0;
TextureBuffer[5].X:= TextureBuffer[3].X + nWaves;
TextureBuffer[5].Y:= 0;
TextureBuffer[4].X:= TextureBuffer[5].X;
TextureBuffer[4].Y:= SpritesData[sprite].Texture^.ry;
TextureBuffer[2].X:= TextureBuffer[3].X;
TextureBuffer[2].Y:= SpritesData[sprite].Texture^.ry;
if (WorldEdge = weSea) then
begin
nWaves:= (topy - ViewTopY) / spriteWidth;
// left side
TextureBuffer[1].X:= TextureBuffer[3].X - nWaves;
TextureBuffer[1].Y:= 0;
TextureBuffer[0].X:= TextureBuffer[1].X;
TextureBuffer[0].Y:= SpritesData[sprite].Texture^.ry;
// right side
TextureBuffer[7].X:= TextureBuffer[5].X + nWaves;
TextureBuffer[7].Y:= 0;
TextureBuffer[6].X:= TextureBuffer[7].X;
TextureBuffer[6].Y:= SpritesData[sprite].Texture^.ry;
end;
glBindTexture(GL_TEXTURE_2D, SpritesData[sprite].Texture^.id);
SetVertexPointer(@VertexBuffer[0], 8);
SetTexCoordPointer(@TextureBuffer[0], 8);
UpdateModelviewProjection;
glDrawArrays(GL_TRIANGLE_STRIP, first, count);
untint;
end;
procedure openglTint(r, g, b, a: Byte); inline;
{$IFDEF GL2}
const
scale:Real = 1.0/255.0;
{$ENDIF}
begin
{$IFDEF GL2}
glUniform4f(uMainTintLocation, r*scale, g*scale, b*scale, a*scale);
{$ELSE}
glColor4ub(r, g, b, a);
{$ENDIF}
end;
procedure Tint(r, g, b, a: Byte); inline;
var
nc, tw: Longword;
begin
nc:= (r shl 24) or (g shl 16) or (b shl 8) or a;
if nc = LastTint then
exit;
if GrayScale then
begin
tw:= round(r * RGB_LUMINANCE_RED + g * RGB_LUMINANCE_GREEN + b * RGB_LUMINANCE_BLUE);
if tw > 255 then
tw:= 255;
r:= tw;
g:= tw;
b:= tw
end;
openglTint(r, g, b, a);
LastTint:= nc;
end;
procedure Tint(c: Longword); inline;
begin
if c = LastTint then exit;
Tint(((c shr 24) and $FF), ((c shr 16) and $FF), (c shr 8) and $FF, (c and $FF))
end;
procedure untint(); inline;
begin
if cWhiteColor = LastTint then exit;
openglTint($FF, $FF, $FF, $FF);
LastTint:= cWhiteColor;
end;
procedure setTintAdd(f: boolean); inline;
begin
if f then
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_ADD)
else
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
end;
procedure ChangeDepth(rm: TRenderMode; d: GLfloat);
var tmp: LongInt;
begin
{$IFNDEF USE_S3D_RENDERING}
rm:= rm; d:= d; tmp:= tmp; // avoid hint
{$ELSE}
d:= d / 5;
if rm = rmDefault then
exit
else if rm = rmLeftEye then
d:= -d;
cStereoDepth:= cStereoDepth + d;
openglTranslProjMatrix(d, 0, 0);
tmp:= round(d / cScaleFactor * cScreenWidth);
ViewLeftX := ViewLeftX - tmp;
ViewRightX:= ViewRightX - tmp;
{$ENDIF}
end;
procedure ResetDepth(rm: TRenderMode);
var tmp: LongInt;
begin
{$IFNDEF USE_S3D_RENDERING}
rm:= rm; tmp:= tmp; // avoid hint
{$ELSE}
if rm = rmDefault then
exit;
openglTranslProjMatrix(-cStereoDepth, 0, 0);
tmp:= round(cStereoDepth / cScaleFactor * cScreenWidth);
ViewLeftX := ViewLeftX + tmp;
ViewRightX:= ViewRightX + tmp;
cStereoDepth:= 0;
{$ENDIF}
end;
procedure initModule;
begin
LastTint:= cWhiteColor + 1;
LastColorPointer := nil;
LastTexCoordPointer := nil;
LastVertexPointer := nil;
{$IFDEF GL2}
LastColorPointerN := 0;
LastTexCoordPointerN:= 0;
LastVertexPointerN := 0;
{$ENDIF}
end;
procedure freeModule;
begin
{$IFDEF GL2}
glDeleteProgram(shaderMain);
glDeleteProgram(shaderWater);
glDeleteBuffers(1, @vBuffer);
glDeleteBuffers(1, @tBuffer);
glDeleteBuffers(1, @cBuffer);
{$ENDIF}
end;
end.