(*
 * Hedgewars, a worms-like game
 * Copyright (c) 2004-2007 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
 *)

unit uStore;
interface
uses uConsts, uTeams, SDLh, uFloat, GL;
{$INCLUDE options.inc}

procedure StoreInit;
procedure StoreLoad;
procedure StoreRelease;
procedure DrawSpriteFromRect(Sprite: TSprite; r: TSDL_Rect; X, Y, Height, Position: LongInt; Surface: PSDL_Surface);
procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt; Surface: PSDL_Surface);
procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: LongInt; Surface: PSDL_Surface);
procedure DrawSurfSprite(X, Y, Height, Frame: LongInt; Source: PTexture; Surface: PSDL_Surface);
procedure DrawLand (X, Y: LongInt);
procedure DrawTexture(X, Y: LongInt; Texture: PTexture);
procedure DXOutText(X, Y: LongInt; Font: THWFont; s: string; Surface: PSDL_Surface);
procedure DrawCentered(X, Top: LongInt; Source: PTexture);
procedure DrawFromRect(X, Y: LongInt; r: PSDL_Rect; SourceTexture: PTexture; DestSurface: PSDL_Surface);
procedure DrawHedgehog(X, Y: LongInt; Dir: LongInt; Pos, Step: LongWord; Surface: PSDL_Surface);
function  RenderStringTex(s: string; Color: Longword; font: THWFont): PTexture;
procedure RenderHealth(var Hedgehog: THedgehog);
procedure AddProgress;
procedure FinishProgress;
function  LoadImage(const filename: string; hasAlpha, critical, setTransparent: boolean): PSDL_Surface;
procedure SetupOpenGL;

var PixelFormat: PSDL_PixelFormat;
 SDLPrimSurface: PSDL_Surface;
   PauseTexture: PTexture;

implementation
uses uMisc, uConsole, uLand, uLocale, GLU;

var
    HHTexture: PTexture;

procedure StoreInit;
begin

end;

procedure DrawRoundRect(rect: PSDL_Rect; BorderColor, FillColor: Longword; Surface: PSDL_Surface; Clear: boolean);
var r: TSDL_Rect;
begin
r:= rect^;
if Clear then SDL_FillRect(Surface, @r, 0);

BorderColor:= SDL_MapRGB(Surface^.format, BorderColor shr 16, BorderColor shr 8, BorderColor and $FF);
FillColor:= SDL_MapRGB(Surface^.format, FillColor shr 16, FillColor shr 8, FillColor and $FF);

r.y:= rect^.y + 1;
r.h:= rect^.h - 2;
SDL_FillRect(Surface, @r, BorderColor);
r.x:= rect^.x + 1;
r.w:= rect^.w - 2;
r.y:= rect^.y;
r.h:= rect^.h;
SDL_FillRect(Surface, @r, BorderColor);
r.x:= rect^.x + 2;
r.y:= rect^.y + 1;
r.w:= rect^.w - 4;
r.h:= rect^.h - 2;
SDL_FillRect(Surface, @r, FillColor);
r.x:= rect^.x + 1;
r.y:= rect^.y + 2;
r.w:= rect^.w - 2;
r.h:= rect^.h - 4;
SDL_FillRect(Surface, @r, FillColor)
end;

function WriteInRoundRect(Surface: PSDL_Surface; X, Y: LongInt; Color: LongWord; Font: THWFont; s: string): TSDL_Rect;
var w, h: LongInt;
    tmpsurf: PSDL_Surface;
    clr: TSDL_Color;
    Result: TSDL_Rect;
begin
TTF_SizeUTF8(Fontz[Font].Handle, Str2PChar(s), w, h);
Result.x:= X;
Result.y:= Y;
Result.w:= w + FontBorder * 2 + 4;
Result.h:= h + FontBorder * 2;
DrawRoundRect(@Result, cWhiteColor, cColorNearBlack, Surface, true);
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.value);
Result.x:= X + FontBorder + 2;
Result.y:= Y + FontBorder;
SDLTry(tmpsurf <> nil, true);
SDL_UpperBlit(tmpsurf, nil, Surface, @Result);
SDL_FreeSurface(tmpsurf);
Result.x:= X;
Result.y:= Y;
Result.w:= w + FontBorder * 2 + 4;
Result.h:= h + FontBorder * 2;
WriteInRoundRect:= Result
end;

