(*

 * 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 uStore;

interface

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

procedure initModule;

procedure freeModule;

procedure LoadFonts();

procedure StoreLoad(reload: boolean);

procedure StoreRelease(reload: boolean);

procedure RenderHealth(var Hedgehog: THedgehog);

function makeHealthBarTexture(w, h, Color: Longword): PTexture;

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 LoadHedgehogHat2(var HH: THedgehog; newHat: shortstring; allowSurfReuse: boolean);

procedure LoadDefaultClanColors(s: shortstring);

procedure InitZoom(zoom: real);

procedure SetupOpenGL;

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 MakeCrossHairs;

{$IFDEF USE_VIDEO_RECORDING}

procedure InitOffscreenOpenGL;

{$ENDIF}

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

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, uLocale, uInputHandler, adler32

    {$IFDEF USE_CONTEXT_RESTORE}, uWorld{$ENDIF};

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

var 

    squaresize : LongInt;

    numsquares : LongInt;

    ProgrTex: PTexture;

    LoadingText: PTexture;

    prevHat: shortstring;

    tmpHatSurf: PSDL_Surface;

const

    cHHFileName = 'Hedgehog';

    cCHFileName = 'Crosshair';

procedure freeTmpHatSurf();

begin

    if tmpHatSurf = nil then exit;

    SDL_FreeSurface(tmpHatSurf);

    tmpHatSurf:= nil;

    prevHat:= 'NoHat';

end;

procedure InitZoom(zoom: real);

begin

    SetScale(zoom);

    // make sure view limits are updated

    // because SetScale() doesn't do it, if zoom=cScaleFactor

    updateViewLimits();

end;

function WriteInRect(Surface: PSDL_Surface; X, Y: LongInt; Color: LongWord; Font: THWFont; s: PChar): 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, 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, s, clr);

if tmpsurf = nil then exit;

tmpsurf:= doSurfaceConversion(tmpsurf);

if tmpsurf <> nil then

begin

    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;

end;

WriteInRect:= finalRect

end;

procedure MakeCrossHairs;

var tmpsurf: PSDL_Surface;

begin

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

    CrosshairTexture:= Surface2Tex(tmpsurf, false);

    SDL_FreeSurface(tmpsurf)

end;

function makeHealthBarTexture(w, h, Color: Longword): PTexture;

var

    rr: TSDL_Rect;

    texsurf: PSDL_Surface;

begin

    rr.x:= 0;

    rr.y:= 0;

    rr.w:= w;

    rr.h:= h;

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

    if not checkFails(texsurf <> nil, errmsgCreateSurface, true) then

        checkFails(SDL_SetColorKey(texsurf, SDL_TRUE, 0) = 0, errmsgTransparentSet, true);

    if not allOK then exit(nil);

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

    rr.x:= 2;

    rr.y:= 2;

    rr.w:= w - 4;

    rr.h:= h - 4;

    DrawRoundRect(@rr, Color, Color, texsurf, false);

    makeHealthBarTexture:= Surface2Tex(texsurf, false);

    SDL_FreeSurface(texsurf);

end;

procedure WriteNames(Font: THWFont);

var t: LongInt;

    i, maxLevel: LongInt;

    r: TSDL_Rect;

    drY: LongInt;

    texsurf, flagsurf, iconsurf: PSDL_Surface;

    foundBot: boolean;

    year, month, md : word;

begin

if cOnlyStats then exit;

r.x:= 0;

r.y:= 0;

drY:= - 4;

{$IFNDEF PAS2C}

DecodeDate(Date, year, month, md);

{$ELSE}

year:= 0;

month:= 0;

md:= 0;

{$ENDIF}

