(*

 * Hedgewars, a free turn based strategy game

 * Copyright (c) 2004-2013 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA

 *)

{$INCLUDE "options.inc"}

{$IF GLunit = GL}{$DEFINE GLunit:=GL,GLext}{$ENDIF}

unit uStore;

interface

uses StrUtils, SysUtils, uConsts, SDLh, GLunit, uTypes, uLandTexture, uCaptions, uChat;

procedure initModule;

procedure freeModule;

procedure StoreLoad(reload: boolean);

procedure StoreRelease(reload: boolean);

procedure RenderHealth(var Hedgehog: THedgehog);

procedure AddProgress;

procedure FinishProgress;

function  LoadImage(const filename: shortstring; imageFlags: LongInt): PSDL_Surface;

// loads an image from the games data files

function  LoadDataImage(const path: TPathType; const filename: shortstring; imageFlags: LongInt): PSDL_Surface;

// like LoadDataImage but uses altPath as fallback-path if file not found/loadable in path

function  LoadDataImageAltPath(const path, altPath: TPathType; const filename: shortstring; imageFlags: LongInt): PSDL_Surface;

// like LoadDataImage but uses altFile as fallback-filename if file cannot be loaded

function  LoadDataImageAltFile(const path: TPathType; const filename, altFile: shortstring; imageFlags: LongInt): PSDL_Surface;

procedure LoadHedgehogHat(var HH: THedgehog; newHat: shortstring);

procedure SetupOpenGL;

procedure SetScale(f: GLfloat);

function  RenderHelpWindow(caption, subcaption, description, extra: ansistring; extracolor: LongInt; iconsurf: PSDL_Surface; iconrect: PSDL_Rect): PTexture;

procedure RenderWeaponTooltip(atype: TAmmoType);

procedure ShowWeaponTooltip(x, y: LongInt);

procedure FreeWeaponTooltip;

procedure MakeCrossHairs;

{$IFDEF USE_VIDEO_RECORDING}

procedure InitOffscreenOpenGL;

{$ENDIF}

{$IFDEF SDL2}

procedure WarpMouse(x, y: Word); inline;

{$ENDIF}

procedure SwapBuffers; {$IFDEF USE_VIDEO_RECORDING}cdecl{$ELSE}inline{$ENDIF};

procedure SetSkyColor(r, g, b: real);

implementation

uses uMisc, uConsole, uVariables, uUtils, uTextures, uRender, uRenderUtils, uCommands

    , uPhysFSLayer

    , uDebug

    {$IFDEF USE_CONTEXT_RESTORE}, uWorld{$ENDIF}

    {$IF NOT DEFINED(SDL2) AND DEFINED(USE_VIDEO_RECORDING)}, glut {$ENDIF};

//type TGPUVendor = (gvUnknown, gvNVIDIA, gvATI, gvIntel, gvApple);

var MaxTextureSize: LongInt;

{$IFDEF SDL2}

    SDLwindow: PSDL_Window;

    SDLGLcontext: PSDL_GLContext;

{$ELSE}

    SDLPrimSurface: PSDL_Surface;

{$ENDIF}

    squaresize : LongInt;

    numsquares : LongInt;

    ProgrTex: PTexture;

const

    cHHFileName = 'Hedgehog';

    cCHFileName = 'Crosshair';

function WriteInRect(Surface: PSDL_Surface; X, Y: LongInt; Color: LongWord; Font: THWFont; s: ansistring): TSDL_Rect;

var w, h: LongInt;

    tmpsurf: PSDL_Surface;

    clr: TSDL_Color;

    finalRect: TSDL_Rect;

begin

w:= 0; h:= 0; // avoid compiler hints

TTF_SizeUTF8(Fontz[Font].Handle, Str2PChar(s), @w, @h);

finalRect.x:= X + cFontBorder + 2;

finalRect.y:= Y + cFontBorder;

