(*

 * Hedgewars, a worms-like game

 *

 * Distributed under the terms of the BSD-modified licence:

 *

 * Permission is hereby granted, free of charge, to any person obtaining a copy

 * of this software and associated documentation files (the "Software"), to deal

 * with the Software without restriction, including without limitation the

 * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or

 * sell copies of the Software, and to permit persons to whom the Software is

 * furnished to do so, subject to the following conditions:

 *

 * 1. Redistributions of source code must retain the above copyright notice,

 *    this list of conditions and the following disclaimer.

 * 2. Redistributions in binary form must reproduce the above copyright notice,

 *    this list of conditions and the following disclaimer in the documentation

 *    and/or other materials provided with the distribution.

 * 3. The name of the author may not be used to endorse or promote products

 *    derived from this software without specific prior written permission.

 *

 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED

 * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF

 * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO

 * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,

 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;

 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,

 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR

 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF

 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

 *)

unit uStore;

interface

uses uConsts, uTeams, SDLh;

{$INCLUDE options.inc}

type PRangeArray = ^TRangeArray;

     TRangeArray = array[0..31] of record

                                   Left, Right: integer;

                                   end;

procedure StoreInit;

procedure StoreLoad;

procedure StoreRelease;

procedure DrawGear(Stuff : TStuff; X, Y: integer; Surface: PSDL_Surface);

procedure DrawSpriteFromRect(r: TSDL_Rect; X, Y, Height, Position: integer; Surface: PSDL_Surface);

procedure DrawSprite (Sprite: TSprite; X, Y, Position: integer; Surface: PSDL_Surface);

procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: integer; Surface: PSDL_Surface);

procedure DrawLand (X, Y: integer; Surface: PSDL_Surface);

procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface);

procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false);

procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);

procedure DrawExplosion(X, Y, Radius: integer);

procedure DrawHLinesExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);

procedure DrawTunnel(X, Y, dX, dY: real; ticks, HalfWidth: integer);

procedure RenderHealth(var Hedgehog: THedgehog);

function  RenderString(var s: shortstring; Color, Pos: integer): TSDL_Rect;

procedure AddProgress;

function  LoadImage(filename: string; hasAlpha: boolean): PSDL_Surface;

var PixelFormat: PSDL_PixelFormat;

 SDLPrimSurface: PSDL_Surface;

implementation

uses uMisc, uIO, uConsole, uLand;

var StoreSurface,

     TempSurface,

       HHSurface: PSDL_Surface;

procedure DrawExplosion(X, Y, Radius: integer);

var ty, tx, p: integer;

begin

for ty:= max(-Radius, -y) to min(radius, 1023 - y) do

    for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do

        Land[ty + y, tx]:= 0;

if SDL_MustLock(LandSurface) then

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

p:= integer(LandSurface.pixels);

case LandSurface.format.BytesPerPixel of

     1: ;// not supported

     2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

            for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do

                PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= 0;

     3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

            for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do

                begin

                PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= 0;

                PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= 0;

                PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= 0;

                end;

     4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

            for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do

                PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= 0;

     end;

inc(Radius, 4);

case LandSurface.format.BytesPerPixel of

     1: ;// not supported

     2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

            for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do

               if Land[y + ty, tx] <> 0 then

                  PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor;

     3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

            for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do

               if Land[y + ty, tx] <> 0 then

                begin

                PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF;

                PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF;

                PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16);

                end;

     4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

            for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do

               if Land[y + ty, tx] <> 0 then

                   PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor;

     end;

if SDL_MustLock(LandSurface) then

   SDL_UnlockSurface(LandSurface);

SDL_UpdateRect(LandSurface, X - Radius, Y - Radius, Radius * 2, Radius * 2)

end;

procedure DrawHLinesExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);

var tx, ty, i, p: integer;

begin

if SDL_MustLock(LandSurface) then

   SDL_LockSurface(LandSurface);

p:= integer(LandSurface.pixels);

for i:= 0 to Pred(Count) do

    begin

    case LandSurface.format.BytesPerPixel of

     1: ;

     2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

            for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do

                PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= 0;

     3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

            for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do

                begin

                PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= 0;

                PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= 0;

                PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= 0;

                end;

     4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

            for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do

                PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= 0;

     end;

    inc(y, dY)

    end;

inc(Radius, 4);

dec(y, Count*dY);

for i:= 0 to Pred(Count) do

    begin

    case LandSurface.format.BytesPerPixel of

     1: ;

     2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

            for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do

               if Land[y + ty, tx] <> 0 then

                  PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor;

     3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

            for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do

               if Land[y + ty, tx] <> 0 then

                begin

                PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF;

                PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF;

                PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16);

                end;

     4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

            for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do

               if Land[y + ty, tx] <> 0 then

                   PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor;

     end;

    inc(y, dY)

    end;