procedure StoreLoad;
var ii: TSprite;
    fi: THWFont;
    s: string;
    tmpsurf: PSDL_Surface;

    procedure WriteNames(Font: THWFont);
    var t: LongInt;
        i: LongInt;
        r, rr: TSDL_Rect;
        drY: LongInt;
        texsurf: PSDL_Surface;
    begin
    r.x:= 0;
    r.y:= 0;
    drY:= cScreenHeight - 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, cColorNearBlack, 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);
      SDL_FreeSurface(texsurf);

      dec(drY, r.h + 2);
      DrawHealthY:= drY;
      for i:= 0 to 7 do
          with Hedgehogs[i] do
               if Gear <> nil then
                  NameTagTex:= RenderStringTex(Name, Clan^.Color, fnt16);
      end;
    end;

    procedure MakeCrossHairs;
    var t: LongInt;
        tmpsurf, texsurf: PSDL_Surface;
        s: string;
        Color: Longword;
    begin
    s:= Pathz[ptGraphics] + '/' + cCHFileName;
    tmpsurf:= LoadImage(s, true, true, false);

    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(SDL_SetColorKey(texsurf, SDL_SRCCOLORKEY, 0) = 0, errmsgTransparentSet, true);

      CrosshairTex:= Surface2Tex(texsurf);
      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:= 'Simple';
          texsurf:= LoadImage(Pathz[ptGraves] + '/' + GraveName, false, true, true);
          GraveTex:= Surface2Tex(texsurf);
          SDL_FreeSurface(texsurf)
          end
    end;

    procedure GetSkyColor;
//    var p: PByteArray;
    begin
(*    if SDL_MustLock(SpritesData[sprSky].Surface) then
       SDLTry(SDL_LockSurface(SpritesData[sprSky].Surface) >= 0, true);
    p:= SpritesData[sprSky].Surface^.pixels;
    case SpritesData[sprSky].Surface^.format^.BytesPerPixel of
         1: cSkyColor:= PByte(p)^;
         2: cSkyColor:= PWord(p)^;
         3: cSkyColor:= (p^[0]) or (p^[1] shl 8) or (p^[2] shl 16);
         4: cSkyColor:= PLongword(p)^;
         end;*)
    cSkyColor:= $3030A0;
    glClearColor((cSkyColor shr 16) / 255, ((cSkyColor shr 8) and $FF) / 255, (cSkyColor and $FF) / 255, 0);

//    if SDL_MustLock(SpritesData[sprSky].Surface) then
//       SDL_UnlockSurface(SpritesData[sprSky].Surface)
    end;

    procedure GetExplosionBorderColor;
    var f: textfile;
        c: LongInt;
    begin
    s:= Pathz[ptCurrTheme] + '/' + cThemeCFGFilename;
    WriteToConsole(msgLoading + s + ' ');
    Assign(f, s);
    {$I-}
    Reset(f);
    Readln(f, s);
    Close(f);
    {$I+}
    TryDo(IOResult = 0, msgFailed, true);
    WriteLnToConsole(msgOK);
    val(s, cExplosionBorderColor, c);
    TryDo(c = 0, 'Theme data corrupted', true);
    cExplosionBorderColor:= (cExplosionBorderColor shr 16) or
                            (cExplosionBorderColor and $FF) or
                            (cExplosionBorderColor shl 16) or
                            $FF000000
    end;

begin
for fi:= Low(THWFont) to High(THWFont) do
    with Fontz[fi] do
         begin
         s:= Pathz[ptFonts] + '/' + Name;
         WriteToConsole(msgLoading + s + '... ');
         Handle:= TTF_OpenFont(Str2PChar(s), Height);
         SDLTry(Handle <> nil, true);
         TTF_SetFontStyle(Handle, style);
         WriteLnToConsole(msgOK)
         end;
AddProgress;

GetExplosionBorderColor;

AddProgress;
WriteNames(fnt16);
MakeCrossHairs;
LoadGraves;

AddProgress;
for ii:= Low(TSprite) to High(TSprite) do
    with SpritesData[ii] do
         begin
         if AltPath = ptNone then
            tmpsurf:= LoadImage(Pathz[Path] + '/' + FileName, true, true, true)
         else begin
            tmpsurf:= LoadImage(Pathz[Path] + '/' + FileName, true, false, true);
            if tmpsurf = nil then
               tmpsurf:= LoadImage(Pathz[AltPath] + '/' + FileName, true, true, true)
            end;
         if Width = 0 then Width:= tmpsurf^.w;
         if Height = 0 then Height:= tmpsurf^.h;
         Texture:= Surface2Tex(tmpsurf);
         if saveSurf then Surface:= tmpsurf else SDL_FreeSurface(tmpsurf)
         end;

GetSkyColor;

AddProgress;

tmpsurf:= LoadImage(Pathz[ptGraphics] + '/' + cHHFileName, true, true, true);
HHTexture:= Surface2Tex(tmpsurf);
SDL_FreeSurface(tmpsurf);

InitHealth;

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