finalRect.w:= w + cFontBorder * 2 + 4;

finalRect.h:= h + cFontBorder * 2;

clr.r:= Color shr 16;

clr.g:= (Color shr 8) and $FF;

clr.b:= Color and $FF;

tmpsurf:= TTF_RenderUTF8_Blended(Fontz[Font].Handle, Str2PChar(s), clr);

tmpsurf:= doSurfaceConversion(tmpsurf);

SDLTry(tmpsurf <> nil, true);

SDL_UpperBlit(tmpsurf, nil, Surface, @finalRect);

SDL_FreeSurface(tmpsurf);

finalRect.x:= X;

finalRect.y:= Y;

finalRect.w:= w + cFontBorder * 2 + 4;

finalRect.h:= h + cFontBorder * 2;

WriteInRect:= finalRect

end;

procedure MakeCrossHairs;

var t: LongInt;

    tmpsurf, texsurf: PSDL_Surface;

    Color, i: Longword;

begin

tmpsurf:= LoadDataImage(ptGraphics, cCHFileName, ifAlpha or ifCritical);

for t:= 0 to Pred(TeamsCount) do

    with TeamsArray[t]^ do

    begin

    texsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, tmpsurf^.w, tmpsurf^.h, 32, RMask, GMask, BMask, AMask);

    TryDo(texsurf <> nil, errmsgCreateSurface, true);

    Color:= Clan^.Color;

    Color:= SDL_MapRGB(texsurf^.format, Color shr 16, Color shr 8, Color and $FF);

    SDL_FillRect(texsurf, nil, Color);

    SDL_UpperBlit(tmpsurf, nil, texsurf, nil);

    TryDo(tmpsurf^.format^.BytesPerPixel = 4, 'Ooops', true);

    if SDL_MustLock(texsurf) then

        SDLTry(SDL_LockSurface(texsurf) >= 0, true);

    // make black pixel be alpha-transparent

    for i:= 0 to texsurf^.w * texsurf^.h - 1 do

        if PLongwordArray(texsurf^.pixels)^[i] = AMask then

            PLongwordArray(texsurf^.pixels)^[i]:= (RMask or GMask or BMask) and Color;

    if SDL_MustLock(texsurf) then

        SDL_UnlockSurface(texsurf);

    FreeTexture(CrosshairTex);

    CrosshairTex:= Surface2Tex(texsurf, false);

    SDL_FreeSurface(texsurf)

    end;

SDL_FreeSurface(tmpsurf)

end;

procedure WriteNames(Font: THWFont);

var t: LongInt;

    i, maxLevel: LongInt;

    r, rr: TSDL_Rect;

    drY: LongInt;

    texsurf, flagsurf, iconsurf: PSDL_Surface;

    foundBot: boolean;

begin

    if cOnlyStats then exit;

r.x:= 0;

r.y:= 0;

drY:= - 4;

