(*

 * 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 DrawSpritePivotedF(Sprite: TSprite; X, Y, Frame, Dir, PivotX, PivotY: 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 DrawLineWrapped       (X0, Y0, X1, Y1, Width: Single; goesLeft: boolean; Wraps: LongWord; color: LongWord); inline;

procedure DrawLineWrapped       (X0, Y0, X1, Y1, Width: Single; goesLeft: boolean; Wraps: LongWord; 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);

procedure Tint                  (c: Longword); inline;

procedure untint(); inline;

procedure setTintAdd            (enable: boolean); inline;

// call this to finish the rendering of current frame

procedure FinishRender();

function isAreaOffscreen(X, Y, Width, Height: LongInt): boolean; inline;

function isCircleOffscreen(X, Y, RadiusSquared: 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

     {$IFDEF GL2}, uMatrix, uConsole, uPhysFSLayer, uDebug{$ENDIF}, uConsts;

{$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;

{$IFNDEF GL2}

    LastColorPointer , LastTexCoordPointer , LastVertexPointer : Pointer;

{$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 isCircleOffscreen(X, Y, RadiusSquared: LongInt): boolean; inline;

var dRightX, dBottomY, dLeftX, dTopY: LongInt;

begin

    dRightX:= (X - ViewRightX);

    dBottomY:= (Y - ViewBottomY);

    dLeftX:= (ViewLeftX - X);

    dTopY:= (ViewTopY - Y);

    isCircleOffscreen:= 

        ((dRightX > 0) and (sqr(dRightX) > RadiusSquared)) or

        ((dBottomY > 0) and (sqr(dBottomY) > RadiusSquared)) or

        ((dLeftX > 0) and (sqr(dLeftX) > RadiusSquared)) or

        ((dTopY > 0) and (sqr(dTopY) > RadiusSquared))

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;