Lua API: Add GetVisualGearType, onVisualGearAdd, onVisualGearDelete
Fixes #99 and #122.
(*
* 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}uVariables, uUtils, uConsts
{$IFDEF GL2}, uMatrix, uConsole{$ENDIF}, uPhysFSLayer, uDebug;
{$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: PFSFile;
source, line: ansistring;
sourceA: Pchar;
lengthA: GLint;
compileResult: GLint;
logLength: GLint;
log: PChar;
begin
f:= pfsOpenRead(cPathz[ptShaders] + '/' + shaderFile);
checkFails(f <> nil, 'Unable to load ' + shaderFile, true);
source:='';
while not pfsEof(f) do
begin
pfsReadLnA(f, line);
source:= source + line + #10;
end;
pfsClose(f);
WriteLnToConsole('Compiling shader: ' + 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(
AddFileLog(Trim(
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}
if glewInit() <> 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.