(*

 * Hedgewars, a worms-like game

 * Copyright (c) 2004, 2005, 2006 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

{$INCLUDE options.inc}

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, Frame: integer; Surface: PSDL_Surface);

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

procedure DrawSurfSprite(X, Y, Height, Frame: integer; Source, 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);

procedure DrawCentered(X, Top: integer; Source, Surface: PSDL_Surface);

procedure DrawFromStoreRect(X, Y: integer; Rect: PSDL_Rect; Surface: PSDL_Surface);

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

procedure RenderHealth(var Hedgehog: THedgehog);

procedure AddProgress;

var PixelFormat: PSDL_PixelFormat;

 SDLPrimSurface: PSDL_Surface;

   PauseSurface: PSDL_Surface;

implementation

uses uMisc, uConsole, uLand, uLocale;

var StoreSurface,

       HHSurface: PSDL_Surface;

procedure StoreInit;

begin

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

SDL_FillRect(StoreSurface, nil, 0);

TryDo(SDL_SetColorKey( StoreSurface, 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

  rr.x:= X;

  rr.y:= Y;

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

  SDL_FreeSurface(tmpsurf);

end;

var r: TSDL_Rect;

begin

r:= rect^;

if Clear then SDL_FillRect(Surface, @r, 0);

SDL_FillRect(Surface, @r, BorderColor);

SDL_FillRect(Surface, @r, BorderColor);

SDL_FillRect(Surface, @r, FillColor);

SDL_FillRect(Surface, @r, FillColor)

end;

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

    tmpsurf: PSDL_Surface;

    clr: TSDL_Color;

begin

Result.x:= X;

Result.y:= Y;

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

Result.h:= h + FontBorder * 2;

clr.r:= Color shr 16;

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

clr.b:= Color and $FF;

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;

end;

procedure StoreLoad;

var i: TStuff;

    ii: TSprite;

    fi: THWFont;

    s: string;

    tmpsurf: PSDL_Surface;

    procedure WriteNames(Font: THWFont);

    var Team: PTeam;

        i: integer;

        r, rr: TSDL_Rect;

        drY: integer;

    begin

    r.x:= 0;

    r.y:= 272;

    drY:= cScreenHeight - 4;

    Team:= TeamsList;

    while Team<>nil do

      begin

      r.w:= 104;

      r.w:= cTeamHealthWidth + 5;

      rr:= r;

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

      inc(r.y, r.h);

      dec(drY, r.h + 2);

      for i:= 0 to 7 do

               if Gear <> nil then

      end;

    end;

    procedure MakeCrossHairs;

    var Team: PTeam;

        tmpsurf: PSDL_Surface;

        s: string;

    begin

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

    Team:= TeamsList;

    while Team<>nil do

      begin

      end;

    SDL_FreeSurface(tmpsurf)

    end;

    procedure InitHealth;

    var p: PTeam;

        i: integer;

    begin

    p:= TeamsList;

    while p <> nil do

          begin

          for i:= 0 to cMaxHHIndex do

          end

    end;

    procedure LoadGraves;

    var p: PTeam;

        l: integer;

    begin

    p:= TeamsList;

    l:= 512;

    while p <> nil do

          begin

          dec(l, 32);

          end

    end;

    procedure GetSkyColor;

    var p: PByteArray;

    begin

    if SDL_MustLock(SpritesData[sprSky].Surface) then

       SDLTry(SDL_LockSurface(SpritesData[sprSky].Surface) >= 0, true);

         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;

    if SDL_MustLock(SpritesData[sprSky].Surface) then

       SDL_UnlockSurface(SpritesData[sprSky].Surface)

    end;

    procedure GetExplosionBorderColor;

    var f: textfile;

        c: integer;

    begin

    s:= Pathz[ptCurrTheme] + '/' + cThemeCFGFilename;

    WriteToConsole(msgLoading + s + ' ');

    {$I-}

    Reset(f);

    Readln(f, s);

    {$I+}

    TryDo(IOResult = 0, msgFailed, true);

    WriteLnToConsole(msgOK);

    val(s, cExplosionBorderColor, c);

    AdjustColor(cExplosionBorderColor);

    end;

begin

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

    with Fontz[fi] do

         begin

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

         WriteToConsole(msgLoading + s + '... ');

         SDLTry(Handle <> nil, true);

         TTF_SetFontStyle(Handle, style);

         WriteLnToConsole(msgOK)

         end;

AddProgress;

WriteToConsole('LandSurface tuning... ');

tmpsurf:= LandSurface;

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

if cFullScreen then

   begin

   LandSurface:= SDL_DisplayFormat(tmpsurf);

   SDL_FreeSurface(tmpsurf);

   end else LandSurface:= tmpsurf;

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

WriteLnToConsole(msgOK);

GetExplosionBorderColor;

AddProgress;

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

    LoadToSurface(Pathz[StuffLoadData[i].Path] + '/' + StuffLoadData[i].FileName, StoreSurface, StuffPoz[i].x, StuffPoz[i].y);

AddProgress;

WriteNames(fnt16);

MakeCrossHairs;

LoadGraves;

AddProgress;

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

    with SpritesData[ii] do

         begin

         if AltPath = ptNone then

         else begin

            if Surface = nil then

            end;

         end;

GetSkyColor;

AddProgress;

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

HHSurface:= SDL_DisplayFormat(tmpsurf);

SDL_FreeSurface(tmpsurf);

InitHealth;

PauseSurface:= RenderString(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: integer; r: PSDL_Rect; SourceSurface, DestSurface: PSDL_Surface);

var rr: TSDL_Rect;

begin

rr.x:= X;

rr.y:= Y;

if SDL_UpperBlit(SourceSurface, r, DestSurface, @rr) < 0 then

   begin

   OutError('Blit: ' + SDL_GetError, true);

   exit

   end;

end;

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

begin

DrawFromRect(X, Y, @StuffPoz[Stuff], StoreSurface, Surface)

end;

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

begin

r.y:= r.y + Height * Position;

r.h:= Height;

DrawFromRect(X, Y, @r, StoreSurface, Surface)

end;

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

begin

DrawSurfSprite(X, Y, SpritesData[Sprite].Height, Frame, SpritesData[Sprite].Surface, Surface)

end;

procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: integer; 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].Surface, Surface)