{$IFDEF DUMP}
SDL_SaveBMP_RW(LandSurface, SDL_RWFromFile('LandSurface.bmp', 'wb'), 1);
SDL_SaveBMP_RW(StoreSurface, SDL_RWFromFile('StoreSurface.bmp', 'wb'), 1);
{$ENDIF}
end;

procedure DrawFromRect(X, Y: LongInt; r: PSDL_Rect; SourceTexture: PTexture; DestSurface: PSDL_Surface);
var rr: TSDL_Rect;
    _l, _r, _t, _b: real;
begin
if SourceTexture^.h = 0 then exit;
rr.x:= X;
rr.y:= Y;
rr.w:= r^.w;
rr.h:= r^.h;

_l:= r^.x / SourceTexture^.w;
_r:= (r^.x + r^.w) / SourceTexture^.w;
_t:= r^.y / SourceTexture^.h;
_b:= (r^.y + r^.h) / SourceTexture^.h;

glBindTexture(GL_TEXTURE_2D, SourceTexture^.id);
glEnable(GL_TEXTURE_2D);

glBegin(GL_QUADS);

glTexCoord2f(_l, _t);
glVertex2i(X, Y);

glTexCoord2f(_r, _t);
glVertex2i(rr.w + X, Y);

glTexCoord2f(_r, _b);
glVertex2i(rr.w + X, rr.h + Y);

glTexCoord2f(_l, _b);
glVertex2i(X, rr.h + Y);

glEnd()
end;

procedure DrawTexture(X, Y: LongInt; Texture: PTexture);
begin
glBindTexture(GL_TEXTURE_2D, Texture^.id);
glEnable(GL_TEXTURE_2D);

glBegin(GL_QUADS);

glTexCoord2f(0, 0);
glVertex2i(X, Y);

glTexCoord2f(1, 0);
glVertex2i(Texture^.w + X, Y);

glTexCoord2f(1, 1);
glVertex2i(Texture^.w + X, Texture^.h + Y);

glTexCoord2f(0, 1);
glVertex2i(X, Texture^.h + Y);

glEnd()
end;

procedure DrawSpriteFromRect(Sprite: TSprite; r: TSDL_Rect; X, Y, Height, Position: LongInt; Surface: PSDL_Surface);
begin
r.y:= r.y + Height * Position;
r.h:= Height;
DrawFromRect(X, Y, @r, SpritesData[Sprite].Texture, Surface)
end;

procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt; Surface: PSDL_Surface);
var r: TSDL_Rect;
begin
r.x:= 0;
r.w:= SpritesData[Sprite].Width;
r.y:= Frame * SpritesData[Sprite].Height;
r.h:= SpritesData[Sprite].Height;
DrawFromRect(X, Y, @r, SpritesData[Sprite].Texture, Surface)
end;

procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: LongInt; Surface: PSDL_Surface);
var r: TSDL_Rect;
begin
r.x:= FrameX * SpritesData[Sprite].Width;
r.w:= SpritesData[Sprite].Width;
r.y:= FrameY * SpritesData[Sprite].Height;
r.h:= SpritesData[Sprite].Height;
DrawFromRect(X, Y, @r, SpritesData[Sprite].Texture, Surface)
end;

procedure DrawSurfSprite(X, Y, Height, Frame: LongInt; Source: PTexture; Surface: PSDL_Surface);
var r: TSDL_Rect;
begin
r.x:= 0;
r.w:= Source^.w;
r.y:= Frame * Height;
r.h:= Height;
DrawFromRect(X, Y, @r, Source, Surface)
end;

procedure DXOutText(X, Y: LongInt; Font: THWFont; s: string; Surface: PSDL_Surface);
var clr: TSDL_Color;
    tmpsurf: PSDL_Surface;
    r: TSDL_Rect;
begin
r.x:= X;
r.y:= Y;
clr.r:= $FF;
clr.g:= $FF;
clr.b:= $FF;
tmpsurf:= TTF_RenderUTF8_Solid(Fontz[Font].Handle, Str2PChar(s), clr.value);
if tmpsurf = nil then
   begin
   SetKB(1);
   exit
   end;
SDL_UpperBlit(tmpsurf, nil, Surface, @r);
SDL_FreeSurface(tmpsurf)
end;

procedure DrawLand(X, Y: LongInt);
begin
DrawTexture(X, Y, LandTexture)
end;

procedure DrawCentered(X, Top: LongInt; Source: PTexture);
begin
DrawTexture(X - Source^.w div 2, Top, Source)
end;

procedure DrawHedgehog(X, Y: LongInt; Dir: LongInt; Pos, Step: LongWord; Surface: PSDL_Surface);
var l, r, t, b: real;
begin

t:= Pos * 32 / HHTexture^.h;
b:= (Pos + 1) * 32 / HHTexture^.h;

