(*

 * Hedgewars, a free turn based strategy game

 * Copyright (c) 2004-2008 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"}

unit uStore;

interface

uses sysutils, uConsts, SDLh, GLunit, uTypes;

procedure initModule;

procedure freeModule;

procedure StoreLoad;

procedure StoreRelease;

procedure RenderHealth(var Hedgehog: THedgehog);

procedure AddProgress;

procedure FinishProgress;

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

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;

implementation

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

var MaxTextureSize: LongInt;

    cGPUVendor: TGPUVendor;

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 + FontBorder + 2;

finalRect.y:= Y + FontBorder;

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

finalRect.h:= h + FontBorder * 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 + FontBorder * 2 + 4;

finalRect.h:= h + FontBorder * 2;

WriteInRect:= finalRect

end;

procedure StoreLoad;

var s: shortstring;

    procedure WriteNames(Font: THWFont);

    var t: LongInt;

        i: LongInt;

        r, rr: TSDL_Rect;

        drY: LongInt;

        texsurf, flagsurf, iconsurf: PSDL_Surface;

    begin

    r.x:= 0;

    r.y:= 0;

    drY:= - 4;

    for t:= 0 to Pred(TeamsCount) do

        with TeamsArray[t]^ do

        begin

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

        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, cNearBlackColorChannels.value, 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

        if (Hedgehogs[0].Gear <> nil) and (Hedgehogs[0].BotLevel > 0) then

            Flag:= 'cpu'

        else if Flag = 'cpu' then

            Flag:= 'hedgewars';

        flagsurf:= LoadImage(Pathz[ptFlags] + '/' + Flag, ifNone);

        if flagsurf = nil then

            flagsurf:= LoadImage(Pathz[ptFlags] + '/hedgewars', ifNone);

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

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

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

        dec(drY, r.h + 2);

        DrawHealthY:= drY;

        for i:= 0 to 7 do

            with Hedgehogs[i] do

                if Gear <> nil then

                    begin

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

                    if Hat <> 'NoHat' then

                        begin

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

                            texsurf:= LoadImage(Pathz[ptHats] + '/Reserved/' + Copy(Hat,9,Length(s)-8), ifNone)

                        else

                            texsurf:= LoadImage(Pathz[ptHats] + '/' + Hat, ifNone);

                        if texsurf <> nil then

                            begin

                            HatTex:= Surface2Tex(texsurf, true);

                            SDL_FreeSurface(texsurf)

                            end;

                        texsurf:= nil;

                        end

                    end;

        end;

    MissionIcons:= LoadImage(Pathz[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 MakeCrossHairs;

    var t: LongInt;

        tmpsurf, texsurf: PSDL_Surface;

        Color, i: Longword;

    begin

    s:= Pathz[ptGraphics] + '/' + cCHFileName;

    tmpsurf:= LoadImage(s, 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);

        CrosshairTex:= Surface2Tex(texsurf, false);

        SDL_FreeSurface(texsurf)

        end;

    SDL_FreeSurface(tmpsurf)

    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:= LoadImage(Pathz[ptGraves] + '/' + GraveName, ifTransparent);

            if texsurf = nil then texsurf:= LoadImage(Pathz[ptGraves] + '/Statue', ifCritical or ifTransparent);

            GraveTex:= Surface2Tex(texsurf, false);

            SDL_FreeSurface(texsurf)

            end

    end;

var ii: TSprite;

    fi: THWFont;

    ai: TAmmoType;

    tmpsurf: PSDL_Surface;

    i: LongInt;

begin

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

    with Fontz[fi] do

        begin

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

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

        Handle:= TTF_OpenFont(Str2PChar(s), Height);

        SDLTry(Handle <> nil, true);

        TTF_SetFontStyle(Handle, style);

        WriteLnToConsole(msgOK)

        end;

WriteNames(fnt16);

MakeCrossHairs;

LoadGraves;

AddProgress;

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

    with SpritesData[ii] do

        // FIXME - add a sprite attribute

        if ((cReducedQuality and rqNoBackground) = 0) or (not (ii in [sprSky, sprSkyL, sprSkyR, sprHorizont, sprHorizontL, sprHorizontR, sprFlake, sprSplash, sprDroplet])) then // FIXME: hack

        begin

            if AltPath = ptNone then

                if ii in [sprHorizontL, sprHorizontR, sprSkyL, sprSkyR] then // FIXME: hack

                    tmpsurf:= LoadImage(Pathz[Path] + '/' + FileName, ifAlpha or ifTransparent)

                else

                    tmpsurf:= LoadImage(Pathz[Path] + '/' + FileName, ifAlpha or ifTransparent or ifCritical)

            else begin

                tmpsurf:= LoadImage(Pathz[Path] + '/' + FileName, ifAlpha or ifTransparent);

                if tmpsurf = nil then

                    tmpsurf:= LoadImage(Pathz[AltPath] + '/' + FileName, ifAlpha or ifCritical or ifTransparent);

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

                    if (ii = sprWater) and ((cReducedQuality and (rq2DWater or rqClampLess)) = 0) then // HACK: We should include some sprite attribute to define the texture wrap directions

                        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);

                end;

                glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_PRIORITY, priority);

                if saveSurf then

                    Surface:= tmpsurf else SDL_FreeSurface(tmpsurf)

                end

            else

                Surface:= nil

        end;

AddProgress;

tmpsurf:= LoadImage(Pathz[ptGraphics] + '/' + cHHFileName, ifAlpha or ifCritical or ifTransparent);

HHTexture:= Surface2Tex(tmpsurf, false);

SDL_FreeSurface(tmpsurf);

InitHealth;

// TODO: are those textures ever freed?

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

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

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

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

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

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

    SDL_FreeSurface(tmpsurf)

end;

AddProgress;

{$IFDEF SDL_IMAGE_NEWER}

IMG_Quit();

{$ENDIF}

end;

procedure StoreRelease;

var ii: TSprite;

begin

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

    begin

        FreeTexture(SpritesData[ii].Texture);

        SpritesData[ii].Texture:= nil;

        if SpritesData[ii].Surface <> nil then

            SDL_FreeSurface(SpritesData[ii].Surface);

        SpritesData[ii].Surface:= nil;

    end;

    SDL_FreeSurface(MissionIcons);

    FreeTexture(ropeIconTex);

    FreeTexture(HHTexture);

end;

procedure RenderHealth(var Hedgehog: THedgehog);

var s: shortstring;

begin

    str(Hedgehog.Gear^.Health, s);

    if Hedgehog.HealthTagTex <> nil then

        FreeTexture(Hedgehog.HealthTagTex);

    Hedgehog.HealthTagTex:= RenderStringTex(s, Hedgehog.Team^.Clan^.Color, fnt16)

end;

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

var tmpsurf: PSDL_Surface;

    s: shortstring;

begin

    WriteToConsole(msgLoading + filename + '.png [flags: ' + inttostr(imageFlags) + ']');

    s:= filename + '.png';

    tmpsurf:= IMG_Load(Str2PChar(s));

    if tmpsurf = nil then

    begin

        OutError(msgFailed, (imageFlags and ifCritical) <> 0);

        exit(nil)

    end;

    if ((imageFlags and ifIgnoreCaps) = 0) and ((tmpsurf^.w > MaxTextureSize) or (tmpsurf^.h > MaxTextureSize)) then

    begin

        SDL_FreeSurface(tmpsurf);

        OutError(msgFailedSize, (imageFlags and ifCritical) <> 0);

        // dummy surface to replace non-critical textures that failed to load due to their size

        exit(SDL_CreateRGBSurface(SDL_SWSURFACE, 2, 2, 32, RMask, GMask, BMask, AMask));

    end;

    tmpsurf:= doSurfaceConversion(tmpsurf);

    if (imageFlags and ifTransparent) <> 0 then

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

    WriteLnToConsole(msgOK + ' (' + inttostr(tmpsurf^.w) + 'x' + inttostr(tmpsurf^.h) + ')');

    LoadImage:= tmpsurf //Result

end;

function glLoadExtension(extension : shortstring) : boolean;

begin

{$IFDEF IPHONEOS}

    extension:= extension; // avoid hint

    glLoadExtension:= false;

{$IFDEF DEBUGFILE}

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

{$ENDIF}

{$ELSE}

    glLoadExtension:= glext_LoadExtension(extension);

{$IFDEF DEBUGFILE}

    if not glLoadExtension then

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

    else

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

{$ENDIF}

{$ENDIF}

end;

procedure SetupOpenGL;

{$IFNDEF IPHONEOS}

var vendor: shortstring;

{$IFDEF DARWIN}

    one: LongInt;

{$ENDIF}

{$ENDIF}

begin

{$IFDEF IPHONEOS}

    SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 0); // no double buffering

    SDL_GL_SetAttribute(SDL_GL_RETAINED_BACKING, 1);