for t:= 0 to Pred(TeamsCount) do

    with TeamsArray[t]^ do

        begin

        NameTagTex:= RenderStringTexLim(TeamName, Clan^.Color, Font, cTeamHealthWidth);

        r.w:= cTeamHealthWidth + 5;

        r.h:= NameTagTex^.h;

        texsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, r.w, r.h, 32, RMask, GMask, BMask, AMask);

        TryDo(texsurf <> nil, errmsgCreateSurface, true);

        TryDo(SDL_SetColorKey(texsurf, SDL_SRCCOLORKEY, 0) = 0, errmsgTransparentSet, true);

        DrawRoundRect(@r, cWhiteColor, cNearBlackColor, texsurf, true);

        rr:= r;

        inc(rr.x, 2); dec(rr.w, 4); inc(rr.y, 2); dec(rr.h, 4);

        DrawRoundRect(@rr, Clan^.Color, Clan^.Color, texsurf, false);

        HealthTex:= Surface2Tex(texsurf, false);

        SDL_FreeSurface(texsurf);

        r.x:= 0;

        r.y:= 0;

        r.w:= 32;

        r.h:= 32;

        texsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, r.w, r.h, 32, RMask, GMask, BMask, AMask);

        TryDo(texsurf <> nil, errmsgCreateSurface, true);

        TryDo(SDL_SetColorKey(texsurf, SDL_SRCCOLORKEY, 0) = 0, errmsgTransparentSet, true);

        r.w:= 26;

        r.h:= 19;

        DrawRoundRect(@r, cWhiteColor, cNearBlackColor, texsurf, true);

        // overwrite flag for cpu teams and keep players from using it

        foundBot:= false;

        maxLevel:= -1;

        for i:= 0 to cMaxHHIndex do

            with Hedgehogs[i] do

                if (Gear <> nil) and (BotLevel > 0) then

                    begin

                    foundBot:= true;

                    // initially was going to do the highest botlevel of the team, but for now, just apply if entire team has same bot level

                    if maxLevel = -1 then maxLevel:= BotLevel

                    else if (maxLevel > 0) and (maxLevel <> BotLevel) then maxLevel:= 0;

                    //if (maxLevel > 0) and (BotLevel < maxLevel) then maxLevel:= BotLevel

                    end

                else if Gear <> nil then  maxLevel:= 0;

        if foundBot then

            begin

            // disabled the plain flag - I think it looks ok even w/ full bars obscuring CPU

            //if (maxLevel > 0) and (maxLevel < 3) then Flag:= 'cpu_plain' else

            Flag:= 'cpu'

            end

        else if (Flag = 'cpu') or (Flag = 'cpu_plain') then

                Flag:= 'hedgewars';

        flagsurf:= LoadDataImageAltFile(ptFlags, Flag, 'hedgewars', ifNone);

        TryDo(flagsurf <> nil, 'Failed to load flag "' + Flag + '" as well as the default flag', true);

        case maxLevel of

            1: copyToXY(SpritesData[sprBotlevels].Surface, flagsurf, 0, 0);

            2: copyToXYFromRect(SpritesData[sprBotlevels].Surface, flagsurf, 5, 2, 17, 13, 5, 2);

            3: copyToXYFromRect(SpritesData[sprBotlevels].Surface, flagsurf, 9, 5, 13, 10, 9, 5);

            4: copyToXYFromRect(SpritesData[sprBotlevels].Surface, flagsurf, 13, 9, 9, 6, 13, 9);

            5: copyToXYFromRect(SpritesData[sprBotlevels].Surface, flagsurf, 17, 11, 5, 4, 17, 11)

            end;

        copyToXY(flagsurf, texsurf, 2, 2);

        SDL_FreeSurface(flagsurf);

        flagsurf:= nil;

        // restore black border pixels inside the flag

        PLongwordArray(texsurf^.pixels)^[32 * 2 +  2]:= cNearBlackColor;

        PLongwordArray(texsurf^.pixels)^[32 * 2 + 23]:= cNearBlackColor;

        PLongwordArray(texsurf^.pixels)^[32 * 16 +  2]:= cNearBlackColor;

        PLongwordArray(texsurf^.pixels)^[32 * 16 + 23]:= cNearBlackColor;

        FlagTex:= Surface2Tex(texsurf, false);

        SDL_FreeSurface(texsurf);

        texsurf:= nil;

        AIKillsTex := RenderStringTex(inttostr(stats.AIKills), Clan^.Color, fnt16);

        dec(drY, r.h + 2);

        DrawHealthY:= drY;

        for i:= 0 to cMaxHHIndex do

            with Hedgehogs[i] do

                if Gear <> nil then

                    begin

                    NameTagTex:= RenderStringTexLim(Name, Clan^.Color, fnt16, cTeamHealthWidth);

                    if Hat <> 'NoHat' then

                        begin

                        if (Length(Hat) > 39) and (Copy(Hat,1,8) = 'Reserved') and (Copy(Hat,9,32) = PlayerHash) then

                            LoadHedgehogHat(Hedgehogs[i], 'Reserved/' + Copy(Hat,9,Length(Hat)-8))

                        else

                            LoadHedgehogHat(Hedgehogs[i], Hat);

                        end

                    end;

        end;

    MissionIcons:= LoadDataImage(ptGraphics, 'missions', ifCritical);

    iconsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, 28, 28, 32, RMask, GMask, BMask, AMask);

    if iconsurf <> nil then

        begin

        r.x:= 0;

        r.y:= 0;

        r.w:= 28;

        r.h:= 28;

        DrawRoundRect(@r, cWhiteColor, cNearBlackColor, iconsurf, true);

        ropeIconTex:= Surface2Tex(iconsurf, false);

        SDL_FreeSurface(iconsurf);

        iconsurf:= nil;

        end;