if Dir = -1 then
   begin
   l:= (Step + 1) * 32 / HHTexture^.w;
   r:= Step * 32 / HHTexture^.w
   end else
   begin
   l:= Step * 32 / HHTexture^.w;
   r:= (Step + 1) * 32 / HHTexture^.w
   end;

glBindTexture(GL_TEXTURE_2D, HHTexture^.id);
glEnable(GL_TEXTURE_2D);

glBegin(GL_QUADS);

glTexCoord2f(l, t);
glVertex2i(X, Y);

glTexCoord2f(r, t);
glVertex2i(32 + X, Y);

glTexCoord2f(r, b);
glVertex2i(32 + X, 32 + Y);

glTexCoord2f(l, b);
glVertex2i(X, 32 + Y);

glEnd();

end;

procedure StoreRelease;
var ii: TSprite;
begin
for ii:= Low(TSprite) to High(TSprite) do
    begin
    FreeTexture(SpritesData[ii].Texture);
    if SpritesData[ii].Surface <> nil then SDL_FreeSurface(SpritesData[ii].Surface)
    end;

FreeTexture(HHTexture);
FreeTexture(LandTexture);

SDL_FreeSurface(LandSurface)
end;

function  RenderStringTex(s: string; Color: Longword; font: THWFont): PTexture;
var w, h: LongInt;
    Result: PSDL_Surface;
begin
TTF_SizeUTF8(Fontz[font].Handle, Str2PChar(s), w, h);
Result:= SDL_CreateRGBSurface(SDL_SWSURFACE, w + FontBorder * 2 + 4, h + FontBorder * 2,
         32, RMask, GMask, BMask, AMask);
TryDo(Result <> nil, 'RenderString: fail to create surface', true);
WriteInRoundRect(Result, 0, 0, Color, font, s);
TryDo(SDL_SetColorKey(Result, SDL_SRCCOLORKEY, 0) = 0, errmsgTransparentSet, true);
RenderStringTex:= Surface2Tex(Result);
SDL_FreeSurface(Result)
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: string; hasAlpha: boolean; critical, setTransparent: boolean): PSDL_Surface;
var tmpsurf: PSDL_Surface;
    //Result: PSDL_Surface;
    s: shortstring;
begin
WriteToConsole(msgLoading + filename + '... ');
s:= filename + '.' + cBitsStr + '.png';
tmpsurf:= IMG_Load(Str2PChar(s));

if tmpsurf = nil then
   begin
   s:= filename + '.png';
   tmpsurf:= IMG_Load(Str2PChar(s));
   end;

if tmpsurf = nil then
   if critical then OutError(msgFailed, true)
      else begin
      WriteLnToConsole(msgFailed);
      exit(nil)
      end;

if setTransparent then TryDo(SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, 0) = 0, errmsgTransparentSet, true);
//if hasAlpha then Result:= SDL_DisplayFormatAlpha(tmpsurf)
//            else Result:= SDL_DisplayFormat(tmpsurf);
{$IFDEF DEBUGFILE}WriteLnToConsole('(' + inttostr(tmpsurf^.w) + ',' + inttostr(tmpsurf^.h) + ') ');{$ENDIF}
WriteLnToConsole(msgOK);
LoadImage:= tmpsurf//Result
end;

procedure SetupOpenGL;
begin
glLoadIdentity;
glViewport(0, 0, cScreenWidth, cScreenHeight);
glScalef(2.0 / cScreenWidth, -2.0 / cScreenHeight, 1.0);
glTranslatef(-cScreenWidth / 2, -cScreenHeight / 2, 0);
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
glMatrixMode(GL_MODELVIEW)
end;

////////////////////////////////////////////////////////////////////////////////
var ProgrTex: PTexture = nil;
    Step: integer = 0;

procedure AddProgress;
var r: TSDL_Rect;
    texsurf: PSDL_Surface;
begin
if Step = 0 then
   begin
   WriteToConsole(msgLoading + 'progress sprite: ');
   texsurf:= LoadImage(Pathz[ptGraphics] + '/Progress', false, true, true);
   ProgrTex:= Surface2Tex(texsurf);
   SDL_FreeSurface(texsurf)
   end;
glClear(GL_COLOR_BUFFER_BIT);
r.x:= 0;
r.w:= ProgrTex^.w;
r.h:= ProgrTex^.w;
r.y:= (Step mod (ProgrTex^.h div ProgrTex^.w)) * ProgrTex^.w;
DrawFromRect((cScreenWidth - ProgrTex^.w) div 2,
             (cScreenHeight - ProgrTex^.w) div 2, @r, ProgrTex, SDLPrimSurface);
SDL_GL_SwapBuffers();
inc(Step);
end;

procedure FinishProgress;
begin
WriteLnToConsole('Freeing progress surface... ');
FreeTexture(ProgrTex)
end;

end.