end;

procedure DrawSurfSprite(X, Y, Height, Frame: integer; Source, Surface: PSDL_Surface);

var r: TSDL_Rect;

begin

r.x:= 0;

r.y:= Frame * Height;

r.h:= Height;

DrawFromRect(X, Y, @r, Source, Surface)

end;

procedure DXOutText(X, Y: Integer; 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;

if tmpsurf = nil then

   begin

   SetKB(1);

   exit

   end;

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

SDL_FreeSurface(tmpsurf)

end;

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

const r: TSDL_Rect = (x: 0; y: 0; w: 2048; h: 1024);

begin

DrawFromRect(X, Y, @r, LandSurface, Surface)

end;

procedure DrawFromStoreRect(X, Y: integer; Rect: PSDL_Rect; Surface: PSDL_Surface);

begin

DrawFromRect(X, Y, Rect, StoreSurface, Surface)

end;

procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface);

begin

DrawFromRect(X - (Rect.w) div 2, Y, @Rect, StoreSurface, Surface)

end;

procedure DrawCentered(X, Top: integer; Source, Surface: PSDL_Surface);

var r: TSDL_Rect;

begin

r.y:= Top;

SDL_UpperBlit(Source, nil, Surface, @r)

end;

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

var r: TSDL_Rect;

begin

r.x:= Step * 32;

r.y:= Pos * 32;

r.w:= 32;

r.h:= 32;

DrawFromRect(X, Y, @r, HHSurface, Surface)

end;

procedure StoreRelease;

var ii: TSprite;

begin

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

    SDL_FreeSurface(SpritesData[ii].Surface);

SDL_FreeSurface(  HHSurface  );

SDL_FreeSurface(LandSurface  );

SDL_FreeSurface(StoreSurface )

end;

begin

Result:= SDL_CreateRGBSurface(SDL_HWSURFACE, w + FontBorder * 2 + 4, h + FontBorder * 2,

TryDo(Result <> nil, 'RenderString: fail to create surface', true);

WriteInRoundRect(Result, 0, 0, Color, font, s);

end;

procedure RenderHealth(var Hedgehog: THedgehog);

var s: shortstring;

begin

if Hedgehog.HealthTag <> nil then SDL_FreeSurface(Hedgehog.HealthTag);

Hedgehog.HealthTag:= RenderString(s, Hedgehog.Team^.Color, fnt16)

end;

procedure AddProgress;

const Step: Longword = 0;

      ProgrSurf: PSDL_Surface = nil;

      MaxCalls = 11; // MaxCalls should be the count of calls to AddProgress to prevent memory leakage

var r: TSDL_Rect;

begin

if Step = 0 then

   begin

   WriteToConsole(msgLoading + 'progress sprite: ');

   end;

SDL_FillRect(SDLPrimSurface, nil, 0);

r.x:= 0;

r.w:= 32;

r.h:= 32;