end;

procedure InitHealth;

var i, t: LongInt;

begin

for t:= 0 to Pred(TeamsCount) do

    if TeamsArray[t] <> nil then

        with TeamsArray[t]^ do

            begin

            for i:= 0 to cMaxHHIndex do

                if Hedgehogs[i].Gear <> nil then

                    RenderHealth(Hedgehogs[i]);

            end

end;

procedure LoadGraves;

var t: LongInt;

    texsurf: PSDL_Surface;

begin

for t:= 0 to Pred(TeamsCount) do

    if TeamsArray[t] <> nil then

        with TeamsArray[t]^ do

            begin

            if GraveName = '' then

                GraveName:= 'Statue';

            texsurf:= LoadDataImageAltFile(ptGraves, GraveName, 'Statue', ifCritical or ifTransparent);

            GraveTex:= Surface2Tex(texsurf, false);

            SDL_FreeSurface(texsurf)

            end

end;

procedure StoreLoad(reload: boolean);

var s: shortstring;

    ii: TSprite;

    fi: THWFont;

    ai: TAmmoType;

    tmpsurf: PSDL_Surface;

    i, imflags: LongInt;

begin

AddFileLog('StoreLoad()');

if not reload then

    for fi:= Low(THWFont) to High(THWFont) do

        with Fontz[fi] do

            begin

            s:= cPathz[ptFonts] + '/' + Name;

            WriteToConsole(msgLoading + s + ' (' + inttostr(Height) + 'pt)... ');

            Handle:= TTF_OpenFontRW(rwopsOpenRead(s), true, Height);

            SDLTry(Handle <> nil, true);

            TTF_SetFontStyle(Handle, style);

            WriteLnToConsole(msgOK)

            end;

MakeCrossHairs;

LoadGraves;

if not reload then

    AddProgress;

for ii:= Low(TSprite) to High(TSprite) do

    with SpritesData[ii] do

        // FIXME - add a sprite attribute to match on rq flags?

        if (((cReducedQuality and (rqNoBackground or rqLowRes)) = 0) or   // why rqLowRes?

                (not (ii in [sprSky, sprSkyL, sprSkyR, sprHorizont, sprHorizontL, sprHorizontR]))) and

           (((cReducedQuality and rqPlainSplash) = 0) or ((not (ii in [sprSplash, sprDroplet, sprSDSplash, sprSDDroplet])))) and

           (((cReducedQuality and rqKillFlakes) = 0) or (Theme = 'Snow') or (Theme = 'Christmas') or ((not (ii in [sprFlake, sprSDFlake])))) and

           ((cCloudsNumber > 0) or (ii <> sprCloud)) and

           ((vobCount > 0) or (ii <> sprFlake)) then

            begin

            if reload then

                tmpsurf:= Surface

            else

                begin

                imflags := (ifAlpha or ifTransparent);

                // these sprites are optional

                if not (ii in [sprHorizont, sprHorizontL, sprHorizontR, sprSky, sprSkyL, sprSkyR, sprChunk]) then // FIXME: hack

                    imflags := (imflags or ifCritical);

                // load the image

                tmpsurf := LoadDataImageAltPath(Path, AltPath, FileName, imflags)

                end;

            if tmpsurf <> nil then

                begin

                if getImageDimensions then

                    begin

                    imageWidth:= tmpsurf^.w;

                    imageHeight:= tmpsurf^.h

                    end;

                if getDimensions then

                    begin

                    Width:= tmpsurf^.w;

                    Height:= tmpsurf^.h

                    end;

                if (ii in [sprSky, sprSkyL, sprSkyR, sprHorizont, sprHorizontL, sprHorizontR]) then

                    begin

                    Texture:= Surface2Tex(tmpsurf, true);

                    Texture^.Scale:= 2

                    end

                else

                    begin

                    Texture:= Surface2Tex(tmpsurf, false);

                    // HACK: We should include some sprite attribute to define the texture wrap directions

                    if ((ii = sprWater) or (ii = sprSDWater)) and ((cReducedQuality and (rq2DWater or rqClampLess)) = 0) then

                        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);

                    end;

                glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_PRIORITY, priority);