{$ELSE}

    SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);

    vendor:= LowerCase(shortstring(pchar(glGetString(GL_VENDOR))));

{$IFNDEF SDL13}

// this attribute is default in 1.3 and must be enabled in MacOSX

    if (cReducedQuality and rqDesyncVBlank) <> 0 then

        SDL_GL_SetAttribute(SDL_GL_SWAP_CONTROL, 0)

    else

        SDL_GL_SetAttribute(SDL_GL_SWAP_CONTROL, 1);

{$IFDEF DARWIN}

// fixes vsync in Snow Leopard

    one:= 1;

    CGLSetParameter(CGLGetCurrentContext(), 222, @one);

{$ENDIF}

{$ENDIF}

{$ENDIF}

    SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 0); // no depth buffer

    SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5);

    SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 6);

    SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5);

    SDL_GL_SetAttribute(SDL_GL_ALPHA_SIZE, 0); // no alpha channel required

    SDL_GL_SetAttribute(SDL_GL_BUFFER_SIZE, 16); // buffer has to be 16 bit only

    SDL_GL_SetAttribute(SDL_GL_ACCELERATED_VISUAL, 1); // try to prefer hardware rendering

    glGetIntegerv(GL_MAX_TEXTURE_SIZE, @MaxTextureSize);

{$IFDEF DEBUGFILE}