if SDL_MustLock(LandSurface) then

   SDL_UnlockSurface(LandSurface);

end;

//

//  - (dX, dY) - direction, vector of length = 0.5

//

procedure DrawTunnel(X, Y, dX, dY: real; ticks, HalfWidth: integer);

var nx, ny: real;

    i, t, tx, ty, p: integer;

begin  // (-dY, dX) is (dX, dY) turned by PI/2

if SDL_MustLock(LandSurface) then

   SDL_LockSurface(LandSurface);

nx:= X + dY * (HalfWidth + 8);

ny:= Y - dX * (HalfWidth + 8);

p:= integer(LandSurface.pixels);

for i:= 0 to 7 do

    begin

    X:= nx - 8 * dX;

    Y:= ny - 8 * dY;

    for t:= -8 to ticks + 8 do

        {$include tunsetborder.inc}

    nx:= nx - dY;

    ny:= ny + dX;

    end;

for i:= -HalfWidth to HalfWidth do

    begin

    X:= nx - dX * 8;

    Y:= ny - dY * 8;

    for t:= 0 to 7 do

        {$include tunsetborder.inc}

    X:= nx;

    Y:= ny;

    for t:= 0 to ticks do

        begin

        X:= X + dX;

        Y:= Y + dY;

        tx:= round(X);

        ty:= round(Y);

        if ((ty and $FFFFFC00) = 0) and ((tx and $FFFFF800) = 0) then

           begin

           Land[ty, tx]:= 0;

           case LandSurface.format.BytesPerPixel of

                1: ;

                2: PWord(p + LandSurface.pitch * ty + tx * 2)^:= 0;

                3: begin

                   PByte(p + LandSurface.pitch * ty + tx * 3 + 0)^:= 0;

                   PByte(p + LandSurface.pitch * ty + tx * 3 + 1)^:= 0;

                   PByte(p + LandSurface.pitch * ty + tx * 3 + 2)^:= 0;

                   end;

                4: PLongword(p + LandSurface.pitch * ty + tx * 4)^:= 0;

                end

           end

        end;

    for t:= 0 to 7 do

        {$include tunsetborder.inc}

    nx:= nx - dY;

    ny:= ny + dX;

    end;

for i:= 0 to 7 do

    begin

    X:= nx - 8 * dX;

    Y:= ny - 8 * dY;

    for t:= -8 to ticks + 8 do

        {$include tunsetborder.inc}

    nx:= nx - dY;

    ny:= ny + dX;

    end;

if SDL_MustLock(LandSurface) then

   SDL_UnlockSurface(LandSurface)

end;

procedure StoreInit;

begin

StoreSurface  := SDL_CreateRGBSurface(SDL_HWSURFACE, 576, 1024, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0);

TryDo( StoreSurface <> nil, errmsgCreateSurface + ': store' , true);

SDL_FillRect(StoreSurface, nil, 0);

TempSurface   := SDL_CreateRGBSurface(SDL_HWSURFACE, 724, 320, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0);

TryDo(  TempSurface <> nil, errmsgCreateSurface + ': temp'  , true);