// This should maybe be flagged. It wastes quite a bit of memory.

                if not reload then

                    begin

{$IFDEF USE_CONTEXT_RESTORE}

                    Surface:= tmpsurf

{$ELSE}

                    if saveSurf then

                        Surface:= tmpsurf

                    else

                        SDL_FreeSurface(tmpsurf)

{$ENDIF}

                    end

                end

            else

                Surface:= nil

        end;

WriteNames(fnt16);

if not reload then

    AddProgress;

tmpsurf:= LoadDataImage(ptGraphics, cHHFileName, ifAlpha or ifCritical or ifTransparent);

HHTexture:= Surface2Tex(tmpsurf, false);

SDL_FreeSurface(tmpsurf);

InitHealth;

PauseTexture:= RenderStringTex(trmsg[sidPaused], cYellowColor, fntBig);

ConfirmTexture:= RenderStringTex(trmsg[sidConfirm], cYellowColor, fntBig);

SyncTexture:= RenderStringTex(trmsg[sidSync], cYellowColor, fntBig);

if not reload then

    AddProgress;

// name of weapons in ammo menu

for ai:= Low(TAmmoType) to High(TAmmoType) do

    with Ammoz[ai] do

        begin

        TryDo(trAmmo[NameId] <> '','No default text/translation found for ammo type #' + intToStr(ord(ai)) + '!',true);

        tmpsurf:= TTF_RenderUTF8_Blended(Fontz[CheckCJKFont(trAmmo[NameId],fnt16)].Handle, Str2PChar(trAmmo[NameId]), cWhiteColorChannels);

        TryDo(tmpsurf <> nil,'Name-texture creation for ammo type #' + intToStr(ord(ai)) + ' failed!',true);

        tmpsurf:= doSurfaceConversion(tmpsurf);

        FreeTexture(NameTex);

        NameTex:= Surface2Tex(tmpsurf, false);

        SDL_FreeSurface(tmpsurf)

        end;

// number of weapons in ammo menu

for i:= Low(CountTexz) to High(CountTexz) do

    begin

    tmpsurf:= TTF_RenderUTF8_Blended(Fontz[fnt16].Handle, Str2PChar(IntToStr(i) + 'x'), cWhiteColorChannels);

    tmpsurf:= doSurfaceConversion(tmpsurf);

    FreeTexture(CountTexz[i]);

    CountTexz[i]:= Surface2Tex(tmpsurf, false);

    SDL_FreeSurface(tmpsurf)

    end;

if not reload then

    AddProgress;

IMG_Quit();

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 StoreRelease(reload: boolean);

var ii: TSprite;

    ai: TAmmoType;

    i, t: LongInt;

begin

for ii:= Low(TSprite) to High(TSprite) do