(*

 * Hedgewars, a free turn based strategy game

 * Copyright (c) 2004-2014 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 DrawLine              (X0, Y0, X1, Y1, Width: Single; color: LongWord); inline;

procedure DrawLine              (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           ();

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;

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 RenderSetup();

// TODO everything below this should not need a public interface

procedure CreateFramebuffer(var frame, depth, tex: GLuint);

procedure DeleteFramebuffer(var frame, depth, tex: GLuint);

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 openglLoadIdentity    (); inline;

procedure openglTranslProjMatrix(X, Y, Z: GLFloat); inline;

procedure openglPushMatrix      (); inline;

procedure openglPopMatrix       (); inline;

procedure openglTranslatef      (X, Y, Z: GLfloat); inline;

procedure openglScalef          (ScaleX, ScaleY, ScaleZ: GLfloat); inline;

procedure openglRotatef         (RotX, RotY, RotZ: GLfloat; dir: LongInt); inline;

procedure openglTint            (r, g, b, a: Byte); inline;

implementation

uses {$IFNDEF PAS2C} StrUtils, {$ENDIF}SysUtils, uVariables, uUtils, uConsts

     {$IFDEF GL2}, uMatrix, uConsole{$ENDIF}

     {$IF NOT DEFINED(SDL2) AND DEFINED(USE_VIDEO_RECORDING)}, glut {$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}

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;

procedure RenderSetClearColor(r, g, b, a: real);

begin

    glClearColor(r, g, b, a);

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;

begin

//TODO: pas2c does not handle {$IF (GLunit = gles11) OR DEFINED(PAS2C)}

{$IFNDEF PAS2C}

{$IF GLunit = gles11}

    // FreePascal doesnt come with OpenGL ES 1.1 Extension headers

    extension:= extension; // avoid hint

    glLoadExtension:= false;

    AddFileLog('OpenGL - "' + extension + '" skipped')

{$ELSE}

    glLoadExtension:= glext_LoadExtension(extension);

    if glLoadExtension then

        AddFileLog('OpenGL - "' + extension + '" loaded')

    else

        AddFileLog('OpenGL - "' + extension + '" failed to load');

{$ENDIF}

{$ELSE} // pas2c part

    glLoadExtension:= false;

{$ENDIF}

end;

{$IF DEFINED(USE_S3D_RENDERING) OR DEFINED(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_RGBA8,  cScreenWidth, cScreenHeight, 0, GL_RGBA, 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 RenderSetup();

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}

{$IFNDEF USE_S3D_RENDERING}

    if (cStereoMode = smHorizontal) or (cStereoMode = smVertical) or (cStereoMode = smAFR) 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;

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