for t:= 0 to Pred(TeamsCount) do

    with TeamsArray[t]^ do

        begin

        if ExtDriven then

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

        else NameTagTex:= RenderStringTex(ansistring(TeamName), Clan^.Color, Font);

        if length(Owner) > 0 then

            if ExtDriven then

                 OwnerTex:= RenderStringTexLim(ansistring(Owner), Clan^.Color, Font, cTeamHealthWidth)

            else OwnerTex:= RenderStringTex(ansistring(Owner), Clan^.Color, Font);

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

        if not checkFails(texsurf <> nil, errmsgCreateSurface, true) then

            checkFails(SDL_SetColorKey(texsurf, SDL_TRUE, 0) = 0, errmsgTransparentSet, true);

        if not allOK then exit;

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

        if not checkFails(flagsurf <> nil, 'Failed to load flag "' + Flag + '" as well as the default flag', true) then

        begin

            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;

        end;

        // 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;

        if not allOK then exit;

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

        LuaTeamValueTex := RenderStringTex(LuaTeamValue, 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

                    if ExtDriven then

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

                    else NameTagTex:= RenderStringTex(ansistring(Name), Clan^.Color, fnt16);

                    if Hat = 'NoHat' then

                        begin

                        if (month = 4) and (md = 20) then

                            Hat := 'eastertop'   // Easter

                        else if (month = 12) and ((md = 24) or (md = 25) or (md = 26)) then

                            Hat := 'Santa'       // Christmas Eve/Christmas/Boxing Day

                        else if (month = 10) and (md = 31) then

                            Hat := 'fr_pumpkin'; // Halloween/Hedgewars' birthday

                        end;

                    if (month = 4) and (md = 1) then

                        begin

                        AprilOne:= true;

                        Hat := 'fr_tomato'; // avoid promoting violence to hedgehogs. see https://hedgewars.org/node/5818

                        end;

                    if Hat <> 'NoHat' then

                        begin

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

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

                        else

                            LoadHedgehogHat2(Hedgehogs[i], Hat, true);

                        end

                    end;

        end;

    freeTmpHatSurf();

    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;

for t:= 0 to Pred(ClansCount) do

    with ClansArray[t]^ do

        HealthTex:= makeHealthBarTexture(cTeamHealthWidth + 5, Teams[0]^.NameTagTex^.h, Color);

GenericHealthTexture:= makeHealthBarTexture(cTeamHealthWidth + 5, TeamsArray[0]^.NameTagTex^.h, cWhiteColor)

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 ifColorKey);

            GraveTex:= Surface2Tex(texsurf, false);

            SDL_FreeSurface(texsurf)

            end

end;

procedure LoadFonts();

var s: shortstring;

    fi: THWFont;

begin

AddFileLog('LoadFonts();');

if (not cOnlyStats) 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);

            if SDLCheck(Handle <> nil, 'TTF_OpenFontRW', true) then exit;

            TTF_SetFontStyle(Handle, style);

            WriteLnToConsole(msgOK)

            end;

end;

procedure StoreLoad(reload: boolean);

var ii: TSprite;

    ai: TAmmoType;

    tmpsurf, tmpoverlay: PSDL_Surface;

    i, y, imflags: LongInt;

    keyConfirm, keyQuit: shortstring;

begin

AddFileLog('StoreLoad()');

if not cOnlyStats then

    begin

    MakeCrossHairs;

    LoadGraves;

{$IFDEF IPHONEOS}

    tmpHatSurf:= LoadDataImage(ptHats, 'chef', ifNone);

{$ELSE}

    tmpHatSurf:= LoadDataImage(ptHats, 'Reserved/chef', ifNone);

{$ENDIF}

    ChefHatTexture:= Surface2Tex(tmpHatSurf, true);

    freeTmpHatSurf();

    end;

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 cSnow or ((not (ii in [sprFlake, sprSDFlake]))))

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

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

           and (savesurf or (not cOnlyStats)) // in stats-only only load those which are needed later

           and allOK

            then

            begin

            if reload then

                tmpsurf:= Surface

            else

                begin

                imflags := (ifAlpha or ifColorKey);

                // these sprites are optional

                if critical then 

                    imflags := (imflags or ifCritical);

                // load the image

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

                if (tmpsurf <> nil) and checkSum then

                    for y := 0 to tmpsurf^.h-1 do

                        syncedPixelDigest:= Adler32Update(syncedPixelDigest, @PByteArray(tmpsurf^.pixels)^[y*tmpsurf^.pitch], tmpsurf^.w*4)

                end;

            if tmpsurf <> nil then

                begin

                if getImageDimensions then

                    begin

                    imageWidth:= tmpsurf^.w;

                    imageHeight:= tmpsurf^.h

                    end;

                if getDimensions then

                    if Height = -1 then //BlueWater

                        begin

                        Width:= tmpsurf^.w;

                        Height:= tmpsurf^.h div watFrames;

                        end

                    else if Height = -2 then //SDWater

                        begin

                        Width:= tmpsurf^.w;

                        Height:= tmpsurf^.h div watSDFrames;

                        end

                    else

                        begin

                        Width:= tmpsurf^.w;

                        Height:= tmpsurf^.h

                        end;

                if (ii in [sprAMAmmos, sprAMAmmosBW]) then

                    begin

                    tmpoverlay := LoadDataImage(Path, copy(FileName, 1, length(FileName)-5), (imflags and (not ifCritical)));

                    if tmpoverlay <> nil then

                        begin

                        copyToXY(tmpoverlay, tmpsurf, 0, 0);

                        SDL_FreeSurface(tmpoverlay)

                        end

                    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.