TryDo(SDL_SetColorKey( StoreSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);

//TryDo(SDL_SetColorKey(SpriteSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);

TryDo(SDL_SetColorKey(  TempSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);

end;

procedure LoadToSurface(Filename: String; Surface: PSDL_Surface; X, Y: integer);

var tmpsurf: PSDL_Surface;

    rr: TSDL_Rect;

begin

  tmpsurf:= LoadImage(Filename, false);

  rr.x:= X;

  rr.y:= Y;

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

  SDL_FreeSurface(tmpsurf);

end;

function WriteInRoundRect(Surface: PSDL_Surface; X, Y: integer; Color: LongWord; Font: THWFont; s: string): TSDL_Rect;

var w, h: integer;

    tmpsurf: PSDL_Surface;

    clr: TSDL_Color;

begin

TTF_SizeText(Fontz[Font].Handle, PChar(s), w, h);

Result.x:= X;

Result.y:= Y;

Result.w:= w + 6;

Result.h:= h + 6;

SDL_GetRGB(Color, Surface.format, @clr.r, @clr.g, @clr.b);

tmpsurf:= TTF_RenderText_Blended(Fontz[Font].Handle, PChar(s), clr);

Result.x:= X + 3;

Result.y:= Y + 3;

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

SDL_FreeSurface(tmpsurf);

Result.x:= X;

Result.y:= Y;

Result.w:= w + 6;

Result.h:= h + 6

end;

procedure StoreLoad;

var i: TStuff;

    ii: TSprite;

    fi: THWFont;

    s: string;

    tmpsurf: PSDL_Surface;

    procedure WriteNames(Font: THWFont);

    var Team: PTeam;

        i: integer;

    begin

    r.x:= 0;

    r.y:= 272;

    Team:= TeamsList;

    while Team<>nil do

      begin

      r:= WriteInRoundRect(StoreSurface, r.x, r.y, Team.Color, Font, Team.TeamName);

      Team.NameRect:= r;

      inc(r.y, r.h);

      for i:= 0 to 7 do

          if Team.Hedgehogs[i].Gear<>nil then

             begin

             r:= WriteInRoundRect(StoreSurface, r.x, r.y, Team.Color, Font, Team.Hedgehogs[i].Name);

             Team.Hedgehogs[i].NameRect:= r;

             inc(r.y, r.h)

             end;

      Team:= Team.Next

      end;

    end;

    procedure MakeCrossHairs;

    var Team: PTeam;

        r: TSDL_Rect;

        tmpsurf: PSDL_Surface;

        s: string;

        TransColor: Longword;

    begin

    r.x:= 0;

    r.y:= 256;

    r.w:= 16;

    r.h:= 16;

    s:= Pathz[ptGraphics] + cCHFileName;

    WriteToConsole(msgLoading + s + ' ');

    tmpsurf:= IMG_Load(PChar(s));

    TryDo(tmpsurf <> nil, msgFailed, true);

    WriteLnToConsole(msgOK);

    TransColor:= SDL_MapRGB(tmpsurf.format, $FF, $FF, $FF);

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

    Team:= TeamsList;

    while Team<>nil do

      begin

      SDL_FillRect(StoreSurface, @r, Team.Color);

      SDL_UpperBlit(tmpsurf, nil, StoreSurface, @r);

      Team.CrossHairRect:= r;

      inc(r.x, 16);

      Team:= Team.Next

      end;

    SDL_FreeSurface(tmpsurf)

    end;

    procedure InitHealth;

    var p: PTeam;

        i, t: integer;

    begin

    p:= TeamsList;

    t:= 0;

    while p <> nil do

          begin

          for i:= 0 to cMaxHHIndex do

              if p.Hedgehogs[i].Gear <> nil then

                 begin

                 p.Hedgehogs[i].HealthRect.y:= t;

                 RenderHealth(p.Hedgehogs[i]);

                 inc(t, p.Hedgehogs[i].HealthRect.h)

                 end;

          p:= p.Next

          end

    end;

    procedure LoadGraves;

    var p: PTeam;

        l: integer;

    begin

    p:= TeamsList;

    l:= 512;

    while p <> nil do

          begin

          dec(l, 32);

          if p.GraveName = '' then p.GraveName:= 'Simple';

          LoadToSurface(Pathz[ptGraves] + p.GraveName + '.png', StoreSurface, l, 512);

          p.GraveRect.x:= l;

          p.GraveRect.y:= 512;

          p.GraveRect.w:= 32;

          p.GraveRect.h:= 256;

          p:= p.Next

          end

    end;

    procedure GetSkyColor;

    var p: Longword;

    begin

    if SDL_MustLock(StoreSurface) then

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

    p:= Longword(StoreSurface.pixels) + Word(StuffPoz[sSky].x) * StoreSurface.format.BytesPerPixel;

    case StoreSurface.format.BytesPerPixel of

         1: cSkyColor:= PByte(p)^;

         2: cSkyColor:= PWord(p)^;

         3: cSkyColor:= (PByte(p)^) or (PByte(p + 1)^ shl 8) or (PByte(p + 2)^ shl 16);

         4: cSkyColor:= PLongword(p)^;

         end;

    if SDL_MustLock(StoreSurface) then

       SDL_UnlockSurface(StoreSurface)

    end;

    procedure GetExplosionBorderColor;

    var f: textfile;

        c: integer;

    begin

    s:= Pathz[ptThemeCurrent] + cThemeCFGFilename;

    WriteToConsole(msgLoading + s + ' ');

    AssignFile(f, s);

    {$I-}

    Reset(f);

    Readln(f, s);

    Closefile(f);

    {$I+}

    TryDo(IOResult = 0, msgFailed, true);

    WriteLnToConsole(msgOK);

    val(s, cExplosionBorderColor, c);

    if cFullScreen then

    cExplosionBorderColor:= SDL_MapRGB(PixelFormat, (cExplosionBorderColor shr 16) and $FF,

                                                    (cExplosionBorderColor shr 8) and $FF,

                                                     cExplosionBorderColor and $FF)

    else

    cExplosionBorderColor:= SDL_MapRGB(LandSurface.format, (cExplosionBorderColor shr 16) and $FF,

                                                           (cExplosionBorderColor shr 8) and $FF,

                                                            cExplosionBorderColor and $FF)

    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(PChar(s), Height);

         TryDo(Handle <> nil, msgFailed, true);